ytecode.RCaller.3.0.source-code.runiversal.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

There is a newer version: 4.0.2

cleanNames<-function(names){
  cln<-paste(unlist(strsplit(names,"\\.")),collapse="_")
  cln<-paste(unlist(strsplit(cln,"<")),collapse="")
  cln<-paste(unlist(strsplit(cln,">")),collapse="")
  cln<-paste(unlist(strsplit(cln," ")),collapse="")
  cln<-paste(unlist(strsplit(cln,"\\(")),collapse="")
  cln<-paste(unlist(strsplit(cln,"\\)")),collapse="")
  cln<-paste(unlist(strsplit(cln,"\\[")),collapse="")
  cln<-paste(unlist(strsplit(cln,"\\]")),collapse="")
  cln<-paste(unlist(strsplit(cln,"\\*")),collapse="")
  cln<-paste(unlist(strsplit(cln,"&")),collapse="")
  return(cln)
}

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)
  if(typeof(obj)=="language") obj<-toString(obj)
  if(typeof(obj)=="logical") obj<-as.character(obj)
  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)){
      xmlcode<-makevectorxml(xmlcode,obj[[i]],cleanNames(objnames[[i]]))
    }
  }
  xmlcode<-paste(xmlcode,"\n",sep="")
  return(xmlcode)
}