get_tidy_data <- function(mat_list, lat, lon, time = NULL, name_variable = 'variable', FUTURE = FALSE){
checks <- makeAssertCollection()
assert_character(name_variable,len = 1, add = checks)
assert_numeric(lat, add = checks)
assert_numeric(lon, add = checks)
assert_logical(FUTURE, add = checks)
reportAssertions(checks)
if(FUTURE){
if( is.array(mat_list)){
mat_list <- list(a = mat_list)
names(mat_list) <- name_variable
}else{
dimentions <- future_sapply(X = mat_list, FUN = dim)
if(any( dimentions - rowMeans(dimentions) != 0 )){
stop('all elements of mat_list must have the same length')
}
}
if( !any(dim(mat_list[[1]]) == length(lat)) | !any(dim(mat_list[[1]]) == length(lon))){
stop('dims of the elements of mat_list must correspond to those of lat, lon and if given time')
}
id_lat <- which(dim(mat_list[[1]]) == length(lat))
id_lon <- which(dim(mat_list[[1]]) == length(lon))
if(is.null(time)){
if(length(dim(mat_list[[1]])) != 2){
stop('if time is not given, mat_list elements has to have 2 dimentions')
}
dim_list <- list(Lat = lat, Lon = lon)
mat_list <- future_lapply(mat_list, aperm, perm=c(id_lat,id_lon))
mat_list <- tbl_cube(dimensions = dim_list, measures = mat_list)
}else{
check_numeric(time)
if( !any(dim(mat_list[[1]]) == length(time))){
stop('dims of mat_list must correspond to those of lat, lon and if given time')
}
if(length(dim(mat_list[[1]])) != 3){
stop('if time is given, mat_list elements has to have 3 dimentions')
}
id_time <- which(dim(mat_list[[1]]) == length(time))
dim_list <- list(Lat = lat, Lon = lon, Time = time)
mat_list <- future_lapply(mat_list, aperm, perm=c(id_lat,id_lon,id_time))
mat_list <- tbl_cube(dimensions = dim_list, measures = mat_list)
}
return(as_tibble(mat_list))
}else{
if( is.array(mat_list)){
mat_list <- list(a = mat_list)
names(mat_list) <- name_variable
}else{
dimentions <- sapply(X = mat_list, FUN = dim)
if(any( dimentions - rowMeans(dimentions) != 0 )){
stop('all elements of mat_list must have the same length')
}
}
if( !any(dim(mat_list[[1]]) == length(lat)) | !any(dim(mat_list[[1]]) == length(lon))){
stop('dims of the elements of mat_list must correspond to those of lat, lon and if given time')
}
id_lat <- which(dim(mat_list[[1]]) == length(lat))
id_lon <- which(dim(mat_list[[1]]) == length(lon))
if(is.null(time)){
if(length(dim(mat_list[[1]])) != 2){
stop('if time is not given, mat_list elements has to have 2 dimentions')
}
dim_list <- list(Lat = lat, Lon = lon)
mat_list <- lapply(mat_list, aperm, perm=c(id_lat,id_lon))
mat_list <- tbl_cube(dimensions = dim_list, measures = mat_list)
}else{
check_numeric(time)
if( !any(dim(mat_list[[1]]) == length(time))){
stop('dims of mat_list must correspond to those of lat, lon and if given time')
}
if(length(dim(mat_list[[1]])) != 3){
stop('if time is given, mat_list elements has to have 3 dimentions')
}
id_time <- which(dim(mat_list[[1]]) == length(time))
dim_list <- list(Lat = lat, Lon = lon, Time = time)
mat_list <- lapply(mat_list, aperm, perm=c(id_lat,id_lon,id_time))
mat_list <- tbl_cube(dimensions = dim_list, measures = mat_list)
}
return(as_tibble(mat_list))
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.