Skip to content
GitLab
Select Git revision
  • master default
Find file BlameHistoryPermalink
file_manip.R 7.22 KiB
1 
# Nicolas Forquet, 2015
2
3 
new.hydrus.subfolder = function(new.name,reference.folder,hydrus.folder){
4 
  # new.name : name of the new hydrus subfolder
5 
  # reference.folder : folder containing all new hydrus subfolder
6 
  # hydrus.folder : folder containing the reference model obtained with the GUI
7 
  # NOTE: the reference folder must contain a copy of the Hydrus batch executable file : H2D_Calc.exe
8
9 
  # get the content list from the reference folder
10 
  files2copy <- list.files(path = hydrus.folder)
11 
  # create a new folder into the reference folder
12 
  setwd(reference.folder)
13 
  dir.create(new.name)
14 
  # copy all input files
15 
  file.copy("H2D_Calc.exe",paste(new.name,"/H2D_Calc.exe",sep=""))
16 
  for (i in 1:length(files2copy)){
17 
    file.copy(paste(hydrus.folder,files2copy[i],sep = "/"),paste(new.name,files2copy[i],sep = "/"))
18 
  }
19 
}
20
21 
dummy.white.space = function(char.line){
22 
  temp = unlist(strsplit(char.line," ",fixed = TRUE))
23 
  test.temp = (temp =="")
24 
  result.vector = temp[!test.temp]
25 
  return(result.vector)
26 
}
27
28 
read.meshtria = function(reference.folder){
29 
  setwd(reference.folder)
30 
  conn = file("meshtria.txt",open="r")
31 
  linn = readLines(conn)
32 
  close(conn)
33
34
35 
  nb.nodes = as.numeric(dummy.white.space(linn[1])[2])
36 
  nb.mesh = as.numeric(dummy.white.space(linn[1])[4])
37 
  coord.nodes = data.frame(x = rep(0,nb.nodes), z = rep(0,nb.nodes))
38 
  edges = data.frame(i = rep(0,nb.mesh), j = rep(0,nb.mesh), k = rep(0, nb.mesh))
39
40 
  for (i in 1:nb.nodes){
41 
    coord.nodes$x[i] = as.numeric(dummy.white.space(linn[i+1])[2])
42 
    coord.nodes$y[i] = as.numeric(dummy.white.space(linn[i+1])[3])
43 
  }
44 
  end.of.table = i+1
45 
  for (m in 1:nb.mesh){
46 
    edges$i[m] = as.numeric(dummy.white.space(linn[m+end.of.table+3])[2])
47 
    edges$j[m] = as.numeric(dummy.white.space(linn[m+end.of.table+3])[3])
48 
    edges$k[m] = as.numeric(dummy.white.space(linn[m+end.of.table+3])[4])
49 
  }
50
51 
  output = list(nb.nodes = nb.nodes, nb.mesh = nb.mesh, coord.nodes = coord.nodes, edges = edges, linn = linn)
52 
  return(output)
53 
}
54
55 
write_domain = function(reference.folder, file.name.out = "empty", Axz = "empty", Bxz = "empty", nb.col = 11, header.size = 6){
56 
  # set working directory to reference folder
57 
  setwd(reference.folder)
58 
  # Hydrus has been developed with Windows. This is bad. What is even worse is that Windows is not case sensitive and therefore Simunek sometimes names its file in upper case, sometimes in lower case. Therefore I introduced a step that list the files having the name we are looking for independly of the case
59 
  file.name.in <- list.files(pattern = "domain.dat", ignore.case = TRUE)
60
61 
  # Then we open the file and extract the lines content and put in linn.
62 
  conn <- file(file.name.in,open="r")
63 
  linn <- readLines(conn)
64 
  close(conn)
65
66 
  # test on model arguments
67 
  if ((is.character(Axz) == TRUE) & (is.character(Bxz) == TRUE)){
68 
    stop("At least Axz or Bxz must be given")
69 
  }
70
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
Axz.log <- is.character(Axz) Bxz.log <- is.character(Bxz) if (Axz.log == FALSE){ nb.nodes <- length(Axz) } else { nb.nodes <- length(Bxz) } # prealocation of matrix that contains data from the domain.dat file node.mat = matrix(rep(0,nb.col*nb.nodes),ncol=nb.col) # filling up node.map line by line starting after the header.size for (i in 1:nb.nodes){ node.mat[i,] = as.numeric(dummy.white.space(linn[header.size+i])) } if (Axz.log == FALSE){ node.mat[,7] = Axz } if (Bxz.log == FALSE){ node.mat[,8] = Bxz } new_linn = linn for (i in 1:nb.nodes){ new_linn[i+header.size] = paste(as.character(node.mat[i,]),collapse=" ") } new_linn[(header.size+nb.nodes+1):length(linn)] = linn[(header.size+nb.nodes+1):length(linn)] if (file.name.out == "empty"){ file.name.out <- file.name.in } conn = file(file.name.out,open="w") writeLines(new_linn,conn) close(conn) return(new_linn) } level_01.creator = function(new.name,reference.folder){ # new.name : name of the new hydrus subfolder # reference.folder : folder containing all new hydrus subfolder level01.file = file(paste(new.name,"/Level_01.dir",sep=""),"w") working.directory = paste(reference.folder,"/",new.name,sep="") writeLines(working.directory,level01.file) close(level01.file) } modify.selector = function(new.name,hydrus.folder,data,header.size = 24, end.size = 65){ # nombre de materiaux dans le modele nb.mat <-dim(data)[1] #read old file to get data written before and after the material matrix selector.file = file(paste(hydrus.folder,"/SELECTOR.IN",sep=""),"r") #store the header.size first lines (no transformation will be done on those lines) before.text = readLines(selector.file,n=header.size) # read data with material properties (data not save) readLines(selector.file,n=dim(data)[1]) # store file content after material properties after.text = readLines(selector.file,n=end.size) #test.data = list(before = before.text,mat1 = mat1.text,mid = mid.text, mat2 = mat2.text, after = after.text) close(selector.file) #create the new selector.in in the appropriate folder selector.new.file = file(paste(new.name,"/SELECTOR.IN",sep=""),"w") # write text block before material properties writeLines(before.text,selector.new.file) # enter the new material properties write.table(data,selector.new.file,row.names=FALSE,col.names=FALSE,sep="\t")
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188
# write text block after material properties writeLines(after.text,selector.new.file) # close file connection close(selector.new.file) } modify.hydraulic.parameters = function(new.name,hydrus.folder,data,hydrus.version="1D"){ # so far this function as only be tested for hydrus 1D #find the header line number corresponding to hydraulic parameters selector.file <- file(paste(hydrus.folder,"/SELECTOR.IN",sep=""),"r") file.content <- readLines(selector.file,n=-1) nb.line.start <- which(grepl("thr",file.content)) close(selector.file) # number of model materials nb.mat <-dim(data)[1] #store the lines before the hydraulic parameters block (no transformation will be done on those lines) before.text = file.content[1:nb.line.start] #store the lines after the hydraulic parameters block (no transformation will be done on those lines) after.text = file.content[nb.line.start+nb.mat+1:length(file.content)] #create the new selector.in in the appropriate folder selector.new.file = file(paste(new.name,"/SELECTOR.IN",sep=""),"w") # write text block before material properties writeLines(before.text,selector.new.file) # enter the new material properties write.table(data,selector.new.file,row.names=FALSE,col.names=FALSE,sep="\t") # write text block after material properties writeLines(after.text,selector.new.file) # close file connection close(selector.new.file) } read.binary = function(filename,nb.elts,nb.ts){ fileSize <- file.info(filename)$size raw <- readBin(filename,what="raw",n=fileSize) if (length(raw) %% 4 !=0){ stop('File format assumption error') } nbrOfRecords <- length(raw)/4 unsort.data = readBin(con=raw,what="double",size = 4,n = nbrOfRecords,endian="little") time.ts = rep(0,nb.ts) data.ts = matrix(rep(0,(nb.ts*nb.elts)),ncol = nb.ts) for(i in 1:nb.ts){ time.ts[i] = unsort.data[i+nb.elts*(i-1)] data.ts[1:nb.elts,i] = unsort.data[(nb.elts*(i-1)+i+1):(i*(nb.elts+1))] } output = list(time.ts = time.ts, data.ts = data.ts) return(output) }