From 6b1dd9af9fcb15d1307b127ba7ccb936aa69d737 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roland=20Holl=C3=B3s?= Date: Wed, 23 Jan 2019 18:56:57 +0100 Subject: [PATCH] forarcheologists is obsolate by design... --- forarcheologists | 446 ----------------------------------------------- 1 file changed, 446 deletions(-) delete mode 100644 forarcheologists diff --git a/forarcheologists b/forarcheologists deleted file mode 100644 index 7ee29bd..0000000 --- a/forarcheologists +++ /dev/null @@ -1,446 +0,0 @@ - - -## runMuso <- function(settings, parameters=c(" ECOPHYS")){ -## #changing section -## # for(i in changeinput){ -## # changemulline(settings, parameters[[i]]) -## # } -## changemulline(settings,parameters) - -## #spinup run -## # changemulline(type=1,setup(), parameters[[2]]) -## setwd(settings$inputloc) -## system(paste(settings$executable,settings$ininput[1],sep=" ")) -## #normal run -## setwd(settings$inputloc) -## system(paste(settings$executable,settings$ininput[2],sep=" ")) -## } - -## rungetMusowc <- function(settings,parameters=c(" ECOPHYS"),timee="y",logfile=FALSE,logfilename=NULL){ -## #spinup run -## # changemulline(type=1,setup(), parameters[[2]]) -## changemulline(settings,parameters) -## setwd(settings$inputloc) -## system(paste(settings$executable,settings$ininput[1],sep=" ")) -## #normal run -## setwd(settings$inputloc) -## system(paste(settings$executable,settings$ininput[2],sep=" ")) - -## switch(timee, -## "d"=(Reva<-getdailyout(settings)), -## "m"=(Reva<-getmonthlyout(settings)), -## "y"=(Reva<-getyearlyout(settings)) -## ) -## return(Reva) -## } - - - -##For this functions there is a built in dirname function in R, which do the same. -## splitstr <- function(string, sep){ -## return(unlist(strsplit(string,sep))) -## } - -## containerdir<-function(string){ -## return(paste(splitstr(string,"/")[1:(length(splitstr(string,"/"))-1)],collapse = "/")) -##} - - - -## changspecline <- function(filename, line_number,content){ -## #This function calls the UNIX(-like) sed program to change specific line to other, using the row numbers. -## for_command_line <- paste("sed -i '",line_number,"s/.*/",content,"/'"," ",filename, sep="") -## system(for_command_line) -## } - -## changespecline<- function(filename,line_number,content){ -## TOT=readLines(filename,-1) -## TOT[line_number]<-content -## writeLines(TOT,filename) -## } - -## changemulline <- function(settings,contents){ -## #This is the function which is capable change multiple specific lines to other using their row numbers. -## #The function uses the previous changspecline function to operate. -## varnum <- length(settings$calibrationpar) -## if(length(contents)!=varnum) -## { -## cat("Error: number of the values is not the same as the number of the changed parameters") -## } - -## for(i in 1:varnum){ -## changspecline(settings$epcinput,settings$calibrationpar[i], contents[i] ) -## } -## } - -## changmulline2 <- function(settings,contents){ -## #This is the function which is capable change multiple specific lines to other using their row numbers. -## #The function uses the previous changspecline function to operate. -## varnum <- length(settings$calibrationpar) -## if(length(contents)!=varnum) -## { -## cat("Error: number of the values is not the same as the number of the changed parameters") -## } - -## for(i in 1:varnum){ -## changespecline(settings$epcinput,settings$calibrationpar[i], contents[i] ) -## } -## } - - - -## changeSpecLine<-function(lineNumber,content,file){ -## TOT=readLines(file,-1) -## TOT[lineNumber]<-content -## writeLines(TOT,file) -## } - - - ###Old solution for path joins, now I use file.path() function - ## if(is.null(inputLoc)){ - ## inputLoc<- "./" - ## } else { - ## file.path(inputLoc,"") - ## } - ## inp <- unlist(strsplit(inputLoc,"")) #This is the charactervector of the given imput location - - ## if(inp[length(inp)]!="/"){ - ## inp<-c(inp,"/") - ## inputLoc <- paste(inp,collapse = "") - ## rm(inp) - ## }# If inp not ends in / paste one at the end, then make a string, that will be the new inputLoc - - ## ##Example: "a/b/c ==> a/b/c/" - - - - - - if(is.null(epcInput)){ - epcflag=TRUE - epcInput[1] <- paste0(inputLoc,inputParser(string=" EPC file name",fileName=iniFiles[[1]],counter=1,value=TRUE)) - epcInput[2] <- paste0(inputLoc,inputParser(string=" EPC file name",fileName=iniFiles[[2]],counter=1,value=TRUE)) - } else { - iniFiles[[1]][grep(" EPC file name",iniFiles[[1]])]<-paste(epcInput[1],"\t EPC file name",sep="") - - if(length(epcInput)==2){ - iniFiles[[2]][grep(" EPC file name",iniFiles[[2]])]<-paste(epcInput[2],"\t EPC file name",sep="") - } - } - - if(is.null(metInput)){ - metflag=TRUE - metInput[1] <- unlist(strsplit(grep(" met file name",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - metInput[2] <- unlist(strsplit(grep(" met file name",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep(" met file name",iniFiles[[1]])]<-paste(metInput[1],"\t met file name",sep="") - - if(length(metInput)==2){ - iniFiles[[2]][grep(" met file name",iniFiles[[2]])]<-paste(metInput[2],"\t met file name",sep="") - }} - - if(is.null(CO2Input)){ - CO2flag=TRUE - CO2Input[1] <- unlist(strsplit(grep(" CO2 file",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - CO2Input[2] <- unlist(strsplit(grep(" CO2 file",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep(" CO2 file",iniFiles[[1]])]<-paste(CO2Input[1],"\t CO2 file",sep="") - - if(length(CO2Input)==2){ - iniFiles[[2]][grep(" CO2 file",iniFiles[[2]])]<-paste(CO2Input[2],"\t CO2 file",sep="") - }} - - if(is.null(nitInput)){ - nitflag=TRUE - nitInput[1] <- unlist(strsplit(grep("N-dep file",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - nitInput[2] <- unlist(strsplit(grep("N-dep file",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep("N-dep file",iniFiles[[1]])]<-paste(nitInput[1],"N-dep file",sep="N-dep file") - - if(length(epcInput)==2){ - iniFiles[[2]][grep("N-dep file",iniFiles[[2]])]<-paste(nitInput[2],"N-dep file",sep="") - }} - - if(is.null(thinInput)){ - thinflag=TRUE - thinInput[1] <- unlist(strsplit(grep("do THINNING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - thinInput[2] <- unlist(strsplit(grep("do THINNING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep("do THINNING",iniFiles[[1]])]<-paste(thinInput[1],"do THINNING",sep="") - - if(length(thinInput)==2){ - iniFiles[[2]][grep("do THINNING",iniFiles[[2]])]<-paste(thinInput[2],"do THINNING",sep="") - }} - - if(is.null(plantInput)){ - plantflag=TRUE - plantInput[1] <- unlist(strsplit(grep("do PLANTING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - plantInput[2] <- unlist(strsplit(grep("do PLANTING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep("do PLANTING",iniFiles[[1]])]<-paste(plantInput[1],"do PLANTING",sep="") - - if(length(plantInput)==2){ - iniFiles[[2]][grep("do PLANTING",iniFiles[[2]])]<-paste(plantInput[2],"do PLANTING",sep="") - }} - - if(is.null(mowInput)){ - mowflag=TRUE - mowInput[1] <- unlist(strsplit(grep("do MOWING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - mowInput[2] <- unlist(strsplit(grep("do MOWING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep("do MOWING",iniFiles[[1]])]<-paste(mowInput[1],"do MOWING",sep="") - - if(length(mowInput)==2){ - iniFiles[[2]][grep("do MOWING",iniFiles[[2]])]<-paste(mowInput[2],"do MOWING",sep="") - }} - - if(is.null(grazInput)){ - grazflag=TRUE - grazInput[1] <- unlist(strsplit(grep("do GRAZING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - grazInput[2] <- unlist(strsplit(grep("do GRAZING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep("do GRAZING",iniFiles[[1]])]<-paste(grazInput[1],"do GRAZING",sep="") - - if(length(grazInput)==2){ - iniFiles[[2]][grep("do GRAZING",iniFiles[[2]])]<-paste(grazInput[2],"do GRAZING",sep="") - }} - - if(is.null(harvInput)){ - harvflag=TRUE - harvInput[1] <- unlist(strsplit(grep("do HARVESTING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - harvInput[2] <- unlist(strsplit(grep("do HARVESTING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep("do HARVESTING",iniFiles[[1]])]<-paste(harvInput[1],"do HARVESTING",sep="") - - if(length(harvInput)==2){ - iniFiles[[2]][grep("do HARVESTING",iniFiles[[2]])]<-paste(harvInput[2],"do HARVESTING",sep="") - }} - - if(is.null(plougInput)){ - plougflag=TRUE - plougInput[1] <- unlist(strsplit(grep("do PLOUGHING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - plougInput[2] <- unlist(strsplit(grep("do PLOUGHING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep("do PLOUGHING",iniFiles[[1]])]<-paste(plougInput[1],"do PLOUGHING",sep="") - - if(length(plougInput)==2){ - iniFiles[[2]][grep("do PLOUGHING",iniFiles[[2]])]<-paste(plougInput[2],"do PLOUGHING",sep="") - }} - - if(is.null(fertInput)){ - fertflag=TRUE - fertInput[1] <- unlist(strsplit(grep("do FERTILIZING",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - fertInput[2] <- unlist(strsplit(grep("do FERTILIZING",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep("do FERTILIZING",iniFiles[[1]])]<-paste(fertInput[1],"do FERTILIZING",sep="") - - if(length(fertInput)==2){ - iniFiles[[2]][grep("do FERTILIZING",iniFiles[[2]])]<-paste(fertInput[2],"do FERTILIZING",sep="") - }} - - if(is.null(irrInput)){ - irrflag=TRUE - irrInput[1] <- unlist(strsplit(grep("do IRRIGATION",iniFiles[[1]],value=TRUE),"[\ \t]"))[1] - irrInput[2] <- unlist(strsplit(grep("do IRRIGATION",iniFiles[[2]],value=TRUE),"[\ \t]"))[1] - } else { - iniFiles[[1]][grep("do IRRIGATION",iniFiles[[1]])]<-paste(irrInput[1],"do IRRIGATION",sep="") - - if(length(irrInput)==2){ - iniFiles[[2]][grep("do IRRIGATION",iniFiles[[2]])]<-paste(irrInput[2],"do IRRIGATION",sep="") - }} -getthewholedata<-function(settings){ - f1<-settings$ininput[2] - filename = paste(settings$inputloc,settings$outputname,"_ann.txt",sep="") - alloutput<-read.table(filename,skip=22, header = FALSE) - return(alloutput) -} - -getthespecdata<-function(settings,colnumbers){ - filename<-paste(settings$inputloc,settings$outputname,"_ann.txt",sep="") - specoutput<-read.table(filename,skip=22, header = FALSE)[,colnumbers] - return(specoutput) -} - -getdailyout<-function(settings){ - binaryname<-paste(settings$inputLoc,settings$outputNames,".dayout",sep="") - d<-file(binaryname,"rb") - dayoutput<-matrix(readBin(d,"double",size=8,n=(settings$numData[1])),(settings$numYears*365),byrow=TRUE) - close(d) - return(dayoutput) -} - -getmonthlyout<-function(settings){ - binaryname<-paste(settings$inputloc,settings$outputname,".monavgout",sep="") - d<-file(binaryname,"rb") - monoutput<-matrix(readBin(d,"double",size=4,n=(settings$numdata[2])),(settings$numyears*12),byrow=TRUE) - close(d) - return(monoutput) -} - -getyearlyout<-function(settings){ - binaryname<-paste(settings$inputloc,settings$outputname,".annout",sep="") - d<-file(binaryname,"rb") - yearoutput<-matrix(readBin(d,"double",size=4,n=(settings$numdata[3])),(settings$numyears),byrow=TRUE) - close(d) - return(yearoutput) -} - - ##Sometimes a bug occure due to logfiles and controlfiles in the input loc directory -##alma - - ## if(silent!=TRUE){ - ## if(length(grep("(dayout$)|(log$)",list.files(inputLoc)))>0){ - ## warning("there is a log or dayout file nearby the ini files, that may cause problemes. \n \n If you want to avoid that possible problemes, please copy the log or dayout files into a save place, and after do a cleanupMuso(), or delete these manually, or run the rungetMuso(), with the agressive=TRUE parameter \n \n") - - ## } - - ## } - ## file.copy(file.path(outputLoc,possibleNames) - ## ,file.path(binaryPlace,paste0((stamp(binaryPlace)+1),"-",possibleNames))) - - - ## epcfiles <- list.files(epcdir)[grep("epc$",list.files( - ## stampnum<-stamp(EPCS) - ## lapply(epc,function (x) file.copy(from = x ,to=paste(EPCS,"/",(stampnum+1),"-", basename(x),sep=""))) - ## if(errorsign==1){ - ## lapply(epc, function (x) file.copy(from = paste(EPCS,"/",(stampnum+1),"-",basename(x),sep=""), to=WRONGEPC)) - ## } - - - ## stampnum<-stamp(dirName) - ## if(inputLoc==outputLoc){ - ## lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) - - ## } else { - ## lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) - ## } - - ## if(errorsign==1){ - ## lapply( logfiles, function (x) file.copy(from=paste(dirName, "/",(stampnum+1),"-",x,sep=""), to=dirERROR ))} - - if(debugging=="stamplog"){ - - logfiles <- file.path(outputLoc,logfiles) - stampAndDir(stampDir=dirName, wrongDir=dirERROR, names=logfiles, type="general",errorsign=errorsign,logfiles=logfiles) - - } else { if(debugging){ - if(is.null(logfilename)){ - - if(inputLoc==outputLoc){ - lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName,"/", x, sep=""))) - } else { - lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName,"/", x, sep=""))) - } - - if(errorsign==1){ - lapply( logfiles, function (x) file.copy(from=paste(dirName,"/", x, sep=""), to=dirERROR)) - } - - } else { - - if(inputLoc==outputLoc){#These are very ugly solutions for a string problem: inputLoc: "./", if outputLoc equalent of inputLoc, it ends with "/", the string manipulation can not handle this. The better solution is easy, but I dont have enough time(Roland Hollo's) - lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep=""))) - } else { - lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep=""))) - } - - if(errorsign==1){ - lapply( logfiles, function (x) file.copy(from=paste(dirName, "/",logfilename,"-",x,sep=""), to=dirERROR)) - } - } - - }} -##Sometimes a bug occure due to logfiles and controlfiles in the input loc directory- NOT ANYMORE! :) - - ## if(silent!=TRUE){ - ## if(length(grep("(dayout$)|(log$)",list.files(inputLoc)))>0){ - ## warning(" \n \n WARMING: there is a log or dayout file nearby the ini files, that may cause problemes. \n \n If you want to avoid that possible problemes, please copy the log or dayout files into a save place, and after do a cleanupMuso(), or delete these manually, or run the rungetMuso(), with the agressive=TRUE parameter \n \n")}} - - ##With the aggressive option every unneeded file will deleted - - - - ##change the epc file if and only if there are given parameters - ## if(!is.null(parameters)){ - ## changemulline(filename=epc[1], calibrationPar, parameters)} - ## logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))] - ## spincrash<-tail(readLines(paste(outputLoc,logspinup,sep="/"),-1),1)==0 - - # logspinup<-list.files(outputLoc)[grep("log$",list.files(outputLoc))]#load the logfiles - - ## logfiles <- list.files(outputLoc)[grep("log$",list.files(outputLoc))] - - ## if(keepEpc){#if keepepc option tured on - - ## if(length(unique(dirname(epc)))>1){ - ## print("Why are you playing with my nervs? Seriously? You hold your epc-s in different folders?") - ## } else { - ## epcdir <- dirname(epc[1]) - - ## WRONGEPC<-paste(inputLoc,"WRONGEPC",sep="") - ## EPCS<-paste(inputLoc,"EPCS",sep="") - - ## if(!dir.exists(WRONGEPC)){ - ## dir.create(WRONGEPC) - ## } - - ## if(!dir.exists(EPCS)){ - ## dir.create(EPCS) - ## } - - ## epcfiles <- list.files(epcdir)[grep("epc$",list.files(epcdir))] - ## stampnum<-stamp(EPCS) - ## lapply(epcfiles,function (x) file.copy(from = paste(epcdir,"/",x,sep=""),to=paste(EPCS,"/",(stampnum+1),"-",x,sep=""))) - ## if(errorsign==1){ - ## lapply(epcfiles,function (x) file.copy(from = paste(EPCS,"/",(stampnum+1),"-",x,sep=""), to=WRONGEPC)) - ## } - - ## } - ## } - - - - - - ## if(debugging=="stamplog"){ - ## stampnum<-stamp(dirName) - ## if(inputLoc==outputLoc){ - ## lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) - - ## } else { - ## lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName, "/",(stampnum+1),"-",x,sep=""))) - ## } - - ## if(errorsign==1){ - ## lapply( logfiles, function (x) file.copy(from=paste(dirName, "/",(stampnum+1),"-",x,sep=""), to=dirERROR ))} - - ## } else { if(debugging){ - ## if(is.null(logfilename)){ - - ## if(inputLoc==outputLoc){ - ## lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName,"/", x, sep=""))) - ## } else { - ## lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName,"/", x, sep=""))) - ## } - - ## if(errorsign==1){ - ## lapply( logfiles, function (x) file.rename(from=paste(dirName,"/", x, sep=""), to=dirERROR)) - ## } - - ## } else { - - ## if(inputLoc==outputLoc){#These are very ugly solutions for a string problem: inputLoc: "./", if outputLoc equalent of inputLoc, it ends with "/", the string manipulation can not handle this. The better solution is easy, but I dont have enough time(Roland Hollo's) - ## lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep=""), to=paste(dirName, "/",logfilename,"-",x,sep=""))) - ## } else { - ## lapply( logfiles, function (x) file.rename(from=paste(outputLoc,x, sep="/"), to=paste(dirName, "/",logfilename,"-",x,sep=""))) - ## } - - ## if(errorsign==1){ - ## lapply( logfiles, function (x) file.rename(from=paste(dirName, "/",logfilename,"-",x,sep=""), to=dirERROR)) - ## } - ## } - - ## }} - - #cleanupMuso(location=outputLoc) -