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, # ~ を導入する。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 # ~ タグを有効にする
) {
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
i <- 0
repeat {
i <- i+1
if (i > n) break
s <- str[i]
if (grepl("^
", s) && header) { # title
s <- sub("^", "", s)
s <- sub("
$", "
", s)
mod <- sprintf('
Last modified: %s
',
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(" is missing.")
}
else {
s <- str[i]
if (grepl("(skip|SKIP|Skip)>", s)) break
}
}
next
}
else if (grepl("^", s)) { # section, subsection, subsubsection, subsubsubsection ...?
if (grepl("^", s)) {
section <- section+1
subsection <- subsubsection <- fig.no <- tab.no <- eq.no <- 0
}
else if (grepl("^", s)) {
subsection <- subsection+1
subsubsection <- 0
}
else if (grepl("^", s)) {
subsubsection <- subsubsection+1
subsubsubsection <- 0
}
else if (grepl("^", 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("^") { # 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("^", grafile, no), s)
}
else if (grepl("図 %i ", fig.no), s)
}
else {
s <- sub('図 %i.%i ", section, fig.no), s)
}
s <- sub('">', "
", s)
}
else if (grepl("表 %i ", tab.no), s)
}
else {
s <- sub('表 %i.%i ", section, tab.no), s)
}
s <- sub('">', "", s)
}
else if (grepl("^", s, ignore.case=TRUE)) { # break after end of table
s <- sub("
", "
", s, ignore.case=TRUE)
}
else if (grepl("^", s)) { # tables to center
s <- sub("^", "", s)
}
# else if (grepl("
", s, ignore.case=TRUE)) { # break after end of table
# s <- sub("
", "
", s, ignore.case=TRUE)
# }
else if (grepl("^", s, ignore.case=TRUE)) { # caption of table
tab.no <- tab.no+1
if (section == 0) {
s <- sub("^", sprintf('表 %i ', tab.no), s, ignore.case=TRUE)
}
else {
s <- sub("^", sprintf('表 %i.%i ', section, tab.no), s, ignore.case=TRUE)
}
}
else if (grepl("^()*%", s)) { # remarks
s <- sub("^(
)*", "", 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("^
", s)) {
s <- sub("^
", "aaa", s)
}
else if (grepl("MathJax scripts", s) && fleqn == TRUE) { # equations to align left
s <- paste(s, '', sep="\n")
}
else if (grepl("\\\\
", s)) { # repair line ends \\ in align* environment
s <- sub("\\\\
", "\\\\\\\\", s)
}
#
if (grepl("^
\n", s, "\n", file=con)
}
else if (s == "
") {
cat("\n\n", file=con)
}
else if (s == " font-size: 12px;") { # body. td
cat(s, "\n line-height: 150%;\n", file=con)
}
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
) {
cat(s, "\n", file=con)
}
}
close(con)
}