statsailr_procs_base 0.1.0

data/lib/statsailr_procs_base/proc_setting/proc_common/factor.rb

@@ -0,0 +1,15 @@
+module FactorSetting
+  include ProcSettingModule
+  source_r_file(__dir__, File.basename(__FILE__ , ".rb") + ".R")
+
+  def setting_for_factor( setting )
+    setting.libname = nil
+    setting.envname = "sts_factor"
+    setting.func_name = "convert_to_factor"
+    setting.main_arg_and_how_to_treat = ["vars", :read_symbols_as_strvec, :no_nil ]
+    setting.runtime_args = {"data" => one_from( result("factor", "numeric"), param("data")) }
+    setting.store_result = true
+    setting.print_opt = false
+  end
+end
+

data/lib/statsailr_procs_base/proc_setting/proc_common/numeric.R

@@ -0,0 +1,7 @@
+sts_numeric = new.env()
+
+sts_numeric$convert_to_numeric = function( data, vars ){
+  data[vars] = lapply(data[vars], as.numeric)
+  print( paste( "as.numeric is applied to", paste( vars, collapse=",") , sep=" ") )
+  return( data )
+}

data/lib/statsailr_procs_base/proc_setting/proc_common/numeric.rb

@@ -0,0 +1,15 @@
+module NumericSetting
+  include ProcSettingModule
+  source_r_file(__dir__, File.basename(__FILE__ , ".rb") + ".R")
+
+  def setting_for_factor( setting )
+    setting.libname = nil
+    setting.envname = "sts_numeric"
+    setting.func_name = "convert_to_numeric"
+    setting.main_arg_and_how_to_treat = ["vars", :read_symbols_as_strvec, :no_nil ]
+    setting.runtime_args = {"data" => one_from( result("factor", "numeric"), param("data")) }
+    setting.store_result = true
+    setting.print_opt = false
+  end
+end
+

data/lib/statsailr_procs_base/proc_setting/proc_mult.R

@@ -0,0 +1,12 @@
+sts_mult = new.env()
+
+sts_mult$p_adjust = function( x , method ){
+  ori_p = summary(x)[[1]][['Pr(>F)']]
+  result = p.adjust( ori_p, method )
+
+  cat( "p adjustment\n" )
+  cat( paste( "Method:", method, "\n", sep=" ", collapse=" " ) )
+  return(result)
+}
+
+

data/lib/statsailr_procs_base/proc_setting/proc_mult.rb

@@ -0,0 +1,35 @@
+module ProcMult
+  include ProcSettingModule
+
+  source_r_file(__dir__, File.basename(__FILE__ , ".rb") + ".R")
+  validate_option("data", is_a: ["SymbolR", "String"], as: "SymbolR" , required: true)
+
+  def setting_for_aov( setting )
+    setting.libname = "stats"
+    setting.func_name = "aov"
+    setting.main_arg_and_how_to_treat = [ "formula" , :read_as_formula, :no_nil]
+    setting.runtime_args = {"data" => param("data")}
+    setting.store_result = true
+    setting.print_opt = "summary"
+  end
+
+  def setting_for_tukey( setting )
+    setting.libname = "stats"
+    setting.func_name = "TukeyHSD"
+    setting.main_arg_and_how_to_treat = nil
+    setting.runtime_args = {"x" => result("aov")}
+    setting.store_result = false
+    setting.print_opt = true
+  end
+
+  def setting_for_p_adjust( setting )
+    setting.libname = nil
+    setting.envname = "sts_mult"
+    setting.func_name = "p_adjust"
+    setting.main_arg_and_how_to_treat = [ "method" , :read_as_strvec, :no_nil]
+    setting.runtime_args = {"x" => result("aov")}
+    setting.store_result = true
+    setting.print_opt = true
+  end
+end
+

data/lib/statsailr_procs_base/proc_setting/proc_plot.R

