Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit66ee83c

Browse files
authored
Merge pull request#129 from pvanlaake/main
Fixing character lat/long columns in hypertibble()#128
2 parentsd676143 +056a1c8 commit66ee83c

File tree

6 files changed

+57
-85
lines changed

6 files changed

+57
-85
lines changed

‎DESCRIPTION

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ Imports:
2626
forcats,
2727
magrittr,
2828
ncdf4,
29-
ncmeta (>= 0.2.0),
29+
ncmeta (>= 0.3.6),
3030
purrr,
3131
RNetCDF (>= 1.9-1),
3232
rlang,

‎R/hyper_array.R

Lines changed: 20 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@
1818
#' By default all variables in the active grid are returned, use `select_var` to
1919
#' specify one or more desired variables.
2020
#'
21-
#' The transforms are stored as a list of tables in an attribute `transforms``,
21+
#' The transforms are stored as a list of tables in an attribute `transforms`,
2222
#' access these with [hyper_transforms()].
2323
#' @param x NetCDF file, connection object, or [tidync] object
2424
#' @param drop collapse degenerate dimensions, defaults to `TRUE`
@@ -85,8 +85,8 @@ hyper_array.tidync <- function(x, select_var = NULL, ...,
8585
## hack to get the order of the indices of the dimension
8686
ordhack<-1+ as.integer(unlist(strsplit(gsub("D","",
8787
dplyr::filter(x$grid,.data$grid== active(x)) %>%
88-
# dplyr::slice(1L) %>% THERE'S ONLY EVER ONE ACTIVE GRID
89-
dplyr::pull(.data$grid)),",")))
88+
# dplyr::slice(1L) %>% THERE'S ONLY EVER ONE ACTIVE GRID
89+
dplyr::pull(.data$grid)),",")))
9090
dimension<-x[["dimension"]] %>%dplyr::slice(ordhack)
9191
## ensure dimension is in order of the dims in these vars
9292
axis<-x[["axis"]] %>%dplyr::filter(variable%in%varname)
@@ -104,30 +104,25 @@ hyper_array.tidync <- function(x, select_var = NULL, ...,
104104
if (length(select_var)<1) stop("no select_var variables available")
105105
if (!isTRUE(getOption("tidync.silent"))) {
106106
warning(sprintf("some select_var variables not found, and ignored:\n %s",
107-
paste(bad,collapse=",")))
107+
paste(bad,collapse=",")))
108108
}
109109
}
110110
## todo, make this quosic?
111111
varnames<-select_var
112112
}
113113

