当前SMathML是一个仍然在快速推进的项目, 因而这里的参考可能是过时的, 必须以实现为准.
SMathML不是一个排版引擎, 目前它将所有的排版工作都委托给了浏览器. 从本质上来说, 排版工作不仅可以委托给浏览器, 还可以通过转换过程或者输出过程 (那么此时输出也是某种变换) 委托给LaTeX等其他后端. 但是, 它的模型是基于浏览器的. 也就是说, 它提供的是表达HTML和MathML的手段. (另外, 它还考虑了CSS和SVG, 但是远非完善, 几乎很难使用.) 即便真有人设计实现了其他后端, 那也是非直接的, 并且也并非作者本人的意图.
SMathML的目的是提供在网页上书写数学内容的成熟方式. 尽管如此, 当前MathJax等其他软件/库的流行使得SMathML看起来似乎没有必要. 问题在于, 当前这些流行的选择几乎都没能提供必要的抽象和组合手段. 这个问题并没有引起太多的重视, 因为数学排版的事实标准LaTeX在抽象和组合方面也已经是一言难尽了. (并且, 大多数软件/库提供的都是对于LaTeX的受限模拟, 使得抽象和组合的能力被进一步削弱.) 然而, 这个问题终究是真实存在的, 所以才有了作者设计和实现的SMathML.
当前SMathML是一个嵌入Racket的DSL. 换言之, 使用者可以不加限制地享受Racket的完整生态系统, 这与某些其他排版系统形成了鲜明的对比, 例如Typst. 嵌入其他的Scheme实现或许是可能的, 但是因为当前SMathML不加限制地使用Racket特有的关键词机制, 所以说兼容层可能并不容易实现. 不过用户也可以选择另起炉灶, 修改SMathML本身的一些表达机制.
SMathML基于SXML, SXML可以理解为在Scheme/Lisp语言中对于XML的直接列表表示. 另外, 或许SXML也可以理解为一种句法, 但是这种理解既没有必要, 也太过受限, 所以我们并不会使用. 这是因为SMathML的表达力来源于它能够对于SXML进行直接的操纵和变换. 我们的SXML和Oleg Kiselyov的SXML并不完全一样, 而Racket提供的SXML库和Oleg Kiselyov的设计是相同的. 不同之处在于当前SXML的属性是强制存在的, 如果没有就使用空表来表示, 这使其更为一致. 不过, 这也使得裸表达SXML更为繁琐. 不过, 通过提供众多的基本函数, 这一点在实际使用SMathML中完全不是问题. SMathML也提供了类似于Oleg Kiselyov的SXSLT的变换机制, 但是只提供了SXSLT的一小部分机能. 至少对于当前而言, 作者认为这已经是足够了的.
这一章我们提供了用于表达MathML和HTML的SXML形式的最为基本函数的参考. 这一章没有什么令人意外的地方, 读者仅需快速浏览即可完全掌握.
(define (Math #:attr* [attr* '()] . mathml*)
`(math ,attr* . ,mathml*))让我们先来看这一个过程, 本章剩余的过程均和此过程的模式完全一致. 它有一个关键词参数, 这个关键词参数是属性, 默认为空. 另外, 我们的命名约定是, 所有的MathML和HTML在SMathML中对应过程的名字是原本的元素名的首字母大写版本. 这就是需要说明的全部内容了.以下是所有的MathML部分基本函数.
(define (Math #:attr* [attr* '()] . mathml*)
`(math ,attr* . ,mathml*))
(define (Merror #:attr* [attr* '()] . mathml*)
`(merror ,attr* . ,mathml*))
(define (Mfrac #:attr* [attr* '()] . mathml*)
`(mfrac ,attr* . ,mathml*))
(define (Mi #:attr* [attr* '()] . mathml*)
`(mi ,attr* . ,mathml*))
(define (Mmultiscripts #:attr* [attr* '()] . mathml*)
`(mmultiscripts ,attr* . ,mathml*))
(define (Mprescripts #:attr* [attr* '()] . mathml*)
`(mprescripts ,attr* . ,mathml*))
(define (Mn #:attr* [attr* '()] . mathml*)
`(mn ,attr* . ,mathml*))
(define (Mo #:attr* [attr* '()] . mathml*)
`(mo ,attr* . ,mathml*))
(define (Mover #:attr* [attr* '()] . mathml*)
`(mover ,attr* . ,mathml*))
(define (Mpadded #:attr* [attr* '()] . mathml*)
`(mpadded ,attr* . ,mathml*))
(define (Mphantom #:attr* [attr* '()] . mathml*)
`(mphantom ,attr* . ,mathml*))
(define (Mroot #:attr* [attr* '()] . mathml*)
`(mroot ,attr* . ,mathml*))
(define (Mrow #:attr* [attr* '()] . mathml*)
`(mrow ,attr* . ,mathml*))
(define (Ms #:attr* [attr* '()] . mathml*)
`(ms ,attr* . ,mathml*))
(define (Mspace #:attr* [attr* '()] . mathml*)
`(mspace ,attr* . ,mathml*))
(define (Msqrt #:attr* [attr* '()] . mathml*)
`(msqrt ,attr* . ,mathml*))
(define (Mstyle #:attr* [attr* '()] . mathml*)
`(mstyle ,attr* . ,mathml*))
(define (Msub #:attr* [attr* '()] . mathml*)
`(msub ,attr* . ,mathml*))
(define (Msubsup #:attr* [attr* '()] . mathml*)
`(msubsup ,attr* . ,mathml*))
(define (Msup #:attr* [attr* '()] . mathml*)
`(msup ,attr* . ,mathml*))
(define (Mtable #:attr* [attr* '()] . mathml*)
`(mtable ,attr* . ,mathml*))
(define (Mtd #:attr* [attr* '()] . mathml*)
`(mtd ,attr* . ,mathml*))
(define (Mtext #:attr* [attr* '()] . mathml*)
`(mtext ,attr* . ,mathml*))
(define (Mtr #:attr* [attr* '()] . mathml*)
`(mtr ,attr* . ,mathml*))
(define (Munder #:attr* [attr* '()] . mathml*)
`(munder ,attr* . ,mathml*))
(define (Munderover #:attr* [attr* '()] . mathml*)
`(munderover ,attr* . ,mathml*))
(define (Maction #:attr* [attr* '()] . mathml*)
`(maction ,attr* . ,mathml*))
(define (Menclose #:attr* [attr* '()] . mathml*)
`(menclose ,attr* . ,mathml*))
(define (Mfenced #:attr* [attr* '()] . mathml*)
`(mfenced ,attr* . ,mathml*))实际上它们也不完全是手写的, 而是生成的. 然而, 从软件工程角度来看, 我应该使用宏进行抽象, 目前的实现并不那么令人满意. 不过, 至少当前的定义足够清晰, 也易于修改.还有一些实用的补充定义, 值得放在这一章.
(define (MathB #:attr* [attr* '()] . mathml*)
`(math ((display "block") . ,attr*) . ,mathml*))
(define M Math)
(define MB MathB)
(define (MBL label . exp*)
(MB (Mtable #:attr*
'((columnalign "left center right")
(displaystyle "true")
(width "100%"))
(Mtr (Mtd (Mphantom label))
(apply Mtd exp*)
(Mtd label)))))其中MathB设定display属性为block, 而M和MB分别是Math和MathB的缩写. 注意Math元素分别有两种渲染方式, 一种是inline, 另一种是block, 默认情况是inline, 使用过LaTeX的人应该不难理解. 至于MBL, 它在MB的基础上为公式添加了标签.(define $ (Mrow))
(define ^ Msup)
(define _ Msub)
(define _^ Msubsup)
(define __ Munder)
(define ^^ Mover)
(define __^^ Munderover)
(define ~ Mfrac)
(define % Mtext)除了$, 其余都是一些基本元素的简短别名. 至于$, 它的功能就是占位, 别无其他.HTML部分和MathML部分如出一辙.
(define (A #:attr* [attr* '()] . html*)
`(a ,attr* . ,html*))
(define (Abbr #:attr* [attr* '()] . html*)
`(abbr ,attr* . ,html*))
(define (Address #:attr* [attr* '()] . html*)
`(address ,attr* . ,html*))
(define (Area #:attr* [attr* '()] . html*)
`(area ,attr* . ,html*))
(define (Article #:attr* [attr* '()] . html*)
`(article ,attr* . ,html*))
(define (Aside #:attr* [attr* '()] . html*)
`(aside ,attr* . ,html*))
(define (Audio #:attr* [attr* '()] . html*)
`(audio ,attr* . ,html*))
(define (B #:attr* [attr* '()] . html*)
`(b ,attr* . ,html*))
(define (Base #:attr* [attr* '()] . html*)
`(base ,attr* . ,html*))
(define (Bdi #:attr* [attr* '()] . html*)
`(bdi ,attr* . ,html*))
(define (Bdo #:attr* [attr* '()] . html*)
`(bdo ,attr* . ,html*))
(define (Blockquote #:attr* [attr* '()] . html*)
`(blockquote ,attr* . ,html*))
(define (Body #:attr* [attr* '()] . html*)
`(body ,attr* . ,html*))
(define (Br #:attr* [attr* '()] . html*)
`(br ,attr* . ,html*))
(define (Button #:attr* [attr* '()] . html*)
`(button ,attr* . ,html*))
(define (Canvas #:attr* [attr* '()] . html*)
`(canvas ,attr* . ,html*))
(define (Caption #:attr* [attr* '()] . html*)
`(caption ,attr* . ,html*))
(define (Cite #:attr* [attr* '()] . html*)
`(cite ,attr* . ,html*))
(define (Code #:attr* [attr* '()] . html*)
`(code ,attr* . ,html*))
(define (Col #:attr* [attr* '()] . html*)
`(col ,attr* . ,html*))
(define (Colgroup #:attr* [attr* '()] . html*)
`(colgroup ,attr* . ,html*))
(define (Data #:attr* [attr* '()] . html*)
`(data ,attr* . ,html*))
(define (Datalist #:attr* [attr* '()] . html*)
`(datalist ,attr* . ,html*))
(define (Dd #:attr* [attr* '()] . html*)
`(dd ,attr* . ,html*))
(define (Del #:attr* [attr* '()] . html*)
`(del ,attr* . ,html*))
(define (Details #:attr* [attr* '()] . html*)
`(details ,attr* . ,html*))
(define (Dfn #:attr* [attr* '()] . html*)
`(dfn ,attr* . ,html*))
(define (Dialog #:attr* [attr* '()] . html*)
`(dialog ,attr* . ,html*))
(define (Div #:attr* [attr* '()] . html*)
`(div ,attr* . ,html*))
(define (Dl #:attr* [attr* '()] . html*)
`(dl ,attr* . ,html*))
(define (Dt #:attr* [attr* '()] . html*)
`(dt ,attr* . ,html*))
(define (Em #:attr* [attr* '()] . html*)
`(em ,attr* . ,html*))
(define (Embed #:attr* [attr* '()] . html*)
`(embed ,attr* . ,html*))
(define (Fieldset #:attr* [attr* '()] . html*)
`(fieldset ,attr* . ,html*))
(define (Figcaption #:attr* [attr* '()] . html*)
`(figcaption ,attr* . ,html*))
(define (Figure #:attr* [attr* '()] . html*)
`(figure ,attr* . ,html*))
(define (Footer #:attr* [attr* '()] . html*)
`(footer ,attr* . ,html*))
(define (Form #:attr* [attr* '()] . html*)
`(form ,attr* . ,html*))
(define (H1 #:attr* [attr* '()] . html*)
`(h1 ,attr* . ,html*))
(define (H2 #:attr* [attr* '()] . html*)
`(h2 ,attr* . ,html*))
(define (H3 #:attr* [attr* '()] . html*)
`(h3 ,attr* . ,html*))
(define (H4 #:attr* [attr* '()] . html*)
`(h4 ,attr* . ,html*))
(define (H5 #:attr* [attr* '()] . html*)
`(h5 ,attr* . ,html*))
(define (H6 #:attr* [attr* '()] . html*)
`(h6 ,attr* . ,html*))
(define (Head #:attr* [attr* '()] . html*)
`(head ,attr* . ,html*))
(define (Header #:attr* [attr* '()] . html*)
`(header ,attr* . ,html*))
(define (Hgroup #:attr* [attr* '()] . html*)
`(hgroup ,attr* . ,html*))
(define (Hr #:attr* [attr* '()] . html*)
`(hr ,attr* . ,html*))
(define (Html #:attr* [attr* '()] . html*)
`(html ,attr* . ,html*))
(define (I #:attr* [attr* '()] . html*)
`(i ,attr* . ,html*))
(define (Iframe #:attr* [attr* '()] . html*)
`(iframe ,attr* . ,html*))
(define (Img #:attr* [attr* '()] . html*)
`(img ,attr* . ,html*))
(define (Input #:attr* [attr* '()] . html*)
`(input ,attr* . ,html*))
(define (Ins #:attr* [attr* '()] . html*)
`(ins ,attr* . ,html*))
(define (Kbd #:attr* [attr* '()] . html*)
`(kbd ,attr* . ,html*))
(define (Label #:attr* [attr* '()] . html*)
`(label ,attr* . ,html*))
(define (Legend #:attr* [attr* '()] . html*)
`(legend ,attr* . ,html*))
(define (Li #:attr* [attr* '()] . html*)
`(li ,attr* . ,html*))
(define (Link #:attr* [attr* '()] . html*)
`(link ,attr* . ,html*))
(define (Main #:attr* [attr* '()] . html*)
`(main ,attr* . ,html*))
(define (Map #:attr* [attr* '()] . html*)
`(map ,attr* . ,html*))
(define (Mark #:attr* [attr* '()] . html*)
`(mark ,attr* . ,html*))
(define (Menu #:attr* [attr* '()] . html*)
`(menu ,attr* . ,html*))
(define (Meta #:attr* [attr* '()] . html*)
`(meta ,attr* . ,html*))
(define (Meter #:attr* [attr* '()] . html*)
`(meter ,attr* . ,html*))
(define (Nav #:attr* [attr* '()] . html*)
`(nav ,attr* . ,html*))
(define (Noscript #:attr* [attr* '()] . html*)
`(noscript ,attr* . ,html*))
(define (Object #:attr* [attr* '()] . html*)
`(object ,attr* . ,html*))
(define (Ol #:attr* [attr* '()] . html*)
`(ol ,attr* . ,html*))
(define (Optgroup #:attr* [attr* '()] . html*)
`(optgroup ,attr* . ,html*))
(define (Option #:attr* [attr* '()] . html*)
`(option ,attr* . ,html*))
(define (Output #:attr* [attr* '()] . html*)
`(output ,attr* . ,html*))
(define (P #:attr* [attr* '()] . html*)
`(p ,attr* . ,html*))
(define (Picture #:attr* [attr* '()] . html*)
`(picture ,attr* . ,html*))
(define (Pre #:attr* [attr* '()] . html*)
`(pre ,attr* . ,html*))
(define (Progress #:attr* [attr* '()] . html*)
`(progress ,attr* . ,html*))
(define (Q #:attr* [attr* '()] . html*)
`(q ,attr* . ,html*))
(define (Rp #:attr* [attr* '()] . html*)
`(rp ,attr* . ,html*))
(define (Rt #:attr* [attr* '()] . html*)
`(rt ,attr* . ,html*))
(define (Ruby #:attr* [attr* '()] . html*)
`(ruby ,attr* . ,html*))
(define (S #:attr* [attr* '()] . html*)
`(s ,attr* . ,html*))
(define (Samp #:attr* [attr* '()] . html*)
`(samp ,attr* . ,html*))
(define (Script #:attr* [attr* '()] . html*)
`(script ,attr* . ,html*))
(define (Search #:attr* [attr* '()] . html*)
`(search ,attr* . ,html*))
(define (Section #:attr* [attr* '()] . html*)
`(section ,attr* . ,html*))
(define (Select #:attr* [attr* '()] . html*)
`(select ,attr* . ,html*))
(define (Slot #:attr* [attr* '()] . html*)
`(slot ,attr* . ,html*))
(define (Small #:attr* [attr* '()] . html*)
`(small ,attr* . ,html*))
(define (Source #:attr* [attr* '()] . html*)
`(source ,attr* . ,html*))
(define (Span #:attr* [attr* '()] . html*)
`(span ,attr* . ,html*))
(define (Strong #:attr* [attr* '()] . html*)
`(strong ,attr* . ,html*))
(define (Style #:attr* [attr* '()] . html*)
`(style ,attr* . ,html*))
(define (Sub #:attr* [attr* '()] . html*)
`(sub ,attr* . ,html*))
(define (Summary #:attr* [attr* '()] . html*)
`(summary ,attr* . ,html*))
(define (Sup #:attr* [attr* '()] . html*)
`(sup ,attr* . ,html*))
(define (Table #:attr* [attr* '()] . html*)
`(table ,attr* . ,html*))
(define (Tbody #:attr* [attr* '()] . html*)
`(tbody ,attr* . ,html*))
(define (Td #:attr* [attr* '()] . html*)
`(td ,attr* . ,html*))
(define (Template #:attr* [attr* '()] . html*)
`(template ,attr* . ,html*))
(define (Textarea #:attr* [attr* '()] . html*)
`(textarea ,attr* . ,html*))
(define (Tfoot #:attr* [attr* '()] . html*)
`(tfoot ,attr* . ,html*))
(define (Th #:attr* [attr* '()] . html*)
`(th ,attr* . ,html*))
(define (Thead #:attr* [attr* '()] . html*)
`(thead ,attr* . ,html*))
(define (Time #:attr* [attr* '()] . html*)
`(time ,attr* . ,html*))
(define (Title #:attr* [attr* '()] . html*)
`(title ,attr* . ,html*))
(define (Tr #:attr* [attr* '()] . html*)
`(tr ,attr* . ,html*))
(define (Track #:attr* [attr* '()] . html*)
`(track ,attr* . ,html*))
(define (U #:attr* [attr* '()] . html*)
`(u ,attr* . ,html*))
(define (Ul #:attr* [attr* '()] . html*)
`(ul ,attr* . ,html*))
(define (Var #:attr* [attr* '()] . html*)
`(var ,attr* . ,html*))
(define (Video #:attr* [attr* '()] . html*)
`(video ,attr* . ,html*))
(define (Wbr #:attr* [attr* '()] . html*)
`(wbr ,attr* . ,html*))同样对于HTML部分, 我们也有一些实用补充定义.
(define (Prelude #:title [title "index"] #:css [css '()] . body*)
(Html
(apply
Head
(Meta #:attr* '((charset "utf-8")))
(Title title)
(map (lambda (stylesheet)
(Link #:attr* `((href ,stylesheet) (rel "stylesheet"))))
(if (string? css) (list css) css)))
(apply Body body*)))Prelude允许用户更简单地构造一个网页, 它为基本情形作了简单抽象.(define (CodeB . str*)
(Pre (apply Code str*)))CodeB用于定义代码块. 或许自定义属性对其也有价值, 不过我从来没有用到过.这一章提供了许多尽管不是最为基本, 但仍然相当重要的定义. 所以说, 我们才将其称为扩展基本定义
. 若不使用这些定义, 许多简单的情况会变得颇为复杂.
首先我们定义基本字母所对应的数学标识符.
(define $a (Mi "a"))
(define $b (Mi "b"))
(define $c (Mi "c"))
(define $d (Mi "d"))
(define $e (Mi "e"))
(define $f (Mi "f"))
(define $g (Mi "g"))
(define $h (Mi "h"))
(define $i (Mi "i"))
(define $j (Mi "j"))
(define $k (Mi "k"))
(define $l (Mi "l"))
(define $m (Mi "m"))
(define $n (Mi "n"))
(define $o (Mi "o"))
(define $p (Mi "p"))
(define $q (Mi "q"))
(define $r (Mi "r"))
(define $s (Mi "s"))
(define $t (Mi "t"))
(define $u (Mi "u"))
(define $v (Mi "v"))
(define $w (Mi "w"))
(define $x (Mi "x"))
(define $y (Mi "y"))
(define $z (Mi "z"))
(define $A (Mi "A"))
(define $B (Mi "B"))
(define $C (Mi "C"))
(define $D (Mi "D"))
(define $E (Mi "E"))
(define $F (Mi "F"))
(define $G (Mi "G"))
(define $H (Mi "H"))
(define $I (Mi "I"))
(define $J (Mi "J"))
(define $K (Mi "K"))
(define $L (Mi "L"))
(define $M (Mi "M"))
(define $N (Mi "N"))
(define $O (Mi "O"))
(define $P (Mi "P"))
(define $Q (Mi "Q"))
(define $R (Mi "R"))
(define $S (Mi "S"))
(define $T (Mi "T"))
(define $U (Mi "U"))
(define $V (Mi "V"))
(define $W (Mi "W"))
(define $X (Mi "X"))
(define $Y (Mi "Y"))
(define $Z (Mi "Z"))
(define $aa (Mi "𝕒"))
(define $bb (Mi "𝕓"))
(define $cc (Mi "𝕔"))
(define $dd (Mi "𝕕"))
(define $ee (Mi "𝕖"))
(define $ff (Mi "𝕗"))
(define $gg (Mi "𝕘"))
(define $hh (Mi "𝕙"))
(define $ii (Mi "𝕚"))
(define $jj (Mi "𝕛"))
(define $kk (Mi "𝕜"))
(define $ll (Mi "𝕝"))
(define $mm (Mi "𝕞"))
(define $nn (Mi "𝕟"))
(define $oo (Mi "𝕠"))
(define $pp (Mi "𝕡"))
(define $qq (Mi "𝕢"))
(define $rr (Mi "𝕣"))
(define $ss (Mi "𝕤"))
(define $tt (Mi "𝕥"))
(define $uu (Mi "𝕦"))
(define $vv (Mi "𝕧"))
(define $ww (Mi "𝕨"))
(define $xx (Mi "𝕩"))
(define $yy (Mi "𝕪"))
(define $zz (Mi "𝕫"))
(define $AA (Mi "𝔸"))
(define $BB (Mi "𝔹"))
(define $CC (Mi "ℂ"))
(define $DD (Mi "𝔻"))
(define $EE (Mi "𝔼"))
(define $FF (Mi "𝔽"))
(define $GG (Mi "𝔾"))
(define $HH (Mi "ℍ"))
(define $II (Mi "𝕀"))
(define $JJ (Mi "𝕁"))
(define $KK (Mi "𝕂"))
(define $LL (Mi "𝕃"))
(define $MM (Mi "𝕄"))
(define $NN (Mi "ℕ"))
(define $OO (Mi "𝕆"))
(define $PP (Mi "ℙ"))
(define $QQ (Mi "ℚ"))
(define $RR (Mi "ℝ"))
(define $SS (Mi "𝕊"))
(define $TT (Mi "𝕋"))
(define $UU (Mi "𝕌"))
(define $VV (Mi "𝕍"))
(define $WW (Mi "𝕎"))
(define $XX (Mi "𝕏"))
(define $YY (Mi "𝕐"))
(define $ZZ (Mi "ℤ"))其中字母重复两次的标识符对应于其黑板粗体 (blackboard bold), 例如分别是有理数集, 实数集, 复数集的常规记号.
对于希腊字母, 我们也有完整的定义.
(define $alpha (Mi "α"))
(define $beta (Mi "β"))
(define $gamma (Mi "γ"))
(define $delta (Mi "δ"))
(define $epsilon (Mi "ε"))
(define $zeta (Mi "ζ"))
(define $eta (Mi "η"))
(define $theta (Mi "θ"))
(define $iota (Mi "ι"))
(define $kappa (Mi "κ"))
(define $lambda (Mi "λ"))
(define $mu (Mi "μ"))
(define $nu (Mi "ν"))
(define $xi (Mi "ξ"))
(define $omicron (Mi "ο"))
(define $pi (Mi "π"))
(define $rho (Mi "ρ"))
(define $sigma (Mi "σ"))
(define $tau (Mi "τ"))
(define $upsilon (Mi "υ"))
(define $phi (Mi "φ"))
(define $chi (Mi "χ"))
(define $psi (Mi "ψ"))
(define $omega (Mi "ω"))
(define $Alpha (Mi "Α"))
(define $Beta (Mi "Β"))
(define $Gamma (Mi "Γ"))
(define $Delta (Mi "Δ"))
(define $Epsilon (Mi "Ε"))
(define $Zeta (Mi "Ζ"))
(define $Eta (Mi "Η"))
(define $Theta (Mi "Θ"))
(define $Iota (Mi "Ι"))
(define $Kappa (Mi "Κ"))
(define $Lambda (Mi "Λ"))
(define $Mu (Mi "Μ"))
(define $Nu (Mi "Ν"))
(define $Xi (Mi "Ξ"))
(define $Omicron (Mi "Ο"))
(define $Pi (Mi "Π"))
(define $Rho (Mi "Ρ"))
(define $Sigma (Mi "Σ"))
(define $Tau (Mi "Τ"))
(define $Upsilon (Mi "Υ"))
(define $Phi (Mi "Φ"))
(define $Chi (Mi "Χ"))
(define $Psi (Mi "Ψ"))
(define $Omega (Mi "Ω"))它们在数学中的使用颇为频繁.对于数字, 我们仅定义了到.
(define $0 (Mn "0"))
(define $1 (Mn "1"))
(define $2 (Mn "2"))
(define $3 (Mn "3"))
(define $4 (Mn "4"))
(define $5 (Mn "5"))
(define $6 (Mn "6"))
(define $7 (Mn "7"))
(define $8 (Mn "8"))
(define $9 (Mn "9"))HTML部分也有一些扩展基本定义, 但是数量并不是很多. 而且, 或许很多都不应该放在该部分.
(define (make-table #:attr* [attr* '()] lst)
(keyword-apply
Table '(#:attr*) (list attr*)
(map (lambda (row)
(apply Tr (map Td row)))
lst)))make-table是用于定义表格的简便过程, 它自动添加了Tr和Td, 但保留了表格的属性自定义.(define (map2 proc lst)
(cond ((null? lst) '())
((null? (cdr lst)) (list (proc (car lst))))
(else (cons (proc (car lst) (cadr lst))
(map2 proc (cddr lst))))))map2类似于map, 但每次作为参数的过程应用于列表的连续两个参数. 这个定义颇为实用, 在很多场合都能用到.(define (columnize . xml*)
(make-table
#:attr* '((width "100%"))
(map2 list xml*)))这个定义实际上不那么基本, 但在我的博客中经常用到, 用于构造整齐排列的两列元素.(define -- "——")这个常量定义同样也只是在我的博客中经常用到, 不过我想或许读者也能经常用到.(define (enum . x*)
(apply Span (add-between x* ", ")))enum的功能是用逗号隔开其参数.这一章开始, 我们将诸多实用定义. 其中有些定义充当了基本的工具, 用户同样也可以使用这些工具. 另外, 还有一些实用定义是基于这些工具而来的.
运算符是数学记号的基本成分之一, 所以我们提供了诸多方便的工具, 以及许多常见的运算符定义.
(define ((make-op op n u) . x*)
(cond
((null? x*) (n))
((null? (cdr x*)) (u (car x*)))
(else
(let iter ((x (car x*)) (x* (cdr x*)) (r '()))
(if (null? x*)
(apply Mrow (reverse (cons x r)))
(iter (car x*)
(cdr x*)
(cons op (cons x r))))))))
(define (err0 id)
(lambda ()
(error id "")))
(define (err1 id)
(lambda (x)
(error id "~s" x)))make-op定义一个运算符所对应的过程, 它可以接受任意数目的参数. 对于参数数目大于等于二的情况, 它的表现就是中缀运算符. 至于参数数目为零或一的情况, 它允许用户单独定义. 另外, 如果用户想要报错, 可以使用err0和err1.(define (make-infix op id)
(make-op op
(err0 id)
(err1 id)))
(define-syntax define-infix*
(syntax-rules ()
((_ (id op) ...)
(begin
(define id (make-infix op 'id))
...))))另外, 我们还有make-infix过程和define-infix*宏, 它们可以方便地定义只适用于参数数目大于等于二情形的中缀运算符过程.我们通过一些例子来理解上述工具的用法.
(define &cm
(make-op $cm
(lambda () $)
(lambda (x) x)))&cm的定义依赖于$cm, 而$cm的定义为(define $cm (Mo ","))也就是说, &cm是一个用逗号隔开其参数的过程. 如果只有一个参数, 就返回该参数本身. 如果没有参数, 就返回占位符$. 请读者注意, 我们在一般情况下总是使用$前缀来表示非函数, 而使用&前缀来表示该非函数实体所对应的表达过程.再看一个例子.
(define &-
(make-op $-
(err0 '&-)
(lambda (x) (Mrow $- x))))&-是代表减法的过程, 它在只有一个参数时是negation. 由此SMathML提供了一些负数常量.(define $-1 (&- $1))
(define $-2 (&- $2))
(define $-3 (&- $3))
(define $-4 (&- $4))
(define $-5 (&- $5))
(define $-6 (&- $6))
(define $-7 (&- $7))
(define $-8 (&- $8))
(define $-9 (&- $9))还有一类特殊的运算符我们经常用到, 或许可以称其为大运算符
.
(define (make-bigop op)
(case-lambda
((u o e) (Mrow (Munderover op u o) e))
((u e) (Mrow (Munder op u) e))
((e) (Mrow op e))))
(define-syntax define-bigop*
(syntax-rules ()
((_ (id op) ...)
(begin
(define id (make-bigop op))
...))))make-bigop用于定义大运算符对应的过程, 而define-bigop*是用于一次性定义许多大运算符过程的宏.大运算符过程总是可以接受一个, 两个或三个参数. 如果只有一个参数, 那么大运算符就没有上下标. 两个参数的话, 就只有下标. 三个参数的话, 就同时拥有上下标. 这与大运算符的使用习惯完全一致. 不过, 读者需要注意的是大运算符的上下标渲染方式在内联模式和块模式下并不相同, 这实际上也和LaTeX差不多就是了. 内联模式下, 上下标会变成角标. 而在块模式下, 上下标才真的出现在大运算符的上方和下方. 如果想要在内联模式下使用块模式的风格, 可以修改displaystyle属性为true.
(define-bigop*
(sum $sum)
(prod $prod)
(Union $Union)
(Cup $Union)
(Intersect $Cap)
(Cap $Cap)
(Disj $Disj)
(Conj $Conj))目前SMathML所提供的有这些大运算符过程的定义. 或许其中的sum和prod应该首字母大写, 但目前已经积重难返.括号和列表式枚举是最常用到的数学表达, 值得我们提供所有常见的可能性.
不过, 先让我们看几个常量定义.
(define $lp (Mo "("))
(define $rp (Mo ")"))
(define $lp0
(Mo "(" #:attr* '((stretchy "false"))))
(define $rp0
(Mo ")" #:attr* '((stretchy "false"))))首先我必须要承认的是, $lp和$rp这样的命名并不直观, 也不容易记忆, 不如改成$\(和$\), 可是目前也已经是积重难返. 不过, 还有一点值得读者注意, 那就是stretchy属性. 这个其实是为了解决Chrome浏览器上的一个问题的, 而这个问题在Firefox浏览器中并不存在. 如果不设定stretchy为false, 那么常规括号总是会在Chrome的渲染中被拉伸, 这并不符合用户的期望. 不过, stretchy这个属性本身是控制运算符是否会被拉伸的, 这在数学表达中用到不多, 但一旦碰到也是相当有用的. 所以说, 即便我们主要只考虑Firefox上的渲染效果, 提供两类括号过程仍然具有价值.(define (pare x)
(Mrow $lp x $rp))
(define (par0 x)
(Mrow $lp0 x $rp0))当然, 现在我对于pare和par0同样不是很满意.有了括号过程之后, 我们可以定义与之相伴的列表枚举过程.
(define (tup . x*)
(pare (apply &cm x*)))
(define (tu0 . x*)
(par0 (apply &cm x*)))以上仅用到了小括号, 对于中括号, 花括号, 角括号, 竖线以及双竖线, 我们都有一些类似的定义.
(define $lb (Mo "["))
(define $rb (Mo "]"))
(define $lb0
(Mo "[" #:attr* '((stretchy "false"))))
(define $rb0
(Mo "]" #:attr* '((stretchy "false"))))
(define $lc (Mo "{"))
(define $rc (Mo "}"))
(define $lc0
(Mo "{" #:attr* '((stretchy "false"))))
(define $rc0
(Mo "}" #:attr* '((stretchy "false"))))
(define $lv (Mo "|"))
(define $rv (Mo "|"))
(define $lv0
(Mo "|" #:attr* '((stretchy "false"))))
(define $rv0
(Mo "|" #:attr* '((stretchy "false"))))
(define $la (Mo "⟨"))
(define $ra (Mo "⟩"))
(define $la0
(Mo "⟨" #:attr* '((stretchy "false"))))
(define $ra0
(Mo "⟩" #:attr* '((stretchy "false"))))
(define $ld (Mo "‖"))
(define $rd (Mo "‖"))
(define $ld0
(Mo "‖" #:attr* '((stretchy "false"))))
(define $rd0
(Mo "‖" #:attr* '((stretchy "false"))))(define (brac x)
(Mrow $lb x $rb))
(define (bra0 x)
(Mrow $lb0 x $rb0))
(define (curb x)
(Mrow $lc x $rc))
(define (cur0 x)
(Mrow $lc0 x $rc0))
(define (vert x)
(Mrow $lv x $rv))
(define (ver0 x)
(Mrow $lv0 x $rv0))
(define (angb x)
(Mrow $la x $ra))
(define (ang0 x)
(Mrow $la0 x $ra0))
(define (dver x)
(Mrow $ld x $rd))
(define (dve0 x)
(Mrow $ld0 x $rd0))(define (lis . x*)
(brac (apply &cm x*)))
(define (li0 . x*)
(bra0 (apply &cm x*)))
(define (enu . x*)
(curb (apply &cm x*)))
(define (en0 . x*)
(cur0 (apply &cm x*)))
(define (tupan . x*)
(angb (apply &cm x*)))
(define (tupa0 . x*)
(ang0 (apply &cm x*)))注意竖线和双竖线倒是没有定义对应的列表枚举过程, 但是我也没有看过或者用到过这种记号.后来我在书写有关指称语义的内容时频繁用到双中括号, 于是有了以下定义.
(define $ldb (Mo "⟦"))
(define $rdb (Mo "⟧"))
(define (&db x)
(Mrow $ldb x $rdb))
(define $ldb0 (Mo "⟦" #:attr* '((stretchy "false"))))
(define $rdb0 (Mo "⟧" #:attr* '((stretchy "false"))))
(define (&db0 x)
(Mrow $ldb0 x $rdb0))对于set-builder记号, 我们有一些定义, 放在这一节似乎比较合适.
(define setE en0)
(define (setI a b)
(cur0 (Mrow a $lv0 b)))
(define (setEnum a b)
(setE a $..h b))其中E代表外延, 而I代表内涵. 或许setI应该接受不定数目的参数, 但暂时作者还未进行修改.经常我们需要给表达式加上括号, 所以SMathML提供了一个括号化过程, 其将一个普通的数学表达过程变成加上括号的版本.
(define (@ . x*)
(par0 (apply : x*)))
(define (@lize &) (compose @ &))
(define-syntax define-@lized-op*
(syntax-rules ()
((_ (id op) ...)
(begin
(define id (@lize op))
...))))其中用到的:类似于Mrow, 定义如下:(define (: . x*)
(cond
((null? x*) $)
((null? (cdr x*)) (car x*))
(else (apply Mrow x*))))@lize用于定义一个这样的过程, define-@lized-op*用于一次性定义许多这样的过程.(define-@lized-op*
(@+ &+)
(@- &-)
(@* &*)
(@i* &i*)
(@c* &c*)
(@d* &d*)
(@t* &t*)
(@w* &w*)
(@compose &compose)
(@conj &conj)
(@disj &disj)
(@sqcup &sqcup)
(@sqcap &sqcap)
(@: &:)
(@neg &neg)
(@-> &->)
(@=> &=>)
(@= &=)
(@ap ap)
(@cong &cong)
(@~ &~)
(@sqsube &sqsube)
(@rarr &rarr)
(@larr &larr)
(@uarr &uarr)
(@darr &darr)
(@rArr &rArr)
(@lArr &lArr)
(@uArr &uArr)
(@dArr &dArr))暂时我们只定义了这些括号化版本过程, 或许还有很多应该定义. 不过, 读者应该注意到这里的命名约定, 也就是使用@前缀代表括号化版本.标准的前缀式函数应用是数学中最频繁使用的记号之一. 所以说, 我们提供了以下过程供用户使用.
(define $af (Mo "⁡"))
(define (ap f x)
(Mrow f $af x))
(define (app f . x*)
(ap f (apply @ x*)))
(define app*
(case-lambda
((f x) (app f x))
((f g . arg*) (app f (apply app* g arg*)))))
(define (appl f . x*)
(ap f (apply tu0 x*)))添加$af是官方文档的做法, 我没有选择违背这一标准. ap用于直接的应用, 数学中运用不多但偶尔出现. app用于给参数加括号的应用, 这在数学中最为常见. app*是app的相继版本, 偶尔会很有用. appl用于多参数函数应用, 这用到了tu0.实际上我们还提供了@ap, 它是ap的括号化版本.
MathML的表格在某些地方类似于HTML表格, 但是保留了许多传统的表格属性. 这些属性对于HTML表格而言已经是不建议使用的了, 而对于Chrome而言其对于这些MathML表格属性也没有任何支持. 不过, 至少Firefox还是有相应支持的. 当前我只考虑了Firefox的渲染效果, 或许为了兼容性应该修改以适应其他浏览器平台. Chrome建议MathML用户使用CSS来控制MathML表格.
我认为目前这一部分的细节我写得非常之烂, 达到了令人发指的地步. 然而, 近来仍然没有更新的精力. 这些过程和宏仍然是值得使用的. 表格的用法非常灵活, 普通的排列, 分支选择, 矩阵, 行列式都可以用表格来表达.
(define (&table l)
(apply Mtable
(map (lambda (r)
(apply Mtr (map Mtd r)))
l)))
(define-syntax &Table
(syntax-rules ()
((_ (x ...) ...)
(&table (list (list x ...) ...)))))
(define (choice l)
(Mrow $lc (&table l)))
(define-syntax Choice
(syntax-rules ()
((_ (x ...) ...)
(choice (list (list x ...) ...)))))
(define (choice0 l)
(Mrow
$lc
(keyword-apply
Mtable
'(#:attr*) '(((displaystyle "true")))
(map (lambda (r)
(Mtr (Mtd (car r))
(keyword-apply
Mtd '(#:attr*) '(((columnalign "left")))
(cdr r))))
l))))
(define-syntax Choice0
(syntax-rules ()
((_ (x ...) ...)
(choice0 (list (list x ...) ...)))))
(define (mat l)
(brac (&table l)))
(define-syntax Mat
(syntax-rules ()
((_ (x ...) ...)
(mat (list (list x ...) ...)))))
(define (ma0 l)
(pare (&table l)))
(define-syntax Ma0
(syntax-rules ()
((_ (x ...) ...)
(ma0 (list (list x ...) ...)))))
(define (det l)
(vert (&table l)))
(define-syntax Det
(syntax-rules ()
((_ (x ...) ...)
(det (list (list x ...) ...)))))目前的一个难题是没法灵活直接调整属性, 但至少读者还有之后的set-attr*这一方便过程可以使用, 所以在表达上也不是问题.SMathML提供了一撇和两撇所对应的过程, 它们经常用来表示导数, 或者不同的名字.
(define $prime (Mo "′"))
(define $Prime (Mo "″"))
(define (&prime x)
(Msup x $prime))
(define (&Prime x)
(Msup x $Prime))
(define (_prime x i)
(_^ x i $prime))
(define (_Prime x i)
(_^ x i $Prime))其中_prime和_Prime是为了方便既有撇号又有下标的情况, 时有用到.各种常量通过^和_的组合在数学中频繁出现, 所以为了用户的方便起见, 我们有大量的预定义. 不过, 这些预定义也是自动生成的.
各种常量的一撇版本也经常用到, 也就是应用&prime. 我们的命名约定是在其后加上^. 实际上, 两撇版本也应该添加, 但是我们遗漏了, 不过命名约定是其后加上^^.
各种字母的所有mathvariant变体我们都有提供, 命名约定是在其后添加:和变体名称, 例如:读者应该注意的是, Chrome的MathML Core压根就不支持mathvariant.
数学文献中经常有各种条目: 公理, 定义, 命题, 定理, 引理, 推论, 诸如此类. 所以说, 有必要提供一个工具, 以及提供一些预定义的条目过程.
(define (entry-make class template)
(lambda (#:n [n ""])
(lambda x*
(keyword-apply
Div '(#:attr*) `(((class ,class)))
(B (format template n)) " " x*))))
(define-syntax-rule
(define-entry* (id class template) ...)
(begin
(define id (entry-make class template))
...))暂时我们提供了以下这些预定义条目.
(define-entry*
(definition "definition" "定义~a.")
(lemma "lemma" "引理~a.")
(theorem "theorem" "定理~a.")
(corollary "corollary" "推论~a.")
(example "example" "例子~a.")
(notation "notation" "记号~a.")
(comment "comment" "注记~a.")
(program "program" "程序~a.")
(exercise "exercise" "练习~a.")
(proposition "proposition" "命题~a.")
(remark "remark" "评注~a.")
(convention "convention" "约定~a.")
(tcomment "tcomment" "译者注记~a.")
(answer "answer" "解答~a."))SMathML的灵活性之一在于它可以表达许多高阶 (higher-order) 抽象, 其中一个直接的应用就是表达各种律/公理, 例如交换律和结合律. 当前的这些定义打磨不够充分, 往往建议读者按照需求自行定义, 这里只是抛砖引玉.
(define (commute* a b)
(&= (&i* a b) (&i* b a)))
(define (commute+ a b)
(&= (&+ a b) (&+ b a)))
(define (commute & a b)
(&= (& a b) (& b a)))(define (assoc* a b c)
(&= (&i* a (@ (&i* b c)))
(&i* (@ (&i* a b)) c)))
(define (assoc+ a b c)
(&= (&+ a (@ (&+ b c)))
(&+ (@ (&+ a b)) c)))
(define (associate & a b c)
(&= (& (@ (& a b)) c) (& a (@ (& b c)))))(define (disL a b c)
(&= (&i* (@ (&+ a b)) c)
(&+ (&i* a c)
(&i* b c))))
(define (disR a b c)
(&= (&i* a (@ (&+ b c)))
(&+ (&i* a b)
(&i* a c))))
(define (distributeL a + b * c)
(&= (* (@ (+ a b)) c)
(+ (@ (* a c)) (@ (* b c)))))
(define (distributeR a * b + c)
(&= (* a (@ (+ b c)))
(+ (@ (* a b)) (@ (* a c)))))读者可能会发现有时他需要将等式的左右反过来, 这也是本来这些过程的疏忽之一.还有一个过程, 尽管尚未加入SMathML, 或许值得一看:
(define (!commute f g . x*)
(&= (f (apply g x*))
(apply g (map f x*))))这也是一种数学中常说的交换, 并且
!commute也相当灵活, 可以适应许多不同的情况. 以下是一个简单的例子.(MB (!commute (curry app $F)
&compose
$f $g))更新: 现已加入.推导式实际上也是基于表格实现的, 不过作者更想单开一节呈现.
(define (make-row . x*)
(apply Mtr (map Mtd x*)))
(define (deriv x y . z*)
(keyword-apply
Mtable
'(#:attr*) '(((displaystyle "true") (columnalign "right center left")))
(cons (make-row x $= y)
(map (lambda (z) (make-row $ $= z)) z*))))
(define (deriv0 x -> y . z*)
(keyword-apply
Mtable
'(#:attr*) '(((displaystyle "true") (columnalign "right center left")))
(cons (make-row x -> y)
(map2 (lambda (-> w) (make-row $ -> w)) z*))))deriv用于都是等号连接的推导, deriv0则允许用户自定义. 最开始它们的定义都颇为复杂, 这尤其是因为原本的columnalign是逐个单元格进行设定的, 后来作者才发现没有必要.基于之后引入的set-attr*, SMathML还提供了一些衍生过程.
(define-syntax-rule (eqn* (x ...) ...)
(MB (set-attr*
(&Table (x ...) ...)
'columnalign "right center left"
'displaystyle "true")))eqn*和deriv的对齐方式类似, 但是允许除了第一行之外的左侧也有元素.(define (deriv^ x . y*)
(set-attr*
(apply
Mtable
(Mtr (Mtd $) (Mtd x))
(map (lambda (y)
(Mtr (Mtd $=) (Mtd y)))
y*))
'displaystyle "true"
'columnalign "center left"))
(define (deriv^0 x . y*)
(set-attr*
(apply
Mtable
(Mtr (Mtd $) (Mtd x))
(map2 (lambda (= y)
(Mtr (Mtd =) (Mtd y)))
y*))
'displaystyle "true"
'columnalign "center left"))deriv^和deriv^0分别类似于deriv和deriv0, 其不同之处在于原本第一行左侧的元素被折到了右侧. 对于数学公式极长的情况, 这两个过程是完全必要的.我们经常需要以一定的间隔枚举一些数学表达式, 因而SMathML也提供了相关的过程.
(define (&space n)
(Mspace #:attr* `((width ,(format "~sex" n)))))
(define (&split n)
(make-op (&space n)
(lambda () $)
(lambda (x) x)))&space可以创造具有一定宽度的常量, 而&split则可以构造一个过程, 其为参数插入指定的间隔.各种箭头也是数学中常常使用的, 读者可以参照以下表格:其中->相当于rarr的别名, =>相当于rArr的别名.
逻辑学和编程语言领域经常需要排版推理规则和证明树. SMathML提供的相关功能完全是基于Mfrac的, 其效果并不特别符合一般审美, 但是至少能够让人理解.
(define (&rule #:space [n 8] . j*)
(let-values (((j* j1) (split-at-right j* 1)))
(if (null? j*)
(car j1)
(~ #:attr* '((displaystyle "true"))
(apply (&split n) j*) (car j1)))))&rule构造一条规则, 不过在其只有一个参数时会省略横线. 许多书籍实际上也偏爱不省略的风格, 那么或许读者需要自行定义. 当然, 或许我们应该定义一些parameter. 但是, 那时作者还未考虑到这一点.(define (&rule* j . j*)
(if (null? j*)
j
(apply &rule*
(~ #:attr* '((displaystyle "true"))
j (car j*))
(cdr j*))))&rule*有点类似于&rule, 但是表达的是连续的规则应用.变换是SMathML的核心, 没有变换就很难表达许多抽象.
T让我们先来呈现T的代码.
(define (T style*)
(define default-handler
(let ((default-binding (assoc '(default) style*)))
(match default-binding
(`((default) *preorder* ,handler) handler)
(`((default) ,handler)
(lambda (tag attr* . xml*)
(apply handler tag attr* (map transform xml*))))
(else
(lambda (tag attr* . xml*)
`(,tag ,attr* . ,(map transform xml*)))))))
(define text-handler
(let ((text-binding (assoc '(text) style*)))
(if text-binding
(cadr text-binding)
identity)))
(define Style*
(map
(lambda (binding)
(match binding
(`(,tag *preorder* ,handler)
(cons tag handler))
(`(,tag ,handler)
(cons tag
(lambda (tag attr* . xml*)
(apply handler tag attr*
(map transform xml*)))))))
(filter (lambda (style) (symbol? (car style)))
style*)))
(define (transform xml)
(match xml
(`(,tag ,attr* . ,xml*)
(let ((binding (assq tag Style*)))
(if binding
(apply (cdr binding) tag attr* xml*)
(apply default-handler tag attr* xml*))))
(str (text-handler str))))
transform)而为了理解这些代码, 首先我们应该来看其注释.;<xml> ::= <string> | <symbol> | <number> | <boolean> | <vector>
; | (<tag> (<attr>*) <xml>*)
;<tag> ::= <symbol> | <a scheme value other than symbol>
;<attr> ::= (<symbol> <string>)
;<binding> ::= (<symbol> <handler>)
; | (<symbol> *preorder* <handler>)
; | ((default) <handler>)
; | ((default) *preorder* <handler>)
; | ((text) <text-handler>)
;<handler> : <symbol> * <attr>* * <xml>* -> <xml>
;<text-handler> : <string> -> <string>当前T的设计有一尴尬之处, 那就是没有提供按照相同方式处理多个可能符号的句法. 不过, 存在各种变通途径, 以至于不是不能表达. 未来这一点应该修改.
SMathML提供了两个过程用于修饰属性, 一个是attr*-set, 另外一个是set-attr*. 实际上, set-attr*基于attr*-set.
(define (attr*-set attr* . xv*)
(define (s a* x v)
(if (eq? v #f)
a*
(let s ((a* a*) (x x) (v v))
(cond ((null? a*)
(list (list x v)))
((eq? (caar a*) x)
(cons (list x v) (cdr a*)))
(else
(cons (car a*)
(s (cdr a*) x v)))))))
(if (null? xv*)
attr*
(let iter ((x (car xv*))
(v (cadr xv*))
(xv* (cddr xv*))
(a* attr*))
(if (null? xv*)
(s a* x v)
(iter (car xv*) (cadr xv*) (cddr xv*)
(s a* x v))))))attr*-set用于修改表示属性的关联列表, 其可以接受多个需要修改的参数. 目前这个过程效率并不高, 实际上或许简单append是更好的实际选择. 不过, 这样语义会发生微妙的改变, 因为原本后出现的要修饰属性可以覆盖之前的. 不过, 在我使用SMathML时, 似乎从来没有这么做过. 当然, 目前的实现也有优点, 那就是可以产生最为紧凑的属性.(define (set-attr* xml . xv*)
(match xml
(`(,tag ,attr* . ,xml*)
`(,tag ,(apply attr*-set attr* xv*) . ,xml*))
((? string? str)
`(div ,(apply attr*-set '() xv*) ,str))))set-attr*用于修改SXML元素, 如果不是元素则会自动添加div. 实际上, 就作者而言, 似乎使用span更为合理, 不过目前已经积重难返了. (实际上, 作者已经记不得博客里是否用到过这种特殊情况.)Tm: 数学内容辅助变换Tm是一个核心的变换过程, 作者的博客几乎每一页面都会用到Tm. 实际上, 只要页面出现数学内容, 就应该使用Tm, 这是推荐做法.
Tm是使用SMathML的部分尴尬体验的修复. 例如, 若不使用Tm, 那么即便是意图内联的MathML元素, 也必须要在外面添加Math或者M, 这明显不太合理. 不过, 单纯添加Math可以简单自动化, 只需检测是否有MathML元素裸露在外即可. 但对于已经被MathML根元素包裹的表达式, 我们必须要予以保留, 并且属性也必须要保留. 不然的话, 比如说内联和块模式改变就糟糕了. Tm还改进了其他一些尴尬之处. 例如, 原本要在MathML内部使用文本, 需要手动添加Mtext, 这一点也被Tm完全自动化了. Tm还对于其他一些原本异常的常量进行了变换, 例如将整数变为由Mn包裹. 而且, 对于裸的整数, Tm还会不忘添加Math. 对于符号和分数的处理, Tm也尽可能保持直觉化了.
以下是我们对于Tm的实现.
(define (Mid id) (Mi (symbol->string id)))
(define (Mnum n) (Mn (number->string n)))
(define (Mint n)
(if (< n 0)
(&- (Mnum (- n)))
(Mnum n)))
(define (Mrat n)
(let* ((a (numerator n))
(b (denominator n)))
(if (< a 0)
(&- (~ (Mnum (- a)) (Mnum b)))
(~ (Mnum a) (Mnum b)))))
(define mathml-tag*
(list->seteq
'(merror
mfrac mi mmultiscripts mn mo mover
mpadded mphantom mroot mrow
ms mspace msqrt mstyle msub msubsup
msup mtable mtd mtext mtr munder
munderover maction menclose mfenced
#;mprescripts)))
(define math-style*
`(((default)
*preorder*
,(lambda (tag attr* . xml*)
(cond ((eq? tag 'math) `(,tag ,attr* . ,(map Tx xml*)))
((set-member? mathml-tag* tag)
(Math (Tx `(,tag ,attr* . ,xml*))))
(else `(,tag ,attr* . ,(map Tm xml*))))))
((text) ,(lambda (text)
(cond ((string? text) text)
((symbol? text) (Math (Mid text)))
((integer? text) (Math (Mint text)))
((rational? text) (Math (Mrat text)))
(else (error 'Tm "unknown element ~s" text)))))
))
;token elements: mtext mi mn mo mspace ms
(define token-tag*
(seteq 'mtext 'mi 'mn 'mo 'mspace 'ms))
(define mtext-style*
`(((default)
*preorder*
,(lambda (tag attr* . xml*)
(cond ((memq tag '(mi mn mo ms mspace mtext))
`(,tag ,attr* . ,xml*))
(else `(,tag ,attr* . ,(map Tx xml*))))))
((text) ,(lambda (text)
(cond ((string? text) (% text))
((symbol? text) (Mid text))
((integer? text) (Mint text))
((rational? text) (Mrat text))
(else (error 'Tm "unknown element ~s" text)))))))
(define Tm (T math-style*))
(define Tx (T mtext-style*))这里的命名比较随意, 但作者也想不出更好的方案了. 或许细心的读者会发现作者没有使用token-tag*, 这主要是因为作者发现在元素较少时, 使用直接的列表似乎效率更高.基于Tm, 我们定义了TmPrelude, 其是直接的复合.
(define TmPrelude
(compose Tm Prelude))Racket本身的compose有一个很大的优点, 就是它能够保留关键词参数.在使用SMathML的初期, 作者感觉有必要提供一个位置敏感的表格变换. 不过, 现在作者认为不如在构造表格时就进行变换.
(define (mapi f l)
(let m ((i 0) (l l))
(if (null? l)
'()
(cons (f (car l) i)
(m (+ i 1) (cdr l))))))
(define (Ttable Td)
(define (Tt tag attr* . r*)
`(mtable ,attr* . ,(mapi Tr r*)))
(define (Tr r i)
(apply
(lambda (tag attr* . d*)
`(mtr ,attr* .
,(mapi (lambda (d j) (Td d i j)) d*)))
r))
(T `((mtable *preorder* ,Tt))))也就是说, 作者近来都没有使用过Ttable.自动编号和引用机制对于实际使用是非常必要的, 这一点目前SMathML有了初步支持, 但是使用起来颇为繁琐.
大致的思路如下: 我们使用特殊的向量tag, 其中的各个field自然是可变的, 首先我们通过线性遍历积累信息, 并同时构造出相应的标题和条目, 以及引用格式. 当然, 我们也会构造一个字符串和引用格式之间的关联列表. 然后, 我们进行第二次遍历, 其将通过字符串的引用转换为对应的引用格式.
这套机制并不优雅, 但是至少堪用, 未来很有可能会进行大幅度的重写.
(define (pass0 exp)
(define citation-table '())
(define (extend-table! id citation)
(if (assoc id citation-table)
(error 'automatic-numbering-pass0 "id conflict!")
(set! citation-table
(cons (cons id citation) citation-table))))
(let iterate ((henv '(0)) (section #f) (genv '()) (lenv '()) (rest exp) (result '()))
(if (null? rest)
(cons citation-table (reverse result))
(let ((current (car rest)) (rest (cdr rest)))
(match current
((,tag ,attr* . ,xml*)
(cond
((symbol? tag)
(iterate henv section genv lenv rest (cons current result)))
((%heading? tag)
(define level (%heading-level tag))
(define id (%heading-id tag))
(define auto? (%heading-auto? tag))
(define present (%heading-present tag))
(define cite (%heading-cite tag))
(define switch? (%heading-switch? tag))
(cond (auto? (define section (henv-next henv level))
(set-%heading-section! tag section)
(when id (extend-table! id (cite tag)))
(iterate section section genv
(if switch? '() lenv) rest
(cons (apply present tag attr* xml*) result)))
(else (define section (henv-* henv level))
(set-%heading-section! tag section)
(when id (extend-table! id (cite tag)))
(iterate henv section genv
(if switch? '() lenv) rest
(cons (apply present tag attr* xml*) result)))))
((%entry? tag)
(define local? (%entry-local? tag))
(define class (%entry-class tag))
(define id (%entry-id tag))
(define auto? (%entry-auto? tag))
(define present (%entry-present tag))
(define cite (%entry-cite tag))
(set-%entry-section! tag section)
(cond (auto? (let-values (((g/lenv nval)
(g/lenv-next (if local? lenv genv) class)))
(set-%entry-index! tag nval)
(when id (extend-table! id (cite tag)))
(if local?
(iterate henv section genv g/lenv rest
(cons (apply present tag attr* xml*) result))
(iterate henv section g/lenv lenv rest
(cons (apply present tag attr* xml*)
result)))))
(else (when id (extend-table! id (cite tag)))
(iterate henv section genv lenv rest
(cons (apply present tag attr* xml*) result)))))
(else
(iterate henv section genv lenv rest (cons current result)))))
(,else (iterate henv section genv lenv rest (cons current result))))))))pass0颇为复杂, 读者需要注意的一点是, 它只会对于顶层进行线性遍历, 但不会深入.;pass1
(define (Ref id) `(ref () ,id))
(define (pass1 exp)
(define citation-table (car exp))
(define (reify id)
(cond ((assoc id citation-table) => cdr)
(else (error 'pass1 "unknown id ~s" id))))
(define Tr
(T `((ref *preorder* ,(lambda (ref empty id) (reify id))))))
(define xml* (cdr exp))
(map Tr xml*))pass1要简单很多, 因为它做的事情从本质上来说只是简单替换. Ref是SMathML提供的一个简单API, 用于引用标题或条目.;automatic numbering
(define numbering-style*
`((body
*preorder*
,(lambda (tag attr* . xml*)
`(,tag ,attr* . ,(pass1 (pass0 xml*)))))))
(define Tn
(T numbering-style*))最后我们将pass0和pass1组合到一起, 就得到了Tn.和TmPrelude类似, SMathML也提供了TnTmPrelude.
(define TnTmPrelude
(compose Tn Tm Prelude))Tn只是一个整体性的框架, 但是对于标题和条目而言, present和cite函数都需要编写之后才能使用. 因此, SMathML也提供了一些默认的辅助过程.
(define (format-section section)
(define sec (cdr (reverse section)))
(apply string-append
(add-between (map number->string sec) ".")))
(define (heading-present %heading attr* . html*)
(define level (%heading-level %heading))
(define auto? (%heading-auto? %heading))
(define section (%heading-section %heading))
(define id (%heading-id %heading))
(cond ((= level 4) `(h4 ,(attr*-set attr* 'id id)
,(format "第~a小节 " (format-section section))
. ,html*))
((= level 3) `(h3 ,(attr*-set attr* 'id id)
,(format "第~a节 " (format-section section))
. ,html*))
((= level 2) `(h2 ,(attr*-set attr* 'id id)
,(format "第~a章 " (format-section section))
. ,html*))
((= level 1) `(h1 ,(attr*-set attr* 'id id) . ,html*))
(else (error 'heading-present "invalid level ~s" level))))
(define (h4-present %heading attr* . html*)
(define auto? (%heading-auto? %heading))
(define id (%heading-id %heading))
(if auto?
(let ((section (%heading-section %heading)))
`(h4 ,(attr*-set attr* 'id id)
,(format "第~a小节 " (format-section section))
. ,html*))
`(h4 ,(attr*-set attr* 'id id) . ,html*)))
(define (h3-present %heading attr* . html*)
(define auto? (%heading-auto? %heading))
(define id (%heading-id %heading))
(if auto?
(let ((section (%heading-section %heading)))
`(h3 ,(attr*-set attr* 'id id)
,(format "第~a节 " (format-section section))
. ,html*))
`(h3 ,(attr*-set attr* 'id id) . ,html*)))
(define (h2-present %heading attr* . html*)
(define auto? (%heading-auto? %heading))
(define id (%heading-id %heading))
(if auto?
(let ((section (%heading-section %heading)))
`(h2 ,(attr*-set attr* 'id id)
,(format "第~a章 " (format-section section))
. ,html*))
`(h2 ,(attr*-set attr* 'id id) . ,html*)))
(define (h1-present %heading attr* . html*)
(define id (%heading-id %heading))
`(h1 ,(attr*-set attr* 'id id) . ,html*))
(define (heading-cite %heading)
(define id (%heading-id %heading))
(define href (string-append "#" id))
(define section (%heading-section %heading))
(define level (%heading-level %heading))
(define ref
`(a ((href ,href)) ,(format-section section)))
(cond ((= level 4) (Cite "第" ref "小节"))
((= level 3) (Cite "第" ref "节"))
((= level 2) (Cite "第" ref "章"))
(else
(error 'heading-cite "invalid level ~s" level))))
(define (H1. #:attr* [attr* '()] #:id [id #f] #:auto? [auto? #t] . html*)
`(,(build-%heading #:present h1-present #:level 1
#:id id #:auto? auto?)
,attr* . ,html*))
(define (H2. #:attr* [attr* '()] #:id [id #f]
#:switch? [switch? #t] #:auto? [auto? #t] . html*)
`(,(build-%heading #:present h2-present #:cite heading-cite
#:level 2 #:id id #:switch? switch?
#:auto? auto?)
,attr* . ,html*))
(define (H3. #:attr* [attr* '()] #:id [id #f]
#:switch? [switch? #t] #:auto? [auto? #t] . html*)
`(,(build-%heading #:present h3-present #:cite heading-cite
#:level 3 #:id id #:switch? switch?
#:auto? auto?)
,attr* . ,html*))
(define (H4. #:attr* [attr* '()] #:id [id #f]
#:switch? [switch? #t] #:auto? [auto? #t] . html*)
`(,(build-%heading #:present h4-present #:cite heading-cite
#:level 4 #:id id #:switch? switch?
#:auto? auto?)
,attr* . ,html*))这里也存在一些设计失误, 例如很多东西都应该参数化, 但是目前读者只能通过同名的新定义来覆盖这些定义. 另外, 函数heading-present是一个历史遗留产物, 目前尚未删除的原因是担心兼容性, 但是未来大概率会删除.至于条目, 目前SMathML还没有提供相关过程. 但是, 在作者书写博客时, 的确产生了一套既定的程序. 问题在于, 作者总是要为每一个页面对其进行小小的修改, 所以这些代码目前还没有合并到SMathML之中.
目前SMathML提供了一套既定的条目定义过程, 并且允许用户以参数化的方式调整编号的格式. 另外, 也允许用户选择是否按照条目的种类进行单独编号. 美中不足的是, 引用格式被定死为了条目种类的名字加上其编号, 未来或许引用格式也应该变成参数化的.
(define (format-num section index)
(cond ((eq? (car section) '*)
(if index
(format "~a" index)
#f))
(else
(format "~a.~a"
(apply string-append
(add-between
(map number->string
(cdr (reverse section))) "."))
(if index index "*")))))
(define (format-head name section index)
(let ((num ((parameter:format-num)
section index)))
(if num
(B name (format "~a. " num))
(B name ". "))))
(define separate-class?
(make-parameter #f))
(define parameter:format-num
(make-parameter format-num))
(define parameter:format-head
(make-parameter format-head))
(define (Entry name class)
(define (present %entry attr* . html*)
(define id (%entry-id %entry))
(define Attr* (attr*-set attr* 'class class 'id id))
(define section (%entry-section %entry))
(define index (%entry-index %entry))
(define head ((parameter:format-head)
name section index))
`(div ,Attr* ,head . ,html*))
(define (cite %entry)
(define id (%entry-id %entry))
(define href (string-append "#" id))
(define section (%entry-section %entry))
(define index (%entry-index %entry))
(define num ((parameter:format-num)
section index))
(if num
(Cite name `(a ((href ,href)) ,num))
(Cite `(a ((href ,href)) "某" ,name))))
(lambda (#:id [id #f] #:auto? [auto? #t])
(lambda (#:attr* [attr* '()] . html*)
(cons (if (separate-class?)
(build-%entry
#:id id #:auto? auto?
#:present present #:cite cite
#:class class)
(build-%entry
#:id id #:auto? auto?
#:present present #:cite cite))
(cons attr* html*)))))
(define-syntax-rule (define-Entry* (id name class) ...)
(begin (define id (Entry name class))
...))
(define-Entry*
(Definition "定义" "definition")
(Lemma "引理" "lemma")
(Theorem "定理" "theorem")
(Corollary "推论" "corollary")
(Example "例子" "example")
(Notation "记号" "notation")
(Comment "注记" "comment")
(Proposition "命题" "proposition")
(Remark "评注" "remark")
(Exercise "练习" "exercise")
(Convention "约定" "convention"))注意其中的format-num和format-head并没有provide.为了使得SMathML实际有用, 我们必须要提供一系列的输出过程.
为了将SXML转换为真正的HTML/XML格式, 我们提供了一个过程Xml, 其实现如下:
;<xml> ::= <string>
; | (<tag> (<attr>*) <xml>*)
;<tag> ::= <symbol>
;<attr> ::= (<symbol> <string>)
(define (Attr* attr*)
(for-each
(lambda (attr)
(printf " ~s=~s" (car attr) (cadr attr)))
attr*))
(define (Xml xml)
(match xml
(`(,tag ,attr* . ,xml*)
#:when (symbol? tag)
(if (null? xml*)
(begin
(printf "<~s" tag)
(Attr* attr*)
(printf "/>"))
(begin
(printf "<~s" tag)
(Attr* attr*)
(printf ">")
(for-each Xml xml*)
(printf "</~s>" tag))))
((? string? str)
(printf "~a" str))))注意到虽然在中间变换的过程中我们允许非符号的tag, 以及非字符串的叶子, 但是到了使用Xml输出时, 我们必须回到最原始的定义.;<attr> ::= (<symbol> <string>)
;<style> ::= (<string> <attr>*)
;<css> ::= (<style>*)
(define (Attr* attr*)
(for-each
(lambda (attr)
(printf "~s: ~a;" (car attr) (cadr attr)))
attr*))
(define (Style style)
(printf "~a {" (car style))
(Attr* (cdr style))
(printf "}\n"))
(define (Css css)
(for-each Style css))SMathML并没有提供什么对于CSS进行抽象和组合的手段, 而是只有输出的过程.当然, 仅是输出还不够, 我们也提供了输出到文件的一些辅助过程.
(define (size x)
(cond ((pair? x) (+ (size (car x)) (size (cdr x))))
((null? x) 0)
((string? x) (string-length x))
(else 1)))
(define replace? (make-parameter #f))
(define compute-size? (make-parameter #f))
(define ((emit proc) exp path)
(define (emit-file)
(when (compute-size?)
(printf "size of [~a]: ~a\n" path (size exp)))
(with-output-to-file path
(lambda () (proc exp))
#:exists 'replace))
(if (file-exists? path)
(if (replace?)
(emit-file)
(printf "~s exists, emit cancelled\n" path))
(emit-file)))
(define ((emit-thunk proc) thunk path)
(define (emit-file)
(define exp (thunk))
(when (compute-size?)
(printf "size of [~a]: ~a\n" path (size exp)))
(with-output-to-file path
(lambda () (proc exp))
#:exists 'replace))
(if (file-exists? path)
(if (replace?)
(emit-file)
(printf "~s exists, emit cancelled\n" path))
(emit-file)))
(define ((emit-promise proc) promise path)
(define (emit-file)
(define exp (force promise))
(when (compute-size?)
(printf "size of [~a]: ~a\n" path (size exp)))
(with-output-to-file path
(lambda () (proc exp))
#:exists 'replace))
(if (file-exists? path)
(if (replace?)
(emit-file)
(printf "~s exists, emit cancelled\n" path))
(emit-file)))其实我们也可以将emit, emit-thunk, emit-promise合为一个过程, 但是当前设计或许能够减少错误的可能. 另外, 这些过程的功能正如名字所暗示的那样: emit就是输出到文件; emit-thunk是要输出一个thunk (无参函数), 故需要先求值; emit-promise是要输出一个promise, 所以需要先force.之所以我们提供了emit-thunk和emit-promise, 是考虑到promise会缓存计算的结果. 然而, 有时我们可能需要做benchmark, 那么这时使用简单thunk更符合我们的需求. 不过, 这两个过程都可以在需要输出许多文件时避免一些工作量. (当然, 这完全没有自动化, 需要用户手工判断.)
基于emit和emit-thunk, 我们提供了以下过程:
(define emitXml (emit Xml))
(define emitCss (emit Css))
(define emitXml-thunk (emit-thunk Xml))
(define emitCss-thunk (emit-thunk Css))
(define emitXml-promise
(emit-promise Xml))
(define emitCss-promise
(emit-promise Css))emitXml-promise和emitCss-promise, 但是作者忘了, 这是一个失误. 未来大概会添加.本章记录一些SMathML提供的不成体系的杂七杂八的功能.
SMathML提供了一个叫做escape*的无参数过程. 一旦调用, 会进入交互. 用户将需要转义的文本复制粘贴并按下回车后, 就会得到转义后的文本.
(define (escape s)
(define l (string-length s))
(let iter ((i 0))
(unless (= i l)
(let ((c (string-ref s i)))
(case c
((#\") (printf """))
((#\<) (printf "<"))
((#\&) (printf "&"))
((#\\) (printf "\\\\"))
(else (printf "~a" c))))
(iter (+ i 1)))))
(define (escape*)
(escape (read-line))
(newline)
(escape*))map变体以下的各种map变体均是在使用SMathML的过程之中总结得到的.
(define (map2 proc lst)
(cond ((null? lst) '())
((null? (cdr lst)) (list (proc (car lst))))
(else (cons (proc (car lst) (cadr lst))
(map2 proc (cddr lst))))))
(define (map* f . x*) (map f x*))
(define (map-toggle flag proc lst)
(cond ((null? lst) '())
(flag (cons (proc (car lst))
(map-toggle (not flag) proc (cdr lst))))
(else (cons (car lst)
(map-toggle (not flag) proc (cdr lst))))))map2之前已经说过, map*是为了枚举诸元素方便, map-toggle则是间隔应用.(define now (current-date))
(define (current-date-string #:format [format 'rfc2822])
(parameterize ((date-display-format format))
(date->string now #t)))这个就不建议使用了. 不过, 它实际上也就是提供一个当前日期字符串.鉴于正体大写希腊字母时有用到, SMathML提供了以下定义:
(define Γ $Gamma:normal)
(define Δ $Delta:normal)
(define Θ $Theta:normal)
(define Λ $Lambda:normal)
(define Ξ $Xi:normal)
(define Π $Pi:normal)
(define Σ $Sigma:normal)
(define Φ $Phi:normal)
(define Ψ $Psi:normal)
(define Ω $Omega:normal)数学中当然经常需要表达最大最小 (以及上界下界). 然而, 其形式相当多样, 以至于SMathML仅提供了以下定义:
(define $max (Mi "max"))
(define (&max . x*)
(apply appl $max x*))
(define $min (Mi "min"))
(define (&min . x*)
(apply appl $min x*))这当然是相当不足的, 然而也足够有用.(define (mref A i j)
(_ A (&cm i j)))
(define (_cm A . x*)
(_ A (apply &cm x*)))mref这种记号一般表示取矩阵的某行某列, 而_cm可以视为mref的更为一般的版本.set-系函数SMathML提供了一些以set-开头的便利函数, 用于修饰属性, 例如
(define (set-compact op)
(set-attr* op 'lspace "0" 'rspace "0"))set-compact可以将一个运算符修改为紧凑版本. 这主要是用于在元组中枚举诸运算符. 不过, 作者暂且没搞明白是修改属性好, 还是定义运算符的Mi版本好, 这在MathML标准中没有交代.(define (set-mathvariant i v)
(set-attr* i 'mathvariant v))set-mathvariant可用于修改数学标识符的mathvariant.(define (set-style x style)
(set-attr* x 'style style))set-style用于内联地修改HTML元素的样式.SMathML提供了一些过程用于编写RSS, 其需要通过(require SMathML/rss)引入.
(define (Rss #:version [version "2.0"] channel)
`(rss ((version ,version)) ,channel))
(define (Title str) `(title () ,str))
(define (Link str) `(link () ,str))
(define (Description str) `(description () ,str))
(define (Channel #:title title #:link link #:description description . xml*)
`(channel () ,(Title title) ,(Link link) ,(Description description) . ,xml*))
(define (RC #:version [version "2.0"]
#:title title #:link link #:description description
. xml*)
(Rss #:version version
(keyword-apply
Channel '(#:description #:link #:title) (list description link title)
xml*)))
(define (Item . xml*) `(item () . ,xml*))
(define (PubDate str) `(pubDate () ,str))SMathML所提供的SVG绘图机制还非常原始, 几乎不可使用. 不过, 有总是比没有更好就是了.
(define (A #:attr* [attr* '()] . svg*)
`(a ,attr* . ,svg*))
(define (Animate #:attr* [attr* '()] . svg*)
`(animate ,attr* . ,svg*))
(define (AnimateMotion #:attr* [attr* '()] . svg*)
`(animateMotion ,attr* . ,svg*))
(define (AnimateTransform #:attr* [attr* '()] . svg*)
`(animateTransform ,attr* . ,svg*))
(define (Circle #:attr* [attr* '()] . svg*)
`(circle ,attr* . ,svg*))
(define (ClipPath #:attr* [attr* '()] . svg*)
`(clipPath ,attr* . ,svg*))
(define (Defs #:attr* [attr* '()] . svg*)
`(defs ,attr* . ,svg*))
(define (Desc #:attr* [attr* '()] . svg*)
`(desc ,attr* . ,svg*))
(define (Ellipse #:attr* [attr* '()] . svg*)
`(ellipse ,attr* . ,svg*))
(define (FeBlend #:attr* [attr* '()] . svg*)
`(feBlend ,attr* . ,svg*))
(define (FeColorMatrix #:attr* [attr* '()] . svg*)
`(feColorMatrix ,attr* . ,svg*))
(define (FeComponentTransfer #:attr* [attr* '()] . svg*)
`(feComponentTransfer ,attr* . ,svg*))
(define (FeComposite #:attr* [attr* '()] . svg*)
`(feComposite ,attr* . ,svg*))
(define (FeConvolveMatrix #:attr* [attr* '()] . svg*)
`(feConvolveMatrix ,attr* . ,svg*))
(define (FeDiffuseLighting #:attr* [attr* '()] . svg*)
`(feDiffuseLighting ,attr* . ,svg*))
(define (FeDisplacementMap #:attr* [attr* '()] . svg*)
`(feDisplacementMap ,attr* . ,svg*))
(define (FeDistantLight #:attr* [attr* '()] . svg*)
`(feDistantLight ,attr* . ,svg*))
(define (FeDropShadow #:attr* [attr* '()] . svg*)
`(feDropShadow ,attr* . ,svg*))
(define (FeFlood #:attr* [attr* '()] . svg*)
`(feFlood ,attr* . ,svg*))
(define (FeFuncA #:attr* [attr* '()] . svg*)
`(feFuncA ,attr* . ,svg*))
(define (FeFuncB #:attr* [attr* '()] . svg*)
`(feFuncB ,attr* . ,svg*))
(define (FeFuncG #:attr* [attr* '()] . svg*)
`(feFuncG ,attr* . ,svg*))
(define (FeFuncR #:attr* [attr* '()] . svg*)
`(feFuncR ,attr* . ,svg*))
(define (FeGaussianBlur #:attr* [attr* '()] . svg*)
`(feGaussianBlur ,attr* . ,svg*))
(define (FeImage #:attr* [attr* '()] . svg*)
`(feImage ,attr* . ,svg*))
(define (FeMerge #:attr* [attr* '()] . svg*)
`(feMerge ,attr* . ,svg*))
(define (FeMergeNode #:attr* [attr* '()] . svg*)
`(feMergeNode ,attr* . ,svg*))
(define (FeMorphology #:attr* [attr* '()] . svg*)
`(feMorphology ,attr* . ,svg*))
(define (FeOffset #:attr* [attr* '()] . svg*)
`(feOffset ,attr* . ,svg*))
(define (FePointLight #:attr* [attr* '()] . svg*)
`(fePointLight ,attr* . ,svg*))
(define (FeSpecularLighting #:attr* [attr* '()] . svg*)
`(feSpecularLighting ,attr* . ,svg*))
(define (FeSpotLight #:attr* [attr* '()] . svg*)
`(feSpotLight ,attr* . ,svg*))
(define (FeTile #:attr* [attr* '()] . svg*)
`(feTile ,attr* . ,svg*))
(define (FeTurbulence #:attr* [attr* '()] . svg*)
`(feTurbulence ,attr* . ,svg*))
(define (Filter #:attr* [attr* '()] . svg*)
`(filter ,attr* . ,svg*))
(define (ForeignObject #:attr* [attr* '()] . svg*)
`(foreignObject ,attr* . ,svg*))
(define (G #:attr* [attr* '()] . svg*)
`(g ,attr* . ,svg*))
(define (Image #:attr* [attr* '()] . svg*)
`(image ,attr* . ,svg*))
(define (Line #:attr* [attr* '()] . svg*)
`(line ,attr* . ,svg*))
(define (LinearGradient #:attr* [attr* '()] . svg*)
`(linearGradient ,attr* . ,svg*))
(define (Marker #:attr* [attr* '()] . svg*)
`(marker ,attr* . ,svg*))
(define (Mask #:attr* [attr* '()] . svg*)
`(mask ,attr* . ,svg*))
(define (Metadata #:attr* [attr* '()] . svg*)
`(metadata ,attr* . ,svg*))
(define (Mpath #:attr* [attr* '()] . svg*)
`(mpath ,attr* . ,svg*))
(define (Path #:attr* [attr* '()] . svg*)
`(path ,attr* . ,svg*))
(define (Pattern #:attr* [attr* '()] . svg*)
`(pattern ,attr* . ,svg*))
(define (Polygon #:attr* [attr* '()] . svg*)
`(polygon ,attr* . ,svg*))
(define (Polyline #:attr* [attr* '()] . svg*)
`(polyline ,attr* . ,svg*))
(define (RadialGradient #:attr* [attr* '()] . svg*)
`(radialGradient ,attr* . ,svg*))
(define (Rect #:attr* [attr* '()] . svg*)
`(rect ,attr* . ,svg*))
(define (Script #:attr* [attr* '()] . svg*)
`(script ,attr* . ,svg*))
(define (Set #:attr* [attr* '()] . svg*)
`(set ,attr* . ,svg*))
(define (Stop #:attr* [attr* '()] . svg*)
`(stop ,attr* . ,svg*))
(define (Style #:attr* [attr* '()] . svg*)
`(style ,attr* . ,svg*))
(define (Svg #:attr* [attr* '()] . svg*)
`(svg ,attr* . ,svg*))
(define (Switch #:attr* [attr* '()] . svg*)
`(switch ,attr* . ,svg*))
(define (Symbol #:attr* [attr* '()] . svg*)
`(symbol ,attr* . ,svg*))
(define (Text #:attr* [attr* '()] . svg*)
`(text ,attr* . ,svg*))
(define (TextPath #:attr* [attr* '()] . svg*)
`(textPath ,attr* . ,svg*))
(define (Title #:attr* [attr* '()] . svg*)
`(title ,attr* . ,svg*))
(define (Tspan #:attr* [attr* '()] . svg*)
`(tspan ,attr* . ,svg*))
(define (Use #:attr* [attr* '()] . svg*)
`(use ,attr* . ,svg*))
(define (View #:attr* [attr* '()] . svg*)
`(view ,attr* . ,svg*))注意到其中一些函数和HTML部分的基本函数有冲突, 所以说当用户使用SMathML时, A, Script, Style, Title都没有被导出. 然而, 其和HTML版本是等效的.鉴于当前尚未有切实可行的优秀设计思路, 所以图形库只提供了最为基础的不会出错的函数. 对于作者而言, Penrose库似乎是理想的图形排版方式.
(struct pt (x y) #:transparent)
(struct vec (x y) #:transparent)
(define (vec+ u v)
(vec (+ (vec-x u) (vec-x v))
(+ (vec-y u) (vec-y v))))
(define (vec- u v)
(vec (- (vec-x u) (vec-x v))
(- (vec-y u) (vec-y v))))
(define (vec* s v)
(vec (* s (vec-x v))
(* s (vec-y v))))
(define (pt+ p v)
(pt (+ (pt-x p) (vec-x v))
(+ (pt-y p) (vec-y v))))
(define (pt- p q)
(vec (- (pt-x p) (pt-x q))
(- (pt-y p) (pt-y q))))
(define (dot u v)
(+ (* (vec-x u) (vec-x v))
(* (vec-y u) (vec-y v))))
(define (vec-len v)
(sqrt (dot v v)))
(define (vec-normalize v)
(vec* (/ 1 (vec-len v)) v))
(define (pt-lerp p q t)
(pt+ p (vec* t (pt- q p))))暂时我们又补充了以下原语, 未来显然还需要进一步扩充.
(define (n2s n)
(~r n #:precision 2))
(define stroke-width
(make-parameter "1px"))
(define (:line start end)
(define x1 (n2s (pt-x start)))
(define y1 (n2s (pt-y start)))
(define x2 (n2s (pt-x end)))
(define y2 (n2s (pt-y end)))
`(line ((x1 ,x1)
(y1 ,y1)
(x2 ,x2)
(y2 ,y2)
(stroke-width
,(stroke-width)))))
(define arrow-head
(Marker
#:attr*
'((id "arrow-head")
(viewbox "0 0 10 10")
(refX "5")
(refY "5")
(markerWidth "6")
(markerHeight "6")
(orient "auto-start-reverse"))
(Path #:attr* '((d "M 0 2 L 6 5 L 0 8 z")))))
(define (:arrow start end)
(define x1 (n2s (pt-x start)))
(define y1 (n2s (pt-y start)))
(define x2 (n2s (pt-x end)))
(define y2 (n2s (pt-y end)))
`(line ((x1 ,x1)
(y1 ,y1)
(x2 ,x2)
(y2 ,y2)
(stroke-width
,(stroke-width))
(marker-end
"url(#arrow-head)"))))这一章的目的是为了提供SMathML的实际例子, 以激发读者的想象力, 帮助他们更好地使用SMathML.
Napier筹是对数的发明者Napier设计的一种计算工具, 最基本的应用是计算乘法. 以下我们将要编写代码, 用于排版Napier筹计算乘法的过程.
(define (char->mn c)
(Mn (string c)))
(define (add0 l)
(if (null? (cdr l))
(cons #\0 l)
l))
(define (cell ab)
(define-values (c d)
(apply values
(map char->mn
(add0 (string->list
(number->string (apply * ab)))))))
(Menclose
#:attr* '((notation "updiagonalstrike"))
(Mtable
#:attr* '((frame "solid"))
(Mtr (Mtd c) (Mtd $))
(Mtr (Mtd $) (Mtd d)))))
(define 1--9 (range 1 10))
(define (product l1 l2)
(map (lambda (x)
(map (lambda (y) (list x y))
l2))
l1))
(define (tmap f t)
(map (lambda (l) (map f l)) t))
(define (list->table lst)
(keyword-apply
Mtable
'(#:attr*)
'(((rowspacing "0")
(columnspacing "0")))
(map (lambda (row)
(apply Mtr (map Mtd row)))
lst)))
(define (napier m n)
(list->table
(tmap cell (product m n))))以下我们来看几个例子.
(P (MB (napier 1--9 1--9))
"这是一个完整的Napier筹表.")这是一个完整的Napier筹表.
(P (MB (napier '(4 6 7 8 5 3 9 9)
'(9 6 4 3 1)))
(MB (&= (&c* 46785399 96431)
(* 46785399 96431))))演算是一种内涵性函数理论, 而(Church风格的)简单类型演算的定型规则如下:
(MB (&rull "(Var)"
(&= (app Γ $x) $tau)
(G!- (&: $x $tau))))(MB (&rull "(Abs)"
(G!- (&: $x $tau_1)
(&: $e $tau_2))
(G!- (&: (Lam (&: $x $tau_1) $e)
(&-> $tau_1 $tau_2)))))(MB (&rull "(App)"
(G!- (&: $e_1 (&-> $tau_1 $tau_2)))
(G!- (&: $e_2 $tau_1))
(G!- (&: (App $e_1 $e_2) $tau_2))))其中(define $!- (Mo "⊢"))
(define (!- . x*)
(let-values (((a* b*) (split-at-right x* 1)))
(: (apply &cm a*) $!- (car b*))))
(define (G!- . x*)
(apply !- Γ x*))
(define $.
(Mo "." #:attr* '((lspace "0"))))
(define (Lam x t)
(: $lambda x $. t))
(define App (&split 2))
(define (&rule #:space [n 8] . j*)
(let-values (((j* j1) (split-at-right j* 1)))
(~ #:attr* '((displaystyle "true"))
(apply (&split n) j*) (car j1))))
(define (&rull label . x*)
(: (apply &rule x*) label))这些代码有的地方稍显尴尬, 说明SMathML存在一些值得改进的地方.