@@ -0,0 +1,52 @@
+sts_plot = new.env()
+
+sts_plot$legend = function( legend , ... ){
+  if( (! is.character(legend)) ){
+    stop("legend argument requires character vector")
+  }
+
+  args = list(...)
+  args$legend = legend
+  args$x = if_exist_else ( "x", args, paste( "topleft" ))
+
+  do.call( get_pkg_fun( "graphics::legend") , args )
+}
+
+sts_plot$hist = function( data , var , ... ){
+  if( (! is.character(var)) || length(var) != 1 ){
+    stop("vars argument requires character vector with size of 1")
+  }
+
+  args = list(...)
+  args$x = data[[var]]
+  args$main = if_exist_else ( "main", args, paste( "Frequency of" , var ))
+  args$xlab = if_exist_else ( "xlab", args, paste( var ))
+
+  do.call( get_pkg_fun( "graphics::hist") , args )
+}
+
+sts_plot$box = function( data , var , ... ){
+  if( (! is.character(var)) || length(var) != 1 ){
+    stop("vars argument requires character vector with size of 1")
+  }
+
+  args = list(...)
+  args$x = data[[var]]
+  args$main = if_exist_else ( "main", args, paste( var ))
+  args$lex.order = TRUE
+
+  do.call( get_pkg_fun( "graphics::boxplot"), args ) 
+}
+
+sts_plot$scatter = function( data , vars , ... ){
+  if( (! is.character(vars)) || length(vars) != 2 ){
+    stop("vars argument requires character vector with size of 2")
+  }
+
+  args = list(...)
+  args$x = data[vars]
+  args$main = if_exist_else ( "main", args, paste( vars[1], "vs", vars[2] ))
+
+  do.call( get_pkg_fun( "graphics::plot"), args )
+}
+

data/lib/statsailr_procs_base/proc_setting/proc_plot.rb

@@ -0,0 +1,54 @@
+module ProcPlot
+  include ProcSettingModule
+  add_setting_from( __dir__, "proc_common/dev_copy.rb" )
+
+  source_r_file( __dir__, "common_utility.R" )
+  source_r_file( __dir__, File.basename(__FILE__ , ".rb") + ".R")
+  validate_option("data", is_a: ["SymbolR", "String"], as: "SymbolR" , required: true)
+
+ def setting_for_legend( setting )
+    setting.libname = nil
+    setting.envname = "sts_plot"
+    setting.func_name = "legend"
+    setting.main_arg_and_how_to_treat = [ "legend" , :read_as_strvec, :no_nil]
+    setting.runtime_args = nil 
+    setting.store_result = false
+    setting.print_opt = false
+    setting.plot_opt = false
+  end
+
+  def setting_for_hist( setting )
+    setting.libname = nil
+    setting.envname = "sts_plot"
+    setting.func_name = "hist"
+    setting.main_arg_and_how_to_treat = [ "var" , :read_as_strvec, :no_nil]
+    setting.runtime_args = {"data" => param("data") }
+    setting.store_result = false
+    setting.print_opt = false
+    setting.plot_opt = true
+  end
+
+  def setting_for_box( setting )
+    setting.libname = nil
+    setting.envname = "sts_plot"
+    setting.func_name = "box"
+    setting.main_arg_and_how_to_treat = [ "var" , :read_as_strvec, :no_nil]
+    setting.runtime_args = {"data" => param("data")}
+    setting.store_result = false
+    setting.print_opt = false
+    setting.plot_opt = true
+  end
+
+  def setting_for_scatter( setting )
+    setting.libname = nil
+    setting.envname = "sts_plot"
+    setting.func_name = "scatter"
+    setting.main_arg_and_how_to_treat = [ "vars" , :read_as_strvec, :no_nil]
+    setting.runtime_args = {"data" => param("data")}
+    setting.store_result = false
+    setting.print_opt = false
+    setting.plot_opt = true
+  end
+
+end
+

data/lib/statsailr_procs_base/proc_setting/proc_print.R

@@ -0,0 +1,60 @@
+sts_print = new.env()
+
+sts_print$nth = function( x , positions ){
+
+# positions are passed as strvec which is already splitted by spaces and signs
+# group these elements
+
+shift_vec = function( x, n , fill=NA ){
+  if( n == 0 ){
+    return( x )
+  }else if( n > 0 ){
+    return( c( rep(fill, n), head(x, -n)) )
+  }else if( n < 0 ){
+    return( c( tail(x, length(x) + n), rep(fill, -n)) )
+  }else{
+    print("inappropriate n.")
+    return(x)
+  }
+}
+
+colon_pos = (positions == ":")
+colon_after_pos = shift_vec( colon_pos , 1, F )
+group_num = cumsum( !( colon_pos | colon_after_pos) )
+
+position_strvec = sapply( split(positions, group_num) , function(elem){ paste( elem, collapse="" )} )
+names( position_strvec) = position_strvecp
+
+# Convert them to a list of int vectors
+
+position_list = lapply(position_strvec, function(elem){
+  range_sep = ":"
+  if( grepl( range_sep, elem, fixed = TRUE) ){ # grepl(pattern, x)
+    range = strsplit(elem, range_sep, fixed=TRUE)[[1]]
+    if( length(range) != 2){
+      print("Range should be specified with x:y form (meaning from x to y).")
+      return( 0 )
+    }else{
+      range_int = strtoi(range)
+      return( seq(range_int[1], range_int[2]) )
+    }
+  }else{
+    return( strtoi(elem))
+  }
+})
+
+# For each int vector, print corresponding rows
+
+lapply( position_list, function(nth){
+  x[ nth , ]
+})
+
+}
+
+sts_print$random = function( x , n  ){
+  row_num = nrow(x)
+  index = ceiling(row_num * runif(n))
+  sorted_index = sort(index)
+  x[ sorted_index , ]
+}
+

data/lib/statsailr_procs_base/proc_setting/proc_print.rb

@@ -0,0 +1,44 @@
+module ProcPrint  
+  include ProcSettingModule
+
+  source_r_file(__dir__, File.basename(__FILE__ , ".rb") + ".R")
+  validate_option("data", is_a: ["SymbolR", "String"], as: "SymbolR" , required: true)
+
+  def setting_for_head( setting )
+    setting.libname = "utils"
+    setting.func_name = "head"
+    setting.main_arg_and_how_to_treat = [ "n", :read_as_intvec, :allow_nil ]
+    setting.runtime_args = { "x" => param("data")}
+    setting.store_result = true
+    setting.print_opt = true
+  end
+
+  def setting_for_tail( setting )
+    setting.libname = "utils"
+    setting.func_name = "tail"
+    setting.main_arg_and_how_to_treat = [ "n", :read_as_intvec, :allow_nil ]
+    setting.runtime_args = { "x" => param("data") }
+    setting.store_result = true
+    setting.print_opt = true
+  end
+
+  def setting_for_nth( setting )
+    setting.libname = nil
+    setting.envname = "sts_print"
+    setting.func_name = "nth"
+    setting.main_arg_and_how_to_treat = [ "positions", :read_as_strvec, :allow_nil ]
+    setting.runtime_args = { "x" => param("data") }
+    setting.store_result = true
+    setting.print_opt = true
+  end
+
+  def setting_for_random( setting )
+    setting.libname = nil
+    setting.envname = "sts_print"
+    setting.func_name = "random"
+    setting.main_arg_and_how_to_treat = [ "n", :read_as_intvec, :allow_nil ]
+    setting.runtime_args = { "x" => param("data") }
+    setting.store_result = true
+    setting.print_opt = true
+  end
+end

data/lib/statsailr_procs_base/proc_setting/proc_reg.rb

@@ -0,0 +1,17 @@
+module ProcReg
+  include ProcSettingModule
+
+  add_setting_from( __dir__, "proc_common/factor.rb" )
+  validate_option("data", is_a: ["SymbolR", "String"], as: "SymbolR" , required: true)
+
+  def setting_for_lm( setting )
+    setting.libname = "stats"
+    setting.func_name = "lm"
+    setting.main_arg_and_how_to_treat = ["formula", :read_as_formula, :no_nil ]
+    setting.runtime_args = {"data" => one_from( result("factor", "numeric"), param("data")) }
+    setting.store_result = true
+    setting.print_opt = "summary"
+  end
+end
+
+

data/lib/statsailr_procs_base/proc_setting/proc_two.R

@@ -0,0 +1,33 @@
+sts_two = new.env()
+
+sts_two$t_test = function( data , vars , ... ){
+  if( (! is.character(vars)) || length(vars) != 2 ){
+    stop("vars argument requires character vector with size of 2")
+  }
+  x = vars[1]
+  y = vars[2]
+  result = t.test( data[[x]], data[[y]], ... )
+  return(result)
+}
+
+sts_two$paired = function( data , vars , ... ){
+  if( (! is.character(vars)) || length(vars) != 2 ){
+    stop("vars argument requires character vector with size of 2")
+  }
+  x = vars[1]
+  y = vars[2]
+  result = t.test( data[[x]], data[[y]], paired = TRUE, ... )
+  return(result)
+}
+
+sts_two$wilcox_test = function( data , vars , ... ){
+  if( (! is.character(vars)) || length(vars) != 2 ){
+    stop("vars argument requires character vector with size of 2")
+  }
+  x = vars[1]
+  y = vars[2]
+  result = wilcox.test( data[[x]], data[[y]], ... )
+  return(result)
+}
+
+

data/lib/statsailr_procs_base/proc_setting/proc_two.rb

@@ -0,0 +1,38 @@
+module ProcTwo
+  include ProcSettingModule
+
+  source_r_file(__dir__, File.basename(__FILE__ , ".rb") + ".R")
+  validate_option("data", is_a: ["SymbolR", "String"], as: "SymbolR" , required: true)
+
+  def setting_for_t_test( setting )
+    setting.libname = nil
+    setting.envname = "sts_two"
+    setting.func_name = "t_test"
+    setting.main_arg_and_how_to_treat = [ "vars" , :read_as_strvec, :no_nil]
+    setting.runtime_args = {"data" => param("data")}
+    setting.store_result = true
+    setting.print_opt = true
+  end
+
+  def setting_for_paired( setting )
+    setting.libname = nil
+    setting.envname = "sts_two"
+    setting.func_name = "paired"
+    setting.main_arg_and_how_to_treat = [ "vars" , :read_as_strvec, :no_nil]
+    setting.runtime_args = {"data" => param("data")}
+    setting.store_result = true
+    setting.print_opt = true
+  end
+
+  def setting_for_wilcox_test( setting )
+    setting.libname = nil
+    setting.envname = "sts_two"
+    setting.func_name = "wilcox_test"
+    setting.main_arg_and_how_to_treat = [ "vars" , :read_as_strvec, :no_nil]
+    setting.runtime_args = {"data" => param("data")}
+    setting.store_result = true
+    setting.print_opt = true
+  end
+
+end
+

data/lib/statsailr_procs_base/proc_setting/proc_uni.R

@@ -0,0 +1,105 @@
+sts_uni = new.env()
+
+sts_uni$list2str = function ( lst, exclude=c() ){
+  str = ""
+  for( i in seq(1,length(lst))){
+    if (! names(lst)[i] %in% exclude ){
+      key = names(lst)[i]
+      value = lst[[i]]
+
+      if( length( value ) == 1 ){
+        str = paste0( str, key, "\t", value, "\n")
+      }else if( is.null( attr( value, "names"))){
+        str = paste0( str, key, "\t", paste( value , collapse=" ") , "\n")
+      }else{
+        str = paste0( str, key, "\n" )
+        str = paste0( str, paste( mapply( paste0, "\t", names(value), "\t" , value), collapse="\n") , "\n")
+      }
+    }
+  }
+  return( str )
+}
+
+
+sts_uni$var = function( data , vars , hist = FALSE , ... ){
+  if( (! is.character(vars)) || length(vars) == 0 ){
+    stop("vars argument requires character vector")
+  }
+  check_name_existance = vars %in% colnames(data)
+  if( ! all(check_name_existance) ){
+    print( paste( check_name_existance , "\n") )
+    stop("vars argument should be colnames of data")
+  }
+
+  results = list()
+  df = data
+
+  for( var in vars){
+    result = list()
+    result$vec = df[[ var ]]
+
+    result$mean = mean( df[[ var ]] )
+    result$N = length( df[[ var ]] )
+    missing_pos = is.na(df[[ var ]])
+
+    result$missing = sum( missing_pos )
+    result$n = sum( ! missing_pos )
+
+    non_missing = df[[ var ]][! missing_pos]
+
+    quantiles = quantile(non_missing, probs = c(1, 0.99, 0.95, 0.90, 0.75, 0.5, 0.25, 0.1, 0.05, 0.01, 0), na.rm = TRUE)
+    third_quart = quantiles[5]
+    first_quart = quantiles[7]
+    result$max = head(quantiles, 1)
+    result$min = tail(quantiles, 1)
+
+    result$mean = mean(non_missing)
+    result$deviation = sd(non_missing)
+    result$median = median(non_missing)
+    result$IQR = c( first_quart ,third_quart )
+    result$quantiles = quantiles
+
+    # To be implemented
+    # skewness 
+    # kurtosis
+
+    results[[var]] = result
+  }
+
+  result_str = ""
+  result_num = length(results)
+  for( i in seq(1, result_num)){
+    result_str = paste0( result_str, names(results)[i], " ", "statistics\n")
+    result_str = paste0( result_str, sts_uni$list2str(results[[i]], exclude=c("vec")), "\n")
+  }
+
+  # output
+  if( hist ){
+    layout( matrix(seq(1, result_num), ncol = 1))
+    for( i in seq(1,result_num)){
+      hist( results[[ i ]]$vec , main = paste( "Histogram of" , names(results)[i] ), xlab=names(results)[i] )
+    }
+    layout( matrix(c(1), ncol = 1))
+  }
+
+  cat( result_str )  # output is done using cat()
+  return(results)  # return value to be used by other instructions is results
+}
+
+
+sts_uni$qqplot = function( results , var = NULL , qqline = FALSE, ... ){
+  if ( (! is.null(var)) && (length(var) != 1) ){
+    stop("main argument needs to be length of 1 character vector")
+  }
+  if( is.null(var) ){
+    vec = results[[1]]$vec
+  }else{
+    vec = results[[var]]$vec
+  }
+  qqnorm(vec)
+  if( qqline ){
+    qqline(vec)
+  }
+}
+
+