tmax_historical <- NULL
tmin_historical <- NULL
grid1 <- 293 - 10 * cos(2 * pi / 365 * (1 : 10958)) + rnorm(10958)
grid2 <- 289 - 8 * cos(2 * pi / 365 * (1 : 10958)) - abs(rnorm(10958))
  par(mfrow=c(1,1))
  plot(1:365, grid1[1:365], type ="b")
  lines(1:365, grid2[1:365], col =4)
  plot(1:length(grid1), grid1, type ="b")
  lines(1:length(grid2), grid2, col =4)

gridlon1 <- NULL
gridlon2 <- NULL
for (i in 1 : 12) {
  gridlon1 <- cbind(gridlon1, grid1 + abs(rnorm(10958, mean = 2, sd = 1) * cos(2 * pi / 365 * (1 : 10958))))
  gridlon2 <- cbind(gridlon2, grid2 - abs(rnorm(10958, mean = 2, sd = 1) * cos(2 * pi / 365 * (1 : 10958))))
}
dim(gridlon1)
  plot(1:365, gridlon1[1:365, 1], type = "b")
  lines(1:365, gridlon2[1:365, 1], col = 4)
  lines(1:365, gridlon1[1:365, 8] ,col = "brown")
  lines(1:365, gridlon2[1:365, 8] ,col = "orange")
sum((gridlon1-gridlon2) < 0)
which((gridlon1-gridlon2) < 0)
  
tmax_historical <- NULL
tmin_historical <- NULL
for (j in 1 : 8) {
  gridnew1 <- apply(gridlon1, 2, function(x) {x - rnorm(10958, mean = j * 0.001, sd = 0.1)})
  gridnew2 <- apply(gridlon2, 2, function(x) {x - abs(rnorm(10958, mean = j * 0.75, sd = 0.5))})
  tmax_historical <- abind(tmax_historical, gridnew1, along = 3)
  tmin_historical <- abind(tmin_historical, gridnew2, along = 3)
}
  plot(1:365, tmax_historical[1:365, 1, 1], type = "b")
  lines(1:365, tmin_historical[1:365, 1, 1], col = 4)
  lines(1:365, tmax_historical[1:365, 1, 8] ,col = "brown")
  lines(1:365, tmin_historical[1:365, 1, 8] ,col = "orange")
  lines(1:365, gridlon1[1:365, 1], col =3)
sum(tmax_historical - tmin_historical < 0)
which(tmax_historical - tmin_historical < 0)

#diff <-  rep(5 + abs(rnorm(10958)), 12 * 8) 
#dim(diff) <- c(10958,12, 8)
#tmin_historical <- tmax_historical -  diff
tmax_historical <- InsertDim(InsertDim(tmax_historical, posdim = 1, lendim = 1), posdim = 1, lendim = 1)
tmin_historical <- InsertDim(InsertDim(tmin_historical, posdim = 1, lendim = 1), posdim = 1, lendim = 1)
names(dim(tmax_historical)) <- c("model", "var", "time", "lon", "lat")
names(dim(tmin_historical)) <- c("model", "var", "time", "lon", "lat")
time <- seq(ISOdate(1971, 1, 1), ISOdate(2000, 12, 31), "day")
metadata <- list(time = list(standard_name = 'time', long_name = 'time', 
                             calendar = 'proleptic_gregorian',
                             units = 'days since 1970-01-01 00:00:00', prec = 'double', 
                             dim = list(list(name = 'time', unlim = FALSE))))
attr(time, "variables") <- metadata
attr(tmax_historical, 'Variables')$dat1$time <- time
attr(tmin_historical, 'Variables')$dat1$time <- time

  par(mfrow = c(1,1))
  plot(1:365, tmax_historical[1,1,1:365, 1, 1], type ="b")
  lines(1:365, tmin_historical[1,1,1:365,1,1], col = 3)
  sum(tmax_historical - tmin_historical < 0) == 0
  plot(1:10958, tmax_historical[1,1, , 1, 1], type ="b")
  lines(1:10958, tmin_historical[1,1, ,1,1], col = 3)


