ytecode.RCaller.3.0.source-code.runiversal_old.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
concat<-function(to,...){
	to<-paste(to,toString(...),sep="");
	return(to);
}

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

makevectorjava<-function(code,objt,name=""){
	javacode<-code;
		obj<-objt;
		if(is.matrix(obj)) obj<-as.vector(obj);
		if(typeof(obj)=="language") obj<-toString(obj);
        	if(typeof(obj)=="logical") obj<-as.character(obj);

		if(is.vector(obj) && is.numeric(obj)){
                        javacode<-concat(javacode,"double[] ");
                        if(name==""){
				javacode<-concat(javacode,cleanNames(deparse(substitute(obj))));
			}else{
				javacode<-concat(javacode,name);
			}
                        javacode<-concat(javacode,"= new double[] {");
                        javacode<-concat(javacode,obj);
                        javacode<-concat(javacode,"};\n");
                }
                if(is.vector(obj) && is.character(obj)){
                        javacode<-concat(javacode,"String[] ");
	                if(name==""){
				javacode<-concat(javacode,cleanNames(deparse(substitute(obj))));
			}else{
				javacode<-concat(javacode,name);
			}
                        javacode<-concat(javacode,"= new String[] {");
                        for (elem in 1:length(obj)){
                                javacode<-paste(javacode,"\"",toString(obj[elem]),"\"",sep="");
                                if (elem!=length(obj)) javacode<-paste(javacode,",",sep="");

                        }
                        javacode<-concat(javacode,"};\n");
                }
	return(javacode);
}

makejava<-function(obj,name=""){
	javacode<-"";
	if(!is.list(obj)){
        	javacode<-makevectorjava(javacode,obj,name);
        }
	if (is.list(obj)){
		objnames<-names(obj);
		for (i in 1:length(obj)){
			javacode<-makevectorjava(javacode,obj[[i]],cleanNames(objnames[[i]]));
		}
	}
return(javacode);
}


makevectorxml<-function(code,objt,name=""){
        xmlcode<-code;
	if(name==""){
	        varname<-cleanNames(deparse(substitute(obj)));
        }else{
                varname<-name;
        }
	obj<-objt;
	if(is.matrix(obj)) obj<-as.vector(obj);
	if(typeof(obj)=="language") obj<-toString(obj);
	if(typeof(obj)=="logical") obj<-as.character(obj);
                if(is.vector(obj) && is.numeric(obj)){
                        xmlcode<-paste(xmlcode,"\n",sep="");
			for (i in obj){
                        	xmlcode<-paste(xmlcode,"\t",sep="");
				xmlcode<-paste(xmlcode,toString(i),sep="");
	                        xmlcode<-paste(xmlcode,"\n",sep="");
			}
                        xmlcode<-paste(xmlcode,"\n",sep="");
                }
                if(is.vector(obj) && is.character(obj)){
                        xmlcode<-paste(xmlcode,"\n",sep="");
                        for (i in obj){
                                xmlcode<-paste(xmlcode,"\t",sep="");
                                xmlcode<-paste(xmlcode,toString(i),sep="");
                                xmlcode<-paste(xmlcode,"\n",sep="");
                        }
			xmlcode<-paste(xmlcode,"\n");
                }
        return(xmlcode);
}


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