rmd <- function(File, # foo.Rmd ファイル（拡張子も書く）
                encoding="euc-jp", # 作られる foo.html のエンコーディング
                base64=FALSE, # 　図をインラインで表示するときは TRUE に（ファイルは figure ディレクトリに作られる）
                tangle=TRUE, # 図を含む場合，tangle で取り出した R ファイルを実行して png ファイルを作る
                fleqn=TRUE, # 式を左寄せにする（LaTeX と同じ）
                force=FALSE, # デフォルトでは foo.Rmd に変更がなければ何もしない。TRUE にすると，必ず foo.html ファイルを作り直す
                skip=TRUE, # <skip> ~ </skip> を導入する。TRUE の場合，foo.Rmd のなかで，skip タグで挟まれた部分は無視される。
                fig.width=400, # png 画像の幅ピクセル数
                fig.height=300, # png 画像の高さピクセル数。任意の時点で options( ) にて設定変更可
                del.wf=TRUE # 最後に foo.md, foo.R を消去する
                ) {
    default.options <- c("hard_wrap", "use_xhtml", "smartypants", "highlight_code", "mathjax")
    if (base64) {
        default.options <- c(default.options, "base64_images")
    }
    options(markdown.HTML.options=default.options)
    library(knitr)
    opts_knit$set(progress=FALSE)
    if (grepl("\\.", File) == FALSE) {
        File <- paste(File, "Rmd", sep=".")
    }
    File.html <- sub(".Rmd$", ".html", File, ignore.case=TRUE)
    if (force || file.exists(File.html) == FALSE ||
        file.info(File.html)$mtime < file.info(File)$mtime) {
        windows <- grepl("932", Sys.getlocale(category="LC_CTYPE"))
        if (windows) {
            Sys.setlocale(locale="C")
        }
        knit2html(File)
        if (windows) {
            Sys.setlocale(locale="Japanese_Japan.932")
        }
        if (tangle) {
            File.R <- sub(".Rmd$", ".R", File, ignore.case=TRUE)
            knit(File, output=File.R, tangle=TRUE)
            options(fig.width=fig.width,  fig.height=fig.height)
            File.png <- sub(".Rmd$", "%03i.png", File, ignore.case=TRUE)
            png(sprintf("figure/%s", File.png), getOption("fig.width"), getOption("fig.height"))
        	old <- par(family="HiraMaruProN-W4")
            sink("junk")
            source(File.R)
            sink()
            par(old)
            file.remove("junk")
            dev.off()
            if (del.wf) {
                file.remove(File.R)
            }
            file.remove(paste("figure", list.files(paste(getwd(), "figure", sep="/"), pattern="unnamed*"), sep="/"))
        }
        changeEncoding(File.html, encoding=encoding, fleqn=fleqn, skip=skip)
        if (del.wf) {
            file.remove(sub(".Rmd", ".md", File, ignore.case=TRUE))
        }
    }
    invisible()
}
changeEncoding <- function(File, # 編集すべき foo.html ファイル
                           encoding = "euc-jp", # foo.html のエンコーディング
                           fleqn = TRUE, # LaTeX と同じように数式を若干左に寄せる
                           skip = TRUE # <skip> ~ </skip> タグを有効にする
                           ) {
    getStr <- function(tag, str) {
    	sub(sprintf(".*<%s (.*?)>.*", tag), "\\1", str)
    }
    stopifnot(grepl(".html", File))
    grafile <- sub(".html", "", File)
    con <- file(File, open="r", encoding="utf-8")
    str <- readLines(con)
    close(con)
    con <- file(File, open="w", encoding=encoding)
    n <- length(str)
    header <- TRUE
    no <- 0
    section <- subsection <- subsubsection <- subsubsubsection <- fig.no <- tab.no <- eq.no <- 0
    labels <- vector("list", 20)
    n.label <- 0
    i.out <- i <- 0
    str.out <- character(n)
    repeat {
        i <- i+1
        if (i > n) break
        s <- str[i]
        repeat {
	        if (grepl("<label ", s, ignore.case=TRUE) == FALSE) {
	        	break
	        }
        	s.label <- sub(".*<label (.*?)>.*", "\\1", s)
        	n.label <- n.label+1
        	labels[[n.label]] <- list(label=sub(".*<label (.*?)>.*", "\\1", s), num=c(section, fig.no, tab.no))
        	s <- sub("(.*)<label .*?>(.*)", "\\1\\2", s)
	    }
#	    if (grepl("<code class=\"r\">", s)) {
#	    	code <- TRUE
#	    }
#	    else if (grepl("</code>", s)) {
#	    	code <- FALSE
#	    }
        if (grepl("^<h1>", s) && header) { # title
            s <- sub("^<h1>", "<center><h1>", s)
            s <- sub("</h1>$", "</h1></center>", s)
            mod <- sprintf('<div align="right">Last modified: %s</div>',
                            sub(" ..:..:..", ",", sub("^....", "", date())))
            s <- sprintf("%s\n%s\n", s, mod)
        }
        else if (grepl("<(skip|SKIP|Skip)>", s) && skip) {
            repeat {
                i <- i+1
                if (i > n) {
                    stop("</skip> is missing.")
                }
                else {
                    s <- str[i]
                    if (grepl("</(skip|SKIP|Skip)>", s)) break
                }
            }
            next
        }        
        else if (grepl("^<h[2-6]>", s)) { # <h2> section, <h3> subsection, <h4> subsubsection, <h5> subsubsubsection ...?
            if (grepl("^<h2>", s)) {
                section <- section+1
                subsection <- subsubsection <- fig.no <- tab.no <- eq.no <- 0
            }
            else if (grepl("^<h3>", s)) {
                subsection <- subsection+1
                subsubsection <- 0
            }
            else if (grepl("^<h4>", s)) {
                subsubsection <- subsubsection+1
                subsubsubsection <- 0
            }
            else if (grepl("^<h5>", s)) {
                subsubsubsection <- subsubsubsection+1
            }
            if (subsection == 0) {
                num <- sprintf(">%i　", section)
            }
            else if (subsubsection == 0) {
                num <- sprintf(">%i.%i　", section, subsection)
            }
            else if (subsubsubsection == 0) {
                num <- sprintf(">%i.%i.%i　", section, subsection ,subsubsection)
            }
            else {
                num <- sprintf(">%i.%i.%i.%i　", section, subsection, subsubsection, subsubsubsection)
            }
            s <- sub(">", num, s)
            s <- sub("^<h", "<br/><h", s)
        }
        else if (grepl("font-size:0.[89]em;", s)) { # h5
            s <- sub("0.[89]", "1.0", s)
        }
        else if (grepl("font-size:1.4em;", s)) { # h3
            s <- sub("1.4", "1.2", s)
        }
        else if (grepl("font-size:1.8em;", s)) { # h2
            s <- sub("1.8", "1.4", s)
        }
        else if (grepl("font-size:2.2em;", s)) { # h1
            s <- sub("2.2", "1.6", s)
        }
        else if (grepl("border: none;", s)) { # table
            s <- "border: 1px solid;"
        }
        else if (grepl("background-color: #F8F8F8;", s)) { # code
            s <- sub("F8F8F8", "e8e8f8", s)
        }
        else if (grepl("&rdquo|&ldquo", s)) { # code
            s <- gsub("&rdquo|&ldquo", "&quot", s)
        }
        else if (s == "<base target=\"_blank\"/>") { # tab
            s <- ""
        }
        else if (grepl("font-family: sans-serif;", s)) { # font
            s <- sub("sans-", "", s)
        }
        else if (grepl("padding-left: 1em;", s)) { # blockquote
            s <- sub("1em", "3em", s)
        }
        else if (grepl("page-break-before: always;", s)) { # hr
            s <- ""
        }
        else if (grepl("height: 0px;", s)) { # hr
            s <- sub("0px", "3px", s)
        }
        else if (grepl("^<meta http-equiv", s)) { # encoding
            s <- sub("utf-8", encoding, s)
        }
        else if (grepl("^<p><img", s)) { # images to center (figure folder)
            s <- sub("^<p><img", "<br/><p align=center><img", s)
            no = no+1
            s <- sub("figure/.+", sprintf("figure/%s%03i.png\"></p>", grafile, no), s)
        }
        else if (grepl("<fig (caption|title)=", s)) { # special tag for figure caption
            fig.no <- fig.no+1
            if (section == 0) {
                s <- sub('<fig (caption|title)="', sprintf("<p align='center'>図 %i　", fig.no), s)
            }
            else {
                s <- sub('<fig (caption|title)="', sprintf("<p align='center'>図 %i.%i　", section, fig.no), s)
            }
            s <- sub('">', "</p><br/><br/>", s)
        }
        else if (grepl("<tab (caption|title)=", s)) { # special tag for table caption
            tab.no <- tab.no+1
            if (section == 0) {
                s <- sub('<tab (caption|title)="', sprintf("<p align='center'>表 %i　", tab.no), s)
            }
            else {
                s <- sub('<tab (caption|title)="', sprintf("<p align='center'>表 %i.%i　", section, tab.no), s)
            }
            s <- sub('">', "", s)
        }
        else if (grepl("^<table border", s, ignore.case=TRUE)) { # tables to center
            s <- sub("^<table border", "<table align=center cellpadding=5 cellspacing=0 border", s, ignore.case=TRUE)
        }
        else if (grepl("</table>", s, ignore.case=TRUE)) { # break after end of table
            s <- sub("</table>", "</table><br/>", s, ignore.case=TRUE)
        }

        else if (grepl("^<table><thead>", s)) { # tables to center
            s <- sub("^<table><thead>", "<table align=center cellpadding=5 cellspacing=0 border=1><thead>", s)
        }
#        else if (grepl("</table>", s, ignore.case=TRUE)) { # break after end of table
#            s <- sub("</table>", "</table><br/>", s, ignore.case=TRUE)
#        }

        else if (grepl("^<caption align=(\"top\"|'top')>", s, ignore.case=TRUE)) { # caption of table
            tab.no <- tab.no+1
            if (section == 0) {
                s <- sub("^<caption align=(\"top\"|'top')>", sprintf('<caption align="top">表 %i　', tab.no), s, ignore.case=TRUE)
            }
            else {
                s <- sub("^<caption align=(\"top\"|'top')>", sprintf('<caption align="top">表 %i.%i　', section, tab.no), s, ignore.case=TRUE)
            }
        }
        else if (grepl("^(<p>)*%", s)) { # remarks
            s <- sub("^(<p>)*", "<!--", s)
            s <- sub("</p>", "-->", s)
        }
        else if (grepl("\\\\tag\\{[0-9]+\\}", s)) { # \tag{n} as eqation number
            eq.no <- eq.no+1
            if (section == 0) {
                s <- sub("\\\\tag\\{[0-9]+\\}", sprintf("\\\\tag{%i}", eq.no), s)
            }
            else {
                s <- sub("\\\\tag\\{[0-9]+\\}", sprintf("\\\\tag{%i.%i}", section, eq.no), s)
            }
        }
        else if (grepl("^<br/>", s)) {
            s <- sub("^<br/>", "aaa", s)
        }
        else if (grepl("MathJax scripts", s) && fleqn == TRUE) { # equations to align left
            s <- paste(s, '<script type="text/x-mathjax-config">MathJax.Hub.Config({extensions: ["tex2jax.js"],jax: ["input/TeX","output/HTML-CSS"],displayAlign: "left",displayIndent: "3em"});</script>', sep="\n")
        }
        else if (grepl("\\\\<br/>", s)) { # repair line ends \\ in align* environment
            s <- sub("\\\\<br/>", "\\\\\\\\", s)
        }
#        else if (!code && grepl("\\$(.*?)\\$", s)) { # たまに（よく？） $ $ は取り残されることがあるので
#            s <- gsub("\\$(.*?)\\$", "\\\\(\\1\\\\)", s)
#        }
#
        if (grepl("^<pre><code", s)) { # indent for code and result
        	i.out <- i.out+1
            str.out[i.out] <- paste("<blockquote>\n", s, "\n", collapse="")
        }
        else if (s == "</code></pre>") {
        	i.out <- i.out+1
            str.out[i.out] <- "</code></pre>\n</blockquote>\n"
        }
        else if (s == "   font-size: 12px;") { # body. td
        	i.out <- i.out+1
            str.out[i.out] <- paste(s, "\n   line-height: 150%;\n", collapse="")
        }
        else if (s != "   border-left: 0.5em #EEE solid;" && # blockquote
                 s != "   border-bottom: none;" && # hr
                 s != "   border-top-width: thin;" && # hr
                 s != "   border-top-style: dotted;" && # hr
                 s != "   border-top-color: #999999;" # hr
                 ) {
        	i.out <- i.out+1
            str.out[i.out] <- paste(s, "\n", collapse="")
        }
    }
	str <- str.out
    n <- length(str)
    i <- 0
    repeat {
        i <- i+1
        if (i > n) break
        s <- str[i]
        repeat {
	        suf <- 0
	        if (grepl("<figref ", s, ignore.case=TRUE)) {
	        	s.label <- getStr("figref", s)
	        	suf <- 2
	        }
	        else if (grepl("<tabref ", s, ignore.case=TRUE)) {
	        	s.label <- getStr("tabref", s)
	        	suf <- 3
	        }
	        if (suf == 0) {
	        	break
	        }
	        rep.label <- "???"
	        for (j in 1:n.label) {
	        	if (s.label == labels[[j]]$label) {
	        		if (labels[[j]]$num[1] == 0) {
	        			rep.label <- labels[[j]]$num[suf]
	        		}
	        		else {
	        			rep.label <- paste(labels[[j]]$num[c(1, suf)], collapse=".")
	       			}
	        		break
	        	}
	        }
	        s <- sub("<(tabref|figref|eqref) .*?>", rep.label, s, ignore.case=TRUE)
        }
        cat(s, file=con)
    }
    close(con)
}