-
Notifications
You must be signed in to change notification settings - Fork 16
/
Copy pathrun_glm.R
136 lines (113 loc) · 3.74 KB
/
run_glm.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
#'@title run the GLM model
#'
#'@description
#'This runs the GLM model on the specific simulation stored in \code{sim_folder}.
#'The specified \code{sim_folder} must contain a valid NML file.
#'
#'@param sim_folder the directory where simulation files are contained
#'@param verbose should output of GLM be shown
#'@param args Optional arguments to pass to GLM executable
#'
#'@keywords methods
#'@author
#'Jordan Read, Luke Winslow
#'@examples
#'sim_folder <- system.file('extdata', package = 'GLMr')
#'run_glm(sim_folder)
#'\dontrun{
#'out_file <- file.path(sim_folder,'output.nc')
#'nml_file <- file.path(sim_folder,'glm2.nml')
#'library(glmtools)
#'fig_path <- tempfile("temperature", fileext = '.png')
#'plot_temp(file = out_file, fig_path = fig_path)
#'cat('find plot here: '); cat(fig_path)
#' }
#'@export
#'@importFrom utils packageName
run_glm <- function(sim_folder = '.', verbose=TRUE, args=character()){
if(!file.exists(file.path(sim_folder, 'glm2.nml'))){
stop('You must have a valid glm2.nml file in your sim_folder: ', sim_folder)
}
#Just going to brute force this at the moment.
if(.Platform$pkgType == "win.binary"){
return(run_glmWin(sim_folder, verbose, args))
}else if(.Platform$pkgType == "mac.binary" ||
.Platform$pkgType == "mac.binary.mavericks"){
maj_v_number <- as.numeric(strsplit(
Sys.info()["release"][[1]],'.', fixed = TRUE)[[1]][1])
if (maj_v_number < 13.0){
stop('pre-mavericks mac OSX is not supported. Consider upgrading')
}
return(run_glmOSx(sim_folder, verbose, args))
}else if(.Platform$pkgType == "source"){
## Probably running linux
return(run_glmNIX(sim_folder, verbose, args))
#stop("Currently UNIX is not supported by ", getPackageName())
}
}
run_glmWin <- function(sim_folder, verbose = TRUE, args){
if(.Platform$r_arch == 'i386'){
glm_path <- system.file('extbin/win32GLM/glm.exe', package=packageName())
}else{
glm_path <- system.file('extbin/winGLM/glm.exe', package=packageName())
}
origin <- getwd()
setwd(sim_folder)
tryCatch({
if (verbose){
out <- system2(glm_path, wait = TRUE, stdout = "",
stderr = "", args=args)
} else {
out <- system2(glm_path, wait = TRUE, stdout = NULL,
stderr = NULL, args=args)
}
setwd(origin)
return(out)
}, error = function(err) {
print(paste("GLM_ERROR: ",err))
setwd(origin)
})
}
run_glmOSx <- function(sim_folder, verbose = TRUE, args){
lib_path <- system.file('extbin/macGLM/bin', package=packageName())
glm_path <- system.file('exec/macglm', package=packageName())
# ship glm and libs to sim_folder
Sys.setenv(DYLD_FALLBACK_LIBRARY_PATH=lib_path)
origin <- getwd()
setwd(sim_folder)
tryCatch({
if (verbose){
out <- system2(glm_path, wait = TRUE, stdout = "",
stderr = "", args = args)
} else {
out <- system2(glm_path, wait = TRUE, stdout = NULL,
stderr = NULL, args=args)
}
setwd(origin)
return(out)
}, error = function(err) {
print(paste("GLM_ERROR: ",err))
setwd(origin)
})
}
run_glmNIX <- function(sim_folder, verbose=TRUE, args){
glm_path <- system.file('exec/nixglm', package=packageName())
origin <- getwd()
setwd(sim_folder)
Sys.setenv(LD_LIBRARY_PATH=system.file('extbin/nixGLM',
package=packageName()))
tryCatch({
if (verbose){
out <- system2(glm_path, wait = TRUE, stdout = "",
stderr = "", args=args)
} else {
out <- system2(glm_path, wait = TRUE, stdout = NULL,
stderr = NULL, args = args)
}
setwd(origin)
return(out)
}, error = function(err) {
print(paste("GLM_ERROR: ",err))
setwd(origin)
})
}