Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Earth Sciences
easyNCDF
Commits
d908e2f9
Commit
d908e2f9
authored
Mar 28, 2017
by
Nicolau Manubens
Browse files
Updated a2nc and adapted nc2a to take indices as variable names.
parent
dfb4fc09
Changes
2
Hide whitespace changes
Inline
Side-by-side
R/ArrayToNetCDF.R
View file @
d908e2f9
...
...
@@ -40,7 +40,7 @@ ArrayToNetCDF <- function(arrays, file_path) {
}
dim_names
<-
names
(
dim
(
arrays
[[
i
]]))
if
(
!
is.null
(
dim_names
))
{
if
(
any
(
is.na
(
dim_names
)
|
|
(
sapply
(
dim_names
,
nchar
)
==
0
)))
{
if
(
any
(
is.na
(
dim_names
)
|
(
sapply
(
dim_names
,
nchar
)
==
0
)))
{
stop
(
"The provided arrays must have all named dimensions or "
,
"all unnamed dimensions."
)
}
...
...
@@ -74,7 +74,7 @@ ArrayToNetCDF <- function(arrays, file_path) {
if
(
!
is.numeric
(
dim_info
[[
'len'
]]))
{
stop
(
"The provided 'len' for the "
,
k
,
"th dimension in the "
,
i
,
"th array must be a numeric value."
)
}
dim_info
[[
'len'
]]
<-
round
(
dim_info
[[
'len'
]][
1
])
dim_info
[[
'len'
]]
<-
as.integer
(
round
(
dim_info
[[
'len'
]][
1
])
)
if
(
dim_info
[[
'len'
]]
!=
dim
(
arrays
[[
i
]])[
k
])
{
stop
(
"The provided 'len' for the "
,
k
,
"th dimension in the "
,
i
,
"th array does not match the actual length of the provided array."
)
}
...
...
@@ -292,10 +292,14 @@ ArrayToNetCDF <- function(arrays, file_path) {
if
(
!
is.character
(
var_info
[[
'coordinates'
]]))
{
stop
(
"The attribute 'coordinates' must be a character string."
)
}
if
(
!
(
all
(
strsplit
(
var_info
[[
'coordinates'
]],
' '
)[[
1
]]
%in%
sapply
(
defined_vars
,
'[['
,
'name'
))))
{
stop
(
"All the dimensions appearing in 'coordinates' must point to defined variables."
)
coords
<-
strsplit
(
var_info
[[
'coordinates'
]],
' '
)[[
1
]]
if
(
!
(
all
(
coords
%in%
sapply
(
defined_vars
,
'[['
,
'name'
)
|
coords
%in%
sapply
(
defined_dims
[
which
(
sapply
(
defined_dims
,
'[['
,
'create_dimvar'
))],
'[['
,
'name'
))))
{
coords
<-
coords
[
which
(
coords
%in%
sapply
(
defined_vars
,
'[['
,
'name'
)
|
coords
%in%
sapply
(
defined_dims
[
which
(
sapply
(
defined_dims
,
'[['
,
'create_dimvar'
))],
'[['
,
'name'
))]
.warning
(
"Some of the dimensions appearing in 'coordinates' have been removed because they point to undefined variables."
)
}
ncatt_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
'coordinates'
,
var_info
[[
'coordinates'
]]
)
ncatt_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
'coordinates'
,
paste
(
coords
,
collapse
=
' '
)
)
}
attrs_to_skip
<-
which
(
names
(
var_info
)
%in%
c
(
'addOffset'
,
'scaleFact'
,
'coordinates'
))
attrs_to_add
<-
names
(
var_info
)
...
...
@@ -303,7 +307,10 @@ ArrayToNetCDF <- function(arrays, file_path) {
attrs_to_add
<-
attrs_to_add
[
-
attrs_to_skip
]
}
for
(
attribute_name
in
attrs_to_add
)
{
ncatt_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
attribute_name
,
var_info
[[
attribute_name
]])
if
(
is.numeric
(
var_info
[[
attribute_name
]])
||
is.character
(
var_info
[[
attribute_name
]]))
{
ncatt_put
(
ncdf_object
,
defined_vars
[[
var_counter
]]
$
name
,
attribute_name
,
var_info
[[
attribute_name
]])
}
}
var_counter
<-
var_counter
+
1
}
...
...
@@ -311,5 +318,3 @@ ArrayToNetCDF <- function(arrays, file_path) {
nc_close
(
ncdf_object
)
invisible
(
NULL
)
}
a2nc
<-
ArrayToNetCDF
R/NetCDFToArray.R
View file @
d908e2f9
...
...
@@ -86,8 +86,8 @@ NetCDFReadDims <- function(file_to_read, var_names = NULL) {
dims
}
NetCDFToArray
<-
function
(
file_to_read
,
var
_names
,
drop_var_dim
=
FALSE
)
{
#
unlist = TRUE) {
NetCDFToArray
<-
function
(
file_to_read
,
var
s_to_read
,
inner_indices
,
drop_var_dim
=
FALSE
,
unlist
=
TRUE
)
{
file_opener
<-
NcOpen
file_closer
<-
NcClose
file_dim_reader
<-
NetCDFReadDims
...
...
@@ -104,26 +104,26 @@ NetCDFToArray <- function(file_to_read, var_names, drop_var_dim = FALSE) {
}
# Check var_names
# if (is.character(var_names)) {
# var_names <- list(var_names)
# }
# print_error <- FALSE
# if (is.list(var_names)) {
# if (!all(sapply(var_names, is.character))) {
# print_error <- TRUE
# }
# } else {
# print_error <- TRUE
# }
# if (print_error) {
# stop("Parameter 'var_names' must be one or a list of vectors of character strings or NULL.")
# }
if
(
!
is.character
(
var_names
))
{
stop
(
"Parameter 'var_names' must be a vector of character strings."
)
if
(
is.character
(
vars_to_read
)
||
is.numeric
(
vars_to_read
))
{
vars_to_read
<-
list
(
vars_to_read
)
}
print_error
<-
FALSE
if
(
is.list
(
vars_to_read
))
{
if
(
!
all
(
sapply
(
vars_to_read
,
function
(
x
)
is.character
(
x
)
||
is.numeric
(
x
))))
{
print_error
<-
TRUE
}
}
else
{
print_error
<-
TRUE
}
if
(
print_error
)
{
stop
(
"Parameter 'vars_to_read' must be one or a list of numeric vectors or vectors of character strings or NULL."
)
}
# if (!is.character(var_names) && !is.numeric(var_names)) {
# stop("Parameter 'var_names' must be a numeric vector or vector of character strings.")
# }
#
result_list <- NULL
#
for (var
_names
_vector in var
_names
) {
result_list
<-
NULL
for
(
var
s_to_read
_vector
in
var
s_to_read
)
{
result
<-
NULL
if
(
!
is.null
(
file_object
))
{
# Create all variables that are 'dimvars'
...
...
@@ -143,8 +143,14 @@ NetCDFToArray <- function(file_to_read, var_names, drop_var_dim = FALSE) {
}
#file_object$var[extra_dimvars] <- extra_dimvars_list
#file_object$nvars <- file_object$nvars + length(extra_dimvars)
# for (var_name in var_names_vector) {
for
(
var_name
in
var_names
)
{
nmv
<-
numeric_var_indices
<-
which
(
is.numeric
(
vars_to_read_vector
))
if
(
length
(
nmv
)
>
0
)
{
if
(
any
(
vars_to_read_vector
[
nmv
]
>
(
length
(
file_object
$
var
)
+
length
(
extra_dimvars
))))
{
stop
(
"Provided numerical variable indices out of bounds in 'vars_to_read'."
)
}
vars_to_read_vector
[
nmv
]
<-
c
(
sapply
(
file_object
$
var
,
'[['
,
'name'
),
extra_dimvars
)[
vars_to_read_vector
[
nmv
]]
}
for
(
var_name
in
vars_to_read_vector
)
{
if
(
var_name
%in%
extra_dimvars
)
{
var_result
<-
file_object
$
dim
[[
var_name
]]
$
vals
#atts <- file_object$dim[[var_name]]
...
...
@@ -193,8 +199,7 @@ NetCDFToArray <- function(file_to_read, var_names, drop_var_dim = FALSE) {
}
var_result
<-
seq
(
as.POSIXct
(
parts
[
2
]),
length
=
max
(
var_result
,
na.rm
=
TRUE
)
+
1
,
by
=
units
)[
var_result
+
1
]
}
# if (!drop_var_dim && (length(var_names_vector) == 1)) {
if
(
!
drop_var_dim
&&
(
length
(
var_names
)
==
1
))
{
if
(
!
drop_var_dim
&&
(
length
(
vars_to_read_vector
)
==
1
))
{
dim
(
var_result
)
<-
c
(
c
(
var
=
1
),
dim
(
var_result
))
}
attr
(
var_result
,
'variables'
)
<-
structure
(
list
(
atts
),
.Names
=
var_name
)
...
...
@@ -210,33 +215,32 @@ NetCDFToArray <- function(file_to_read, var_names, drop_var_dim = FALSE) {
}
}
}
#
if (is.null(result_list)) {
#
if (length(var
_names
) == 1 &&
simplify
) {
#
result_list <- result
#
} else {
#
if (length(var
_names
_vector) == 1) {
#
result_list <- structure(list(result), .Names = var
_names
_vector)
#
} else {
#
result_list <- list(result)
#
}
#
}
#
} else {
#
if (length(var
_names
_vector) == 1) {
#
result_list <- do.call('[[<-', list(x = result_list,
#
i = var
_names
_vector,
#
value = result))
#
} else {
#
result_list <- do.call('[[<-', list(x = result_list,
#
i = length(result_list) + 1,
#
value = result))
#
}
#
}
#
}
if
(
is.null
(
result_list
))
{
if
(
length
(
var
s_to_read
)
==
1
&&
unlist
)
{
result_list
<-
result
}
else
{
if
(
length
(
var
s_to_read
_vector
)
==
1
)
{
result_list
<-
structure
(
list
(
result
),
.Names
=
var
s_to_read
_vector
)
}
else
{
result_list
<-
list
(
result
)
}
}
}
else
{
if
(
length
(
var
s_to_read
_vector
)
==
1
)
{
result_list
<-
do.call
(
'[[<-'
,
list
(
x
=
result_list
,
i
=
var
s_to_read
_vector
,
value
=
result
))
}
else
{
result_list
<-
do.call
(
'[[<-'
,
list
(
x
=
result_list
,
i
=
length
(
result_list
)
+
1
,
value
=
result
))
}
}
}
if
(
close
)
{
file_closer
(
file_object
)
}
# result_list
result
result_list
}
# Parameter 'file_selectos' expects a named character vector of single
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment