R/rrepast-helper.R

Defines functions col.sum pick.fittest Calibration.GetMemberList Calibration.GetMemberKeys dfround dffilterby dfsumcol df2matrix SequenceItem

Documented in Calibration.GetMemberKeys Calibration.GetMemberList col.sum df2matrix dffilterby dfround dfsumcol pick.fittest SequenceItem

##================================================================================
## This file is part of the R/Repast package - R/Repast
##
## (C)2016, 2017 Antonio Prestes Garcia <@>
## For license terms see DESCRIPTION and/or LICENSE
##
## @file: rrepast-helper.R
##
## This file contains helper functions
##================================================================================


#' @title SequenceItem
#'
#' @description Generate a sequence from min to max using an increment
#' based on the number of of elements in v
#'
#' @param v A column of n x k design matrix
#' @param min The lower boundary of range
#' @param max The uper boundary of range
#'
#' @return A sequence between min and max value
#'
#' @export
SequenceItem<- function(v,min,max) {
  n<- length(v)
  delta<- (max-min)/(n-1)
  return(seq(min,max,delta))
}

#' @title df2matrix
#'
#' @description This function converts data frames to matrix data type.
#'
#' @param d The data frame
#' @param n The column names to be converted. Null for all data frame columns
#'
#' @return The data frame converted to a matrix
#'
#' @export
df2matrix<- function(d,n=c()) {
  if(length(n) == 0) {
    n<- names(d)
  }
  m<- c()
  for(k in n) {
    m<- cbind(m,as.matrix(d[,k]))
  }
  colnames(m)<- n
  return(m)
}

#' @title dfsumcol
#'
#' @description Sum data frame columns but tho
#'
#' @param d The data frame
#' @param lst Skip columns included. Sum columns NOT included
#' @param invert Sum only the columns included in \code{lst}
#'
#' @return The original data frame with a new column (sum) holding the sum
#'
#' @export
dfsumcol<- function(d,lst=c(),invert=FALSE) {
  v<- as.data.frame(d)
  s<- NULL
  
  op<- "!"
  if(invert) {
    identity<- function(x) {x}
    op<- "identity"
  }
  
  for(key in colnames(v)) {
    if(match.fun(FUN=op)(toupper(key) %in% toupper(lst))) {
      if(is.null(s)){
        s<- v[, key]
      } else {
        s<- s + v[, key]
      }
    }
  }
  v$total<- s
  
  ## Return the same type of original data
  if(is.matrix(d)) {
    v<- as.matrix(v)
  }
  
  return(v)
}

#' @title dffilterby
#'
#' @description Selects a subset of a data frame, filtering by
#' column values.
#'
#' @param d The data frame holding data to be filtered
#' @param key The column name for selection valuas
#' @param values The collection of values used to filter the data set
#'
#' @return The filtered data set
#'
#' @export
dffilterby<- function(d, key, values=c()) {
  d<- as.data.frame(d)
  
  o<- c()
  for(v in values) {
    o<- rbind(o,d[d[,colnames(d) == key] %in% v,])
  }
  return(o)
}

#' @title dfround
#'
#' @description Round all numeric columns of a data frame
#'
#' @param d The data frame
#' @param p The number of decimal digits to be keept
#'
#' @return A data frame with rounded columns
#'
#' @export
dfround<- function(d, p) {
  return(sapply(d[,sapply(d,is.numeric)],round,digits=p))
}

#' @title Calibration.GetMemberKeys
#'
#' @description Gets the list of keys (the factor names)
#'
#' @param obj An instance of the object returned by \code{Easy} methods
#'
#' @return The collection of keys
#' @export
Calibration.GetMemberKeys<- function(obj) {
  if(!"variable" %in% colnames(obj)) {
    stop("Not an instance of a Easy.Calibration return!")
  }
  unlist(obj[,"variable"])
}

#' @title Calibration.GetMemberList
#'
#' @description Gets the member list value
#'
#' @param obj An instance of the object returned by \code{Easy} methods
#' @param key The key value
#' @param name The column name
#'
#' @return The member list
#' @export
Calibration.GetMemberList<- function(obj, key, name) {
  if(!"variable" %in% colnames(obj)) {
    stop("Not an instance of a Easy.Calibration return!")
  }
  obj[(obj[,"variable"] == key),name][[1]]
}


#' @title pick.fittest
#'
#' @description Choose the best solutions minimizing the objective function
#'
#' @param out The output data set holding the values of goals
#' @param goals The column names which must be used as goal
#' @param n The number of solutions
#'
#' @return The n rows holding the best results
#'
#' @export
pick.fittest<- function(out, goals=c(), n=4) {
  out<- as.data.frame(out)
  
  ## -- Check if out was generated by RunExperiment
  if(!"pset" %in% colnames(out)) {
    stop("Invalid data set!")
  }
  
  ## --- Adjusting defaults
  n<- ifelse(n > nrow(out),nrow(out),n)
  goals<- ifelse(length(goals) == 0,c(2),goals)
  
  out<- out[order(out[,goals]), ]
  return(out[1:n,])
}

#' @title col.sum
#'
#' @description Sum all columns but one (pset) of a data frame
#'
#' @param d The data frame
#' @param skip The columns which should not be included in the sum
#'
#' @return The original data frame with a new column (sum) holding the sum
#'
#' @export
col.sum<- function(d,skip=c()) {
  v<- as.data.frame(d)
  s<- NULL
  
  ## -- always skip pset
  if(!"pset" %in% skip) {
    skip<- c("pset",skip)
  }
  
  ## -- always skip total
  if(!"total" %in% skip) {
    skip<- c("total",skip)
  }
  
  v<- dfsumcol(v,skip)
  
  return(v)
}

Try the rrepast package in your browser

Any scripts or data that you put into this service are public.

rrepast documentation built on May 29, 2017, 8:47 p.m.