| 日 | 月 | 火 | 水 | 木 | 金 | 土 |
|---|---|---|---|---|---|---|
| 1 | 2 | 3 | 4 | 5 | 6 | 7 |
| 8 | 9 | 10 | 11 | 12 | 13 | 14 |
| 15 | 16 | 17 | 18 | 19 | 20 | 21 |
| 22 | 23 | 24 | 25 | 26 | 27 | 28 |
| 29 | 30 | 31 |
分数が組めるようになりました。
といっても、水平方向の文字位置を調整する機能が入っていませんので、 2 次方程式の解の公式のように、中央寄せが必要な場合も、左寄せになってしまいます。
この組み方ですと、 CSS の text-align 属性が効かないみたいなのですよね。 もちろん、 div の align 属性も駄目。 とすると、 padding で中央に持っていくくらいしかないのですかねえ。
| 固定リンク
| コメント (0)
| トラックバック (0)
CSS の出力部分を作成します。
(defun gen-css-props (root ast) (let ((hs (get-elem-heights ast))) (gen-css-props1 root ast hs))) (defun gen-css-props1 (root ast hs) (let ((mh (max-velem-n-height hs))) (gen-css-props2 root ast nil hs mh))) (defun gen-css-props2 (root ast rest? hs mh) (cond ((atom ast) nil) ((atom (car ast)) (let ((c1 (car ast)) (c2 (cadr ast)) (c3 (caddr ast))) (cond ((or (eq c1 'text) (eq c1 'argend)) nil) ((eq c1 'frac) (cons (list (make-css-name root c1 c2) (list 'float "left") (list 'position "relative") (list 'top (format nil "~Aem" (* (- mh (cadr (caddr hs))) 1.1)))) (gen-frac-props root c3 hs))) (t (cons (list (make-css-name root c1 c2)) (gen-css-props1 root c3 hs)))))) ((atom (caar ast)) (let ((c1 (caar ast)) (c2 (cadar ast))) (if (and (eq c1 'text) (not rest?)) (cons (list (make-css-name root "b" c2) (list 'padding-left "0.2em") (list 'padding-right "0.2em") (list 'float "left") (list 'position "relative") (list 'top (format nil "~Aem" (* mh 0.8)))) (gen-css-props2 root (cdr ast) t (cdr hs) mh)) (append (gen-css-props2 root (car ast) nil (car hs) mh) (gen-css-props2 root (cdr ast) nil (cdr hs) mh))))))) (defun gen-frac-props (root ast hs) (defun frac-arg (arg h pfn) (let ((c1 (car arg)) (c2 (cadr arg)) (c3 (caddr arg))) (cons (append (list (make-css-name root c1 c2) (list 'clear "left")) (funcall pfn)) (gen-css-props1 root c3 h)))) (let ((num (car ast)) (den (cadr ast))) (append (frac-arg num (caddr (caddr hs)) (lambda () nil)) (frac-arg den (caddr (cadddr hs)) (lambda () (list (list 'border-top "solid 1pt"))))))) (defun output-css-classes (classes stm) (mapc (lambda (class) (let ((cn (car class)) (ps (cdr class))) (format stm "~A {~%" cn) (mapc (lambda (p) (let ((n (car p)) (v (cadr p))) (format stm "~A: ~A;~%" n v))) ps) (format stm "}~%"))) classes)) (defun css-props-string (props) (with-output-to-string (out) (format out "~%") (output-css-classes props out))) (defun math2html (str) (let ((ast (parse-string str 0))) (let ((elem `(html ((head ((style (type "text/css") (text ,(css-props-string (gen-css-props "math" ast)))))) (body ((div (class "math") ,(gen-html-elem ast)))))) ) (b (get-buffer-create *buffer-name*))) (erase-buffer b) (with-open-stream (stm (make-buffer-stream b)) (output-html elem stm)) b)))
| 固定リンク
| コメント (0)
| トラックバック (0)
式中の分数の最大高さを求めます。
(defun max-velem-height (elems) (defun velem-height (e) (let ((c1 (car e)) (c2 (cadr e))) (if (eq c1 'v) c2 0))) (defun iter (es i) (cond ((eq es nil) i) ((listp (car es)) (iter (cdr es) (max (velem-height (car es)) i))) (t (iter (cdr es) i)))) (iter elems 0))
このように：
(max-velem-height (get-elem-heights (parse-string "x = \\frac{a}{b} + c" 0))) =>2 (max-velem-height (get-elem-heights (parse-string "\\frac{1}{1 + \\frac{1}{2}} + a + \\frac{\\frac{1}{2} + 1}{1 + \\frac{1}{2}}" 0))) =>4
式中の分数の分子の最大高さを求めます。
(defun max-velem-n-height (elems) (defun velem-n-height (e) (let ((c1 (car e)) (c2 (cadr e))) (if (eq c1 'v) (let ((c3 (caddr e))) (cadr c3)) 0))) (defun iter (es i) (cond ((eq es nil) i) ((listp (car es)) (iter (cdr es) (max (velem-n-height (car es)) i))) (t (iter (cdr es) i)))) (iter elems 0))
このように：
(max-velem-n-height (get-elem-heights (parse-string "x = \\frac{a}{b} + c" 0))) =>1 (max-velem-n-height (get-elem-heights (parse-string "\\frac{1}{1 + \\frac{1}{2}} + a + \\frac{\\frac{1}{2} + 1}{1 + \\frac{1}{2}}" 0))) =>2
| 固定リンク
| コメント (0)
| トラックバック (0)
各要素の高さを求めます。
(defun text-height (str) (if (<= (length str) 1) (char-columns (schar str 0)) (reduce (lambda (x y) (cond ((and (characterp x) (characterp y)) (max (char-columns x) (char-columns y))) ((and (numberp x) (characterp y)) (max x (char-columns y))))) str))) (defun helem-height (h) (cond ((eq h nil) 0) ((numberp h) h) (t (cadr h)))) (defun get-helem-heights (hs) (let ((h (car hs))) (cond ((symbolp h) (cadr hs)) ((<= (length hs) 1) (helem-height (car hs))) (t (reduce (lambda (x y) (max (helem-height x) (helem-height y))) hs))))) (defun get-elem-heights (elem) (if elem (cond ((atom (car elem)) (let ((c1 (car elem)) (c2 (cadr elem)) (c3 (caddr elem))) (cond ((eq c1 'frac) (let ((num (get-elem-heights (car c3))) (den (get-elem-heights (cadr c3)))) (list 'v (+ (get-helem-heights num) (get-helem-heights den)) num den))) ((eq c1 'text) (text-height c3)) ((eq c1 'argbegin) (let ((hs (cons (get-elem-heights (car c3)) (get-elem-heights (cdr c3))))) (list 'h (get-helem-heights hs) hs))) (t 0)))) (t (cons (get-elem-heights (car elem)) (get-elem-heights (cdr elem)))))))
こうなります：
(get-elem-heights
(parse-string "\\frac{\\frac{1}{2} + 1}{1 + \\frac{1}{2}}" 0))
((v 4
(h 2 ((v 2 (h 1 (1 0)) (h 1 (1 0))) 1 1 0))
(h 2 (1 1 (v 2 (h 1 (1 0)) (h 1 (1 0))) 0))))
| 固定リンク
| コメント (0)
| トラックバック (0)
垂直方向の位置を決める問題。
というのは、例えば以下のような式があったとしまして：
x = \frac{a}{b} + c
分数の前後にある文字の位置を、分母と分子の間まで下げたいわけです。
もっと、嫌らしい例を挙げますと：
\frac{1}{1 + \frac{1}{2}} + a + \frac{\frac{1}{2} + 1}{1 + \frac{1}{2}}
まず、真ん中の a をどれだけ下げればよいか、というのは、その後ろの分数の分子の高さで決まります。この分数は、分子にさらに分数が入っていますので、その高さはその分数の、 分子の高さ ＋ 分母の高さ ということになります。
次に、先頭の分数を下げる量を考えます。この分数の分子には、分数が入っていませんので、後ろの分数の方が高さが大きくなり、その差は、後ろの分数の分子の分数の分子の高さ、ということになります。よって、先頭の分数は、これだけを下げることとなります。
この例からわかることをまとめますと：
最後に、分数の分母分子の中に分数がある場合には、その分母分子の中についても同様に位置を下げる必要があります。
さて、そうすると、やらなければならない処理は：
と、いうことになりますかね。
| 固定リンク
| コメント (0)
| トラックバック (0)
parse-string 関数の誤りの訂正。 キーワードを見つけたときにも、下降しないと駄目でした。横着な実装は、やはり使えないみたいです。
(defun parse-string (str se) (if (> (length str) 0) (let ((m (match-token str))) (let ((mb (car m)) (me (cadr m)) (spec (caddr m))) (if mb (let ((se2 (+ se me))) (cond ((eq spec 'key) ; 下降させる。 (let ((keyargs (parse-keyargs (substring str (+ mb 1) me) (substring str me) se2))) (let ((se3 (parse-end keyargs))) (cons keyargs (parse-string (substring str (- se3 se)) se3))))) ((eq spec 'argbegin) ; parse-args -> parse-arg (let ((arg (parse-arg (substring str me) se2))) (let ((se3 (parse-end arg))) (cons arg (parse-string (substring str (+ (- se3 se2) 1)) se3))))) ((eq spec 'argend) (cons (list spec se2 (substring str mb me)) nil)) ((eq spec 'text) (cons (list spec se2 (substring str mb me)) (parse-string (substring str me) se2))))) (parse-string (substring str 1) (+ se 1))))))) (defun parse-keyargs (kw str se) (let ((sym (find-keyword kw *keywords*))) (if (eq sym nil) (error (format nil "keyword ~A not found." kw)) (list sym se (parse-args str se))))) (defun parse-args (str se) (if (> (length str) 0) (let ((m (match-token str))) (let ((mb (car m)) (me (cadr m)) (spec (caddr m))) (if mb (let ((se2 (+ se me))) (cond ((eq spec 'argbegin) (let ((arg (parse-arg (substring str me) se2))) (let ((se3 (parse-end arg))) (cons arg (parse-args (substring str (+ (- se3 se2) 1)) se3))))) (t nil)))))))) (defun parse-arg (str se) (let ((succ (parse-string str se))) (if (eq succ nil) (list 'argbegin se (list (+ se 1) nil)) (list 'argbegin se succ))))
| 固定リンク
| コメント (0)
| トラックバック (0)
再度 HTML 出力に戻ります。 CSS に手を付けて気付きましたが、 span 要素が div 要素に入っていないのはまずい。位置指定ができなくなってしまいます。
(defun gen-html-elem1 (ast rest?) (cond ((atom ast) nil) ((and (atom (car ast)) (listp (caddr ast))) (list 'div (list 'class (format nil "~A~A" (car ast) (cadr ast))) (gen-html-elem1 (caddr ast) nil))) ((and (atom (caar ast)) (eq (caar ast) 'argend)) (gen-html-elem1 (cdr ast) nil)) ((and (atom (caar ast)) (eq (caar ast) 'text)) (if rest? (gen-html-elem1 (cdr ast) rest?) (cons (list 'div (list 'class (format nil "b~A" (cadar ast))) (gen-html-elem2 ast)) (gen-html-elem1 (cdr ast) t)))) (t (cons (gen-html-elem1 (car ast) nil) (gen-html-elem1 (cdr ast) nil))))) (defun gen-html-elem2 (ast) (cond ((atom ast) nil) ((atom (car ast)) (cond ((eq (car ast) 'text) (list 'span (list 'class (format nil "~A~A" (car ast) (cadr ast))) (list 'text (caddr ast)))) (t nil))) ((and (atom (caar ast)) (eq (caar ast) 'text)) (cons (gen-html-elem2 (car ast)) (gen-html-elem2 (cdr ast)))) (t nil))) (defun gen-html-elem (ast) (gen-html-elem1 ast nil))
ということで、 span 要素は全部 div のなかに入れました。
(gen-html-elem (parse-string "x = \\frac{a}{b} + c" 0)) => ((div (class "b1") ((span (class "text1") (text "x")) (span (class "text3") (text "=")))) (div (class "frac9") ((div (class "argbegin10") ((div (class "b11") ((span (class "text11") (text "a")))))) (div (class "argbegin13") ((div (class "b14") ((span (class "text14") (text "b")))))))) (div (class "b17") ((span (class "text17") (text "+")) (span (class "text19") (text "c")))))
math2html を実行しますと：
(math2html "x = \\frac{a}{b} + c")
=>#<buffer: *math2html*>
このように：
<html> <body> <div class="math"> <div class="b1"> <span class="text1">x</span> <span class="text3">=</span> </div> <div class="frac9"> <div class="argbegin10"> <div class="b11"> <span class="text11">a</span> </div> </div> <div class="argbegin13"> <div class="b14"> <span class="text14">b</span> </div> </div> </div> <div class="b17"> <span class="text17">+</span> <span class="text19">c</span> </div> </div> </body> </html>
| 固定リンク
| コメント (0)
| トラックバック (0)
CSS の出力にとりかかります。これが、このプログラムの一番のキモになる部分ですね。
(defun gen-css-props (root ast) (cond ((atom ast) nil) ((atom (car ast)) (let ((c1 (car ast)) (c2 (cadr ast)) (c3 (caddr ast))) (cond ((eq c1 'argend) nil) ((eq c1 'frac) (cons (list (make-css-name root c1 c2)) (gen-frac-props root c3))) (t (cons (list (make-css-name root c1 c2)) (gen-css-props root c3)))))) (t (append (gen-css-props root (car ast)) (gen-css-props root (cdr ast)))))) (defun make-css-name (root c1 c2) (format nil ".~A .~A~A" root c1 c2)) (defun gen-frac-props (root ast) (append (gen-css-props root (car ast)) (let ((c (cadr ast))) (let ((c1 (car c)) (c2 (cadr c)) (c3 (caddr c))) (cons (list (make-css-name root c1 c2) (list 'border-top "solid 1pt")) (gen-css-props root c3))))))
とりあえず、荒くスケッチを作ってみました。
(gen-css-props "math" (parse-string "x =\\frac{a}{b}+ c" 0)) => ((".math .text1") (".math .text3") (".math .frac8") (".math .argbegin9") (".math .text10") (".math .argbegin12" (border-top "solid 1pt")) (".math .text13") (".math .text15") (".math .text17"))
| 固定リンク
| コメント (0)
| トラックバック (0)
HTML の出力です。
HTML を出力するだけならカンタン、と思いきや妙に手こずってしまいました。入出力は、関数プログラミングの鬼門かも。 Common Lisp は、モナドとかじゃなくて、普通に副作用で出力するのですけど。
(defun gen-html-elem (ast) (cond ((atom ast) nil) ((and (atom (car ast)) (atom (caddr ast))) (cond ((eq (car ast) 'text) (list 'span (list 'class (format nil "~A~A" (car ast) (cadr ast))) (list 'text (caddr ast)))) (t nil))) ((atom (car ast)) (list 'div ;; cons list -> list (list 'class (format nil "~A~A" (car ast) (cadr ast))) (gen-html-elem (caddr ast)))) ((and (atom (caadr ast)) (eq (caadr ast) 'argend)) ;; ignore argend. (cons (gen-html-elem (car ast)) (gen-html-elem (cddr ast)))) (t (cons (gen-html-elem (car ast)) (gen-html-elem (cdr ast))))))
gen-html-elem 関数に、色々と忘れものをしていたので、変更を行いました。
(defun elem-childs (elem) (cond ((atom elem) nil) ((atom (car elem)) (elem-childs (cdr elem))) ((atom (caar elem)) (elem-childs (cdr elem))) (t (car elem)))) (defun output-attrs (attrs stm outfn) (cond ((atom attrs) nil) ((and (atom (caar attrs)) (atom (cadar attrs))) (let ((n (caar attrs)) (v (cadar attrs))) (progn (funcall outfn n v stm) (output-attrs (cdr attrs) stm outfn)))) (t (output-attrs (cdr attrs) stm outfn)))) (defun output-html (elem stm) (cond ((atom elem) nil) ((atom (car elem)) (let ((c (car elem)) (cs (cdr elem))) (format stm "<~A" c) (output-attrs cs stm (lambda (n v stm) (if (eq n 'text) nil (format stm " ~A=\"~A\"" n v)))) (format stm ">~%") (output-attrs cs stm (lambda (n v stm) (if (eq n 'text) (format stm "~A~%" v)))) (output-html (elem-childs cs) stm) (format stm "</~A>~%" c))) (t (progn (output-html (car elem) stm) (output-html (cdr elem) stm))))) (setf *buffer-name* "*math2html*") (defun math2html (str) (let ((ast (parse-string str 0))) (let ((elem `(html ((body ((div (class "math") ,(gen-html-elem ast)))))) ) (b (get-buffer-create *buffer-name*))) (erase-buffer b) (with-open-stream (stm (make-buffer-stream b)) (output-html elem stm)) b)))
最後の関数、 math2html を eval すると：
(math2html "x =\\frac{a}{b}+ c")
=>#<buffer: *math2html*>
バッファに HTML を出力します。長いので、 span エレメントの改行を消してます。実際には、エレメントごとに改行した状態で出力されます。
<html> <body> <div class="math"> <span class="text1">x</span> <span class="text3">=</span> <div class="frac8"> <div class="argbegin9"> <span class="text10">a</span> </div> <div class="argbegin12"> <span class="text13">b</span> </div> </div> <span class="text15">+</span> <span class="text17">c</span> </div> </body> </html>
| 固定リンク
| コメント (0)
| トラックバック (0)
HTML エレメントに変換。
;(defun parse-string (str elems se) (defun parse-string (str se)
重大なことに気付きました。 parse-string 関数の elems 引数は使っていません。ので、キャンセルということで。
たぶん、ここに破壊的代入で AST を構築するつもりだったのですね。で、戻り値で文字位置を戻すと。 命令的な書き方ですと、そういうインターフェイスになりそうです。
(defun gen-html-elem (ast) (cond ((atom ast) nil) ((and (atom (car ast)) (atom (caddr ast))) (cond ((eq (car ast) 'text) (list 'span (list 'class (format nil "~A~A" (car ast) (cadr ast))) (list 'text (caddr ast)))) (t nil))) ((atom (car ast)) (cons (list 'div (list 'class (format nil "~A~A" (car ast) (cadr ast)))) (gen-html-elem (caddr ast)))) (t (cons (gen-html-elem (car ast)) (gen-html-elem (cdr ast))))))
gen-html-elem 関数は、 AST を受け取って、 HTML エレメントに変換します。
こんな感じ：
(gen-html-elem (parse-string "x =\\frac{a}{b}+ c" 0)) => ((span (class "text1") (text "x")) (span (class "text3") (text "=")) ((div (class "frac8")) ((div (class "argbegin9")) (span (class "text10") (text "a")) nil) ((div (class "argbegin12")) (span (class "text13") (text "b")) nil)) (span (class "text15") (text "+")) (span (class "text17") (text "c")))
| 固定リンク
| コメント (0)
| トラックバック (0)
キーワード＋引数部分の解析です。
(defun parse-string (str elems se) (if (> (length str) 0) (let ((m (match-token str))) (let ((mb (car m)) (me (cadr m)) (spec (caddr m))) (if mb (let ((se2 (+ se me))) (cond ((eq spec 'keyargs) (cons (parse-keyword (substring str mb me) se) ;; se2 -> se (parse-string (substring str me) elems se2))) ((eq spec 'argbegin) (let ((args (parse-args (substring str me) se2))) (let ((se3 (parse-end args))) (cons args (parse-string (substring str (+ (- se3 se2) 1)) elems se3))))) ((eq spec 'argend) (cons (list spec se2 (substring str mb me)) nil)) ((eq spec 'text) (cons (list spec se2 (substring str mb me)) (parse-string (substring str me) elems se2))))) (parse-string (substring str 1) elems (+ se 1))))))) (defun parse-keyword (str se) (let ((mb (string-match *match-key* str)) (me (match-end 0))) (let ((kw (match-string 1))) (let ((sym (find-keyword kw *keywords*))) (if (eq sym nil) (error (format nil "keyword ~A not found." kw)) (let ((se2 (+ se me))) (list sym se2 (parse-string (substring str me) nil se2))))))))
これで、 parse-string 関数は一応完成と：
(parse-string "x = \\frac{a}{b} + c" nil 0) => ((text 1 "x") (text 3 "=") (frac 9 ((argbegin 10 ((text 11 "a") (argend 12 "}"))) (argbegin 13 ((text 14 "b") (argend 15 "}"))))) (text 17 "+") (text 19 "c"))
| 固定リンク
| コメント (0)
| トラックバック (0)
引数解析で、色々ハマりました^^)
(setf *match-argbegin* "{") (setf *match-argend* "}") (setf *match-text* "[^ \\{}]+") (defun parse-string (str elems se) (if (> (length str) 0) (let ((m (match-token str))) (let ((mb (car m)) (me (cadr m)) (spec (caddr m))) (if mb (let ((se2 (+ se me))) (cond ((eq spec 'keyargs) (cons (parse-keyword (substring str mb me) se2) (parse-string (substring str me) elems se2))) ((eq spec 'argbegin) (let ((args (parse-args (substring str me) se2))) (let ((se3 (parse-end args))) (cons args (parse-string (substring str (+ (- se3 se2) 1)) elems se3))))) ((eq spec 'argend) (cons (list spec se2 (substring str mb me)) nil)) ((eq spec 'text) (cons (list spec se2 (substring str mb me)) (parse-string (substring str me) elems se2))))) (parse-string (substring str 1) elems (+ se 1)))))))
引数解析を行なう関係で、 parse-string 関数を色々と書き換えました。トークンの種類別に処理を行なう、というのと、解析対象の文字列をどこまで読んだか判るように、引数・戻り値にそれぞれ文字位置を追加しました。
(defun parse-end (ast) (cond ((atom ast) 0) ((atom (car ast)) (max (cadr ast) (parse-end (caddr ast)))) (t (max (parse-end (car ast)) (parse-end (cdr ast)))))) (defun parse-args (str se) (let ((succ (parse-string str nil se))) (if (eq succ nil) (list 'argbegin se (list (+ se 1) nil)) (list 'argbegin se succ))))
parse-end 関数は、解析結果を受け取って、文字列からどこまでトークンを読み込んだか、その最後の文字位置を返します。
ここは、 グローバル変数を使おうかと 悩みました。単に文字位置を取るためにリストを走査するっていうのがね。作り方間違ったかな？ ま、とりあえずこうしておいて、後でまた考えるということで。
parse-args 関数は、 parse-string 関数が、引数のカッコを見つけたときに呼ばれる関数です。
こうなりました：
(parse-string "{a}{b}" nil 0) => ((argbegin 1 ((text 2 "a") (argend 3 "}"))) (argbegin 4 ((text 5 "b") (argend 6 "}")))) (parse-string "{a{b}}{c}" nil 0) => ((argbegin 1 ((text 2 "a") (argbegin 3 ((text 4 "b") (argend 5 "}"))) (argend 6 "}"))) (argbegin 7 ((text 8 "c") (argend 9 "}")))) (parse-string "{a{b{c}}}{d{e}}" nil 0) => ((argbegin 1 ((text 2 "a") (argbegin 3 ((text 4 "b") (argbegin 5 ((text 6 "c") (argend 7 "}"))) (argend 8 "}"))) (argend 9 "}"))) (argbegin 10 ((text 11 "d") (argbegin 12 ((text 13 "e") (argend 14 "}"))) (argend 15 "}"))))
| 固定リンク
| コメント (0)
| トラックバック (0)
(setf *match-keyargs* "\\\\[a-z]+\\({.+}\\)*") (setf *match-text* "[^ \\]+") (defun debug (msg) (let ((b (get-buffer-create "*debug*"))) (let ((bp (buffer-size b))) (with-open-stream (stm (make-buffer-stream b bp)) (format stm "~A~%" msg)))))
defvar を setf に変更しました。 defvar で一度値が束縛されてしまうと、再度評価しても値を変えられないことに、遅まきながら気付きまして。
match-text の仕様を変えようと思って、実際変えてみたら、再評価で値を変えられないということに気付きました。空白だけでなく、バックスラッシュでも、トークンを区切れるように変えてます。
debug 関数が追加されているのは、それで、ちょっとハマったから ^^)
キーワード解析部分の途中まで。
(setf *match-key* "\\\\\\([a-z]+\\)") (setf *match-arg* "{\\(.+\\)}") (setf *keywords* (list '("frac" frac))) (defun find-keyword (str lst) (cond ((eq nil lst) nil) ((string= str (caar lst)) (cadar lst)) (t (find-keyword str (cdr lst))))) (defun parse-keyword (str) (let ((mb (string-match *match-key* str)) (me (match-end 0))) (let ((kw (match-string 1))) (list (find-keyword kw *keywords*) (substring str me)))))
最後の関数 parse-keyword を eval すると、こうなります：
(parse-keyword "\\frac{a}{b}") =>(frac "{a}{b}")
| 固定リンク
| コメント (0)
| トラックバック (0)
さて、プログラミングのお時間です。
xyzzy の Common Lisp 処理系を使わせていただきます。理由は、私が愛用しているエディタだからです。以上。
分数を組版することだけを考えることにします。数式は、以下のように入力します。何かに似ているような気がするかもしれませんが、気のせいです。
x = \frac{a}{b} + c
まだ手をつけたところですが、何か長くなりそうなので、途中経過を載せてしまいます。あまり長くなると、ソースを載せるのが面倒になってしまいますので。
入力文字列を、トークンに分割するところまでです。
(defvar *match-keyargs* "\\\\[a-z]+{.+}*") (defvar *match-text* "[^ ]+") (defun match-token (str) (match-token-specs str (list `(,*match-keyargs* keyargs) `(,*match-text* text)))) (defun match-token-specs (str specs) (if specs (let ((mb (string-match (concat "^" (caar specs)) str)) (me (match-end 0))) (if mb (list mb me (cadar specs)) (match-token-specs str (cdr specs)))) nil)) (defun parse-string (str elems) (if (> (length str) 0) (let ((m (match-token str))) (let ((mb (car m)) (me (cadr m)) (spec (caddr m))) (if mb (if (eq spec 'keyargs) (cons (list spec (substring str mb me)) (parse-string (substring str me) elems)) (cons (list spec (substring str mb me)) (parse-string (substring str me) elems))) (parse-string (substring str 1) elems))))))
最後の関数を eval すると、こうなります：
(parse-string "x = \\frac{a}{b} + c" nil) =>((text "x") (text "=") (keyargs "\\frac{a}{b}") (text "+") (text "c"))
parse-string 関数の、 (if (eq spec 'keyargs) ... のところ、同じ式を 2 回書いていますが、ここが、これから手をつけようとしている場所です。 キーワード＋引数を見つけたら、どうにかするという処理を、これから書こうかと思っているところです。
| 固定リンク
| コメント (0)
| トラックバック (0)
例えば、こういう "イベント型" のテーブルがあったとき :
select ev_id, ev_date, ev_str from t_event order by ev_date; ev_id | ev_date | ev_str -------+------------+---------- 23 | 2003-01-01 | event1 24 | 2003-01-21 | event2 25 | 2003-02-20 | event3 26 | 2003-03-19 | event4 27 | 2003-04-05 | event5 28 | 2003-04-22 | event6 29 | 2003-05-12 | event7 30 | 2003-06-04 | event8 -- More --
"前の日付" とか、 "前の前の日付" とかを一緒にとりたい場合があります。
すなわち :
ev_date | ev_str | p_ev_date | pp_ev_date ------------+----------+------------+------------ 2003-01-01 | event1 | | 2003-01-21 | event2 | 2003-01-01 | 2003-02-20 | event3 | 2003-01-21 | 2003-01-01 2003-03-19 | event4 | 2003-02-20 | 2003-01-21 2003-04-05 | event5 | 2003-03-19 | 2003-02-20 2003-04-22 | event6 | 2003-04-05 | 2003-03-19 2003-05-12 | event7 | 2003-04-22 | 2003-04-05 2003-06-04 | event8 | 2003-05-12 | 2003-04-22 -- More --
こんな SQL :
select e1.ev_date, e1.ev_str, e2.p_ev_date, max(e3.ev_date) as pp_ev_date from t_event e1 inner join ( select e1.ev_id, e1.ev_date, max(e2.ev_date) as p_ev_date from t_event e1 left join ( select ev_date from t_event) e2 on e2.ev_date < e1.ev_date group by e1.ev_id, e1.ev_date) e2 on e2.ev_id = e1.ev_id left join ( select ev_date from t_event) e3 on e3.ev_date < e2.p_ev_date group by e1.ev_date, e1.ev_str, e2.p_ev_date order by e1.ev_date;
往々にして、この種のテーブルは、レコードが 1億件 とかあるんですよね。そのようなテーブルで、上のような SQL を実行しますと、テンポラリ領域がオーバー・フローします。
これこそ、非正規化して、 "前の日付" 、 "前の前の日付" をカラムに持たせるべきじゃないでしょうか？
と、ここで私の中のゴースト X が語りかけてきます。
「おいおい、データベースの中に linked list を作ろう ってのかい？ INSERT 、 DELETE、 UPDATE でどうなるか考えてみなよ。」
こうなりますね :
まさに linked list 。
「 "みんなの" データベース でそんなことしたら、どうなる？ われらがレコードをまさにデータベースに突っ込まんとす、ってときに、他の奴が "前の" レコードを消しちまったら？ RDBMS が java.util.ConcurrentModificationException を throw してくださるってのか？」
ですわな。
とすると、やっぱり、 テーブルはこのまま正規形にしておいて、読み取り側のアプリケーションに泣いてもらうのがベターですかね。 SQL 式でとろうとせずに、ホスト言語側でループするなり、 PL/SQL − PL/pgSQL か − を使うなりすれば、何とかなるでしょう。
| 固定リンク
| コメント (0)
| トラックバック (0)
数式の組版も組版には違いないわけですから、 HTML と CSS でも出来るんじゃね？ と思いまして。実際、 CSS の仕様書なんて、まるで組版システムですしね。
Cascading Style Sheets Level 2 Revision 1 (CSS 2.1) Specification
実際やってみると、ブラウザによって、レンダリングが違いすぎるのがつらい。まあ、細かいところに目をつぶれば、それなりには出来る、とはいえるかも。
以下が、試しに作ってみたもの。
| 固定リンク
| コメント (2)
| トラックバック (0)
実装クラスを、適当なタイミングで差し替えたいわけですね。
>java Main Foo1Factory class Foo1Factory Foo1@9304b1 >java Main Foo2Factory class Foo2Factory Foo2@9304b1
public class Main { public static void main(String[] args) throws ClassNotFoundException { Class.forName(args[0]); Foo foo = FooFactory.createFoo(); System.out.println(foo); } } public abstract class FooFactory { static FooFactory factory; public static Foo createFoo() { return factory.createFooImpl(); } public abstract Foo createFooImpl(); } public class Foo1Factory extends FooFactory { @Override public Foo createFooImpl() { return new Foo1(); } static { FooFactory.factory = new Foo1Factory(); System.out.println(Foo1Factory.class); } } public class Foo2Factory extends FooFactory { @Override public Foo createFooImpl() { return new Foo2(); } static { FooFactory.factory = new Foo2Factory(); System.out.println(Foo2Factory.class); } }
しかし、クラスの数が増えてくると、似たような Factory のコードをいっぱい書かなければならないのが、面倒になってくるわけでして。”汎用ファクトリ”が欲しくなってきます。そこで、 Dependency Injection Container （ DI コンテナ） の登場、ということになります。
でも、外部ライブラリ （ DI コンテナ） を使いたくないってこともあります。ソース・コードだけで完結する、ということにも色々メリットがありますしね。そういったときは、 Factory パターンを使えばよいかと。
余談。
実装クラスを差し替えたい場合というのは、たいていは、リンク・エディット時に実装クラスを決めたいってことだったりします。ひとつのソース・ツリーから、2種類以上の実行ファイルを作り出したいとき。どのソース・ファイルがビルドに含まれるかによって、 どの実装クラスを使うのかが決まるようにしたいわけです。
でも、 Java には、スタティック・リンクという概念がないのですよね。結局、差し替えるのは、アプリケーション起動時になります。
アプリケーション起動時に実装が決まる、というのは、なにか中途半端に感じるのですよね。実装を決めたいのは、普通はビルド時じゃないかな。ソフトウエアを配布する前。
ソフトウエアの実行中（起動時にあらず）に実装を差し替える、という要件は、電話の交換機のソフトウエアなどではあるらしいですね。台数が多いから、いちいちデプロイ・再起動なんてやってられない、ってことですかね。全部自動で入れ替われ、と。
| 固定リンク
| コメント (0)
| トラックバック (0)
回線速度の計測 の続き。
Linux サーバ側で、ローカル・ループバックに送ってみました。
[localhost]$ java SpeedTest client localhost 9999 145 187 874 1507 7417 14891 73285 3615779.3103448274 4.485886631016043E7 4.798974828375286E7 5.566428666224287E7 5.654987191586895E7 5.63334094419448E7 5.723277614791567E7 4.603496258174721E7
50Mbps くらい。伝送効率 0.5 というのは低いですが、ありえない値という程でもないですね。
としますと、 Linux サーバ側に問題がある、という訳でもなさそうです。 Windows クライアント - Linux サーバ間の通信の問題と考えるべきでしょう。
Wireshark を使って、 Windows クライアントのパケットを除いてみます。
[TCP Dup ACK 27#1] distinct > saiseh [ACK] Seq=1 Ack=9653 Win=26280 Len=0 SLE=11113 SRE=12573
saiseh > distinct [ACK] Seq=22225 Ack=1 Win=65535 Len=1460
[TCP Dup ACK 27#2] distinct > saiseh [ACK] Seq=1 Ack=9653 Win=26280 Len=0 SLE=11113 SRE=14033
[TCP Fast Retransmission] saiseh > distinct [ACK] Seq=9653 Ack=1 Win=65535 Len=1460
[TCP Dup ACK 27#3] distinct > saiseh [ACK] Seq=1 Ack=9653 Win=26280 Len=0 SLE=11113 SRE=15493
saiseh > distinct [PSH, ACK] Seq=23685 Ack=1 Win=65535 Len=892
[TCP Dup ACK 27#4] distinct > saiseh [ACK] Seq=1 Ack=9653 Win=26280 Len=0 SLE=11113 SRE=16385
[TCP Dup ACK 27#5] distinct > saiseh [ACK] Seq=1 Ack=9653 Win=26280 Len=0 SLE=11113 SRE=17845
[TCP Dup ACK 27#6] distinct > saiseh [ACK] Seq=1 Ack=9653 Win=26280 Len=0 SLE=11113 SRE=19305
[TCP Dup ACK 27#7] distinct > saiseh [ACK] Seq=1 Ack=9653 Win=26280 Len=0 SLE=11113 SRE=20765
[TCP Dup ACK 27#8] distinct > saiseh [ACK] Seq=1 Ack=9653 Win=26280 Len=0 SLE=22225 SRE=23685 SLE=11113 SRE=20765
distinct > saiseh [ACK] Seq=1 Ack=20765 Win=29200 Len=0 SLE=22225 SRE=23685
[TCP Dup ACK 41#1] distinct > saiseh [ACK] Seq=1 Ack=20765 Win=29200 Len=0 SLE=22225 SRE=24577
saiseh > distinct [ACK] Seq=24577 Ack=1 Win=65535 Len=1460
[TCP Dup ACK 41#2] distinct > saiseh [ACK] Seq=1 Ack=20765 Win=29200 Len=0 SLE=22225 SRE=26037
[TCP Fast Retransmission] saiseh > distinct [ACK] Seq=20765 Ack=1 Win=65535 Len=1460
"Dup ACK" というのが一杯出てます。クライアントがパケットを送り出すスピードが速すぎて、サーバが受け取れない、ってことですかね。
以下を参考に、 Windows の TCP ウインドウ・サイズを、 64 KB から 17KB へと変えてみましたが、特に変化なし。
Windows 2000 および Windows Server 2003 の TCP 機能について - Microsoft Knowledge Base 224829
Java プログラムの書き込みバッファ・サイズを変更する、というのは効くみたいです。
final int BUFFER_SIZE = 1460 * 4; System.out.print("Buffer: "); System.out.println(BUFFER_SIZE); Socket sock = new Socket(host, port); sock.setSendBufferSize(BUFFER_SIZE); sock.setReceiveBufferSize(BUFFER_SIZE); BufferedOutputStream out = new BufferedOutputStream(sock.getOutputStream(), BUFFER_SIZE);
でも、 これだけですと、 10Mbps くらいが限度みたいですね。
>java -client SpeedTest client 192.168.0.125 9999 Buffer: 5840 1982 1205 4013 8118 40793 81263 416608 264524.7225025227 6961500.41493776 1.0451791677049588E7 1.0333343187977334E7 1.0281920917804526E7 1.0322788969149552E7 1.0067747138797143E7 8383373.861174061
| 固定リンク
| コメント (0)
| トラックバック (0)
問題の趣旨を理解できていないかもしれませんが。
これができないから、いつまでたっても、Date型とか使わずにcharやnumberな日付時刻カラムがなくならないんだよな。
夜勤帯が存在するような業務の場合、「当日の24:00」と「翌日の0:00」を区別したい、という話は出てきますね。
日付と時刻を分割するしかないんじゃないですかねえ。
PostgreSQL ですと、こんな感じになります。
create table t_event( ev_id serial, ev_date date, ev_interval interval, ev_str varchar(10), primary key (ev_id) ); insert into t_event( ev_date, ev_interval, ev_str) values( '2009-01-31', '24:01:00', 'event1'); insert into t_event( ev_date, ev_interval, ev_str) values( '2009-02-01', '00:00:00', 'event2'); insert into t_event( ev_date, ev_interval, ev_str) values( '2009-02-01', '00:01:00', 'event3'); select * from t_event order by ev_date, ev_interval; ev_id | ev_date | ev_interval | ev_str -------+------------+-------------+-------- 1 | 2009-01-31 | 24:01:00 | event1 2 | 2009-02-01 | 00:00:00 | event2 3 | 2009-02-01 | 00:01:00 | event3 (3 rows) select ev_date + ev_interval as normalize, ev_str from t_event order by ev_date, ev_interval; normalize | ev_str ---------------------+-------- 2009-02-01 00:01:00 | event1 2009-02-01 00:00:00 | event2 2009-02-01 00:01:00 | event3 (3 rows) select ev_date::varchar || ' ' || ev_interval::varchar as to_s, ev_str from t_event order by ev_date, ev_interval; to_s | ev_str ---------------------+-------- 2009-01-31 24:01:00 | event1 2009-02-01 00:00:00 | event2 2009-02-01 00:01:00 | event3 (3 rows) select ev_date - 1 as round_date, ev_interval + '24:00:00' as round_interval, ev_str from t_event where ev_id = 3 order by ev_date, ev_interval; round_date | round_interval | ev_str ------------+----------------+-------- 2009-01-31 | 24:01:00 | event3 (1 row)
| 固定リンク
| コメント (0)
| トラックバック (0)
最近のコメント