R/create_design_space.R

In PopED: Population (and Individual) Optimal Experimental Design

#' Create design variables and a design space for a full description of an optimization problem.
#' 
#' \code{create_design_space} takes an initial design and arguments for a design space and 
#' creates a design and design space for design optimization.
#' Checks the sizes of supplied design space variables and 
#' changes them to sizes that  make sense if there are inconsistencies.  
#' Function arguments can use shorthand notation (single values, vectors, lists of vectors and 
#' list of list) or matricies.
#' Returns a list of matricies compatible with PopED.
#' 
#' If a value (or a vector or a list of values) is supplied that corresponds to only one group and the design has
#' multiple groups then all groups will have the same value(s). If a matrix is expected then a list of lists can be supplied 
#' instead, each list corresponding to a group.   
#' 
#' @param design  The output from a call to \code{\link{create_design}}.
#' @param maxni Vector defining the maximum number of samples per group. 
#' @param minni Vector defining the minimum number of samples per group. 
#' @param maxtotni Number defining the maximum number of samples allowed in the experiment. 
#' @param mintotni Number defining the minimum number of samples allowed in the experiment.  
#' @param maxgroupsize Vector defining the maximum size of the different groups (maximum number of individuals in each group)
#' @param mingroupsize Vector defining the minimum size of the different groups (minimum num individuals in each group) 
#' @param maxtotgroupsize The total maximal groupsize over all groups
#' @param mintotgroupsize The total minimal groupsize over all groups
#' @param maxxt Matrix or single value defining the maximum value for each xt sample.  If a single value is 
#' supplied then all xt values are given the same maximum value.
#' @param minxt Matrix or single value defining the minimum value for each xt sample.  If a single value is 
#' supplied then all xt values are given the same minimum value
#' @param x_space Cell array \code{\link{cell}} defining the discrete variables for each x value.
#' @param xt_space Cell array \code{\link{cell}} defining the discrete variables allowed for each xt value.
#'   Can also be a vector of values \code{c(1:10)} (same values allowed for all xt), or a list of lists 
#'  \code{list(1:10, 2:23, 4:6)} (one for each value in xt in row major order or just for one row in xt, 
#'  and all other rows will be duplicated).
#' @param a_space Cell array \code{\link{cell}} defining the discrete variables allowed for each a value.
#'   Can also be a list of values \code{list(1:10)} (same values allowed for all a), or a list of lists 
#'  \code{list(1:10, 2:23, 4:6)} (one for each value in a).
#' @param maxa Vector defining the maximum value for each covariate. IF a single value is supplied then
#'  all a values are given the same maximum value
#' @param mina Vector defining the minimum value for each covariate. IF a single value is supplied then
#'  all a values are given the same minimum value
#' @param use_grouped_xt Group sampling times between groups so that each group has the same values (\code{TRUE} or \code{FALSE}).
#' @param grouped_xt Matrix defining the grouping of sample points. Matching integers mean that the points are matched.  
#' Allows for finer control than \code{use_grouped_xt}
#' @param use_grouped_a Group continuous design variables between groups so that each group has the same values (\code{TRUE} or \code{FALSE}).
#' @param grouped_a Matrix defining the grouping of continuous design variables. Matching integers mean that the values are matched.  
#' Allows for finer control than \code{use_grouped_a}.
#' @param use_grouped_x Group discrete design variables between groups so that each group has the same values (\code{TRUE} or \code{FALSE}).
#' @param grouped_x Matrix defining the grouping of discrete design variables. Matching integers mean that the values are matched.  
#' Allows for finer control than \code{use_grouped_x}.
#' @param our_zero Value to interpret as zero in design.
#' 
#' 
#' @family poped_input
#' 
#' @example tests/testthat/examples_fcn_doc/examples_create_design_space.R
#' 
#' @export
#' 
# @importFrom dplyr rbind_all

