# # Functions to illustrate how to convert a MathML tree # to an R expression that can be used to annotate a plot # as an argument to plotmath. # # # mchar # mfrac # !=, ==, <=, >=, etc.to the # sqrt, # sub-, super-script [], ^ # times %*% # %~~% # %subset%, %subseteq% # %supset%, %supseteq% # %in% # %notin% # hat # tilde # group("(",list(a, b),"]") # inf(S) # sum(x[i],i==1,n) # # # # mathmlPlot <- function(node) { UseMethod("mathmlPlot",node) } mathmlPlot.XMLDocument <- function(doc) { return(mathmlPlot(doc$doc$children)) } mathmlPlot.default <- function(children) { expr <- expression() i <- 1 ok <- (i <= length(children)) while(ok) { #cat(i,"\n") child <- children[[i]] if(is.null(child)) { i <- i+1 ok <- (i <= length(children)) next } if(!is.null(class(child)) && class(child) == "XMLComment") { i <- i+1 ok <- (i <= length(children)) next } # if(inherits(child,"XMLNode")) {} #if(is.null(class(child))) cat("Null child:",child,"\n") if(xmlName(child) == "mo") { op <- child$children[[1]]$value if(op == "sum") { # needs to get operand. tmp <- c(as.name(op), quote(x[i]),mathmlPlot(children[[i+1]]), mathmlPlot(children[[i+2]])) expr <- c(expr, tmp) i <- i+2 } else { expr <- c(mathmlPlot(child), expr , mathmlPlot(children[[i+1]])) } mode(expr) <- "call" i <- i+1 } else { expr <- c(expr, mathmlPlot(child)) } i <- i+1 ok <- (i <= length(children)) #cat(i,length(children),"\n") } return(expr) } mathmlPlot.XMLEntityRef <- function(node) { nm <- xmlName(node) val <- switch(nm, PlusMinus=as.name("%+-%"), InvisibleTimes=as.name("*"), int=as.name("integral"), infty = as.name("infinity"), NULL ) if(is.null(val)) { val <- as.name(nm) } return(val) } mathmlPlot.XMLNode <- function(node) { nm <- name(node) if(nm == "mi" || nm == "ci") { val <- c(as.name("italic"),mathmlPlot(node$children)) mode(val) <- "call" } else if(nm == "msqrt") { val <- c(as.name("sqrt"), mathmlPlot(node$children)) mode(val) <- "call" } else if(nm == "msubsup") { tmp <- c(as.name("^"), mathmlPlot(node$children[[1]]),mathmlPlot(node$children[[2]])) mode(tmp) <- "call" val <- c(as.name("["), tmp, mathmlPlot(node$children[[3]])) mode(val) <- "call" } else if(nm == "mrow") { val <- mathmlPlot(node$children) } else if(nm == "text") { val <- node$value } else if(nm == "mo") { if(inherits(node$children[[1]],"XMLEntityRef")) val <- mathmlPlot(node$children[[1]]) else { op <- node$children[[1]]$value tmp <- switch(op, "=" = "==", op) val <- as.name(tmp) } } else if(nm == "mfrac") { val <- list(as.name("frac"), mathmlPlot(node$children[[1]]), mathmlPlot(node$children[[2]])) mode(val) <- "call" } else if(nm == "msup" || nm == "msub") { op <- switch(nm, "msup" = "^", "msub"="[") val <- c(as.name(op), mathmlPlot(node$children[[1]]), mathmlPlot(node$children[[2]])) mode(val) <- "call" } else if(nm == "mn" || nm == "cn") { val <- as.numeric(node$children[[1]]$value) } else if(nm == "mstyle") { val <- mathmlPlot(node$children) } else if(nm == "munderover") { val <- mathmlPlot(node$children) } else if(nm == "mroot") { val <- c(as.name("sqrt"), mathmlPlot(node$children[[1]]), mathmlPlot(node$children[[2]])) mode(val) <- "call" } else if(nm == "reln") { val <- mathmlPlot(node$children) mode(val) <- "call" } else if(nm == "eq") { val <- as.name("==") } else if(nm == "geq") { val <- as.name(">=") } else if(nm == "set") { # This looks for a tag and takes # everything before that as preceeding the `|' n <- min( (1:length(node$children))[sapply(node$children, xmlName) == "condition"]) cat("Condition @",n,"\n") args <- c(mathmlPlot(node$children[1:(n-1)]), "|", mathmlPlot(node$children[n:length(node$children)])) args <- c(as.name("paste"), args) mode(args) <- "call" val <- list(as.name("group"),"{", args,"}") mode(val) <- "call" } else if(nm == "bvar") { val <- mathmlPlot(node$children) } else if(nm == "condition") { val <- mathmlPlot(node$children) } else if(nm == "interval") { sep <- xmlAttrs(node)[["closure"]] sep <- switch(sep, open=c("(",")"), closed=c("[","]"), "closed-open"=c("[",")"), "open-closed"=c("(","]"), ) els <- mathmlPlot(node$children) els <- c(as.name("paste"), els[[1]],",",els[[2]]) mode(els) <- "call" val <- list(as.name("group"),sep[1], els ,sep[2]) mode(val) <- "call" } else if(nm == "power") { val <- c(as.name("^"), mathmlPlot(node$children[[1]]), mathmlPlot(node$children[[2]])) # mode(val) <- "call" } else if(nm == "plus") { val <- as.name("+") } else if(nm == "apply") { val <- mathmlPlot.apply(node) } return(val) } mathmlPlot.apply <- function(node) { sub <- mathmlPlot(node$children) nm <- xmlName(node$children[[1]]) print(node$children[[1]]) if(nm == "plus" || nm == "minus" || nm == "times" || nm == "div" ) { print(sub[[1]]) val <- c(mathmlPlot(node$children[[1]]), sub[[2]], sub[[3]]) mode(val) <- "call" for(i in 4:length(sub)) { tmp <- c(mathmlPlot(node$children[[1]]), val, sub[[i]]) mode(tmp) <- "call" val <- tmp } } else { val <- sub mode(val) <- "call" } return(val) }