114114
#browser()
115-
opt<- getOption("tidync.large.data.check")
116-
if (!isTRUE(opt)) {
117-
opt<-FALSE
118-
}
119-
if (opt&& (prod(dimension[["count"]])* length(varnames))*4>1e9&&
120-
interactive()&&!force) {
121-
message("please confirm data extraction, Y(es) to proceed ... use 'force = TRUE' to avoid size check\n ( see '?hyper_array')")
122-
123-
mess<- sprintf("pretty big extraction, (%i*%i values [%s]*%i)",
124-
as.integer(prod(COUNT)), length(varnames),
125-
paste(COUNT,collapse=","),
126-
length(varnames))
127-
yes<-utils::askYesNo(mess)
128-
if (!yes) {
129-
stop("extraction cancelled by user",call.=FALSE)
130-
## return(invisible(NULL))
115+
if (interactive()&&!force&& prod(COUNT)* length(varnames)*4>1e9) {
116+
opt<- getOption("tidync.large.data.check")
117+
if (!isTRUE(opt))opt<-FALSE
118+
if (opt) {
119+
message("please confirm data extraction, Y(es) to proceed ... use 'force = TRUE' to avoid size check\n (see '?hyper_array')")
120+
mess<- sprintf("pretty big extraction, (%1$.0f*%2$i values [%3$s]*%2$i)",
121+
prod(COUNT), length(varnames), paste(COUNT,collapse=","))
122+
yes<-utils::askYesNo(mess)
123+
if (!yes) {
124+
stop("extraction cancelled by user",call.=FALSE)
125+
}
131126
}
132127
}
133128

@@ -137,7 +132,7 @@ hyper_array.tidync <- function(x, select_var = NULL, ...,
137132
datalist<- lapply(varnames,function(vara) {
138133
ncdf4::ncvar_get(con,vara,start=START,count=COUNT,
139134
raw_datavals=raw_datavals,collapse_degen=FALSE)
140-
})
135+
})
141136

142137
## Get dimension names from the transforms. Use "timestamp" instead of "time"
143138
transforms<- active_axis_transforms(x)
@@ -177,17 +172,15 @@ hyper_array.tidync <- function(x, select_var = NULL, ...,
177172
## Drop any degenerate dimensions, if requested and needed
178173
if (drop&& any(lengths(dn)==1))datalist<- lapply(datalist,drop)
179174

180-
structure(datalist,names=varnames,
181-
transforms=transforms,
175+
structure(datalist,names=varnames,transforms=transforms,
182176
source=x$source,class="tidync_data")
183177
}
184178

185179
#' @name hyper_array
186180
#' @export
187-
hyper_array.character<-function(x,select_var=NULL,...,
181+
hyper_array.character<-function(x,select_var=NULL,...,
188182
raw_datavals=FALSE,force=FALSE,drop=TRUE) {
189183
tidync(x) %>%
190-
hyper_filter(...) %>%
191-
hyper_array(select_var=select_var,
192-
raw_datavals=raw_datavals,drop=drop)
184+
hyper_filter(...) %>%
185+
hyper_array(select_var=select_var,raw_datavals=raw_datavals,drop=drop)
193186
}

‎R/hyper_tibble.R

Lines changed: 13 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -59,12 +59,20 @@ hyper_tibble.tidync<- function(x, ..., na.rm = TRUE, force = FALSE) {
5959
out<-tibble::as_tibble(lapply(slabs,as.vector))
6060

6161
prod_dims<-1
62-
dn<- dimnames(slabs[[1]])
63-
nm<- names(dn)
62+
trans<- attr(slabs,"transforms")
6463

65-
for (iin seq_along(nm)) {
66-
out[[nm[i]]]<- rep(dn[[i]],each=prod_dims,length.out=total_prod)
67-
prod_dims<-prod_dims* length(dn[[i]])
64+
for (iin seq_along(trans)) {
65+
nm<- names(trans)[i]
66+
nr<- sum(trans[[i]]$selected)
67+
68+
out[[nm]]<-if ("timestamp"%in% colnames(trans[[i]]))
69+
rep(dplyr::filter(trans[[nm]],.data$selected)[["timestamp"]],
70+
each=prod_dims,length.out=total_prod)
71+
else
72+
rep(dplyr::filter(trans[[nm]],.data$selected)[[nm]],
73+
each=prod_dims,length.out=total_prod)
74+
75+
prod_dims<-prod_dims*nr
6876
}
6977
if (na.rm)out<-dplyr::filter(out,!all_na)
7078
out

‎R/hyper_transforms.R

Lines changed: 13 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -52,65 +52,42 @@ active_axis_transforms <- function(x, ...) {
5252
#' @export
5353
hyper_transforms.default<-function(x,all=FALSE,...) {
5454
if (!all)return(active_axis_transforms(x,...))
55-
grid<-x$grid
56-
axis<-x$axis
57-
dimension<-x$dimension
58-
source<-x$source
59-
## ignore activation, just do all
60-
#active_x <- active(x)
61-
dims<-axis %>%
62-
# dplyr::filter(.data$grid == active_x) %>%
63-
#dplyr::inner_join(axis, "variable") %>%
64-
dplyr::inner_join(dimension, c("dimension"="id")) %>%
55+
56+
dims<-x$axis %>%
57+
dplyr::inner_join(x$dimension, c("dimension"="id")) %>%
58+
dplyr::inner_join(x$extended, c("name","dimension")) %>%
6559
dplyr::distinct(.data$name,.data$dimension,.keep_all=TRUE) %>%
66-
dplyr::select(.data$name,.data$dimension,.data$length,.data$coord_dim)
60+
dplyr::select(.data$name,.data$dimension,.data$length,.data$coord_dim,.data$time)
6761

6862
transforms<- vector("list", nrow(dims))
6963
names(transforms)<-dims$name
7064

71-
all_atts<- mutate(x$attribute,low_name= tolower(.data$name))
72-
7365
for (iin seq_along(transforms)) {
7466
ll<-list(value= ifelse(rep(dims$coord_dim[i],dims$length[i]),
75-
nc_get(source$source,dims$name[i]), seq_len(dims$length[i])))
67+
nc_get(x$source$source,dims$name[i]), seq_len(dims$length[i])))
7668
axis<-tibble::as_tibble(ll)
77-
names(axis)<-dims$name[i]
69+
names(axis)<-dims$name[i]
70+
71+
## Add timestamp for any "time" dimension by taking the CFtime
72+
## instance from the extended attributes
73+
## tidync/issues/54
74+
if (!is.na(dims$time[i]))
75+
axis$timestamp<-CFtime::CFtimestamp(dims$time[i][[1]])
7876

7977
## axis might have a column called "i"
8078
## tidync/issues/74
8179
id_value<-dims$dimension[i]
8280
dim_name<-dims$name[i]
8381
dim_coord<-dims$coord_dim[i]
8482

85-
## Add timestamp for any "time" dimension. Since not all files have a
86-
## "calendar" attribute or "axis == "T"", just try to create a CFtime
87-
## instance from the "units" attribute and a "calendar" if present
88-
## tidync/issues/54
89-
dim_atts<-all_atts %>%dplyr::filter(.data$variable==dim_name)
90-
units<- unlist(dim_atts$value[which(dim_atts$low_name=="units")])
91-
if (!(is.null(units))) {
92-
cal_idx<- which(dim_atts$low_name=="calendar")
93-
if (length(cal_idx)==0)calendar<-"standard"
94-
elsecalendar<- unlist(dim_atts$value[cal_idx])
95-
try({
96-
cft<-CFtime::CFtime(units,calendar,axis[[1]])
97-
axis$timestamp=CFtime::as_timestamp(cft)
98-
},silent=TRUE)
99-
}
100-
10183
axis<- mutate(axis,
10284
index= row_number(),
10385
id=id_value,
10486
name=dim_name,
10587
coord_dim=dim_coord,
10688
selected=TRUE)
10789

108-
10990
transforms[[i]]<-axis
110-
11191
}
112-
113-
11492
transforms
115-
11693
}

‎R/tidync.R

Lines changed: 9 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -137,6 +137,7 @@ tidync.character <- function(x, what, ...) {
137137
grid=meta$grid,
138138
dimension=meta$dimension,
139139
variable=variable,
140+
extended=meta$extended,
140141
attribute=meta$attribute)
141142
out$transforms<- hyper_transforms(out,all=TRUE)
142143

@@ -226,10 +227,9 @@ first_numeric_var <- function(x) {
226227
#' argo %>% hyper_filter(N_LEVELS = index > 300)
227228
print.tidync<-function(x,...) {
228229
ushapes<-dplyr::distinct(x$grid,.data$grid) %>%
229-
dplyr::arrange(desc(nchar(.data$grid)))
230+
dplyr::arrange(desc(nchar(.data$grid)))
230231
nshapes<- nrow(ushapes)
231-
cat(sprintf("\nData Source (%i): %s ...\n",
232-
nrow(x$source),
232+
cat(sprintf("\nData Source (%i): %s ...\n", nrow(x$source),
233233
paste(utils::head(basename(x$source$source),2),collapse=",")))
234234
cat(sprintf("\nGrids (%i) <dimension family> : <associated variables>\n\n",
235235
nshapes))
@@ -241,13 +241,12 @@ print.tidync <- function(x, ...) {
241241
return(invisible(NULL))
242242
}
243243
active_sh<- active(x)
244-
nms<-if(nrow(ushapes)>0)nchar(ushapes$grid)else0
244+
nms<-if(nrow(ushapes)>0) nchar(ushapes$grid)else0
245245
longest<- sprintf("[%%i] %%%is",-max(nms))
246-
if (utils::packageVersion("tidyr")>"0.8.3" ) {
246+
if (utils::packageVersion("tidyr")>"0.8.3")
247247
vargrids<-tidyr::unnest(x$grid,cols= c(.data$variables))
248-
}else {
248+
else
249249
vargrids<-tidyr::unnest(x$grid)
250-
}
251250

252251
# Warning message:
253252
# In dplyr::inner_join(., x$axis, "variable") :
@@ -289,7 +288,6 @@ print.tidync <- function(x, ...) {
289288
nms<- names(x$transforms)
290289
## handle case where value is character
291290
for (iin seq_along(x$transforms)) {
292-
293291
if (!is.numeric(x$transforms[[nms[i]]][[nms[i]]])) {
294292
x$transforms[[nms[i]]][[nms[i]]]<-NA_integer_
295293
}
@@ -305,7 +303,6 @@ print.tidync <- function(x, ...) {
305303

306304
filter_ranges<- do.call(rbind,filter_ranges)
307305
ranges<- do.call(rbind,ranges)
308-
309306

310307
idxnm<- match(names(x$transforms),dims$name)
311308
dims$dmin<-dims$dmax<-dims$min<-dims$max<-NA_real_
@@ -328,10 +325,9 @@ print.tidync <- function(x, ...) {
328325
dplyr::filter(.data$active) %>%
329326
dplyr::mutate(id=NULL,active=NULL),n=Inf)
330327
dimension_other<- format(alldims %>%dplyr::filter(!.data$active) %>%
331-
dplyr::select(.data$dim,.data$name,
332-
.data$length,.data$min,.data$max,
333-
334-
.data$unlim,.data$coord_dim),n=Inf)
328+
dplyr::select(.data$dim,.data$name,.data$length,
329+
.data$min,.data$max,.data$unlim,
330+
.data$coord_dim),n=Inf)
335331

336332
}
337333

@@ -354,5 +350,3 @@ print.tidync <- function(x, ...) {
354350
}
355351
invisible(NULL)
356352
}
357-
358-

‎man/hyper_array.Rd

Lines changed: 1 addition & 1 deletion
Some generated files are not rendered by default. Learn more aboutcustomizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp