Skip to content
Permalink
Browse files

Massive changes to geneorama

Using R oxygen2 now for documentation
Took out several functions
Added tests and a test suite
Changed imports and dependencies
  • Loading branch information...
geneorama committed Sep 5, 2014
1 parent 3efb11f commit fcf66f556366db697c1cde5f63081b715577ff8c
Showing with 3,652 additions and 1,871 deletions.
  1. +2 −0 .Rbuildignore
  2. +3 −0 .gitignore
  3. +0 −19 .project
  4. +0 −3 .settings/de.walware.r.core.prefs
  5. +9 −11 DESCRIPTION
  6. +2 −0 NAMESPACE
  7. +68 −9 R/NAsummary.R
  8. +107 −27 R/ReadAssign.R
  9. +33 −0 R/TestGeneorama.R
  10. +70 −14 R/addbg.R
  11. +68 −4 R/bgfun.R
  12. +60 −0 R/bs.R
  13. +67 −0 R/bs_withdiv.R
  14. +58 −7 R/clipdir.R
  15. +45 −5 R/clipped.R
  16. +41 −4 R/clipper.R
  17. +38 −4 R/comma.R
  18. +33 −3 R/convert_datatable_DateIDate.R
  19. +195 −15 R/convert_datatable_StringDate.R
  20. +46 −14 R/convert_datatable_int_to_num.R
  21. +46 −18 R/dependencylist.R
  22. +83 −27 R/detach_nonstandard_namespaces.R
  23. +89 −30 R/detach_nonstandard_packages.R
  24. +52 −0 R/dftab.R
  25. +116 −0 R/dtconv.R
  26. +0 −6 R/enclose.R
  27. +0 −11 R/getFormals.R
  28. +60 −5 R/heatplot.R
  29. +21 −0 R/inin.R
  30. +119 −20 R/list2matrix.R
  31. +44 −8 R/lll.R
  32. +24 −2 R/loader.R
  33. +75 −58 R/loadinstall_libraries.R
  34. +26 −2 R/makebm.R
  35. +23 −2 R/makegm.R
  36. +71 −11 R/plot100colors.R
  37. +22 −2 R/printDebugMessage.R
  38. +26 −13 R/reset_graphic_parameters.R
  39. +99 −16 R/round_weeks.R
  40. +21 −0 R/saver.R
  41. +25 −13 R/set_project_dir.R
  42. +27 −2 R/sourceDir.R
  43. +19 −0 R/tic.R
  44. +19 −2 R/toc.R
  45. +16 −0 R/wtf.R
  46. +35 −0 RTests/Working_test.detach_nonstandard_pacakges.R
  47. +32 −0 RTests/test.ReadAssign.R
  48. +13 −0 RTests/test.addbg.R
  49. +13 −0 RTests/test.bgfun.R
  50. +26 −0 RTests/test.bs.R
  51. +44 −0 RTests/test.bs_withdiv.R
  52. +16 −0 RTests/test.comma.R
  53. +50 −0 RTests/test.dftab.R
  54. +93 −0 RTests/test.dtconv.R
  55. +38 −0 RTests/test.list2matrix.R
  56. +33 −0 RTests/test.round_weeks.R
  57. 0 doc/{ → OLD}/InstallGeneorama.R
  58. 0 {R → doc/OLD}/YahooAdjCloseAsZoo.R
  59. 0 {R → doc/OLD}/YahooAdjCloseAsZooWeekly.R
  60. +10 −0 doc/OLD/getFormals.R
  61. 0 {R → doc/OLD}/headstr.R
  62. 0 {R → doc/OLD}/loadinstall_geneorama.R
  63. 0 {R → doc/OLD}/plotRunningSd.R
  64. 0 {R → doc/OLD}/stacker.R
  65. +25 −0 doc/documentation_template.R
  66. +3 −2 geneorama.Rproj
  67. +36 −29 man/NAsummary.Rd
  68. +79 −39 man/ReadAssign.Rd
  69. +24 −0 man/TestGeneorama.Rd
  70. +0 −57 man/YahooAdjCloseAsZoo.Rd
  71. +33 −30 man/addbg.Rd
  72. +41 −37 man/bgfun.Rd
  73. +44 −0 man/bs.Rd
  74. +50 −0 man/bs_withdiv.Rd
  75. +40 −17 man/clipdir.Rd
  76. +26 −24 man/clipped.Rd
  77. +22 −32 man/clipper.Rd
  78. +15 −39 man/comma.Rd
  79. +32 −0 man/convert_datatable_DateIDate.Rd
  80. +31 −0 man/convert_datatable_IntNum.Rd
  81. +42 −0 man/convert_datatable_StringDate.Rd
  82. +34 −0 man/dependencylist.Rd
  83. +65 −0 man/detach_nonstandard_namespaces-open-paren-DOES-NOT-WORK-close-paren.Rd
  84. +51 −73 man/detach_nonstandard_packages.Rd
  85. +32 −48 man/dftab.Rd
  86. +28 −0 man/dtconv.Rd
  87. +0 −43 man/enclose.Rd
  88. +0 −38 man/geneorama-package.Rd
  89. +0 −38 man/getFormals.Rd
  90. +0 −84 man/headstr.Rd
  91. +34 −98 man/heatplot.Rd
  92. +13 −35 man/inin.Rd
  93. +52 −0 man/list2matrix.Rd
  94. +18 −28 man/lll.Rd
  95. +27 −0 man/loader-open-paren-DEPRICATED-close-paren.Rd
  96. +0 −66 man/loader.Rd
  97. +0 −71 man/loadinstall_geneorama.Rd
  98. +30 −36 man/loadinstall_libraries.Rd
  99. +16 −79 man/makebm.Rd
  100. +16 −72 man/makegm.Rd
  101. +23 −50 man/plot100colors.Rd
  102. +0 −27 man/plotRunningSd.Rd
  103. +14 −27 man/printDebugMessage.Rd
  104. +24 −32 man/reset_graphic_parameters.Rd
  105. +48 −0 man/round_weeks.Rd
  106. +27 −0 man/saver-open-paren-DEPRICATED-close-paren.Rd
  107. +22 −48 man/set_project_dir.Rd
  108. +16 −31 man/sourceDir.Rd
  109. +0 −64 man/stacker.Rd
  110. +12 −41 man/tic.Rd
  111. +24 −0 man/toc.Rd
  112. +12 −49 man/wtf.Rd
@@ -0,0 +1,2 @@
^.*\.Rproj$
^\.Rproj\.user$
@@ -0,0 +1,3 @@
.Rproj.user
.Rhistory
.RData

This file was deleted.

Oops, something went wrong.

This file was deleted.

Oops, something went wrong.
@@ -1,17 +1,15 @@
Package: geneorama
Type: Package
Title: Gene's collection of miscellaneous functions
Version: 1.3
Version: 1.4
Date: 2012-01-30
Author: Gene Leynes
Maintainer: Gene Leynes <rpackage@geneorama.com>
Enhances: PBSmodelling, fImport, gtools, zoo
Depends: data.table
Imports: data.table
Description: This is an assortment of utilities that I personally use on a
regular basis. Documentation is minimal at this point.
License: LGPL (>= 2.0, < 3) | Mozilla Public License
LazyLoad: yes



Depends:
R (>= 3.0.0),
data.table,
RUnit
Description: This is an assortment of convenience utilities and documentation of
lessons learned (mostly the hard way) in R. See FAQ.R in the doc
folder for "lessons learned".
License: LGPL (>= 2.0, < 3) | Mozilla Public License + file LICENSE
@@ -1 +1,3 @@
exportPattern("^[[:alpha:]]+")
import(data.table)
import(RUnit)
@@ -1,25 +1,84 @@
NAsummary <-
function(df, include.nan=FALSE){
newdf = data.frame(
col=1:ncol(df),
Count =nrow(df),
nNA = sapply(df,function(x)length(x[is.na(x)]))
)
#' @name NAsummary
#' @title Summarize NA values in a matrix or data.frame (or data.table)
#' @author Gene Leynes
#'
#' @param df A data.frame to be summarized
#' @param include_nan Do you want to also see Nan's along with NA's
#' Defaults to FALSE
#'
#' @description
#' Summarize the available information in a data.frame (or similar) quickly
#'
#' @details
#' For a data frame, data.table, or matrix this function creates a summary
#' of how many NA's and unique values there are in each column. Useful for
#' a quick summary of how complete your data is, and can be useful to pass
#' to other commands; for example to remove columns that only have one
#' unique value.
#'
#' @examples
#' ## Create an example data frame:
#' set.seed(100)
#' df <- data.frame(ID = 1:30,
#' col1 = sample(c(rep(NA, 5), rpois(25, 7))),
#' col2 = sample(letters[1:5], replace=TRUE),
#' col3 = sample(letters[1:5], replace=TRUE),
#' col4 = NA,
#' col5 = "OneValue",
#' col6 = sample(letters[1:5], replace=TRUE))
#' ## Create a summary:
#' MySummary <- NAsummary(df)
#' MySummary
#' ## Columns with only one unique value:
#' rownames(MySummary)[MySummary$nUnique == 1]
#' ## Columns with 100% NA values:
#' rownames(MySummary)[MySummary$rNA == 1]
#'
#'


NAsummary <-function(df, include_nan=FALSE){
newdf = data.frame(col=1:ncol(df),
Count =nrow(df),
nNA = sapply(df,function(x)length(x[is.na(x)])))

newdf$rNA = newdf$nNA / newdf$Count
newdf$rNA = trunc(newdf$rNA*10000)/10000

if(include.nan){
if(include_nan){
newdf$nNan = sapply(df,function(x)length(x[is.nan(x)]))
newdf$rNan = newdf$nNan / newdf$Count
newdf$rNan = trunc(newdf$rNan*10000)/10000
}

newdf$nUnique = sapply(df,function(x)length(unique(x)))
newdf$nUnique = sapply(df,function(x)length(unique(x)))

newdf$rUnique = newdf$nUnique / newdf$Count
newdf$rUnique = trunc(newdf$rUnique*10000)/10000

rownames(newdf) = colnames(df)
return(newdf)
}


if(FALSE){
rm(list=ls())
require(geneorama)
detach_nonstandard_packages()
source('R/NAsummary.R')
set.seed(100)
df <- data.frame(ID = 1:30,
col1 = sample(c(rep(NA, 5), rpois(25, 7))),
col2 = sample(letters[1:5], replace=TRUE),
col3 = sample(letters[1:5], replace=TRUE),
col4 = NA,
col5 = "OneValue",
col6 = sample(letters[1:5], replace=TRUE))
MySummary <- NAsummary(df)
MySummary
## Columns with only one unique value:
rownames(MySummary)[MySummary$nUnique == 1]
## Columns with 100% NA values:
rownames(MySummary)[MySummary$rNA == 1]
}

@@ -1,34 +1,114 @@

##
## Read an Rds file and assign the value to the global environment with a
## the name implied from the filename
##

##
## 2014-04-01 SJR Updated to take a path and filename
## 2014-05-05 GWL Adding function to geneorama package
## 2014-05-05 GWL Adding $ to gsub pattern argument
##

## Usage:
## MyExampleData <- data.frame(x=letters, y=rnorm(length(letters)))
## saveRDS(MyExampleData, file="MyExampleData.Rds")
## rm(MyExampleData)
## ReadAssign("MyExampleData.Rds")
## ls()
## unlink("MyExampleData.Rds"); rm(MyExampleData) ## Clean up
#' @name ReadAssign
#' @title Read in a list of files, and assign them to variables based on the
#' filename (or return as a list)
#' @author Gene Leynes and Scott Rodgers
#'
#' @param x file name, and source of the future object name
#' @param assignGlobal Assign the object to the global space or return
#' invisibly? Default is TRUE, which assigns the
#' object globally.
#'
#' @description
#' Read an Rds file and assign the value to the global environment with a
#' the name implied from the filename
#'
#' @details
#' This function will open a serialized R object and assign the object to the
#' name implied by the object. For example a matrix saved as
#' "Results/Yhat867.Rds" will be loaded and put into a matrix named
#' "Yhat867" if you call \code{ReadAssign("Results/Yhat867.Rds")}.
#'
#' This function is particularly valuable when
#' you use file names that match the object names you would use for the
#' saved objects.
#' For example, imagine that in a folder "results" you had 1,000 .Rds files
#' named Vec0001.Rds, Vec0002.Rds ... up to Vec1000.Rds, and imagine that
#' each file had one vector of length 60. If you wanted to load Vec200.Rds
#' to Vec299.Rds into memory you could get get the file names using
#' \code{list.files}: \code{MyFiles <- list.files('results/', full.names=T,
#' pattern = "vec2[0-9][0-9].Rds")}. Then you could load those vectors
#' into variables in the global enviornment using ReadAssign:
#' \code{sapply(MyFiles, ReadAssign)}
#' Since these happen to be the same length, you could also put them all
#' into a matrix using this syntax:
#' \code{MyMatrix <- sapply(MyFiles, ReadAssign, assignGlobal = F)}
#'
#' This pattern is useful when you 1) Use file names that match your
#' object names 2) Have many files / objects and want to relaod all / some
#' of them at different times.
#'
#' @note
#' 2014-04-01 SJR Updated to take a path and filename
#'
#' 2014-05-05 GWL Adding function to geneorama package
#'
#' 2014-05-05 GWL Adding $ to gsub pattern argument
#'
#' @examples
#' require(geneorama)
#' ##----------------------------------------------------------------------
#' ## Create example data, save it, then load it from disk using ReadAssign
#' ##----------------------------------------------------------------------
#' set.seed(27)
#' ## Generate Data
#' MyExampleData <- data.frame(x=letters, y=rnorm(length(letters)))
#' saveRDS(MyExampleData, file="MyExampleData.Rds")
#' rm(MyExampleData)
#' ## MyExampleData" is no longer in the environment
#' ls()
#' ## Now reload "MyExampleData"
#' ReadAssign("MyExampleData.Rds")
#' ls()
#' ## Clean up
#' unlink("MyExampleData.Rds")
#' rm(MyExampleData)
#'
#'
#' \dontrun{
#' ##----------------------------------------------------------------------
#' ## Example of making 600 files, and reloading 100 of them
#' ##----------------------------------------------------------------------
#' mat <- matrix(rnorm(60000), 100, 600)
#' for(i in 1:ncol(mat)){
#' fp <- file.path("ReadAssignExampleData",
#' paste0("vec", sprintf("%03.f", i),".Rds"))
#' saveRDS(object = mat[,i],
#' file = fp)
#' }
#' mat_recovered <- sapply(list.files('ReadAssignExampleData/',
#' full.names=T,
#' pattern = "vec3[0-9][0-9].Rds"),
#' ReadAssign, assignGlobal = F)
#' head(mat[,300:310])
#' head(mat_recovered[,1:11])
#' ## Clean Up
#' unlink("ReadAssignExampleData")
#' rm(mat, mat_recovered)
#' }
#'

ReadAssign <- function(x, assignGlobal = TRUE){
dat <- readRDS(x)
objname <- gsub("\\.Rds$", "", basename(x), ignore.case=TRUE)
if(assignGlobal){
assign(x=objname, value=dat, pos=.GlobalEnv)
invisible(objname)
} else {
return(dat)
}
dat <- readRDS(x)
objname <- gsub("\\.[Rr][Dd][Ss]$", "", basename(x), ignore.case=TRUE)
if(assignGlobal){
assign(x=objname, value=dat, pos=.GlobalEnv)
invisible(objname)
} else {
return(dat)
}
}


if(FALSE){
rm(list=ls())
source("R/ReadAssign.R")
source('tests/test.ReadAssign.R')
test.ReadAssign()
}







@@ -0,0 +1,33 @@
#' @name TestGeneorama
#' @title TestGeneorama
#' @author Gene Leynes
#'
#' @description
#' Run tests on the geneorama package to make sure the functions are
#' working.
#'
#' @details
#' Depends on RUnit
#'
#' @examples
#' \dontrun{
#' library(geneorama)
#' TestGeneorama()
#' }
#'


TestGeneorama <- function(){

# require(RUnit)

testsuite1 <- defineTestSuite(
"Geneorama main test suite",
# dirs = file.path(.path.package(package="RUnit"), "examples"),
dirs = file.path(".", "RTests"),
testFileRegexp = "^test.+\\.[rR]",
testFuncRegexp = "^test.+")

testResult <- runTestSuite(testsuite1)
printTextProtocol(testResult)
}
Oops, something went wrong.

0 comments on commit fcf66f5

Please sign in to comment.
You can’t perform that action at this time.