tmax_projection <- NULL
tmin_projection <- NULL
grid1 <- 293 - 10 * cos(2 * pi / 365 * (1 : 34698)) + rnorm(34698) + (1 : 34698) * rnorm(1, mean = 4) / 34698 
grid2 <- 289 - 8 * cos(2 * pi / 365 * (1 : 34698)) - abs(rnorm(34698)) + (1 : 34698) * rnorm(1, mean = 4) / 40000
    par(mfrow=c(1,1))
    plot(1:365, grid1[1:365], type ="b")
    lines(1:365, grid2[1:365], col =4)
    plot(1:length(grid1), grid1, type ="b")
    lines(1:length(grid2), grid2, col =4)
    sum(grid1 - grid1 > 0)
    which(grid1 - grid1 > 0)
gridlon1 <- NULL
gridlon2 <- NULL
for (i in 1 : 12) {
  gridlon1 <- cbind(gridlon1, grid1 + abs(rnorm(34698, mean = 2, sd = 1) * cos(2 * pi / 365 * (1 : 34698))))
  gridlon2 <- cbind(gridlon2, grid2 - abs(rnorm(34698, mean = 2, sd = 1) * cos(2 * pi / 365 * (1 : 34698))))
}
  dim(gridlon1)
  plot(1:365, gridlon1[1:365, 1], type = "b")
  lines(1:365, gridlon2[1:365, 1], col = 4)
  lines(1:365, gridlon1[1:365, 8] ,col = "brown")
  lines(1:365, gridlon2[1:365, 8] ,col = "orange")
  sum((gridlon1-gridlon2) < 0)
  which((gridlon1-gridlon2) < 0)
tmax_projection <- NULL
tmin_projection <- NULL
  for (j in 1 : 8) {
  gridnew1 <- apply(gridlon1, 2, function(x) {x - rnorm(34698, mean = j * 0.01, sd = 0.1)})
  gridnew2 <- apply(gridlon2, 2, function(x) {x - abs(rnorm(34698, mean = j * 0.75, sd = 0.5))})
  tmax_projection <- abind(tmax_projection, gridnew1, along = 3)
  tmin_projection <- abind(tmin_projection, gridnew2, along = 3)
}
    plot(1:365, tmax_projection[1:365, 1, 1], type = "b")
    lines(1:365, tmin_projection[1:365, 1, 1], col = 4)
    lines(1:365, tmax_projection[1:365, 1, 8] ,col = "brown")
    lines(1:365, tmin_projection[1:365, 1, 8] ,col = "orange")
    lines(1:365, gridlon1[1:365, 1], col =3)
    sum(tmax_historical - tmin_historical < 0)
    which(tmax_historical - tmin_historical < 0)
#diff <-  rep(7 + abs(rnorm(34698)) + (1:34698) * 0.00003, 12 * 8) 
#dim(diff) <- c(34698,12, 8)
#tmin_projection <- tmax_projection -  diff
tmax_projection <- InsertDim(InsertDim(tmax_projection, posdim = 1, lendim = 1), posdim = 1, lendim = 1)
tmin_projection <- InsertDim(InsertDim(tmin_projection, posdim = 1, lendim = 1), posdim = 1, lendim = 1)
names(dim(tmax_projection)) <- c("model", "var", "time", "lon", "lat")
names(dim(tmin_projection)) <- c("model", "var", "time", "lon", "lat")
time <- seq(ISOdate(2006, 1, 1), ISOdate(2100, 12, 31), "day")
metadata <- list(time = list(standard_name = 'time', long_name = 'time', 
                             calendar = 'proleptic_gregorian',
                             units = 'days since 1970-01-01 00:00:00', prec = 'double', 
                             dim = list(list(name = 'time', unlim = FALSE))))
