R/get_tidy.R

In santiagoh719/ClimFunctions: Functions For Climate Data

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))
  }
}