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
b724771f
Commit
b724771f
authored
Apr 01, 2017
by
Nicolau Manubens Gil
Browse files
Fixes.
parent
3f53aa44
Changes
3
Hide whitespace changes
Inline
Side-by-side
R/ArrayToNc.R
View file @
b724771f
ArrayToN
etCDF
<-
function
(
arrays
,
file_path
)
{
ArrayToN
c
<-
function
(
arrays
,
file_path
)
{
# Check parameter arrays.
if
(
is.array
(
arrays
))
{
arrays
<-
list
(
arrays
)
...
...
R/NcReadVarNames.R
0 → 100644
View file @
b724771f
NcReadVarNames
<-
function
(
file_to_read
)
{
file_opener
<-
nc_open
file_closer
<-
nc_close
close
<-
FALSE
if
(
is.character
(
file_to_read
))
{
file_object
<-
file_opener
(
file_to_read
)
file_path
<-
file_to_read
close
<-
TRUE
}
else
if
(
grepl
(
'^ncdf'
,
class
(
file_to_read
)))
{
file_object
<-
file_to_read
file_path
<-
file_object
$
filename
}
else
{
stop
(
"Either the path to a NetCDF file or a ncdf object must be provided as 'file_to_read'."
)
}
var_names
<-
names
(
file_object
$
var
)
if
(
!
is.null
(
file_object
))
{
extra_dimvars
<-
NULL
# Create all variables that are 'dimvars'
for
(
dim_name
in
names
(
file_object
$
dim
))
{
if
(
file_object
$
dim
[[
dim_name
]]
$
create_dimvar
)
{
extra_dimvars
<-
c
(
extra_dimvars
,
dim_name
)
}
}
var_names
<-
c
(
var_names
,
extra_dimvars
)
}
var_names
}
R/NcToArray.R
View file @
b724771f
...
...
@@ -17,30 +17,37 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
stop
(
"Either the path to a NetCDF file or a ncdf object must be provided as 'file_to_read'."
)
}
var_tag
<-
'var'
# Check dim_indices
if
(
length
(
dim_indices
)
==
0
)
{
dim_indices
<-
NULL
}
if
(
!
is.null
(
dim_indices
))
{
if
(
!
is.list
(
dim_indices
))
{
stop
(
"Parameter 'dim_indices' must be a list of numeric vectors."
)
}
if
(
is.null
(
names
(
dim_indices
)))
{
stop
(
"Parameter 'dim_indices' must have dimension names."
)
stop
(
"Parameter 'dim_indices' must have dimension
names as
names."
)
}
var_indices_position
<-
NULL
for
(
i
in
1
:
length
(
dim_indices
))
{
i
<-
1
while
(
i
<=
length
(
dim_indices
))
{
if
(
names
(
dim_indices
)[
i
]
%in%
c
(
'var'
,
'variable'
))
{
vars_to_read
<-
dim_indices
[[
i
]]
var_indices_position
<-
i
var_tag
<-
names
(
dim_indices
)[
i
]
}
else
{
if
(
!
(
names
(
dim_indices
)[
i
]
%in%
names
(
file_object
$
dim
)))
{
stop
(
"Provided indices in 'dim_indices' for a non-existing dimension."
)
}
if
(
!
is.numeric
(
dim_indices
[[
i
]]))
{
stop
(
"Parameter 'dim_indices' must be a list of numeric vectors."
)
if
(
!
(
is.numeric
(
dim_indices
[[
i
]])
||
is.logical
(
dim_indices
[[
i
]]))
)
{
stop
(
"Parameter 'dim_indices' must be a list of numeric vectors
, TRUE or NA
."
)
}
}
if
(
identical
(
dim_indices
[[
i
]],
TRUE
))
{
dim_indices
[[
i
]]
<-
NA
}
i
<-
i
+
1
}
if
(
!
is.null
(
var_indices_position
))
{
dim_indices
<-
dim_indices
[
-
var_indices_position
]
...
...
@@ -134,6 +141,9 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
common_dims
<-
which
(
names
(
found_dims
)
%in%
names
(
dim_indices
))
if
(
length
(
common_dims
)
>
0
)
{
extra_dims
<-
found_dims
[
-
common_dims
]
if
(
length
(
extra_dims
)
==
0
)
{
extra_dims
<-
NULL
}
}
else
{
extra_dims
<-
found_dims
}
...
...
@@ -190,12 +200,12 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
# }
# missing_dims <- missing_dim_names
#}
in
ner
_dims
<-
names
(
indices
_to_take
)
reorder
<-
NULL
if
(
any
(
names
(
found_dims
)
!=
in
ner
_dims
))
{
reorder
<-
sapply
(
names
(
found_dims
),
function
(
x
)
which
(
in
ner
_dims
==
x
))
reorder_back
<-
sapply
(
in
ner
_dims
,
function
(
x
)
which
(
names
(
found_dims
)
==
x
))
indices_to_take
<-
indices_to_take
[
reorder
]
in
dices
_dims
<-
names
(
dim_
indices
)[
which
(
names
(
dim_indices
)
%in%
names
(
found_dims
))]
reorder
_back
<-
NULL
if
(
any
(
names
(
found_dims
)
!=
in
dices
_dims
))
{
#
reorder <- sapply(names(found_dims), function(x) which(in
dices
_dims == x))
reorder_back
<-
sapply
(
in
dices
_dims
,
function
(
x
)
which
(
names
(
found_dims
)
==
x
))
#
indices_to_take <- indices_to_take[reorder]
}
start
<-
sapply
(
indices_to_take
,
function
(
x
)
if
(
is_single_na
(
x
))
1
else
min
(
x
))
count
<-
sapply
(
indices_to_take
,
function
(
x
)
if
(
is_single_na
(
x
))
-1
else
max
(
x
)
-
min
(
x
)
+
1
)
...
...
@@ -203,17 +213,17 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
lapply
(
indices_to_take
,
function
(
x
)
if
(
is_single_na
(
x
))
TRUE
else
x
-
min
(
x
)
+
1
),
list
(
drop
=
FALSE
)))
#metadata <- c(metadata, structure(list(file_object$var[[var_name]]), .Names = var_name))
## TODO: Crop dimensions in attributes
if
(
!
is.null
(
reorder
))
{
if
(
!
is.null
(
reorder
_back
))
{
var_result
<-
aperm
(
var_result
,
reorder_back
)
}
#if (!is.null(missing_dims)) {
# dim(var_result) <- original_dims
#}
if
(
!
is.null
(
extra_dims
))
{
dim
(
var_result
)
<-
dim
(
var_result
)[
-
which
(
in
ner
_dims
%in%
extra_dims
)]
dim
(
var_result
)
<-
dim
(
var_result
)[
-
which
(
in
dices
_dims
%in%
extra_dims
)]
}
#attr(var_result, 'variables') <- metadata
names
(
dim
(
var_result
))
<-
in
ner
_dims
names
(
dim
(
var_result
))
<-
in
dices
_dims
}
atts
<-
file_object
$
var
[[
var_name
]]
atts_to_remove
<-
c
(
'id'
,
'name'
,
'ndims'
,
'natts'
,
'size'
,
...
...
@@ -226,7 +236,7 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
extra_atts
<-
ncatt_get
(
file_object
,
var_name
)
atts
[
names
(
extra_atts
)]
<-
extra_atts
units
<-
file_object
$
var
[[
var_name
]]
$
units
names
(
dim
(
var_result
))
<-
sapply
(
file_object
$
var
[[
var_name
]]
$
dim
,
'[['
,
'name'
)
#
names(dim(var_result)) <- sapply(file_object$var[[var_name]]$dim, '[[', 'name')
}
if
(
!
is.null
(
var_result
))
{
# if (units %in% c('seconds', 'minutes', 'hours', 'days', 'weeks', 'months', 'years')) {
...
...
@@ -247,7 +257,7 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
# 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
(
vars_to_read_vector
)
==
1
))
{
dim
(
var_result
)
<-
c
(
c
(
var
=
1
),
dim
(
var_result
))
dim
(
var_result
)
<-
c
(
setNames
(
1
,
var_tag
),
dim
(
var_result
))
}
attr
(
var_result
,
'variables'
)
<-
structure
(
list
(
atts
),
.Names
=
var_name
)
## TODO: Take the general attributes out of atts and put them as
...
...
@@ -257,7 +267,7 @@ NcToArray <- function(file_to_read, dim_indices = NULL, vars_to_read = NULL,
}
else
{
new_attrs
<-
c
(
attr
(
result
,
'variables'
),
attr
(
var_result
,
'variables'
))
result
<-
.MergeArrays
(
result
,
var_result
,
'
var
'
)
result
<-
.MergeArrays
(
result
,
var_result
,
var
_tag
)
attr
(
result
,
'variables'
)
<-
new_attrs
}
}
...
...
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