attr(time, "variables") <- metadata
attr(tmax_projection, 'Variables')$dat1$time <- time
attr(tmin_projection, 'Variables')$dat1$time <- time

  par(mfrow = c(1,1))
  plot(1:365, tmax_projection[1,1,1:365, 1, 1], type ="b")
  lines(1:365, tmin_projection[1,1,1:365,1,1], col = 3)
  sum(tmax_projection - tmin_projection < 0) == 0
  plot(1:34698, tmax_projection[1,1, , 1, 1], type ="b")
  lines(1:34698, tmin_projection[1,1, ,1,1], col = 3)

dtr_reference <- DTRRef(tmax = tmax_historical, tmin = tmin_historical, by.seasons = TRUE, ncores = NULL)
str(dtr_reference)


dtr_indicator <- DTRIndicator(tmax_projection, tmin_projection, ref = dtr_reference, by.seasons = TRUE, ncores = NULL)
str(dtr_indicator)


season <-   as.factor(dtr_indicator$season)
year <- dtr_indicator$year
breaks <- seq(0, max(apply(data, c(2, 5, 6), mean)), 5)

dtr_rcp <- array(dim = c(length(lon), length(lat), 4))             
for (j in 1:4){
  dtr_rcp[,,j] <- Mean1Dim(dtr_indicator$indicator[,j,,,,], 1)
}            
breaks <- 0 : (max(dtr_rcp) + 1)
PlotLayout(PlotEquiMap, c(1, 2), lon = lon, lat = lat, var = dtr_rcp, titles = c('DJF', 'MAM', 'JJA', 'SON'), 
           toptitle = "DTR", filled.continents = FALSE, color_fun = clim.palette("yellowred"), brks = breaks)


#-----------------------------------------------------------------

plot(1:dim(tmax_historical)[3], tmax_historical[1,1, ,1,1])
lines(1:dim(tmax_historical)[3], tmin_historical[1, 1, ,1,1], col = 3)
sum(tmax_historical-tmin_historical < 0)

plot(1:dim(tmax_projection)[3], tmax_projection[1,1, ,1,1])
lines(1:dim(tmax_projection)[3], tmin_projection[1, 1, ,1,1], col = 3)
sum(tmax_projection-tmin_projection < 0)


Apply(data = data, margins = margins, AtomicFun = .WaveDuration, date.factor = date.factor, jdays = jdays,
      op = op, spell.length = spell.length, ncores = ncores)