create_design_space <- function(
  design,
  ## -- Max number of samples per group --
  maxni=NULL,                     
  ## -- Min number of samples per group --
  minni=NULL,  
  maxtotni=NULL, # computed as sum of maxni
  mintotni=NULL,
  ## -- Vector defining the max size of the different groups (max num individuals in each group) --
  maxgroupsize=NULL,       
  ## -- Vector defining the min size of the different groups (min num individuals in each group) --
  mingroupsize=NULL,   
  ## -- The total maximal groupsize over all groups--
  maxtotgroupsize=NULL,   
  ## -- The total minimal groupsize over all groups--
  mintotgroupsize=NULL,   
  ## -- Matrix defining the max value for each sample --
  maxxt=NULL,   
  ## -- Matrix defining the min value for each sample --
  minxt=NULL,
  xt_space=NULL,
  ## -- Vector defining the max value for each covariate --
  maxa=NULL,   
  ## -- Vector defining the min value for each covariate --
  mina=NULL, 
  a_space=NULL,
  ## -- Cell defining the discrete variables --
  x_space = NULL,    
  use_grouped_xt=FALSE, # group sampling times between groups so that each group has same values  
  grouped_xt=NULL, ## -- Matrix defining the grouping of sample points --  finer control than use_grouped_xt
  ## -- Use grouped covariates (1=TRUE, 0=FALSE) --
  use_grouped_a=FALSE,               
  ## -- Matrix defining the grouping of covariates --
  grouped_a=NULL,               
  ## -- Use grouped discrete design variables (1=TRUE, 0=FALSE) --
  use_grouped_x=FALSE,               
  ## -- Matrix defining the grouping of discrete design variables --
  grouped_x=NULL,
  our_zero = NULL)
{
  
  called_args <- match.call()
  
  comp_max_min <- function (max_val, min_val, called_args) {
    args <- match.call()
    if(any(max_val<min_val,na.rm = T)){
      min_val_sup <- paste(args[[3]]) %in% names(called_args)
      max_val_sup <- paste(args[[2]]) %in% names(called_args)
      if(min_val_sup && max_val_sup) stop("Some value of ", args[[2]]," is smaller than ",  args[[3]])
      if(min_val_sup && !max_val_sup) max_val <- pmax(max_val,min_val)
      if(!min_val_sup && max_val_sup) min_val <- pmin(max_val,min_val)
    }
    return(list(max_val=max_val,min_val=min_val))
  }
  
  # assign defaults if not supplied
  if(is.null(maxni)) maxni=design$ni
  if(is.null(minni)) minni=design$ni
  if(is.null(maxgroupsize)) maxgroupsize=design$groupsize
  if(is.null(mingroupsize)) mingroupsize=design$groupsize
  maxxt_imputed <- F
  if(is.null(maxxt)){
    maxxt=design$xt
    maxxt_imputed <- T
  } 
  minxt_imputed <- F
  if(is.null(minxt)){
    minxt=design$xt
    minxt_imputed <- T
  } 
  maxa_imputed <- F
  if(is.null(maxa)){
    maxa=design$a
    maxa_imputed <- T
  } 
  mina_imputed <- F
  if(is.null(mina)){
    mina=design$a
    mina_imputed <- T
  } 
  
  design_space <- list()
  design_new <- design
  with(design,{
    
    
    
    ## rules:
    # 1. set default if not already defined
    # 2. read in value and translate to correct format
    # 3. check that size of object is correct
    # 4. add row and column names
    # 4. check that max is greater than min
    # 5. check that design value is wihin range of design_space
    
    # maxni
    if(size(maxni,1)==1 && m!=1) maxni <- matrix(rep(maxni,m),ncol=1,nrow=m,byrow=T)
    if(!is.matrix(maxni)) maxni <- cbind(maxni)
    if((test_mat_size(c(m, 1),maxni,'maxni')==1)){
      rownames(maxni) <- paste("grp_",1:m,sep="")
      colnames(maxni) <- "n_obs" 
    } 
    
    # minni
    if(size(minni,1)==1 && m!=1) minni <- matrix(rep(minni,m),ncol=1,nrow=m,byrow=T)
    if(!is.matrix(minni)) minni <- cbind(minni)
    if((test_mat_size(c(m, 1),minni,'minni')==1)){
      rownames(minni) <- paste("grp_",1:m,sep="")
      colnames(minni) <- "n_obs" 
    }
    
    # make sure max is min smaller than max
    ret <- comp_max_min(maxni,minni,called_args)
    maxni <- ret$max_val
    minni <- ret$min_val
    
    # check ni given max and min
    if(any(ni<minni)) stop("ni is less than minni")
    if(any(ni>maxni)) stop("ni is greater than maxni")
    #     ni <- pmax(ni,minni)
    #     ni <- pmin(ni,maxni)
    #     design_new$ni <- ni
    # or test_for_min() and test_for_max() from poped
    
    
    #maxtotni and mintotni
    if(is.null(maxtotni)) maxtotni <- sum(maxni)
    if(is.null(mintotni)) mintotni <- sum(minni)
    test_mat_size(c(1, 1),maxtotni,'maxtotni')
    test_mat_size(c(1, 1),mintotni,'mintotni')    
    ret <- comp_max_min(maxtotni,mintotni,called_args)
    maxtotni <- ret$max_val
    mintotni <- ret$min_val   
    if(any(sum(ni)<mintotni)) stop("sum of ni is less than mintotni")
    if(any(sum(ni)>maxtotni)) stop("sum of ni is greater than maxtotni")
    
    
    # update xt and model_switch given maxni
    if(max(maxni)>size(xt,2)){
      
      # xt has to increase
      xt_full <- ones(m,max(maxni))*NA
      xt_full[1:m,1:size(xt,2)] = xt
      rownames(xt_full) <- paste("grp_",1:m,sep="")
      colnames(xt_full) <- paste("obs_",1:(size(xt_full,2)),sep="") 
      xt <- xt_full
      design_new$xt <- xt
      
      # model switch has to increase
      model_switch_full <- ones(m,max(maxni))*NA
      model_switch_full[1:m,1:size(model_switch,2)] = model_switch
      rownames(model_switch_full) <- paste("grp_",1:m,sep="")
      colnames(model_switch_full) <- paste("obs_",1:(size(model_switch_full,2)),sep="") 
      model_switch <- model_switch_full            
      for(i in 1:size(model_switch,1)){
        x_tmp <- model_switch[i,]
        if(length(unique(x_tmp[!is.na(x_tmp)]))==1){
          x_tmp[is.na(x_tmp)]=unique(x_tmp[!is.na(x_tmp)])
        } else {
          stop("Unable to determine the model_switch values needed for group ", i,
               "\n Please supply them as input.")
        }
        model_switch[i,] <- x_tmp
      }
      design_new$model_switch <- model_switch
    }
    
    #maxgroupsize
    if(size(maxgroupsize,1)==1 && m!=1) maxgroupsize <- matrix(rep(maxgroupsize,m),ncol=1,nrow=m,byrow=T,
                                                               dimnames=list(paste("grp_",1:m,sep=""),NULL))
    if(!is.matrix(maxgroupsize)) maxgroupsize <- cbind(maxgroupsize)
    if((test_mat_size(c(m, 1),maxgroupsize,'maxgroupsize')==1)){
      rownames(maxgroupsize) <- paste("grp_",1:m,sep="")
      colnames(maxgroupsize) <- paste("n_id")
    }
    
    #mingroupsize
    if(size(mingroupsize,1)==1 && m!=1) mingroupsize <- matrix(rep(mingroupsize,m),ncol=1,nrow=m,byrow=T,
                                                               dimnames=list(paste("grp_",1:m,sep=""),NULL))
    if(!is.matrix(mingroupsize)) mingroupsize <- cbind(mingroupsize)
    if((test_mat_size(c(m, 1),mingroupsize,'mingroupsize')==1)){
      rownames(mingroupsize) <- paste("grp_",1:m,sep="")
      colnames(mingroupsize) <- paste("n_id")
    }
    
    # make sure min is less than max
    ret <- comp_max_min(maxgroupsize,mingroupsize,called_args)
    maxgroupsize <- ret$max_val
    mingroupsize <- ret$min_val    
    
    # check  given max and min
    if(any(groupsize<mingroupsize)) stop("groupsize is less than mingroupsize")
    if(any(groupsize>maxgroupsize)) stop("groupsize is greater than maxgroupsize")
    
    #maxtotgroupsize
    if(is.null(maxtotgroupsize)) maxtotgroupsize <- sum(groupsize)
    
    #mintotgroupsize
    if(is.null(mintotgroupsize)) mintotgroupsize <- sum(mingroupsize)
    
    # make sure min is less than max
    ret <- comp_max_min(maxtotgroupsize,mintotgroupsize,called_args)
    maxtotgroupsize <- ret$max_val
    mintotgroupsize <- ret$min_val   
    
    # check  given max and min
    if(any(sum(groupsize)<mintotgroupsize)) stop("sum of groupsizes is less than mintotgroupsize")
    if(any(sum(groupsize)>maxtotgroupsize)) stop("sum of groupsizes is greater than maxtotgroupsize")
    
    
    # maxxt and minxt    
    if(length(maxxt)==1) maxxt=ones(size(xt,1),size(xt,2))*maxxt
    if(is.list(maxxt)) maxxt <- t(sapply(maxxt,'[',seq(max(sapply(maxxt,length)))))
    if(size(maxxt,1)==1 && m!=1) maxxt <- matrix(rep(maxxt,m),ncol=length(maxxt),nrow=m,byrow=T)
    if(!is.matrix(maxxt)) maxxt <- rbind(maxxt)
    if(size(maxxt,1)!=m){
      stop("The number of rows in maxxt (", 
           size(maxxt,1), 
           ") is not the same as the number of groups m (", m,")")  
    } 
    if(size(maxxt,2)==max(ni) && max(maxni)>max(ni) && size(xt,2)==max(maxni)){
      maxxt_full <- xt
      maxxt_full[,1:max(ni)] <- maxxt
      maxxt <- maxxt_full
    }
    if((test_mat_size(size(xt),maxxt,'maxxt')==1)){
      rownames(maxxt) <- paste("grp_",1:m,sep="")
      colnames(maxxt) <- paste("obs_",1:(size(maxxt,2)),sep="")
    }
    
    
    if(length(minxt)==1) minxt=ones(size(xt,1),size(xt,2))*minxt
    if(is.list(minxt)) minxt <- t(sapply(minxt,'[',seq(max(sapply(minxt,length)))))
    if(size(minxt,1)==1 && m!=1) minxt <- matrix(rep(minxt,m),ncol=length(minxt),nrow=m,byrow=T)
    if(!is.matrix(minxt)) minxt <- rbind(minxt)
    if(size(minxt,1)!=m) stop("The number of rows in minxt (", size(minxt,1), ") is not the same as the number of groups m (", m,")")
    if(size(minxt,2)==max(ni) && max(maxni)>max(ni) && size(xt,2)==max(maxni)){
      minxt_full <- xt
      minxt_full[,1:max(ni)] <- minxt
      minxt <- minxt_full
    }
    if((test_mat_size(size(xt),minxt,'minxt')==1)){
      rownames(minxt) <- paste("grp_",1:m,sep="")
      colnames(minxt) <- paste("obs_",1:(size(minxt,2)),sep="")
    }
    
    # make sure min is less than max
    ret <- comp_max_min(maxxt,minxt,called_args)
    maxxt <- ret$max_val
    minxt <- ret$min_val   
    
    # check for zeros
    if(!is.null(our_zero)){
      minxt = minxt + our_zero*(minxt == 0)
      maxxt = maxxt + our_zero*(maxxt == 0)
      xt = xt + our_zero*(xt == 0)
    }
    
    # check  given max and min
    if(any(xt<minxt,na.rm = T)) stop("xt is less than minxt")
    if(any(xt>maxxt,na.rm = T)) stop("xt is greater than maxxt")
    
    # need to decide on appripriate values of xt and minxt and maxxt if applicable
    if(any(maxni>ni) && any(is.na(xt))){
      for(grp in 1:m){
        xt_grp <- xt[grp,]
        maxxt_grp <- maxxt[grp,]
        minxt_grp <- minxt[grp,]
        if(any(is.na(maxxt_grp))){
          max_vals <- unique(maxxt_grp[!is.na(maxxt_grp)])
          if(length(max_vals)==1){ 
            maxxt_grp[is.na(maxxt_grp)] <- max_vals
          } else {
            stop("Unable to determine the maxxt values needed for group ", grp,
                 "\n if ni increases with optimization \nPlease supply them as input.")
          }
        }
        if(any(is.na(minxt_grp))){
          min_vals <- unique(minxt_grp[!is.na(minxt_grp)])
          if(length(min_vals)==1){ 
            minxt_grp[is.na(minxt_grp)] <- min_vals
          } else {
            stop("Unable to determine the minxt values needed for group ", grp,
                 "\n if ni increases with optimization \nPlease supply them as input.")
          }
        }
        if(any(is.na(xt_grp))){
          max_vals <- unique(maxxt_grp[!is.na(maxxt_grp)])
          min_vals <- unique(minxt_grp[!is.na(minxt_grp)])
          one_max <- length(max_vals)==1
          one_min <- length(min_vals)==1
          if(one_max && one_min) xt_grp[is.na(xt_grp)] <- mean(c(max_vals,min_vals))
          if(one_max && !one_min) xt_grp[is.na(xt_grp)] <- max_vals
          if(!one_max && one_min) xt_grp[is.na(xt_grp)] <- min_vals
          if(!one_max && !one_min) stop("Unable to determine the initial xt values needed for group ", grp,
                                        "\n if ni increases with optimization \nPlease supply them as input.")
        }
        xt[grp,] <- xt_grp
        maxxt[grp,] <- maxxt_grp
        minxt[grp,] <- minxt_grp
      }
      design_new$xt <- xt
    }
    
    
    ## for a ---------
    if(!is.null(maxa)){
      if(is.list(maxa)){
        #if(packageVersion("dplyr") >= "0.5.0"){
        maxa <- as.matrix(dplyr::bind_rows(lapply(maxa,function(x){data.frame(rbind(unlist(x)))})))
        #} else {
        #  maxa <- as.matrix(dplyr::rbind_all(lapply(maxa,function(x){data.frame(rbind(unlist(x)))})))
        #}
      }
      if(size(maxa,1)==1 && m!=1) maxa <- matrix(rep(maxa,m),ncol=length(maxa),nrow=m,byrow=T)
      if(!is.matrix(maxa)) maxa  <- rbind(maxa)
      if(size(maxa,1)!=m) stop("The number of rows in maxa (", size(maxa,1), ") is not the same as the number of groups m (", m,")")
      rownames(maxa) <- paste("grp_",1:m,sep="")
      if(is.null(colnames(maxa))) colnames(maxa) <- colnames(a)
      design_space$maxa <- maxa
    }
    
    if(!is.null(mina)){
      if(is.list(mina)){
        #if(packageVersion("dplyr") >= "0.5.0"){
        mina <- as.matrix(dplyr::bind_rows(lapply(mina,function(x){data.frame(rbind(unlist(x)))})))
        #} else {
        #  mina <- as.matrix(dplyr::rbind_all(lapply(mina,function(x){data.frame(rbind(unlist(x)))})))
        #}
      }
      if(size(mina,1)==1 && m!=1) mina <- matrix(rep(mina,m),ncol=length(mina),nrow=m,byrow=T)
      if(!is.matrix(mina)) mina  <- rbind(mina)
      if(size(mina,1)!=m) stop("The number of rows in mina (", size(mina,1), ") is not the same as the number of groups m (", m,")")
      rownames(mina) <- paste("grp_",1:m,sep="")
      if(is.null(colnames(mina))) colnames(mina) <- colnames(a)
      design_space$mina <- mina
    }
    
    # make sure max is min smaller than max
    if(!is.null(mina) && !is.null(maxa)){
      ret <- comp_max_min(maxa,mina,called_args)
      maxa <- ret$max_val
      mina <- ret$min_val
    }
    
    # check ni given max and min
    if(!is.null(mina) && !is.null(maxa) && !is.null(a)){
      if(any(a<mina)) stop("a is less than mina")
      if(any(a>maxa)) stop("a is greater than maxa")
    }    
    
    
    
    ## for x ----------
    if(is.null(x_space) && exists("x",inherits = F)){
      x_space <- cell(size(x))
      for(i in 1:size(x,1)){
        for(j in 1:size(x,2)){
          x_space[i,j] <- list(x[i,j]) 
        }
      }
    }
    if(!is.null(x_space)){
      #       if(is.list(x_space)) x_space <- as.matrix(dplyr::rbind_all(lapply(x_space,function(x){data.frame(rbind(unlist(x)))})))
      if(size(x_space,1)==1 && m!=1) x_space <- matrix(rep(x_space,m),ncol=length(x_space),nrow=m,byrow=T)
      #       if(!is.matrix(x_space)) x_space  <- rbind(x_space)
      if((test_mat_size(size(x),x_space,'x_space')==1)){
        rownames(x_space) <- paste("grp_",1:m,sep="")
        colnames(x_space) <- colnames(x)
      }
      design_space$x_space <- x_space
      
      
      for(i in 1:size(x,1)){
        for(j in 1:size(x,2)){
          if(!(x[i,j] %in% x_space[[i,j]])) stop("x value for group ",i," (column ",j,") is not in the design space") 
        }
      }
    }
    
    ## for xt_space
    if(!is.null(xt_space)){
      if(is.null(dim(xt_space))){ # then we have a vector or a list
        if(is.list(xt_space)){ 
          # then it is a list with no dimensions
          # need to convert to a cell
          nspace <- length(xt_space)
          nrow_xt <- nrow(xt)
          ncol_xt <- ncol(xt)
          if(nspace==1){ # all time points in all groups have the same space
            xt_space_tmp <- xt_space
            xt_space <- cell(size(xt))
            xt_space[,] <- xt_space_tmp
          } else if(nspace==ncol_xt){ # we assume that all groups have the same space
            xt_space_tmp <- xt_space
            xt_space <- cell(size(xt))
            for (ii in 1:nrow_xt) xt_space[ii,] <- xt_space_tmp
          } else if(nspace==(ncol_xt*nrow_xt)){ # we assume that spaces are entered in row major form
            xt_space_tmp <- xt_space
            xt_space <- matrix(xt_space_tmp,ncol = nrow_xt, byrow = T)
          }
        } else { # assume the vector is the same for all xt's
          tmp_lst <- list(xt_space)
          xt_space <- cell(size(xt))
          xt_space[,] <- tmp_lst
        }
      }
      #       if(is.list(x_space)) x_space <- as.matrix(dplyr::rbind_all(lapply(x_space,function(x){data.frame(rbind(unlist(x)))})))
      if(size(xt_space,1)==1 && m!=1) xt_space <- matrix(rep(xt_space,m),ncol=length(xt_space),nrow=m,byrow=T)
      if(size(xt_space,2)==1 && size(xt,2)!=1) xt_space <- matrix(rep(xt_space,size(xt,2)),ncol=size(xt,2),nrow=m,byrow=F)
      #       if(!is.matrix(x_space)) x_space  <- rbind(x_space)
      if((test_mat_size(size(xt),xt_space,'xt_space')==1)){
        rownames(xt_space) <- paste("grp_",1:m,sep="")
        colnames(xt_space) <- colnames(xt)
      }
      
      for(i in 1:size(xt,1)){
        for(j in 1:size(xt,2)){
          if(!(xt[i,j] %in% xt_space[[i,j]]) && !is.na(xt[i,j])) stop("xt value for group ",i," (column ",j,") is not in the design space") 
        }
      }
    }
    
    ## for a_space
    if(!is.null(a_space)){
      if(is.null(dim(a_space)) && is.list(a_space)){
        if(!is.list(unlist(a_space, recursive = F))){ # only one set of values
          a_space <- matrix(rep(a_space,m),ncol=length(a_space),nrow=m,byrow=T)
        } else {
          tmp_lst <- lapply(a_space,function(x){matrix(x,ncol=length(x),nrow=1,byrow=T,dimnames = list(NULL,names(x)))})
          mat <- NULL
          for(jj in 1:length(tmp_lst)){
            tmp <- tmp_lst[[jj]]
            if(!is.null(colnames(tmp)) && !is.null(colnames(a))) tmp <- tmp[, colnames(a)]
            mat <- rbind(mat,tmp)
          }
          a_space <- mat
        }
      }
      #       if(is.list(x_space)) x_space <- dplyr::bind_rows(lapply(a_space,function(x){data.frame(rbind(unlist(x)))}))
      # browser()
      # a_space
      # str(a_space)
      # tmp <- list(a_space,a_space)
      # str(tmp)
      # 
      # a_tmp =c(DOSE=100,TAU=24)
      # dplyr::bind_rows(list(a_tmp))
      # as.matrix(dplyr::bind_rows(lapply(a_tmp,function(x){data.frame(rbind(unlist(x,recursive = FALSE)))})))
      # 
      # if(is.list(a_space)){
      #   #plyr::rbind.fill.matrix(t(a[[1]]),t(a[[2]]))
      #   #a <- t(sapply(a,'[',seq(max(sapply(a,length)))))
      #   #all_cov_names <- unique(unlist(sapply(a,names)))
      #   
      #   #a <- as.matrix(plyr::rbind.fill(lapply(a,function(x){data.frame(rbind(unlist(x)))})))
      #   if(packageVersion("dplyr") >= "0.5.0"){
      #     a <- 
      #       as.matrix(dplyr::bind_rows(lapply(a_space,function(x){data.frame(rbind(unlist(x,recursive = FALSE)))})))
      #   } else {
      #     a <- as.matrix(dplyr::rbind_all(lapply(a,function(x){data.frame(rbind(unlist(x)))})))
      #   }
      # }
      if(size(a_space,1)==1 && m!=1) a_space <- matrix(rep(a_space,m),ncol=length(a_space),nrow=m,byrow=T)
      if(size(a_space,2)==1 && size(a,2)!=1) a_space <- matrix(rep(a_space,size(a,2)),ncol=size(a,2),nrow=m,byrow=F)
      #       if(!is.matrix(x_space)) x_space  <- rbind(x_space)
      if((test_mat_size(size(a),a_space,'a_space')==1)){
        if(is.null(dim(a_space)) && all(size(a_space)==1)) a_space <- matrix(a_space)
        rownames(a_space) <- paste("grp_",1:m,sep="")
        colnames(a_space) <- colnames(a)
      }
      
      for(i in 1:size(a,1)){
        for(j in 1:size(a,2)){
          if(!(a[i,j] %in% a_space[[i,j]]) && !is.na(a[i,j])) stop("a value for group ",i," (column ",j,") is not in the design space") 
        }
      }
    }
    
    # grouped_xt ------------------------
    if(is.null(grouped_xt)){
      grouped_xt <- xt*NA
      val <- 1
      for(i in 1:size(xt,1)){
        if(use_grouped_xt) val <- 1
        for(j in 1:size(xt,2)){
          if(!is.na(xt[i,j])){ 
            grouped_xt[i,j] <- val
            val <- val+1
          }
        }
      }
    }
    if(length(grouped_xt)==1){
      grouped_xt=ones(size(xt,1),size(xt,2))*grouped_xt
      use_grouped_xt <- TRUE
    } 
    if(is.list(grouped_xt)) grouped_xt <- t(sapply(grouped_xt,'[',seq(max(sapply(grouped_xt,length)))))
    if(size(grouped_xt,1)==1 && m!=1){ 
      grouped_xt <- matrix(rep(grouped_xt,m),ncol=length(grouped_xt),nrow=m,byrow=T)
      use_grouped_xt <- TRUE
    }
    if(!is.matrix(grouped_xt)) grouped_xt <- rbind(grouped_xt)
    if(size(grouped_xt,2)==max(ni) && max(maxni)>max(ni) && size(xt,2)==max(maxni)){
      grouped_xt_full <- xt*NA
      grouped_xt_full[,1:max(ni)] <- grouped_xt
      #       if( !(grouped_xt  %in% names(called_args))){ 
      #         grouped_xt_full <- matrix(seq(1,length(xt),len=length(xt)),size(xt,1),size(xt,2),byrow=T)
      #       }
      grouped_xt <- grouped_xt_full
    }
    if((test_mat_size(size(xt),grouped_xt,'grouped_xt')==1)){
      rownames(grouped_xt) <- paste("grp_",1:m,sep="")
      colnames(grouped_xt) <- paste("obs_",1:(size(grouped_xt,2)),sep="")
    }
    
    ## get values in the NA region if possible
    if(any(maxni>ni) && any(is.na(grouped_xt))){
      for(grp in 1:m){
        grouped_xt_grp <- grouped_xt[grp,]
        if(any(is.na(grouped_xt_grp))){
          vals <- unique(grouped_xt_grp[!is.na(grouped_xt_grp)])
          if(length(vals)==1){ 
            grouped_xt_grp[is.na(grouped_xt_grp)] <- vals
          } else {
            stop("Unable to determine the grouped_xt values needed for group ", grp,
                 "\n if ni increases with optimization \nPlease supply them as input.")
          }
        }
        grouped_xt[grp,] <- grouped_xt_grp
      }
    }
    
    for(i in unique(grouped_xt[!is.na(xt)])){
      if(length(unique(xt[grouped_xt==i & !is.na(xt)]))!=1){
        stop(sprintf('xt values grouped with value %g from grouped_xt do not have the same initial values.\n',i)) 
      }   
      if(length(unique(maxxt[grouped_xt==i & !is.na(xt)]))!=1){
        stop(sprintf('xt values grouped with value %g from grouped_xt do not have the same maximum allowed values (maxxt).\n',i)) 
      }   
      if(length(unique(minxt[grouped_xt==i & !is.na(xt)]))!=1){
        stop(sprintf('xt values grouped with value %g from grouped_xt do not have the same minimum allowed values (minxt).\n',i)) 
      } 
      grouped_cells_xt <- xt_space[grouped_xt==i & !is.na(xt)]
      for(j in 1:length(grouped_cells_xt)){
        for(k in j:length(grouped_cells_xt)){
          if(any(size(grouped_cells_xt[[j]])!=size(grouped_cells_xt[[k]])) || any(grouped_cells_xt[[j]]!=grouped_cells_xt[[k]])){ 
            stop(sprintf('xt values grouped with value %g from grouped_xt do not have the same allowed discrete values (xt_space).\n',i))
          }
        }
      }
    }  
    
    for(i in 1:max(unique(grouped_xt[!is.na(xt)]))){
      if(length(unique(xt[grouped_xt==i & !is.na(xt)]))==0){
        stop(sprintf('grouped_xt must be sequential and cannot have missing values. 
                     \nNo xt values were grouped with value %g in grouped_xt.\n',i)) 
      }   
    }  
    
    # grouped_a ------------------------
    if(exists("a",inherits = F)){
      if(is.null(grouped_a)){
        grouped_a <- a*NA
        val <- 1
        for(i in 1:size(a,1)){
          if(use_grouped_a) val <- 1
          for(j in 1:size(a,2)){
            if(!is.na(a[i,j])){ 
              grouped_a[i,j] <- val
              val <- val+1
            }
          }
        }
      }
      if(length(grouped_a)==1){
        grouped_a=ones(size(a,1),size(a,2))*grouped_a
        #use_grouped_a <- TRUE
      } 
      if(is.list(grouped_a)) grouped_a <- t(sapply(grouped_a,'[',seq(max(sapply(grouped_a,length)))))
      if(size(grouped_a,1)==1 && m!=1){ 
        grouped_a <- matrix(rep(grouped_a,m),ncol=length(grouped_a),nrow=m,byrow=T)
        use_grouped_a <- TRUE
      }
      if(!is.matrix(grouped_a)) grouped_a <- rbind(grouped_a)
      if((test_mat_size(size(a),grouped_a,'grouped_a')==1)){
        rownames(grouped_a) <- paste("grp_",1:m,sep="")
        if(is.null(colnames(grouped_a))) colnames(grouped_a) <- colnames(a)  
      }
      
      for(i in unique(grouped_a[!is.na(a)])){
        if(length(unique(a[grouped_a==i & !is.na(a)]))!=1){
          stop(sprintf('a values grouped with value %g from grouped_a do not have the same initial values.\n',i)) 
        }  
        if(length(unique(maxa[grouped_a==i & !is.na(a)]))!=1){
          stop(sprintf('a values grouped with value %g from grouped_a do not have the same maximum allowed values (maxa).\n',i)) 
        }  
        if(length(unique(mina[grouped_a==i & !is.na(a)]))!=1){
          stop(sprintf('a values grouped with value %g from grouped_a do not have the same minimum allowed values (mina).\n',i)) 
        } 
        grouped_cells_a <- a_space[grouped_a==i & !is.na(a)]
        for(j in 1:length(grouped_cells_a)){
          for(k in j:length(grouped_cells_a)){
            if(any(size(grouped_cells_a[[j]])!=size(grouped_cells_a[[k]])) || any(grouped_cells_a[[j]]!=grouped_cells_a[[k]])){ 
              stop(sprintf('a values grouped with value %g from grouped_a do not have the same allowed discrete values (a_space).\n',i))
            }
          }
        }
      }  
      
      for(i in 1:max(unique(grouped_a[!is.na(a)]))){
        if(length(unique(a[grouped_a==i & !is.na(a)]))==0){
          stop(sprintf('grouped_a must be sequential and cannot have missing values. 
                     \nNo a values were grouped with value %g in grouped_a.\n',i)) 
        }   
      } 
      
      design_space$grouped_a <- grouped_a
      design_space$use_grouped_a <- use_grouped_a
      
    }
    
    # grouped_x ------------------------
    if(exists("x",inherits = F)){
      if(is.null(grouped_x)){
        grouped_x <- x*NA
        val <- 1
        for(i in 1:size(x,1)){
          if(use_grouped_x) val <- 1
          for(j in 1:size(x,2)){
            if(!is.na(x[i,j])){ 
              grouped_x[i,j] <- val
              val <- val+1
            }
          }
        }
      }
      if(length(grouped_x)==1){
        grouped_x=ones(size(x,1),size(x,2))*grouped_x
        #use_grouped_x <- TRUE
      } 
      if(is.list(grouped_x)) grouped_x <- t(sapply(grouped_x,'[',seq(max(sapply(grouped_x,length)))))
      if(size(grouped_x,1)==1 && m!=1){ 
        grouped_x <- matrix(rep(grouped_x,m),ncol=length(grouped_x),nrow=m,byrow=T)
        use_grouped_x <- TRUE
      }
      if(!is.matrix(grouped_x)) grouped_x <- rbind(grouped_x)
      if((test_mat_size(size(x),grouped_x,'grouped_x')==1)){
        rownames(grouped_x) <- paste("grp_",1:m,sep="")
        if(is.null(colnames(grouped_x))) colnames(grouped_x) <- colnames(x)  
      }
      
      for(i in unique(grouped_x[!is.na(x)])){
        if(length(unique(x[grouped_x==i & !is.na(x)]))!=1){
          stop(sprintf('x values grouped with value %g from grouped_x do not have the same initial values.\n',i)) 
        } 
        grouped_cells <- x_space[grouped_x==i & !is.na(x)]
        for(j in 1:length(grouped_cells)){
          for(k in j:length(grouped_cells)){
            if(any(size(grouped_cells[[j]])!=size(grouped_cells[[k]])) || any(grouped_cells[[j]]!=grouped_cells[[k]])){ 
              stop(sprintf('x values grouped with value %g from grouped_x do not have the same allowed discrete values (x_space).\n',i))
            }
          }
        }
      }  
      
      for(i in 1:max(unique(grouped_x[!is.na(x)]))){
        if(length(unique(x[grouped_x==i & !is.na(x)]))==0){
          stop(sprintf('grouped_x must be sequential and cannot have missing values. 
                       \nNo x values were grouped with value %g in grouped_x.\n',i)) 
        }   
      } 
      
      design_space$grouped_x <- grouped_x
      design_space$use_grouped_x <- use_grouped_x
      
    }
    ## rules:
    # 1. set default if not already defined
    # 2. read in value and translate to correct format
    # 3. check that size of object is correct
    # 4. add row and column names
    # 4. check that max is greater than min
    # 5. check that design value is wihin range of design_space
    
    design_space$maxni <- maxni
    design_space$minni <- minni
    
    design_space$maxtotni <- maxtotni
    design_space$mintotni <- mintotni
    
    design_space$maxgroupsize <- maxgroupsize
    design_space$mingroupsize <- mingroupsize
    
    design_space$maxtotgroupsize <- maxtotgroupsize
    design_space$mintotgroupsize <- mintotgroupsize
    
    design_space$maxxt <- maxxt
    design_space$minxt <- minxt
    design_space$xt_space <- xt_space
    
    design_space$grouped_xt <- grouped_xt
    design_space$use_grouped_xt <- use_grouped_xt
    
    design_space$a_space <- a_space
    
    # update max and min of a and xt if imputed and discrete
    if(maxa_imputed && !is.null(a_space)){
      for(i in 1:nrow(a_space)){
        for(j in 1:ncol(a_space) ){
          maxa[i,j] <- max(a_space[i,j][[1]])
        }
      }
    }
    if(mina_imputed && !is.null(a_space)){
      for(i in 1:nrow(a_space)){
        for(j in 1:ncol(a_space) ){
          mina[i,j] <- min(a_space[i,j][[1]])
        }
      }
    }
    design_space$maxa <- maxa
    design_space$mina <- mina
    
    if(maxxt_imputed && !is.null(xt_space)){
      for(i in 1:nrow(xt_space)){
        for(j in 1:ncol(xt_space) ){
          maxxt[i,j] <- max(xt_space[i,j][[1]])
        }
      }
    }
    if(minxt_imputed && !is.null(xt_space)){
      for(i in 1:nrow(xt_space)){
        for(j in 1:ncol(xt_space) ){
          minxt[i,j] <- min(xt_space[i,j][[1]])
        }
      }
    }
    design_space$maxxt <- maxxt
    design_space$minxt <- minxt
    
    return(list(design=design_new,design_space=design_space)) 
  }) # end with(design,{})
}