ytecode.RCaller.4.0.2.source-code.xml_exporting.R Maven / Gradle / Ivy

Go to download

Show more of this group Show more artifacts with this name
Show all versions of RCaller Show documentation

http://www.mhsatman.com

The newest version!

replaceXMLchars <- function(aStr){
  cln <-paste(unlist(strsplit(aStr,"&")),collapse="&")
  cln <-paste(unlist(strsplit(cln,"<")),collapse="<")
  cln <-paste(unlist(strsplit(cln,">")),collapse=">")
  cln <-paste(unlist(strsplit(cln,"'")),collapse="'")
  return(cln)	
}

makevectorxml<-function(code,objt,name=""){
  xmlcode<-code
  if(name==""){
    varname<-cleanNames(deparse(substitute(obj)))
  }else{
    varname<-name
  }
  obj<-objt  
  n <- 0; m <- 0
  mydim <- dim(obj)
  if(!is.null(mydim)){
    n <- mydim[1]; m <- mydim[2]
  }else{
    n <- length(obj); m <- 1
  }
  if(is.matrix(obj)) {
    obj<-as.vector(obj)
  }else if(typeof(obj)=="language") {
    obj<-toString(obj)
  }else if(typeof(obj)=="logical") {
    obj<-as.character(obj)
  }else if(class(obj)=="factor") {
    obj<-as.vector(obj)
  }
  if(is.vector(obj) && is.numeric(obj)){
    xmlcode<-paste(xmlcode,"",sep="")
    s <- sapply(X=obj, function(str){
      return(
        paste("",iconv(replaceXMLchars(toString(str)), to="UTF-8"),"",sep="")
      )})
    xmlcode<-paste(xmlcode,paste(s, collapse=""),"\n")
  }
  if(is.vector(obj) && is.character(obj)){
    xmlcode<-paste(xmlcode,"\n",sep="")
    s <- sapply(X=obj, function(str){
                            return(
                              paste("",iconv(replaceXMLchars(toString(str)), to="UTF-8"),"",sep="")
                             )})
    xmlcode<-paste(xmlcode,paste(s, collapse=""),"\n")
  }
  return(xmlcode)
}


makexml<-function(obj,name=""){
  xmlcode<-"\n\n"
  if(!is.list(obj)){
    xmlcode<-makevectorxml(xmlcode,obj,cleanNames(name))
  }else{
    objnames<-names(obj)
    for (i in 1:length(obj)){
      name <- objnames[[i]]
      if (is.null(name)) {
        name <- paste(typeof(obj[[i]]), "-", i, sep='')
      }
      xmlcode<-makevectorxml(xmlcode,obj[[i]],cleanNames(name))
    }
  }
  xmlcode<-paste(xmlcode,"\n",sep="")
  return(xmlcode)
}