data <- list(summer_tmax_projection$data, thresholds)
margins = list(c(2,3),c(2,3))
date.factor = as.factor(rep(2006:2100, 92))
jdays = rep(1:92, 95)
op = ">"
spell.length = 5
ncores = NULL
> Apply
function (data, target_dims = NULL, AtomicFun, ..., output_dims = NULL, 
          margins = NULL, ncores = NULL) 
{
  if (!is.list(data)) {
    data <- list(data)
  }
  if (any(!sapply(data, is.numeric))) {
    stop("Parameter 'data' must be one or a list of numeric objects.")
  }
  is_vector <- rep(FALSE, length(data))
  is_unnamed <- rep(FALSE, length(data))
  for (i in 1:length(data)) {
    if (is.null(dim(data[[i]]))) {
      is_vector[i] <- TRUE
      is_unnamed[i] <- TRUE
      dim(data[[i]]) <- length(data[[i]])
    }
    if (!is.null(names(dim(data[[i]])))) {
      if (any(sapply(names(dim(data[[i]])), nchar) == 0)) {
        stop("Dimension names of arrays in 'data' must be at least ", 
             "one character long.")
      }
    }
    else {
      is_unnamed[i] <- TRUE
    }
  }
  if (is.character(AtomicFun)) {
    try({
      AtomicFun <- get(AtomicFun)
    }, silent = TRUE)
    if (!is.function(AtomicFun)) {
      stop("Could not find the function '", AtomicFun, 
           "'.")
    }
  }
  if (!is.function(AtomicFun)) {
    stop("Parameter 'AtomicFun' must be a function or a character string ", 
         "with the name of a function.")
  }
  if ("startR_step" %in% class(AtomicFun)) {
    if (is.null(target_dims)) {
      target_dims <- attr(AtomicFun, "target_dims")
    }
    if (is.null(output_dims)) {
      output_dims <- attr(AtomicFun, "output_dims")
    }
  }
  if (is.null(margins) && is.null(target_dims)) {
    stop("One of 'margins' or 'target_dims' must be specified.")
  }
  if (!is.null(margins)) {
    target_dims <- NULL
  }
  margins_names <- vector("list", length(data))
  target_dims_names <- vector("list", length(data))
  if (!is.null(margins)) {
    if (!is.list(margins)) {
      margins <- rep(list(margins), length(data))
    }
    if (any(!sapply(margins, function(x) is.character(x) || 
                    is.numeric(x) || is.null(x)))) {
      stop("Parameter 'margins' must be one or a list of numeric or ", 
           "character vectors.")
    }
    duplicate_dim_specs <- sapply(margins, function(x) {
      length(unique(x)) != length(x)
    })
    if (any(duplicate_dim_specs)) {
      stop("Parameter 'margins' must not contain duplicated dimension ", 
           "specifications.")
    }
    target_dims <- vector("list", length(data))
    for (i in 1:length(data)) {
      if (length(margins[[i]]) > 0) {
        if (is.character(unlist(margins[i]))) {
          if (is.null(names(dim(data[[i]])))) {
            stop("Parameter 'margins' contains dimension names, but ", 
                 "some of the corresponding objects in 'data' do not have ", 
                 "dimension names.")
          }
          margins2 <- margins[[i]]
          margins2_new_num <- c()
          for (j in 1:length(margins2)) {
            matches <- which(names(dim(data[[i]])) == 
                               margins2[j])
            if (length(matches) < 1) {
              stop("Could not find dimension '", margins2[j], 
                   "' in ", i, "th object provided in 'data'.")
            }
            margins2_new_num[j] <- matches[1]
          }
          margins_names[[i]] <- margins[[i]]
          margins[[i]] <- margins2_new_num
        }
        if (!is.null(names(dim(data[[i]])))) {
          target_dims_names[[i]] <- names(dim(data[[i]]))[-margins[[i]]]
        }
        target_dims[[i]] <- (1:length(dim(data[[i]])))[-margins[[i]]]
      }
      else {
        target_dims[[i]] <- 1:length(dim(data[[i]]))
        if (!is.null(names(dim(data[[i]])))) {
          target_dims_names[[i]] <- names(dim(data[[i]]))
        }
      }
    }
  }
  else {
    if (!is.list(target_dims)) {
      target_dims <- rep(list(target_dims), length(data))
    }
    if (any(!sapply(target_dims, function(x) is.character(x) || 
                    is.numeric(x)))) {
      stop("Parameter 'target_dims' must be one or a list of numeric or ", 
           "character vectors.")
    }
    if (any(sapply(target_dims, length) == 0)) {
      stop("Parameter 'target_dims' must not contain length-0 vectors.")
    }
    duplicate_dim_specs <- sapply(target_dims, function(x) {
      length(unique(x)) != length(x)
    })
    if (any(duplicate_dim_specs)) {
      stop("Parameter 'target_dims' must not contain duplicated dimension ", 
           "specifications.")
    }
    margins <- vector("list", length(data))
    for (i in 1:length(data)) {
      if (is.character(unlist(target_dims[i]))) {
        if (is.null(names(dim(data[[i]])))) {
          stop("Parameter 'target_dims' contains dimension names, but ", 
               "some of the corresponding objects in 'data' do not have ", 
               "dimension names.")
        }
        targs2 <- target_dims[[i]]
        targs2_new_num <- c()
        for (j in 1:length(targs2)) {
          matches <- which(names(dim(data[[i]])) == targs2[j])
          if (length(matches) < 1) {
            stop("Could not find dimension '", targs2[j], 
                 "' in ", i, "th object provided in 'data'.")
          }
          targs2_new_num[j] <- matches[1]
        }
        target_dims_names[[i]] <- target_dims[[i]]
        target_dims[[i]] <- targs2_new_num
      }
      if (!is.null(names(dim(data[[i]])))) {
        margins_names[[i]] <- names(dim(data[[i]]))[-target_dims[[i]]]
      }
      margins[[i]] <- (1:length(dim(data[[i]])))[-target_dims[[i]]]
    }
  }
  for (i in 1:length(data)) {
    if (length(target_dims[[i]]) > 0) {
      if (is.unsorted(target_dims[[i]]) || (max(target_dims[[i]]) > 
                                            length(target_dims[[i]]))) {
        marg_dims <- (1:length(dim(data[[i]])))[-target_dims[[i]]]
        data[[i]] <- .aperm2(data[[i]], c(target_dims[[i]], 
                                          marg_dims))
        target_dims[[i]] <- 1:length(target_dims[[i]])
        margins[[i]] <- (length(target_dims[[i]]) + 1):length(dim(data[[i]]))
      }
    }
  }
  if (!is.null(output_dims)) {
    if (!is.list(output_dims)) {
      output_dims <- list(output1 = output_dims)
    }
    if (any(sapply(output_dims, function(x) !(is.character(x) || 
                                              is.null(x))))) {
      stop("Parameter 'output_dims' must be one or a list of vectors of character strings (or NULLs).")
    }
    if (is.null(names(output_dims))) {
      names(output_dims) <- rep("", length(output_dims))
    }
    missing_output_names <- which(sapply(names(output_dims), 
                                         nchar) == 0)
    if (length(missing_output_names) > 0) {
      names(output_dims)[missing_output_names] <- paste0("output", 
                                                         missing_output_names)
    }
  }
  if (is.null(ncores)) {
    ncores <- 1
  }
  if (!is.numeric(ncores)) {
    stop("Parameter 'ncores' must be numeric.")
  }
  ncores <- round(ncores)
  all_found_margins_lengths <- afml <- list()
  for (i in 1:length(data)) {
    if (!is.null(margins_names[[i]])) {
      if (length(afml) > 0) {
        matches <- which(margins_names[[i]] %in% names(afml))
        if (length(matches) > 0) {
          margs_to_add <- as.list(dim(data[[i]])[margins[[i]]][-matches])
          if (any(dim(data[[i]])[margins[[i]][matches]] != 
                  unlist(afml[margins_names[[i]][matches]]))) {
            stop("Found one or more margin dimensions with the same name and ", 
                 "different length in some of the input objects in 'data'.")
          }
        }
        else {
          margs_to_add <- as.list(dim(data[[i]])[margins[[i]]])
        }
        unnamed_margins <- which(sapply(names(afml), 
                                        nchar) == 0)
        if (length(unnamed_margins) > 0) {
          stop_with_error <- FALSE
          if (length(unnamed_margins) <= length(margs_to_add)) {
            if (any(unlist(afml[unnamed_margins]) != 
                    unlist(margs_to_add[1:length(unnamed_margins)]))) {
              stop_with_error <- TRUE
            }
            names(afml)[unnamed_margins] <- names(margs_to_add)[1:length(unnamed_margins)]
            margs_to_add <- margs_to_add[-(1:length(margs_to_add))]
          }
          else {
            if (any(unlist(afml[unnamed_margins[1:length(margs_to_add)]]) != 
                    unlist(margs_to_add))) {
              stop_with_error <- TRUE
            }
            names(afml)[unnamed_margins[1:length(margs_to_add)]] <- names(margs_to_add)
            margs_to_add <- list()
          }
          if (stop_with_error) {
            stop("Found unnamed margins (for some objects in parameter ", 
                 "'data') that have been associated by their position to ", 
                 "named margins in other objects in 'data' and do not have ", 
                 "matching length. It could also be that the unnamed ", 
                 "margins don not follow the same order as the named ", 
                 "margins. In that case, either put the corresponding names ", 
                 "to the dimensions of the objects in 'data', or put them ", 
                 "in a consistent order.")
          }
        }
        afml <- c(afml, margs_to_add)
      }
      else {
        afml <- as.list(dim(data[[i]])[margins[[i]]])
      }
    }
    else {
      margs_to_add <- as.list(dim(data[[i]])[margins[[i]]])
      names(margs_to_add) <- rep("", length(margs_to_add))
      if (length(afml) > 0) {
        stop_with_error <- FALSE
        if (length(afml) >= length(margs_to_add)) {
          if (any(unlist(margs_to_add) != unlist(afml[1:length(margs_to_add)]))) {
            stop_with_error <- TRUE
          }
        }
        else {
          if (any(unlist(margs_to_add)[1:length(afml)] != 
                  unlist(afml))) {
            stop_with_error <- TRUE
          }
          margs_to_add <- margs_to_add[-(1:length(afml))]
          afml <- c(afml, margs_to_add)
        }
        if (stop_with_error) {
          stop("Found unnamed margins (for some objects in parameter ", 
               "'data') that have been associated by their position to ", 
               "named margins in other objects in 'data' and do not have ", 
               "matching length. It could also be that the unnamed ", 
               "margins don not follow the same order as in other ", 
               "objects. In that case, either put the corresponding names ", 
               "to the dimensions of the objects in 'data', or put them ", 
               "in a consistent order.")
        }
      }
      else {
        afml <- margs_to_add
      }
    }
  }
  missing_margin_names <- which(names(afml) == "")
  if (length(missing_margin_names) > 0) {
    names(afml)[missing_margin_names] <- paste0("_unnamed_margin_", 
                                                1:length(missing_margin_names), "_")
  }
  margins_afml <- margins
  for (i in 1:length(data)) {
    if (!is.null(margins_names[[i]])) {
      margins_afml[[i]] <- sapply(margins_names[[i]], function(x) {
        sapply(x, function(y) {
          which(names(afml) == y)
        })
      })
    }
    else if (length(margins_afml[[i]]) > 0) {
      margins_afml[[i]] <- margins_afml[[i]] - min(margins_afml[[i]]) + 
        1
      margins_names[[i]] <- names(afml)[margins_afml[[i]]]
      names(dim(data[[i]]))[margins[[i]]] <- margins_names[[i]]
    }
  }
  common_margs <- margins_afml[[1]]
  if (length(margins_afml) > 1) {
    for (i in 2:length(margins_afml)) {
      margs_a <- unlist(afml[common_margs])
      margs_b <- unlist(afml[margins_afml[[i]]])
      matches <- which(names(margs_a) %in% names(margs_b))
      if (length(matches) > 0) {
        common_margs <- common_margs[matches]
      }
      else {
        common_margs <- NULL
      }
    }
  }
  non_common_margs <- 1:length(afml)
  if (length(common_margs) > 0) {
    non_common_margs <- non_common_margs[-common_margs]
  }
  .isolate <- function(data, margin_length, drop = FALSE) {
    eval(dim(environment()$data))
    structure(list(env = environment(), index = margin_length, 
                   drop = drop, subs = as.name("[")), class = c("indexed_array"))
  }
  .consolidate <- function(subsets, dimnames, out_dims) {
    lapply(setNames(1:length(subsets), names(subsets)), function(x) {
      if (length(out_dims[[x]]) > 0) {
        dims <- dim(subsets[[x]])
        if (!is_unnamed[x]) {
          names(dims) <- dimnames[[x]]
        }
        dims <- dims[out_dims[[x]]]
        array(subsets[[x]], dim = dims)
      }
      else {
        as.vector(subsets[[x]])
      }
    })
  }
  data_indexed <- vector("list", length(data))
  data_indexed_indices <- vector("list", length(data))
  for (i in 1:length(data)) {
    margs_i <- which(names(dim(data[[i]])) %in% names(afml[c(non_common_margs, 
                                                             common_margs)]))
    false_margs_i <- which(margs_i %in% target_dims[[i]])
    margs_i <- setdiff(margs_i, false_margs_i)
    if (length(margs_i) > 0) {
      margin_length <- lapply(dim(data[[i]]), function(x) 1:x)
      margin_length[-margs_i] <- ""
    }
    else {
      margin_length <- as.list(rep("", length(dim(data[[i]]))))
    }
    margin_length <- expand.grid(margin_length, KEEP.OUT.ATTRS = FALSE, 
                                 stringsAsFactors = FALSE)
    data_indexed[[i]] <- .isolate(data[[i]], margin_length)
    if (length(margs_i) > 0) {
      data_indexed_indices[[i]] <- array(1:prod(dim(data[[i]])[margs_i]), 
                                         dim = dim(data[[i]])[margs_i])
    }
    else {
      data_indexed_indices[[i]] <- array(1, dim = 1)
    }
  }
  splatted_f <- splat(AtomicFun)
  if (length(c(non_common_margs, common_margs)) > 0) {
    marg_inds_ordered <- sort(c(non_common_margs, common_margs))
    margins_array <- ma <- array(1:prod(unlist(afml[marg_inds_ordered])), 
                                 dim = unlist(afml[marg_inds_ordered]))
  }
  else {
    ma <- array(1)
  }
  arrays_of_results <- NULL
  found_first_result <- FALSE
  total_size <- prod(dim(ma))
  if (!is.null(ncores)) {
    chunk_size <- round(total_size/(ncores * 4))
  }
  else {
    chunk_size <- 4
  }
  if (chunk_size < 1) {
    chunk_size <- 1
  }
  nchunks <- floor(total_size/chunk_size)
  chunk_sizes <- rep(chunk_size, nchunks)
  if (total_size%%chunk_size != 0) {
    chunk_sizes <- c(chunk_sizes, total_size%%chunk_size)
  }
  iteration <- function(m) {
    sub_arrays_of_results <- list()
    found_first_sub_result <- FALSE
    for (n in 1:chunk_sizes[m]) {
      j <- n + (m - 1) * chunk_size
      marg_indices <- arrayInd(j, dim(ma))
      names(marg_indices) <- names(dim(ma))
      input <- list()
      for (i in 1:length(data_indexed)) {
        inds_to_take <- which(names(marg_indices) %in% 
                                names(dim(data_indexed_indices[[i]])))
        if (length(inds_to_take) > 0) {
          marg_inds_to_take <- marg_indices[inds_to_take][names(dim(data_indexed_indices[[i]]))]
          input[[i]] <- data_indexed[[i]][[do.call("[", 
                                                   c(list(x = data_indexed_indices[[i]]), marg_inds_to_take, 
                                                     list(drop = TRUE)))]]
        }
        else {
          input[[i]] <- data_indexed[[i]][[1]]
        }
      }
      result <- splatted_f(.consolidate(input, lapply(lapply(data, 
                                                             dim), names), target_dims), ...)
      if (!is.list(result)) {
        result <- list(result)
      }
      if (!found_first_sub_result) {
        sub_arrays_of_results <- vector("list", length(result))
        if (!is.null(output_dims)) {
          if (length(output_dims) != length(sub_arrays_of_results)) {
            stop("The 'AtomicFun' returns ", length(sub_arrays_of_results), 
                 " elements, but ", length(output_dims), 
                 " elements were expected.")
          }
          names(sub_arrays_of_results) <- names(output_dims)
        }
        else if (!is.null(names(result))) {
          names(sub_arrays_of_results) <- names(result)
        }
        else {
          names(sub_arrays_of_results) <- paste0("output", 
                                                 1:length(result))
        }
      }
      atomic_fun_out_dims <- vector("list", length(result))
      for (component in 1:length(result)) {
        if (is.null(dim(result[[component]]))) {
          if (length(result[[component]]) == 1) {
            component_dims <- NULL
          }
          else {
            component_dims <- length(result[[component]])
          }
        }
        else {
          component_dims <- dim(result[[component]])
        }
        if (!found_first_sub_result) {
          sub_arrays_of_results[[component]] <- array(dim = c(component_dims, 
                                                              chunk_sizes[m]))
        }
        if (!is.null(component_dims)) {
          atomic_fun_out_dims[[component]] <- component_dims
        }
        sub_arrays_of_results[[component]][(1:prod(component_dims)) + 
                                             (n - 1) * prod(component_dims)] <- result[[component]]
      }
      if (!found_first_sub_result) {
        found_first_sub_result <- TRUE
      }
      if (!is.null(output_dims)) {
        if (length(output_dims) != length(result)) {
          stop("Expected AtomicFun to return ", length(output_dims), 
               " components, ", "but ", length(result), 
               " found.")
        }
        for (component in 1:length(result)) {
          if (length(atomic_fun_out_dims[[component]]) != 
              length(output_dims[[component]])) {
            stop("Expected ", component, "st returned element by 'AtomicFun' ", 
                 "to have ", length(output_dims[[component]]), 
                 " dimensions, ", "but ", length(atomic_fun_out_dims[[component]]), 
                 " found.")
          }
        }
      }
    }
    sub_arrays_of_results
  }
  parallel <- ncores > 1
  if (parallel) 
    registerDoParallel(ncores)
  result <- llply(1:length(chunk_sizes), iteration, .parallel = parallel)
  if (parallel) 
    registerDoSEQ()
  chunk_length <- NULL
  fun_out_dims <- vector("list", length(result[[1]]))
  for (m in 1:length(result)) {
    if (!found_first_result) {
      arrays_of_results <- vector("list", length(result[[1]]))
      if (!is.null(output_dims)) {
        if (length(output_dims) != length(arrays_of_results)) {
          stop("The 'AtomicFun' returns ", length(arrays_of_results), 
               " elements, but ", length(output_dims), " elements were expected.")
        }
        names(arrays_of_results) <- names(output_dims)
      }
      else if (!is.null(names(result[[1]]))) {
        names(arrays_of_results) <- names(result[[1]])
      }
      else {
        names(arrays_of_results) <- paste0("output", 
                                           1:length(result[[1]]))
      }
    }
    for (component in 1:length(result[[m]])) {
      component_dims <- dim(result[[m]][[component]])
      if (!found_first_result) {
        if (length(component_dims) > 1) {
          fun_out_dims[[component]] <- component_dims[-length(component_dims)]
        }
        arrays_of_results[[component]] <- array(dim = c(fun_out_dims[[component]], 
                                                        dim(ma)))
        dimnames_to_remove <- which(grepl("^_unnamed_margin_", 
                                          names(dim(arrays_of_results[[component]]))))
        if (length(dimnames_to_remove) > 0) {
          names(dim(arrays_of_results[[component]]))[dimnames_to_remove] <- rep("", 
                                                                                length(dimnames_to_remove))
        }
        if (all(names(dim(arrays_of_results[[component]])) == 
                "")) {
          names(dim(arrays_of_results[[component]])) <- NULL
        }
        chunk_length <- prod(component_dims)
      }
      arrays_of_results[[component]][(1:prod(component_dims)) + 
                                       (m - 1) * chunk_length] <- result[[m]][[component]]
    }
    if (!found_first_result) {
      found_first_result <- TRUE
    }
  }
  if (!is.null(output_dims)) {
    for (component in 1:length(output_dims)) {
      if (length(output_dims[[component]]) > 0) {
        names(dim(arrays_of_results[[component]]))[1:length(output_dims[[component]])] <- output_dims[[component]]
      }
    }
  }
  arrays_of_results
}
<environment: namespace:multiApply>