Surr_Prepare.R 1.78 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
## Time-stamp: "Last modified 2018-05-06 18:55:57 delucia"
##' @title Extracts input/output tables from a list of Reactive
##'     Transport Simulations
##' @param simlist a list containing the simulations
##' @param var_design optional, a character vector containing the
##'     names of the variables to extract for design. If omitted all
##'     variables are selected
##' @param var_result optional, a character vector containing the
##'     names of the variables to extract for results. If omitted all
##'     variables are selected
##' @return a list with 2 elements: design and result
##' @author MDL
##' @export
ExtractSamples <- function(simlist, var_design, var_result)
{
    ## transform the given simulations in explicit input/output tables for training
    totsim <- vector(mode = "list", length = sum(sapply(simlist,length)) - length(simlist))

    if (missing(var_design))
        var_design <- colnames(simlist[[1]][[2]]$T)
    if (missing(var_result))
        var_result <- colnames(simlist[[1]][[2]]$C)

    k <- 1
    for (i in seq_along(simlist)) {
        for (j in seq(2, length(simlist[[i]]))) {
            totsim[[k]] <- simlist[[i]][[j]]
            k = k + 1
        }
    }

    tmpT  <- plyr::ldply(totsim, function(x) x$T[, var_design], .id=NULL)
    tmpC  <- plyr::ldply(totsim, function(x) x$C[, var_result], .id=NULL)

    unT <- mgcv::uniquecombs(tmpT)
    ## unique design combinations
    iT <- attr(unT,"index")
    index <- match(seq(1,max(iT)), iT)
    unC <- tmpC[index,]
    saved_index_comp <- as.integer(rownames(unC))
    design <- tmpT[index,]
    result <- tmpC[index,]
    if(!all.equal(unT,tmpT[index,], check.attributes=FALSE))
        stopmsg("Something wrong with extracting unique combinations of design and results")
    return(list(design=design, result=result))
}