├── R ├── aaa.R ├── mat2df.R ├── copy.R ├── par.reset.R ├── addDebugOutput.R ├── Kmisc-package.R ├── defaultdict.R ├── install-rforge.R ├── simp.R ├── str_collapse.R ├── name1.R ├── cite_package.R ├── html_attach.R ├── silent.R ├── hex.R ├── setnames.R ├── clang_format.R ├── matches.R ├── is_sorted.R ├── transpose.R ├── any_na.R ├── split_.R ├── update_date.R ├── wrap.R ├── list2mat.R ├── list_to_dataframe.R ├── read.R ├── counts.R ├── Rcpp_gen_makevars.R ├── in_interval.R ├── clean_doc.R ├── nametree.R ├── remove_char_digit.R ├── chunk.R ├── fast_factor.R ├── enumerate.R ├── pad.R ├── html_tags.R ├── error.R ├── value_matching.R ├── pymat.R ├── overwrite.R ├── str_rev.R ├── str_sort.R ├── split_runs.R ├── size.R ├── apply.R ├── htmlTable.R └── ChangeLog.R ├── src ├── Makevars ├── Makevars.win ├── fast_factor.cpp ├── name1.c ├── copy.c ├── str_collapse.cpp ├── char_to_factor.cpp ├── matches.cpp ├── str_rev.c ├── df2list.c ├── simp.c ├── factor_to_char.c ├── in_interval.c ├── doublehex.c ├── any_na.c ├── mat2list.c ├── charlist_transpose_to_df.c └── str_slice.c ├── cleanup ├── tests ├── test-all.R └── testthat │ ├── test-labeller.R │ ├── test-str_split.R │ ├── test-any_na.R │ ├── test-char_to_factor.R │ ├── test-stack_list.R │ ├── test-enumerate.R │ ├── test-transpose.R │ ├── test-kMerge.R │ ├── test-awk.R │ ├── test-split_.R │ ├── test-dictionary.R │ ├── test-regular-expressions.R │ ├── test-setnames.R │ ├── test-apply.R │ ├── test-swap.R │ ├── test-read.R │ ├── test-unmelt.R │ ├── test-extract_rows_from_file.R │ ├── test-factor_.R │ ├── test-coerce.R │ ├── test-counts.R │ └── test-split_file.R ├── cleanup.win ├── dist └── Kmisc_0.5.0.tar.gz ├── old ├── Kmisc_0.1.0.tar.gz ├── Kmisc_0.2.0.tar.gz ├── Kmisc_0.3.0.tar.gz ├── Kmisc_0.4.0.tar.gz └── Kmisc_0.4.0-1.tar.gz ├── .gitignore ├── inst └── resources │ ├── shiny │ ├── server.R │ └── ui.R │ ├── highlight │ ├── styles │ │ ├── pojoaque.jpg │ │ ├── school_book.png │ │ ├── brown_papersq.png │ │ ├── ascetic.css │ │ ├── tomorrow.css │ │ ├── solarized_dark.css │ │ ├── solarized_light.css │ │ ├── tomorrow-night-bright.css │ │ ├── tomorrow-night-eighties.css │ │ ├── tomorrow-night.css │ │ └── tomorrow-night-blue.css │ └── LICENSE │ ├── bootstrap │ └── fonts │ │ ├── glyphicons-halflings-regular.eot │ │ ├── glyphicons-halflings-regular.ttf │ │ └── glyphicons-halflings-regular.woff │ └── js │ └── fancyboxify.js ├── stress ├── stress-factor_to_char.R ├── stress-melt_.R └── stress-split-factor.R ├── man ├── as.dict.Rd ├── defaultdict.Rd ├── hex.Rd ├── attachHTML.Rd ├── detachHTML.Rd ├── mat2df.Rd ├── df2mat.Rd ├── mat2list.Rd ├── duplicate.Rd ├── par.reset.Rd ├── list2mat.Rd ├── cite_package.Rd ├── str_collapse.Rd ├── u.Rd ├── Kmisc.Rd ├── setnamed.Rd ├── awk.set.Rd ├── silent.Rd ├── update_date.Rd ├── cat.cb.Rd ├── lu.Rd ├── simp.Rd ├── remove_digits.Rd ├── df2list.Rd ├── remove_chars.Rd ├── remove_na.Rd ├── Kmisc.knit2html.Rd ├── pad.Rd ├── install_rforge.Rd ├── kFivenum.Rd ├── kImg.Rd ├── list2df.Rd ├── tree.Rd ├── make_dummy.Rd ├── print.kHTML.Rd ├── cd.Rd ├── getObjects.Rd ├── matches.Rd ├── read.Rd ├── setnames.Rd ├── Rcpp_gen_makevars.Rd ├── transpose.Rd ├── clean_doc.Rd ├── any_na.Rd ├── us.Rd ├── str_rev2.Rd ├── split_.Rd ├── str_rev.Rd ├── unmelt.Rd ├── kAnova.Rd ├── strip_extension.Rd ├── char_to_factor.Rd ├── kSvg.Rd ├── swap_.Rd ├── pp_plot.Rd ├── is.sorted.Rd ├── kmeans_plot.Rd ├── read.cb.Rd ├── enumerate.Rd ├── scan.cb.Rd ├── factor_to_char.Rd ├── size.Rd ├── html.Rd ├── lg.Rd ├── wrap.Rd ├── pxt.Rd ├── counts.Rd ├── error-wrappers.Rd ├── p1t.Rd ├── chunk.Rd ├── gradient.Rd ├── str_sort.Rd ├── apply.Rd ├── prepare_package.Rd ├── factor_.Rd ├── kLoad.Rd ├── write.cb.Rd ├── str_slice.Rd ├── value_matching.Rd ├── in_interval.Rd ├── kSave.Rd ├── pymat.Rd ├── str_slice2.Rd ├── without.Rd ├── makeHTMLTag.Rd ├── extract.Rd ├── extract_rows_from_file.Rd ├── swap.Rd ├── anat.Rd ├── hSvg.Rd ├── split_runs.Rd ├── pMerge.Rd ├── dapply.Rd ├── htmlTable.Rd ├── bwplot2.Rd ├── labeller.Rd ├── sys.Rd ├── dict.Rd ├── hImg.Rd ├── registerFunctions.Rd ├── tapply_.Rd ├── awk.Rd ├── kCoef.Rd ├── melt_.Rd └── kMerge.Rd ├── incubator ├── function_pointer.cpp ├── DataTable.R ├── htmlPlot.R ├── multimelt.R ├── install_svn.R └── replace_function.R ├── .Rbuildignore ├── bench └── bench-melt_.R ├── Kmisc.Rproj ├── tools ├── check.sh └── modernize.sh ├── .travis.yml ├── DESCRIPTION └── README.md /R/aaa.R: -------------------------------------------------------------------------------- 1 | .Kmisc <- new.env() 2 | -------------------------------------------------------------------------------- /src/Makevars: -------------------------------------------------------------------------------- 1 | PKG_CPPFLAGS = -I. 2 | -------------------------------------------------------------------------------- /cleanup: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | R -e "source('R/cleanup.R'); cleanup()" 4 | -------------------------------------------------------------------------------- /tests/test-all.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(Kmisc) 3 | test_dir("testthat") 4 | -------------------------------------------------------------------------------- /cleanup.win: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | R.exe -e "source('R/cleanup.R'); cleanup()" 4 | -------------------------------------------------------------------------------- /dist/Kmisc_0.5.0.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/dist/Kmisc_0.5.0.tar.gz -------------------------------------------------------------------------------- /old/Kmisc_0.1.0.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/old/Kmisc_0.1.0.tar.gz -------------------------------------------------------------------------------- /old/Kmisc_0.2.0.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/old/Kmisc_0.2.0.tar.gz -------------------------------------------------------------------------------- /old/Kmisc_0.3.0.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/old/Kmisc_0.3.0.tar.gz -------------------------------------------------------------------------------- /old/Kmisc_0.4.0.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/old/Kmisc_0.4.0.tar.gz -------------------------------------------------------------------------------- /old/Kmisc_0.4.0-1.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/old/Kmisc_0.4.0-1.tar.gz -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | PKG_LIBS = $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "Rcpp:::LdFlags()") 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | src/*.o 5 | src/*.so 6 | src/*.dll 7 | Rplots.pdf 8 | -------------------------------------------------------------------------------- /inst/resources/shiny/server.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | shinyServer( function(input, output, session) { 4 | 5 | }) 6 | -------------------------------------------------------------------------------- /inst/resources/highlight/styles/pojoaque.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/inst/resources/highlight/styles/pojoaque.jpg -------------------------------------------------------------------------------- /inst/resources/highlight/styles/school_book.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/inst/resources/highlight/styles/school_book.png -------------------------------------------------------------------------------- /inst/resources/highlight/styles/brown_papersq.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/inst/resources/highlight/styles/brown_papersq.png -------------------------------------------------------------------------------- /inst/resources/bootstrap/fonts/glyphicons-halflings-regular.eot: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/inst/resources/bootstrap/fonts/glyphicons-halflings-regular.eot -------------------------------------------------------------------------------- /inst/resources/bootstrap/fonts/glyphicons-halflings-regular.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/inst/resources/bootstrap/fonts/glyphicons-halflings-regular.ttf -------------------------------------------------------------------------------- /inst/resources/bootstrap/fonts/glyphicons-halflings-regular.woff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/kevinushey/Kmisc/HEAD/inst/resources/bootstrap/fonts/glyphicons-halflings-regular.woff -------------------------------------------------------------------------------- /src/fast_factor.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | // [[Rcpp::export]] 5 | SEXP fast_factor(SEXP x, SEXP levels) { 6 | Function factor("factor_"); 7 | return factor(x, levels); 8 | } 9 | -------------------------------------------------------------------------------- /stress/stress-factor_to_char.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | 3 | x <- list( 1:10, factor(1:10), list(1:5, "a", "b"), "z" ) 4 | gctorture(TRUE) 5 | 6 | for(i in 1:10) { 7 | print( factor_to_char(x) ) 8 | } 9 | gctorture(FALSE) 10 | -------------------------------------------------------------------------------- /R/mat2df.R: -------------------------------------------------------------------------------- 1 | ##' Convert a Matrix to a DataFrame 2 | ##' 3 | ##' Identical to \code{as.matrix.data.frame}, but faster. 4 | ##' 5 | ##' @param x A \code{matrix}. 6 | ##' @export 7 | mat2df <- function(x) { 8 | return(.Call(Cmat2df, x)) 9 | } 10 | -------------------------------------------------------------------------------- /src/name1.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | // [[register]] 7 | SEXP setnamed(SEXP x, SEXP i) { 8 | SET_NAMED(x, INTEGER(i)[0]); 9 | return R_NilValue; 10 | } 11 | 12 | #undef USE_RINTERNALS 13 | -------------------------------------------------------------------------------- /src/copy.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | // [[register]] 7 | SEXP copy(SEXP x_) { 8 | SEXP x = PROTECT( duplicate(x_) ); 9 | UNPROTECT(1); 10 | return x; 11 | } 12 | 13 | #undef USE_RINTERNALS 14 | -------------------------------------------------------------------------------- /R/copy.R: -------------------------------------------------------------------------------- 1 | ##' Force a Copy of an R Object 2 | ##' 3 | ##' In \R, objects are copied 'lazily'. We use this function to force a copy. 4 | ##' 5 | ##' @param x An \R object. 6 | ##' @export 7 | duplicate <- function(x) { 8 | return( .Call(Ccopy, x) ) 9 | } 10 | -------------------------------------------------------------------------------- /man/as.dict.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{as.dict} 3 | \alias{as.dict} 4 | \title{Coerce an Object to a Dictionary} 5 | \usage{ 6 | as.dict(x, ...) 7 | } 8 | \description{ 9 | Coerce an Object to a Dictionary 10 | } 11 | 12 | -------------------------------------------------------------------------------- /tests/testthat/test-labeller.R: -------------------------------------------------------------------------------- 1 | context("labeller") 2 | 3 | library(ggplot2) 4 | df <- data.frame( x=1:100, y=rnorm(100), grp=rep( letters[1:2], each=50 )) 5 | p <- ggplot(df, aes(x=x, y=y)) + geom_point() 6 | 7 | p + facet_grid( ". ~ grp", labeller=labeller(a="alpha", b="beta")) 8 | -------------------------------------------------------------------------------- /inst/resources/shiny/ui.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | 3 | shinyUI(bootstrapPage( 4 | includeCSS("www/css/jquery-ui.css"), 5 | 6 | includeScript("www/js/jquery.js"), 7 | includeScript("www/js/jquery-ui.js"), 8 | includeScript("www/js/jquery.dialogextend.min.js") 9 | 10 | )) 11 | -------------------------------------------------------------------------------- /man/defaultdict.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{defaultdict} 3 | \alias{defaultdict} 4 | \title{Python-style Default Dictionaries in R} 5 | \usage{ 6 | defaultdict(..., `_size` = 29L) 7 | } 8 | \description{ 9 | Python-style Default Dictionaries in R 10 | } 11 | 12 | -------------------------------------------------------------------------------- /man/hex.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{hex} 3 | \alias{hex} 4 | \title{Get the hex representation of a value} 5 | \usage{ 6 | hex(x) 7 | } 8 | \arguments{ 9 | \item{x}{A value.} 10 | } 11 | \description{ 12 | Prints the hex (byte) representation of a value. 13 | } 14 | 15 | -------------------------------------------------------------------------------- /man/attachHTML.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{attachHTML} 3 | \alias{attachHTML} 4 | \title{Attach Common, Non-Masking HTML Functions} 5 | \usage{ 6 | attachHTML() 7 | } 8 | \description{ 9 | DEPRECATED: Please use the \code{\link{html}} function to generate HTML. 10 | } 11 | 12 | -------------------------------------------------------------------------------- /man/detachHTML.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{detachHTML} 3 | \alias{detachHTML} 4 | \title{Detach Common, Non-Masking HTML Functions} 5 | \usage{ 6 | detachHTML() 7 | } 8 | \description{ 9 | DEPRECATED: Please use the \code{\link{html}} function to generate HTML. 10 | } 11 | 12 | -------------------------------------------------------------------------------- /incubator/function_pointer.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | SEXP f(SEXP x) { 4 | int len = Rf_length(x); 5 | for( int i=0; i < len; ++i ) { 6 | INTEGER(x)[i] = INTEGER(x)[i] + 1; 7 | } 8 | return R_NilValue; 9 | } 10 | 11 | RcppExport SEXP do_stuff( SEXP x ) { 12 | (*f)(x); 13 | return R_NilValue; 14 | } 15 | -------------------------------------------------------------------------------- /man/mat2df.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{mat2df} 3 | \alias{mat2df} 4 | \title{Convert a Matrix to a DataFrame} 5 | \usage{ 6 | mat2df(x) 7 | } 8 | \arguments{ 9 | \item{x}{A \code{matrix}.} 10 | } 11 | \description{ 12 | Identical to \code{as.matrix.data.frame}, but faster. 13 | } 14 | 15 | -------------------------------------------------------------------------------- /R/par.reset.R: -------------------------------------------------------------------------------- 1 | .par.orig <- par() 2 | 3 | ##' Restore the 'par' settings 4 | ##' 5 | ##' If you have been mucking around with parameter settings, this function 6 | ##' will revert to the parameter settings that were available when this 7 | ##' package was loaded. 8 | ##' @export 9 | par.reset <- function() { 10 | par(.par.orig) 11 | } 12 | -------------------------------------------------------------------------------- /man/df2mat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{df2mat} 3 | \alias{df2mat} 4 | \title{Convert a data.frame to a matrix} 5 | \usage{ 6 | df2mat(df) 7 | } 8 | \arguments{ 9 | \item{df}{a \code{data.frame}.} 10 | } 11 | \description{ 12 | This function converts a \code{data.frame} to a \code{matrix}. 13 | } 14 | 15 | -------------------------------------------------------------------------------- /man/mat2list.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{mat2list} 3 | \alias{mat2list} 4 | \title{Convert a matrix to a list} 5 | \usage{ 6 | mat2list(matrix) 7 | } 8 | \arguments{ 9 | \item{matrix}{A \code{matrix}.} 10 | } 11 | \description{ 12 | This function converts a \code{matrix} to a \code{list}. 13 | } 14 | 15 | -------------------------------------------------------------------------------- /man/duplicate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{duplicate} 3 | \alias{duplicate} 4 | \title{Force a Copy of an R Object} 5 | \usage{ 6 | duplicate(x) 7 | } 8 | \arguments{ 9 | \item{x}{An \R object.} 10 | } 11 | \description{ 12 | In \R, objects are copied 'lazily'. We use this function to force a copy. 13 | } 14 | 15 | -------------------------------------------------------------------------------- /R/addDebugOutput.R: -------------------------------------------------------------------------------- 1 | addDebugOutput <- function(lines=Kmisc::scan.cb()) { 2 | lines_escaped <- gsub('(? 2 | using namespace Rcpp; 3 | 4 | // [[Rcpp::export]] 5 | CharacterVector str_collapse_list(List x) { 6 | int n = x.size(); 7 | CharacterVector output = no_init(n); 8 | for (int i=0; i < n; ++i) { 9 | output[i] = collapse( as(x[i]) ); 10 | } 11 | 12 | output.attr("names") = x.attr("names"); 13 | 14 | return output; 15 | } 16 | 17 | // [[Rcpp::export]] 18 | String str_collapse_str(CharacterVector x) { 19 | return collapse(x); 20 | } 21 | -------------------------------------------------------------------------------- /man/df2list.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{df2list} 3 | \alias{df2list} 4 | \title{Convert data.frame to list} 5 | \usage{ 6 | df2list(df, inplace = FALSE) 7 | } 8 | \arguments{ 9 | \item{df}{A data.frame.} 10 | 11 | \item{inplace}{Boolean. If \code{TRUE}, we convert the 12 | list in place, so that the \code{list} itself is 13 | transformed into a \code{data.frame}, sans copying.} 14 | } 15 | \description{ 16 | This function converts a \code{data.frame} to a list. 17 | } 18 | 19 | -------------------------------------------------------------------------------- /tests/testthat/test-enumerate.R: -------------------------------------------------------------------------------- 1 | context("enumerate") 2 | 3 | v <- replicate(2, rnorm(2), simplify=FALSE) 4 | 5 | expect_that (enumerate(v, function(x, j) x + 1), 6 | is_identical_to( lapply(v, function(x) x + 1))) 7 | 8 | l <- as.list(1:10) 9 | expect_that( enumerate(l, function(x, k) x + 1), 10 | is_identical_to( lapply(l, function(x) x + 1))) 11 | 12 | ## make sure even the ridiculous calls might work 13 | enumerate <- 10:1 14 | expect_that( enumerate(l, function(x, k) enumerate[k]), 15 | is_identical_to( as.list(10:1))) 16 | -------------------------------------------------------------------------------- /R/silent.R: -------------------------------------------------------------------------------- 1 | ##' Hide All Potential Output when Evaluating an Expression 2 | ##' 3 | ##' This function hides any output a function might try to write 4 | ##' to \code{stdout}, \code{stderr}, to the \R console as a message, warning, 5 | ##' and so on. 6 | ##' 7 | ##' @param expr An \R expression. 8 | ##' @export 9 | silent <- function(expr) { 10 | call <- match.call() 11 | suppressMessages(suppressWarnings( 12 | capture.output(output <- eval(call$expr, envir=parent.frame(1), enclos=baseenv())) 13 | )) 14 | return(output) 15 | } 16 | -------------------------------------------------------------------------------- /man/remove_chars.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{remove_chars} 3 | \alias{remove_chars} 4 | \title{Remove Alphabetic Characters from a Character Vector} 5 | \usage{ 6 | remove_chars(x, remove_spaces = TRUE) 7 | } 8 | \arguments{ 9 | \item{x}{A character vector, or vector coercable to 10 | character.} 11 | 12 | \item{remove_spaces}{boolean; if \code{TRUE} we remove 13 | all white-space as well.} 14 | } 15 | \description{ 16 | Removes all alphabetic characters from a character vector. 17 | } 18 | 19 | -------------------------------------------------------------------------------- /man/remove_na.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{remove_na} 3 | \alias{remove_na} 4 | \title{Remove NA Entries from a Vector} 5 | \usage{ 6 | remove_na(x) 7 | } 8 | \arguments{ 9 | \item{x}{An (atomic) vector, or a list / data.frame.} 10 | } 11 | \description{ 12 | This function removes all \code{NA} entries from a vector. 13 | } 14 | \details{ 15 | For \code{data.frames}, we use \code{complete.cases} to remove \code{NA}s, 16 | and hence remove all rows for which an \code{NA} value in encountered. 17 | } 18 | 19 | -------------------------------------------------------------------------------- /man/Kmisc.knit2html.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{Kmisc.knit2html} 3 | \alias{Kmisc.knit2html} 4 | \title{Knit an Rmd File to HTML with Kmisc Styling} 5 | \usage{ 6 | Kmisc.knit2html(input, ...) 7 | } 8 | \arguments{ 9 | \item{input}{An \code{.Rmd} file.} 10 | 11 | \item{...}{Optional arguments passed to \code{knit}.} 12 | } 13 | \description{ 14 | This function 'knits' an R Markdown document with \code{knitr}, and injects 15 | HTML, CSS and JavaScript from CSS for nice, interactive HTML reports. 16 | } 17 | 18 | -------------------------------------------------------------------------------- /man/pad.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{pad} 3 | \alias{pad} 4 | \title{Pad an Object with NAs} 5 | \usage{ 6 | pad(x, n) 7 | } 8 | \arguments{ 9 | \item{x}{An \R object (list, data.frame, matrix, atomic 10 | vector).} 11 | 12 | \item{n}{The final length of each object.} 13 | } 14 | \description{ 15 | This function pads an \R object (list, data.frame, matrix, atomic vector) 16 | with \code{NA}s. For matrices, lists and data.frames, this occurs by extending 17 | each (column) vector in the object. 18 | } 19 | 20 | -------------------------------------------------------------------------------- /man/install_rforge.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{install_rforge} 3 | \alias{install_rforge} 4 | \title{Attempts to install a package directly from R-Forge.} 5 | \usage{ 6 | install_rforge(project, ...) 7 | } 8 | \arguments{ 9 | \item{project}{project name} 10 | 11 | \item{...}{Other arguments passed on to 12 | \code{\link{install.packages}}.} 13 | } 14 | \description{ 15 | Attempts to install a package directly from R-Forge. 16 | } 17 | \examples{ 18 | \dontrun{ 19 | install_rforge("data.table") 20 | } 21 | } 22 | 23 | -------------------------------------------------------------------------------- /man/kFivenum.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{kFivenum} 3 | \alias{kFivenum} 4 | \title{Fivenum with Names} 5 | \usage{ 6 | kFivenum(x, na.rm = TRUE) 7 | } 8 | \arguments{ 9 | \item{x}{numeric, maybe including \code{NA}s and 10 | \code{Inf}s.} 11 | 12 | \item{na.rm}{logical. remove NAs?} 13 | } 14 | \value{ 15 | \code{data.frame} version of five number summary 16 | } 17 | \description{ 18 | A wrapper to \code{stats::fivenum} that also produces variable names. 19 | } 20 | \seealso{ 21 | \code{\link{fivenum}} 22 | } 23 | 24 | -------------------------------------------------------------------------------- /man/kImg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{kImg} 3 | \alias{kImg} 4 | \title{HTML - Source an Image} 5 | \usage{ 6 | kImg(x, width = 480, height = 480) 7 | } 8 | \arguments{ 9 | \item{x}{path to an image you want to source} 10 | 11 | \item{width}{width (in pixels) of the image} 12 | 13 | \item{height}{height (in pixels) of the image} 14 | } 15 | \description{ 16 | Convenience function for \code{cat}-ing out HTML markup for an image as 17 | \code{}. 18 | } 19 | \seealso{ 20 | \code{\link{hImg}} 21 | } 22 | 23 | -------------------------------------------------------------------------------- /man/list2df.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{list2df} 3 | \alias{list2df} 4 | \title{Convert list to data.frame} 5 | \usage{ 6 | list2df(list, inplace = FALSE) 7 | } 8 | \arguments{ 9 | \item{list}{A list.} 10 | 11 | \item{inplace}{Boolean. If \code{TRUE}, we convert the 12 | list in place, so that the \code{list} itself is 13 | transformed into a \code{data.frame}, sans copying.} 14 | } 15 | \description{ 16 | This function converts a list to a data frame, assuming that each 17 | element of the list is of equal length. 18 | } 19 | 20 | -------------------------------------------------------------------------------- /man/tree.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{tree} 3 | \alias{tree} 4 | \title{Print a Tree Representation of an Object of Nested Lists} 5 | \usage{ 6 | tree(x) 7 | } 8 | \arguments{ 9 | \item{x}{A (named) list.} 10 | } 11 | \description{ 12 | This function returns output similar to that of the command line 13 | tool \code{tree}, except rather than directory/file structure, 14 | we simply print the names of lists. 15 | } 16 | \seealso{ 17 | http://stackoverflow.com/questions/18122548/display-names-of-column-of-recursive-list-as-tree 18 | } 19 | 20 | -------------------------------------------------------------------------------- /man/make_dummy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{make_dummy} 3 | \alias{make_dummy} 4 | \title{Make Dummy Variables from a Factor} 5 | \usage{ 6 | make_dummy(x) 7 | } 8 | \arguments{ 9 | \item{x}{an object coercable to \code{factor}.} 10 | } 11 | \description{ 12 | This functions converts a single factor into dummy variables, with one 13 | dummy variable for each level of that factor. Names are constructed as 14 | \code{_}. 15 | } 16 | \examples{ 17 | x <- factor( rep( c("a", "b", "c", "d"), each=25 ) ) 18 | make_dummy(x) 19 | } 20 | 21 | -------------------------------------------------------------------------------- /tests/testthat/test-transpose.R: -------------------------------------------------------------------------------- 1 | context("transpose") 2 | 3 | l <- replicate(10, rnorm(1E1), simplify=FALSE) 4 | gctorture(TRUE) 5 | tmp1 <- transpose(l) 6 | gctorture(FALSE) 7 | expect_identical( 8 | tmp1, 9 | tmp2 <- unname(as.list(as.data.frame(t(as.matrix(as.data.frame(l)))))) 10 | ) 11 | 12 | m <- matrix(1:9, nrow=3) 13 | rownames(m) <- letters[1:3] 14 | colnames(m) <- LETTERS[1:3] 15 | 16 | expect_identical( 17 | transpose(m), 18 | t(m) 19 | ) 20 | 21 | l <- list(1:3, 4:7) 22 | expect_error(transpose(l)) 23 | l <- list(1:3, letters[4:6]) 24 | expect_warning(transpose(l)) 25 | -------------------------------------------------------------------------------- /man/print.kHTML.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{print.kHTML} 3 | \alias{print.kHTML} 4 | \title{Print kHTML Objects} 5 | \usage{ 6 | \method{print}{kHTML}(...) 7 | } 8 | \arguments{ 9 | \item{...}{a set of kHTML objects (strings).} 10 | } 11 | \description{ 12 | By default, we \code{cat} out kHTML objects as we typically 13 | intend to embed them in \R Markdown documents. This is mainly used for 14 | printing of items in the environment \code{html}. 15 | } 16 | \examples{ 17 | Kmisc:::.html$br() 18 | } 19 | \seealso{ 20 | \code{\link{html}} 21 | } 22 | 23 | -------------------------------------------------------------------------------- /man/cd.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{cd} 3 | \alias{cd} 4 | \title{Set Working Directory} 5 | \usage{ 6 | cd(...) 7 | } 8 | \arguments{ 9 | \item{...}{the set of strings to paste together. if no 10 | arguments are submitted, then we return to the home 11 | directory.} 12 | } 13 | \description{ 14 | A small convenience function that wraps \code{file.path} into a 15 | \code{setwd} call. 16 | } 17 | \examples{ 18 | x <- "my_favourite_dir" 19 | #setwd( "C:/", x, "really_awesome_stuff" ) 20 | ## calls setwd( paste( "C:/", x, "really_awesome_stuff", collapse="" ) ) 21 | } 22 | 23 | -------------------------------------------------------------------------------- /tests/testthat/test-kMerge.R: -------------------------------------------------------------------------------- 1 | context("kMerge") 2 | n <- 10 3 | 4 | x <- data.frame( id=n:1, y=rnorm(n), z=sample( letters, n, replace=TRUE ) ) 5 | y <- data.frame( id=sample(1:n), a=rnorm(n), b=sample( LETTERS, n, replace=TRUE ) ) 6 | 7 | dat <- kMerge( x, y ) 8 | dat2 <- kMerge( x, y, by.x="id" ) 9 | dat3 <- kMerge( x, y, by.y="id" ) 10 | dat4 <- kMerge( x, y, by="id" ) 11 | 12 | expect_identical( dat, dat2 ) 13 | expect_identical( dat, dat3 ) 14 | expect_identical( dat, dat4 ) 15 | 16 | expect_identical( dat[1:3], x ) 17 | 18 | xx <- data.frame( id=1:n, y=rnorm(n) ) 19 | expect_identical( kMerge( xx, y), merge(xx, y) ) 20 | -------------------------------------------------------------------------------- /R/hex.R: -------------------------------------------------------------------------------- 1 | ##' Get the hex representation of a value 2 | ##' 3 | ##' Prints the hex (byte) representation of a value. 4 | ##' 5 | ##' @param x A value. 6 | ##' @export 7 | hex <- function(x) { 8 | UseMethod("hex") 9 | } 10 | 11 | ##' @export 12 | hex.double <- function(x) { 13 | vapply(x, FUN.VALUE=character(1), function(xx) .Call(Cdouble2hex, xx) ) 14 | } 15 | 16 | ##' @export 17 | hex.integer <- function(x) { 18 | vapply(x, FUN.VALUE=character(1), function(xx) .Call(Cint2hex, xx) ) 19 | } 20 | 21 | ##' @export 22 | hex.logical <- function(x) { 23 | vapply(x, FUN.VALUE=character(1), function(xx) .Call(Cint2hex, xx) ) 24 | } 25 | -------------------------------------------------------------------------------- /man/getObjects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{getObjects} 3 | \alias{getObjects} 4 | \title{Get all Objects in Environment} 5 | \usage{ 6 | getObjects(env) 7 | } 8 | \arguments{ 9 | \item{env}{an environment.} 10 | } 11 | \value{ 12 | a list of the objects contained within that environment. 13 | } 14 | \description{ 15 | Get all objects within an environment. Useful for inspecting the objects 16 | available in a particular environment. 17 | } 18 | \examples{ 19 | myenv <- new.env() 20 | assign( "foo", "bar", env=myenv ) 21 | assign( "baz", "spam", env=myenv ) 22 | getObjects( myenv ) 23 | } 24 | 25 | -------------------------------------------------------------------------------- /man/matches.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{matches} 3 | \alias{matches} 4 | \title{Count Matches} 5 | \usage{ 6 | matches(...) 7 | } 8 | \arguments{ 9 | \item{...}{A set of (possibly named) arguments, all of 10 | the same type.} 11 | } 12 | \description{ 13 | This function returns a matrix of matches between each argument passed. 14 | Each cell \code{x_ij} in the output denotes how many times the elements in 15 | input \code{i} were found in input \code{j}. 16 | } 17 | \examples{ 18 | x <- c("a", "b", "c", "d") 19 | y <- c("a", "b", "c") 20 | z <- c("a", "b", "d") 21 | matches(x, y, z) 22 | } 23 | 24 | -------------------------------------------------------------------------------- /man/read.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{read} 3 | \alias{read} 4 | \alias{readlines} 5 | \title{Read a File} 6 | \usage{ 7 | read(file) 8 | 9 | readlines(file) 10 | } 11 | \arguments{ 12 | \item{file}{Path to a file.} 13 | } 14 | \description{ 15 | These functions read a file into memory. We memory map the file for fast I/O. 16 | The file is read in as a character vector (length one for \code{read}, 17 | length \code{n} for \code{readlines}). 18 | } 19 | \examples{ 20 | p <- file.path( R.home(), "NEWS" ) 21 | if (file.exists(p)) 22 | stopifnot( identical( readLines(p), readlines(p) ) ) 23 | } 24 | 25 | -------------------------------------------------------------------------------- /man/setnames.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{setrownames} 3 | \alias{setcolnames} 4 | \alias{setrownames} 5 | \title{Set the row, column names of a matrix in place} 6 | \usage{ 7 | setrownames(x, value) 8 | 9 | setcolnames(x, value) 10 | } 11 | \arguments{ 12 | \item{x}{Either a \code{data.frame}, or an array.} 13 | 14 | \item{value}{Either \code{NULL} or a vector coercible to 15 | character.} 16 | } 17 | \description{ 18 | Similar to the \code{setattr} or \code{setnames} functions of 19 | \code{data.table}, but makes it slightly easier to set these attributes 20 | in-place for matrices. 21 | } 22 | 23 | -------------------------------------------------------------------------------- /man/Rcpp_gen_makevars.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{Rcpp_gen_makevars} 3 | \alias{Rcpp_gen_makevars} 4 | \alias{rcpp_gen_makevars} 5 | \title{Reproduce Rcpp Makevars Files} 6 | \usage{ 7 | Rcpp_gen_makevars(src = file.path(getwd(), "src")) 8 | 9 | rcpp_gen_makevars(src = file.path(getwd(), "src")) 10 | } 11 | \arguments{ 12 | \item{src}{the location to output the Makevars.} 13 | } 14 | \description{ 15 | If you're building a package and want a simple set of 16 | Makevars files to export, this function will handle it 17 | for you. Borrowed from the Rcpp \code{rcpp.package.skeleton} 18 | function. 19 | } 20 | 21 | -------------------------------------------------------------------------------- /man/transpose.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{transpose} 3 | \alias{transpose} 4 | \alias{transpose.data.frame} 5 | \alias{transpose.default} 6 | \alias{transpose.list} 7 | \title{Tranpose an Object} 8 | \usage{ 9 | transpose(x) 10 | 11 | \method{transpose}{list}(x) 12 | 13 | \method{transpose}{data.frame}(x) 14 | 15 | \method{transpose}{default}(x) 16 | } 17 | \arguments{ 18 | \item{x}{A matrix, data.frame, or matrix-like list.} 19 | } 20 | \description{ 21 | This functions similarily to \R's \code{t}, but we add a new method, 22 | \code{transpose.list}, for transposing lists in a specific way. 23 | } 24 | 25 | -------------------------------------------------------------------------------- /R/setnames.R: -------------------------------------------------------------------------------- 1 | ##' Set the row, column names of a matrix in place 2 | ##' 3 | ##' Similar to the \code{setattr} or \code{setnames} functions of 4 | ##' \code{data.table}, but makes it slightly easier to set these attributes 5 | ##' in-place for matrices. 6 | ##' 7 | ##' @rdname setnames 8 | ##' @param x Either a \code{data.frame}, or an array. 9 | ##' @param value Either \code{NULL} or a vector coercible to character. 10 | ##' @export 11 | setrownames <- function(x, value) { 12 | .Call(Csetrownames, x, value) 13 | } 14 | 15 | ##' @rdname setnames 16 | ##' @export 17 | setcolnames <- function(x, value) { 18 | .Call(Csetcolnames, x, value) 19 | } 20 | -------------------------------------------------------------------------------- /R/clang_format.R: -------------------------------------------------------------------------------- 1 | clang_format <- function( 2 | files=NULL, 3 | style=c("Chromium", "LLVM", "Google", "Mozilla", "WebKit"), 4 | verbose=FALSE) { 5 | 6 | style <- match.arg(style) 7 | 8 | if (is.null(files)) { 9 | files <- list.files("src", pattern="cpp$|c$", full.names=TRUE) 10 | } 11 | 12 | files <- unlist( lapply(files, function(file) { 13 | normalizePath(file, mustWork=TRUE) 14 | }) ) 15 | 16 | styleArg <- paste0("-style=", shQuote(style)) 17 | iArg <- "-i" 18 | cmd <- paste("clang-format", styleArg, iArg, paste(files, collapse=" ")) 19 | if (verbose) { 20 | message(cmd) 21 | } 22 | system(cmd) 23 | } 24 | -------------------------------------------------------------------------------- /man/clean_doc.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{clean_doc} 3 | \alias{clean_doc} 4 | \title{Clean Documentation in Current Package} 5 | \usage{ 6 | clean_doc(dir = getwd(), ask = TRUE) 7 | } 8 | \arguments{ 9 | \item{dir}{the project directory.} 10 | 11 | \item{ask}{boolean. ask before clearing directory?} 12 | } 13 | \description{ 14 | This function removes all the .Rd documentation files present in 15 | \code{/man}. This function is handy if you've 'polluted' your 16 | \code{man} directory in prototyping different functions -- assuming that 17 | you're documenting your code with eg. \code{roxygen}. 18 | } 19 | 20 | -------------------------------------------------------------------------------- /R/matches.R: -------------------------------------------------------------------------------- 1 | ##' Count Matches 2 | ##' 3 | ##' This function returns a matrix of matches between each argument passed. 4 | ##' Each cell \code{x_ij} in the output denotes how many times the elements in 5 | ##' input \code{i} were found in input \code{j}. 6 | ##' 7 | ##' @param ... A set of (possibly named) arguments, all of the same type. 8 | ##' @export 9 | ##' @examples 10 | ##' x <- c("a", "b", "c", "d") 11 | ##' y <- c("a", "b", "c") 12 | ##' z <- c("a", "b", "d") 13 | ##' matches(x, y, z) 14 | matches <- function(...) { 15 | output <- .Call( CKmisc_matches, list(...) ) 16 | rownames(output) <- colnames(output) <- names( list(...) ) 17 | return(output) 18 | } 19 | -------------------------------------------------------------------------------- /src/char_to_factor.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | SEXP fast_factor(SEXP, SEXP); 5 | 6 | // [[Rcpp::export(.char_to_factor)]] 7 | RObject char_to_factor( RObject x_, bool inplace ) { 8 | 9 | RObject x; 10 | if (inplace) { 11 | x = x_; 12 | } else { 13 | x = clone(x_); 14 | } 15 | 16 | if (TYPEOF(x) == VECSXP) { 17 | int n = Rf_length(x); 18 | for (int i=0; i < n; ++i) { 19 | SET_VECTOR_ELT(x, i, char_to_factor( VECTOR_ELT(x, i), false )); 20 | } 21 | } else if (TYPEOF(x) == STRSXP) { 22 | x = fast_factor(x, sort_unique( as(x) )); 23 | } 24 | 25 | return x; 26 | 27 | } 28 | -------------------------------------------------------------------------------- /man/any_na.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{any_na} 3 | \alias{any_na} 4 | \title{Check whether there are any Missing Values in a Vector} 5 | \usage{ 6 | any_na(x, how = "unlist") 7 | } 8 | \arguments{ 9 | \item{x}{An \R object.} 10 | 11 | \item{how}{The simplification to use if \code{x} is a 12 | list. See \code{\link{rapply}} for more details.} 13 | } 14 | \description{ 15 | This function checks whether there are any missing values in an \R 16 | object. For list objects, we recurse over each entry. This is typically 17 | faster than \code{any(is.na(x))} as we exit and return \code{TRUE} as soon 18 | as an \code{NA} is discovered. 19 | } 20 | 21 | -------------------------------------------------------------------------------- /man/us.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{us} 3 | \alias{us} 4 | \title{unlist( strsplit( ... ) )} 5 | \usage{ 6 | us(x, split = "", ...) 7 | } 8 | \arguments{ 9 | \item{x}{vector of items, as passed to 10 | \code{\link{strsplit}}} 11 | 12 | \item{split}{the delimiter to split on} 13 | 14 | \item{...}{optional arguments passed to strsplit} 15 | } 16 | \description{ 17 | This is a thin wrapper to \code{ unlist( strsplit( ... ) ) }. 18 | Primarily intended for interactive, not programmatic, use. 19 | } 20 | \examples{ 21 | x <- "apple_banana_cherry" 22 | us(x, "_") 23 | } 24 | \seealso{ 25 | \code{\link{unlist}}, \code{\link{strsplit}} 26 | } 27 | 28 | -------------------------------------------------------------------------------- /R/is_sorted.R: -------------------------------------------------------------------------------- 1 | ##' Test if an Object is Sorted 2 | ##' 3 | ##' Test if an object is sorted, without the cost of sorting it. 4 | ##' Wrapper to \code{\link{is.unsorted}}. 5 | ##' 6 | ##' @param x an \R object with a class or a numeric, complex, character or logical vector. 7 | ##' @param na.rm logical. Should missing values be removed before checking? 8 | ##' @param strictly logical indicating if the check should be for strictly increasing values. 9 | ##' @export 10 | ##' @seealso \code{\link{is.unsorted}} 11 | ##' @examples 12 | ##' stopifnot( is.sorted(1, 2, 4) ) 13 | is.sorted <- function(x, na.rm=FALSE, strictly=FALSE) { 14 | return( !is.unsorted(x, na.rm=na.rm, strictly=strictly) ) 15 | } 16 | -------------------------------------------------------------------------------- /tests/testthat/test-awk.R: -------------------------------------------------------------------------------- 1 | context("awk") 2 | dat <- data.frame(x=c(1, 2, 3), y=c('a', 'b', 'c'), z=c(10L, 11L, 12L)) 3 | file <- tempfile() 4 | file2 <- paste(file, "_sub", sep='') 5 | write.table(dat, file=file, 6 | row.names=FALSE, 7 | col.names=FALSE, 8 | sep="\t", 9 | quote=FALSE 10 | ) 11 | 12 | tryAwk <- try(awk('print $0', file=file), silent=TRUE) 13 | if (!inherits(tryAwk, "try-error")) { 14 | dat2 <- read.table( text=awk('print $0', file=file) ) 15 | expect_true( all(dat == dat2) ) 16 | 17 | awk('print $1', file=file, out=file2) 18 | dat3 <- read.table(file2, header=FALSE) 19 | expect_true( all(dat[,1] == dat3[,1]) ) 20 | } 21 | -------------------------------------------------------------------------------- /man/str_rev2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{str_rev2} 3 | \alias{str_rev2} 4 | \title{Reverse a Vector of Strings (UTF-8)} 5 | \usage{ 6 | str_rev2(x) 7 | } 8 | \arguments{ 9 | \item{x}{a character vector.} 10 | } 11 | \description{ 12 | Reverses a vector of 'strings' (a character vector). This will safely reverse a 13 | vector of unicode (UTF-8) characters. 14 | } 15 | \details{ 16 | This function will handle UTF-8 characters safely. If you 17 | are working only with ASCII characters and require speed, 18 | see \code{\link{str_rev2}}. 19 | } 20 | \examples{ 21 | x <- c("ABC", "DEF", "GHIJ") 22 | str_rev(x) 23 | } 24 | \seealso{ 25 | \code{\link{str_rev}} 26 | } 27 | 28 | -------------------------------------------------------------------------------- /man/split_.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{split_} 3 | \alias{split_} 4 | \title{Fast Split} 5 | \usage{ 6 | split_(x, f, na.last = TRUE) 7 | } 8 | \arguments{ 9 | \item{x}{A vector containing values to be divided into 10 | groups.} 11 | 12 | \item{f}{A grouping variable defining the grouping.} 13 | 14 | \item{na.last}{Boolean, if \code{TRUE} then \code{NA} 15 | elements are split as well. Note that we diverge from 16 | \code{split} in that we allow \code{NA} elements to be 17 | split on.} 18 | } 19 | \description{ 20 | A faster version of \code{\link{split}} -- this divides the data in the 21 | vector \code{x} into the groups defined by \code{f}. 22 | } 23 | 24 | -------------------------------------------------------------------------------- /man/str_rev.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{str_rev} 3 | \alias{str_rev} 4 | \title{Reverse a Vector of Strings} 5 | \usage{ 6 | str_rev(x) 7 | } 8 | \arguments{ 9 | \item{x}{a character vector.} 10 | } 11 | \description{ 12 | Reverses a vector of 'strings' (a character vector). Not safe for 13 | unicode (UTF-8) characters. 14 | } 15 | \details{ 16 | This function is written in C for fast execution; however, we do not handle 17 | non-ASCII characters. For a 'safe' version of \code{str_rev} that handles 18 | unicode characters, see \code{\link{str_rev2}}. 19 | } 20 | \examples{ 21 | x <- c("ABC", "DEF", "GHIJ") 22 | str_rev(x) 23 | } 24 | \seealso{ 25 | \code{\link{str_rev2}} 26 | } 27 | 28 | -------------------------------------------------------------------------------- /tests/testthat/test-split_.R: -------------------------------------------------------------------------------- 1 | context("split") 2 | 3 | num <- rnorm(10) 4 | int <- 1:10 5 | char <- letters[1:10] 6 | lgcl <- as.logical(int) 7 | 8 | for (x1 in list(num, int, char, lgcl)) { 9 | for (x2 in list(num, int, char, lgcl)) { 10 | expect_identical( 11 | unname(split(x1, x2)), 12 | unname(split_(x1, x2)) 13 | ) 14 | } 15 | } 16 | 17 | num[ sample(10, 5) ] <- NA 18 | int[ sample(10, 5) ] <- NA 19 | char[ sample(10, 5) ] <- NA 20 | lgcl[ sample(10, 5) ] <- NA 21 | 22 | for (x1 in list(num, int, char, lgcl)) { 23 | for (x2 in list(num, int, char, lgcl)) { 24 | expect_identical( 25 | unname(split(x1, x2)), 26 | unname(split_(x1, x2, na.last=FALSE)) 27 | ) 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /man/unmelt.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{unmelt_} 3 | \alias{unmelt_} 4 | \title{Unmelt a Melted Data Frame} 5 | \usage{ 6 | unmelt_(data, variable = "variable", value = "value") 7 | } 8 | \arguments{ 9 | \item{data}{A \code{data.frame}.} 10 | 11 | \item{variable}{The index, or name, of the 12 | \code{variable} vector; analogous to the vector produced 13 | with name \code{variable.name}.} 14 | 15 | \item{value}{The value of the \code{value} vector; 16 | analogous to the vector produced with name 17 | \code{value.name}.} 18 | } 19 | \description{ 20 | This function undoes the \code{melt}ing process done by either 21 | \code{reshape2::melt} or \code{\link{melt_}}. 22 | } 23 | 24 | -------------------------------------------------------------------------------- /man/kAnova.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{kAnova} 3 | \alias{kAnova} 4 | \title{Nicely Formatted ANOVA Table} 5 | \usage{ 6 | kAnova(fit, test = "LRT", swap.periods = TRUE) 7 | } 8 | \arguments{ 9 | \item{fit}{the model fit to generate an ANOVA table for.} 10 | 11 | \item{test}{the type of test to perform. default is 12 | likelihood-ratio test (LRT).} 13 | 14 | \item{swap.periods}{swap periods with spaces?} 15 | } 16 | \description{ 17 | Returns a nicely formatted ANOVA table. 18 | See \code{\link{kCoef}} for other details. 19 | } 20 | \examples{ 21 | x <- rnorm(100) 22 | y <- ifelse( x + runif(100) > 1, 1, 0 ) 23 | myFit <- glm( y ~ x, family="binomial" ) 24 | kAnova( myFit ) 25 | } 26 | 27 | -------------------------------------------------------------------------------- /man/strip_extension.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{strip_extension} 3 | \alias{strip_extension} 4 | \title{Strip File Extension} 5 | \usage{ 6 | strip_extension(x, lvl = 1) 7 | } 8 | \arguments{ 9 | \item{x}{the file name, including extension.} 10 | 11 | \item{lvl}{the number of \code{'.'} used in defining the 12 | file extension.} 13 | } 14 | \description{ 15 | Strips the extension from a file name. By default, we assume the extension 16 | is separated from the file name by a single period; however, the \code{lvl} 17 | argument lets us specify how many periods are used in forming the file 18 | extension. 19 | } 20 | \examples{ 21 | x <- "path_to_file.tar.gz" 22 | strip_extension(x, lvl=2) 23 | } 24 | 25 | -------------------------------------------------------------------------------- /incubator/htmlPlot.R: -------------------------------------------------------------------------------- 1 | htmlPlot <- function(plot) { 2 | 3 | if (inherits(plot, "trellis")) { 4 | p1 <- plot 5 | p2 <- plot 6 | p2$main <- paste0(p2$main, " - Large") 7 | print(p1) 8 | print(p2) 9 | return( invisible(NULL) ) 10 | } 11 | 12 | if (inherits(plot, "ggplot")) { 13 | p1 <- plot 14 | p2 <- plot 15 | if (is.null(p2$labels$title)) { 16 | p2$labels$title <- "Large" 17 | } else { 18 | p2$labels$title <- paste0(p2$labels$title, " - Large") 19 | } 20 | print(p1) 21 | print(p2) 22 | return( invisible(NULL) ) 23 | } 24 | 25 | ## if we get here, assume we have received a base graphics plot 26 | stop("Currently only handle lattice and ggplot2 plots") 27 | 28 | } 29 | -------------------------------------------------------------------------------- /man/char_to_factor.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{char_to_factor} 3 | \alias{char2factor} 4 | \alias{char_to_factor} 5 | \title{Converts Characters to Factors in an Object} 6 | \usage{ 7 | char_to_factor(X, inplace = FALSE, ...) 8 | 9 | char2factor(X, inplace = FALSE, ...) 10 | } 11 | \arguments{ 12 | \item{X}{an object.} 13 | 14 | \item{inplace}{boolean; if \code{TRUE} the object is 15 | modified in place. Useful if you're modifying a list and 16 | don't want to force a copy, but be wary of other symbols 17 | pointing at the same data.} 18 | 19 | \item{...}{Ignored.} 20 | } 21 | \description{ 22 | Converts characters to factors in an object. Leaves non-factor elements 23 | untouched. 24 | } 25 | 26 | -------------------------------------------------------------------------------- /man/kSvg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{kSvg} 3 | \alias{kSvg} 4 | \title{HTML - Source an SVG file} 5 | \usage{ 6 | kSvg(file = NULL, width = 4, height = 4, class = NULL) 7 | } 8 | \arguments{ 9 | \item{file}{path to the SVG file you want to embed} 10 | 11 | \item{width}{width (in pixels) of the SVG file (or, more 12 | accurately, canvas in which that file is displayed)} 13 | 14 | \item{height}{height (in pixels) of the SVG file (or, 15 | more accurately, canvas in which that file is displayed)} 16 | 17 | \item{class}{class passed to the \code{} tag} 18 | } 19 | \description{ 20 | Convenience function for \code{cat}-ing out HTML markup for an SVG image, using 21 | \code{}. 22 | } 23 | 24 | -------------------------------------------------------------------------------- /R/transpose.R: -------------------------------------------------------------------------------- 1 | ##' Tranpose an Object 2 | ##' 3 | ##' This functions similarily to \R's \code{t}, but we add a new method, 4 | ##' \code{transpose.list}, for transposing lists in a specific way. 5 | ##' 6 | ##' @param x A matrix, data.frame, or matrix-like list. 7 | ##' @export 8 | transpose <- function(x) { 9 | UseMethod("transpose") 10 | } 11 | 12 | ##' @rdname transpose 13 | ##' @export 14 | transpose.list <- function(x) { 15 | return( .Call(Ctranspose_list, as.list(x)) ) 16 | } 17 | 18 | ##' @rdname transpose 19 | ##' @export 20 | transpose.data.frame <- function(x) { 21 | return( as.matrix( transpose.list(x) ) ) 22 | } 23 | 24 | ##' @rdname transpose 25 | ##' @export 26 | transpose.default <- function(x) { 27 | return( t.default(x) ) 28 | } 29 | -------------------------------------------------------------------------------- /man/swap_.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{swap_} 3 | \alias{swap_} 4 | \title{Swap Elements in a Vector} 5 | \usage{ 6 | swap_(vec, ...) 7 | } 8 | \arguments{ 9 | \item{vec}{the vector of items whose elemetns you will be 10 | replacing.} 11 | 12 | \item{...}{A set of named arguments, whereby we translate 13 | from \code{names} to \code{values} of those arguments.} 14 | } 15 | \description{ 16 | This function swaps elements in a vector. See examples for usage. 17 | } 18 | \details{ 19 | If \code{to} is of different type than \code{from}, it will be coerced 20 | to be of the same type. 21 | } 22 | \examples{ 23 | x <- c('a', 'a', 'b', 'c') 24 | swap_(x, a="A") 25 | } 26 | \seealso{ 27 | \code{\link{swap}} 28 | } 29 | 30 | -------------------------------------------------------------------------------- /tools/check.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | IN_KMISC=`pwd | grep Kmisc$` 4 | if [ ${#IN_KMISC} == 0 ]; then 5 | echo "Error: not in base Kmisc directory." 6 | exit 0 7 | fi; 8 | 9 | ## NOTE: For some reason, clang-modernize tries to add a second 10 | ## set of overrides to Rstreambuf.h, so we exclude it explicitly 11 | 12 | ## I also currently get assertion errors if I try to use 13 | ## '-use-auto', hence I explicitly set some parameters for modernizing 14 | 15 | clang-check src/*.cpp \ 16 | -analyze \ 17 | -- \ 18 | -std=c++1y \ 19 | -I/Users/kevinushey/.llvm/libcxx/include \ 20 | -I/Library/Frameworks/R.framework/Headers \ 21 | -I/Library/Frameworks/R.framework/Resources/library/Rcpp/include \ 22 | -Iinst/include 23 | -------------------------------------------------------------------------------- /man/pp_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{pp_plot} 3 | \alias{pp_plot} 4 | \title{Construct a Probability-Probability Plot from a Set of P-Values} 5 | \usage{ 6 | pp_plot(x, ...) 7 | } 8 | \arguments{ 9 | \item{x}{A vector of p-values; numbers within the range 0 10 | to 1.} 11 | 12 | \item{...}{Optional arguments passed to 13 | \code{\link{xyplot}}. Note that a custom panel function 14 | is used for generating the plot and hence you shouldn't 15 | try to generate your own panel function.} 16 | } 17 | \description{ 18 | This function constructs a probability-probability plot as based 19 | on a vector of p-values. 20 | } 21 | \examples{ 22 | pp_plot( runif(100), main="PP-Plot of 100 random uniforms" ) 23 | } 24 | 25 | -------------------------------------------------------------------------------- /R/any_na.R: -------------------------------------------------------------------------------- 1 | ##' Check whether there are any Missing Values in a Vector 2 | ##' 3 | ##' This function checks whether there are any missing values in an \R 4 | ##' object. For list objects, we recurse over each entry. This is typically 5 | ##' faster than \code{any(is.na(x))} as we exit and return \code{TRUE} as soon 6 | ##' as an \code{NA} is discovered. 7 | ##' 8 | ##' @param x An \R object. 9 | ##' @param how The simplification to use if \code{x} is a list. See 10 | ##' \code{\link{rapply}} for more details. 11 | ##' @export 12 | any_na <- function(x, how="unlist") { 13 | if( is.list(x) ) { 14 | f <- function(x) { 15 | .Call(Cany_na, x) 16 | } 17 | return( rapply( x, how=how, f ) ) 18 | } else { 19 | return(.Call(Cany_na, x)) 20 | } 21 | } 22 | -------------------------------------------------------------------------------- /R/split_.R: -------------------------------------------------------------------------------- 1 | ##' Fast Split 2 | ##' 3 | ##' A faster version of \code{\link{split}} -- this divides the data in the 4 | ##' vector \code{x} into the groups defined by \code{f}. 5 | ##' 6 | ##' @param x A vector containing values to be divided into groups. 7 | ##' @param f A grouping variable defining the grouping. 8 | ##' @param na.last Boolean, if \code{TRUE} then \code{NA} elements are 9 | ##' split as well. Note that we diverge from \code{split} in that we 10 | ##' allow \code{NA} elements to be split on. 11 | ##' @export 12 | split_ <- function(x, f, na.last=TRUE) { 13 | na.last <- if (isTRUE(na.last)) TRUE else NA 14 | if (is.character(x)) 15 | return( split(x, factor_(f, na.last=na.last)) ) 16 | else 17 | return( .Call(CKmisc_split, x, f, isTRUE(na.last)) ) 18 | } 19 | -------------------------------------------------------------------------------- /man/is.sorted.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{is.sorted} 3 | \alias{is.sorted} 4 | \title{Test if an Object is Sorted} 5 | \usage{ 6 | is.sorted(x, na.rm = FALSE, strictly = FALSE) 7 | } 8 | \arguments{ 9 | \item{x}{an \R object with a class or a numeric, complex, 10 | character or logical vector.} 11 | 12 | \item{na.rm}{logical. Should missing values be removed 13 | before checking?} 14 | 15 | \item{strictly}{logical indicating if the check should be 16 | for strictly increasing values.} 17 | } 18 | \description{ 19 | Test if an object is sorted, without the cost of sorting it. 20 | Wrapper to \code{\link{is.unsorted}}. 21 | } 22 | \examples{ 23 | stopifnot( is.sorted(1, 2, 4) ) 24 | } 25 | \seealso{ 26 | \code{\link{is.unsorted}} 27 | } 28 | 29 | -------------------------------------------------------------------------------- /tests/testthat/test-dictionary.R: -------------------------------------------------------------------------------- 1 | context("dictionary") 2 | 3 | test_that("dictionary primitives work", { 4 | 5 | d <- dict() 6 | d["a"] <- 1 7 | expect_identical(d[["a"]], 1) 8 | expect_identical(d["a"], list(a = 1)) 9 | d["b"] <- 2 10 | expect_equal(d[["b"]], 2) 11 | expect_equal(length(d), 2) 12 | d[["c"]] <- 3 13 | expect_equal(d[["c"]], 3) 14 | d[["c"]] <- 4 15 | expect_equal(d[["c"]], 4) 16 | expect_equal(length(d), 3) 17 | en <- enumerate(d, function(key, value) list(key, value)) 18 | expect_identical(en, list(list("a", 1), list("b", 2), list("c", 4))) 19 | 20 | }) 21 | 22 | test_that("we throw an error when trying to access an element that doesn't exist", { 23 | 24 | d <- dict() 25 | expect_error(d["a"]) 26 | expect_error(d[["a"]]) 27 | 28 | }) 29 | -------------------------------------------------------------------------------- /man/kmeans_plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{kmeans_plot} 3 | \alias{kmeans_plot} 4 | \title{k-means Diagnostic Plot} 5 | \usage{ 6 | kmeans_plot(dat, nmax = 20, ...) 7 | } 8 | \arguments{ 9 | \item{dat}{numeric matrix of data, or an object that can 10 | be coerced to such a matrix (such as a numeric vector or 11 | a data frame with all numeric columns).} 12 | 13 | \item{nmax}{maximum number of clusters to examine} 14 | 15 | \item{...}{optional arguments passed to xyplot} 16 | } 17 | \description{ 18 | Using \code{kmeans}, plot percentage variance explained vs. number of clusters. 19 | Used as a means of picking \code{k}. 20 | } 21 | \examples{ 22 | data(iris) 23 | kmeans_plot(iris[,1:4]) 24 | } 25 | \seealso{ 26 | \code{\link{kmeans}} 27 | } 28 | 29 | -------------------------------------------------------------------------------- /man/read.cb.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{read.cb} 3 | \alias{read.cb} 4 | \title{Read Tabular Data from the Clipboard} 5 | \usage{ 6 | read.cb(sep = "\\t", header = TRUE, ...) 7 | } 8 | \arguments{ 9 | \item{sep}{the delimiter used in the copied text.} 10 | 11 | \item{header}{boolean; does the first row contain column 12 | names?} 13 | 14 | \item{...}{optional arguments passed to 15 | \code{read.table}.} 16 | } 17 | \description{ 18 | Convenience function for reading tabular data from the clipboard. 19 | The function checks the system OS and provides the appropriate wrapper 20 | call to \code{\link{read.table}}. 21 | } 22 | \examples{ 23 | ## with some data on the clipboard, simply write 24 | # x <- read.cb() 25 | } 26 | \seealso{ 27 | \code{\link{read.table}} 28 | } 29 | 30 | -------------------------------------------------------------------------------- /R/update_date.R: -------------------------------------------------------------------------------- 1 | ##' Update Date in DESCRIPTION File 2 | ##' 3 | ##' This function for package authors updates the time in the \code{DESCRIPTION} 4 | ##' file to the current date, as discovered through \code{Sys.Date()}. 5 | ##' @param file The path to the \code{DESCRIPTION} file. 6 | update_date <- function(file="DESCRIPTION") { 7 | 8 | DESCRIPTION <- tryCatch( 9 | scan( what=character(), sep="\n", quiet=TRUE, file ), 10 | error=function(e) { 11 | stop("DESCRIPTION file not found.") 12 | } ) 13 | 14 | DESCRIPTION <- gsub("^Date:.*", 15 | paste( sep="", "Date: ", Sys.Date() ), 16 | DESCRIPTION, 17 | perl=TRUE ) 18 | 19 | cat( DESCRIPTION, file=file, sep="\n" ) 20 | message("DESCRIPTION date successfully updated.") 21 | 22 | } 23 | -------------------------------------------------------------------------------- /R/wrap.R: -------------------------------------------------------------------------------- 1 | ##' Wrap a String 2 | ##' 3 | ##' This function operates similarily to \code{\link{strwrap}}, but 4 | ##' \code{paste}s the wrapped text back together with line separators. 5 | ##' Useful for automatically wrapping long labels. 6 | ##' 7 | ##' @param x A character vectors, or an object which can be converted to 8 | ##' a character vector by \code{\link{as.character}}. 9 | ##' @param width A positive integer giving the number of characters a line 10 | ##' can reach before we wrap and introduce a new line. 11 | ##' @param ... Optional arguments passed to \code{\link{strwrap}}. 12 | ##' @examples 13 | ##' long_label <- "This is a very long label which needs wrapping." 14 | ##' wrap(long_label) 15 | ##' @export 16 | wrap <- function(x, width=8, ...) { 17 | return( paste( strwrap(x, width, ...), collapse="\n" ) ) 18 | } 19 | -------------------------------------------------------------------------------- /R/list2mat.R: -------------------------------------------------------------------------------- 1 | ##' Convert a list to a matrix 2 | ##' 3 | ##' This function converts a \code{list} to a \code{matrix}, assuming that each 4 | ##' element of the list is of equal length. 5 | ##' 6 | ##' @param list A list. 7 | ##' @export 8 | list2mat <- function(list) { 9 | return( .Call(Clist2mat, list) ) 10 | } 11 | 12 | ##' Convert a data.frame to a matrix 13 | ##' 14 | ##' This function converts a \code{data.frame} to a \code{matrix}. 15 | ##' 16 | ##' @param df a \code{data.frame}. 17 | ##' @export 18 | df2mat <- function(df) { 19 | return( .Call(Clist2mat, df) ) 20 | } 21 | 22 | ##' Convert a matrix to a list 23 | ##' 24 | ##' This function converts a \code{matrix} to a \code{list}. 25 | ##' 26 | ##' @param matrix A \code{matrix}. 27 | ##' @export 28 | mat2list <- function(matrix) { 29 | return( .Call(Cmat2list, matrix) ) 30 | } 31 | -------------------------------------------------------------------------------- /man/enumerate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{enumerate} 3 | \alias{enumerate} 4 | \title{Enumerate over a Vector} 5 | \usage{ 6 | enumerate(X, FUN, ...) 7 | } 8 | \arguments{ 9 | \item{X}{A vector.} 10 | 11 | \item{FUN}{A function, taking two arguments.} 12 | 13 | \item{...}{Optional arguments to \code{FUN}.} 14 | } 15 | \description{ 16 | This function extends \code{lapply} to operate on functions taking two 17 | arguments -- the first refers to each element within a vector, while 18 | the second refers to the current index. 19 | } 20 | \examples{ 21 | data <- setNames( list(1, 2, 3), c('a', 'b', 'c') ) 22 | v <- replicate(10, rnorm(1E3), simplify=FALSE) 23 | identical( lapply(v, sum), enumerate(v, sum) ) 24 | f <- function(x, i) i 25 | enumerate(v, f) 26 | enumerate(v, function(x, i) i) 27 | } 28 | 29 | -------------------------------------------------------------------------------- /man/scan.cb.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{scan.cb} 3 | \alias{scan.cb} 4 | \title{Read Data from the Clipboard} 5 | \usage{ 6 | scan.cb(what = character(), sep = "\\n", quiet = TRUE, 7 | blank.lines.skip = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{what}{passed to \code{scan}.} 11 | 12 | \item{sep}{passed to \code{scan}.} 13 | 14 | \item{quiet}{passed to \code{scan}.} 15 | 16 | \item{blank.lines.skip}{Skip blank lines? Defaults to 17 | \code{FALSE}, as opposed to base \R's \code{scan}.} 18 | 19 | \item{...}{passed to \code{scan}.} 20 | } 21 | \description{ 22 | Convenience function for reading data from the clipboard. 23 | Wraps to \code{\link{scan}}. By default, we assume the data is 24 | \code{character}, and delimit by new lines. 25 | } 26 | \seealso{ 27 | \code{\link{scan}} 28 | } 29 | 30 | -------------------------------------------------------------------------------- /man/factor_to_char.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{factor_to_char} 3 | \alias{factor2char} 4 | \alias{factor_to_char} 5 | \title{Converts Factors to Characters in an Object} 6 | \usage{ 7 | factor_to_char(X, inplace = FALSE) 8 | 9 | factor2char(X, inplace = FALSE) 10 | } 11 | \arguments{ 12 | \item{X}{an object.} 13 | 14 | \item{inplace}{Boolean; if \code{TRUE} we modify the 15 | object in place. Useful if you're modifying a list and 16 | don't want to force a copy, but be wary of other symbols 17 | pointing at the same data.} 18 | } 19 | \description{ 20 | Converts factors to characters in an object. Leaves non-character 21 | elements untouched. 22 | } 23 | \details{ 24 | We iterate through all elements in the object (e.g. if 25 | it is a list) and convert anything that is a factor into a character. 26 | } 27 | 28 | -------------------------------------------------------------------------------- /tests/testthat/test-regular-expressions.R: -------------------------------------------------------------------------------- 1 | context("Regular Expressions") 2 | 3 | test_that("re_* functions work with various objects", { 4 | 5 | ## Re: GitHub issue #9 6 | library(data.table) 7 | dt <- data.table( 8 | id=letters[1:6], 9 | gender=rep(c('M','F'),times=3), 10 | dv1=runif(6), 11 | dv2=rnorm(6) 12 | ) 13 | 14 | dt_sub <- re_without(dt,"^dv\\d") 15 | expect_equal( 16 | as.data.frame(dt_sub), 17 | re_without(as.data.frame(dt), "^dv\\d") 18 | ) 19 | 20 | dt_sub <- re_extract(dt, "[dr]$") 21 | expect_equal( 22 | as.data.frame(dt_sub), 23 | extract(as.data.frame(dt), id, gender) 24 | ) 25 | 26 | ## Other basic tests 27 | m <- matrix(1:25, nrow = 5) 28 | rownames(m) <- letters[1:5] 29 | expect_identical( 30 | re_extract_rows(m, "[a-c]"), 31 | m[c("a", "b", "c"), ] 32 | ) 33 | 34 | 35 | }) 36 | -------------------------------------------------------------------------------- /tests/testthat/test-setnames.R: -------------------------------------------------------------------------------- 1 | context("setnames") 2 | 3 | test_that("setrownames, setcolnames behave as expected for data.frames", { 4 | 5 | df <- data.frame(x=1, y=2, z=3) 6 | setrownames(df, "foo") 7 | setcolnames(df, c("foo", "bar", "baz")) 8 | expect_identical( rownames(df), "foo" ) 9 | expect_identical( colnames(df), c("foo", "bar", "baz") ) 10 | expect_error( setrownames(df, c("foo", "bar")) ) 11 | expect_error( setcolnames(df, "bar") ) 12 | 13 | }) 14 | 15 | test_that("setrownames, setcolnames behave as expected for matrices", { 16 | 17 | m <- matrix(1:9, nrow=3) 18 | setrownames(m, letters[1:3]) 19 | setcolnames(m, LETTERS[1:3]) 20 | expect_identical(rownames(m), letters[1:3]) 21 | expect_identical(colnames(m), LETTERS[1:3]) 22 | expect_error(setrownames(m, "foo")) 23 | expect_error(setcolnames(m, "bar")) 24 | 25 | }) 26 | -------------------------------------------------------------------------------- /src/matches.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | template 5 | IntegerMatrix do_matches(List x) { 6 | int n = x.size(); 7 | IntegerMatrix output(n, n); 8 | 9 | for (int i=0; i < n; ++i) { 10 | for (int j=0; j < n; ++j) { 11 | int tmp = sum( !is_na( match( as(x[i]), as(x[j]) ) ) ); 12 | output(i, j) = (int) tmp; 13 | } 14 | } 15 | 16 | return output; 17 | 18 | } 19 | 20 | // [[Rcpp::export]] 21 | IntegerMatrix matches(List x) { 22 | switch( TYPEOF(x[0]) ) { 23 | case INTSXP: return do_matches(x); 24 | case REALSXP: return do_matches(x); 25 | case STRSXP: return do_matches(x); 26 | case LGLSXP: return do_matches(x); 27 | default: { 28 | stop("invalid SEXP type"); 29 | return R_NilValue; 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /man/size.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{size} 3 | \alias{size} 4 | \title{Print the Object Size, with Auto Units} 5 | \usage{ 6 | size(x, quote = FALSE, units = "auto", ...) 7 | } 8 | \arguments{ 9 | \item{x}{An \R object.} 10 | 11 | \item{quote}{logical, indicating whether or not the 12 | result should be printed with surrounding quotes.} 13 | 14 | \item{units}{The units to be used in printing the size. 15 | Other allowed values are \code{"Kb"}, \code{"Mb"}, 16 | \code{"Gb"} and \code{"auto"}. See 17 | \code{\link{object.size}} for more details.} 18 | 19 | \item{...}{Arguments to be passed to or from other 20 | methods.} 21 | } 22 | \description{ 23 | Provides an estimate of the memory that is being used to store an \R 24 | object. Similar to \code{\link{object.size}}, but we set \code{units="auto"} 25 | as default. 26 | } 27 | 28 | -------------------------------------------------------------------------------- /man/html.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{html} 3 | \alias{html} 4 | \title{Print HTML Elements} 5 | \usage{ 6 | html(..., file = "", .sub = NULL) 7 | } 8 | \arguments{ 9 | \item{...}{A set of HTML tag functions. See examples for 10 | details.} 11 | 12 | \item{file}{Location to output the generated HTML.} 13 | 14 | \item{.sub}{A named list of substitutions to perform; we 15 | substitute each symbol from the names of \code{.sub} with 16 | its corresponding value.} 17 | } 18 | \description{ 19 | Use this function to output HTML code for use in R Markdown documents 20 | or otherwise. 21 | } 22 | \examples{ 23 | html( 24 | h1("Welcome!"), 25 | div(class="header", table( tr( td("nested elements are ok") ) ) ), 26 | footer(class="foot", "HTML5 footer") 27 | ) 28 | } 29 | \seealso{ 30 | \code{\link{makeHTMLTag}}, for making your own tags. 31 | } 32 | 33 | -------------------------------------------------------------------------------- /man/lg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{lg} 3 | \alias{lg} 4 | \title{length( grep( ... ) )} 5 | \usage{ 6 | lg(pattern, x, perl = TRUE, ...) 7 | } 8 | \arguments{ 9 | \item{pattern}{regex pattern passed to \code{grep}.} 10 | 11 | \item{x}{a vector on which we attempt to match 12 | \code{pattern} on.} 13 | 14 | \item{perl}{boolean. use perl-compatible regular 15 | expressions?} 16 | 17 | \item{...}{additional arguments passed to 18 | \code{\link{grep}}.} 19 | } 20 | \description{ 21 | This is a wrapper to a \code{length( grep( ... ) )}. See examples for usage. 22 | Primarily intended for interactive, not programmatic, use. 23 | } 24 | \examples{ 25 | x <- c("apple", "banana", "cherry") 26 | if( lg( "^ap", x ) > 0 ) { 27 | print( "regular expression '^ap' found in 'x'" ) 28 | } 29 | } 30 | \seealso{ 31 | \code{\link{re_exists}} 32 | } 33 | 34 | -------------------------------------------------------------------------------- /man/wrap.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{wrap} 3 | \alias{wrap} 4 | \title{Wrap a String} 5 | \usage{ 6 | wrap(x, width = 8, ...) 7 | } 8 | \arguments{ 9 | \item{x}{A character vectors, or an object which can be 10 | converted to a character vector by 11 | \code{\link{as.character}}.} 12 | 13 | \item{width}{A positive integer giving the number of 14 | characters a line can reach before we wrap and introduce 15 | a new line.} 16 | 17 | \item{...}{Optional arguments passed to 18 | \code{\link{strwrap}}.} 19 | } 20 | \description{ 21 | This function operates similarily to \code{\link{strwrap}}, but 22 | \code{paste}s the wrapped text back together with line separators. 23 | Useful for automatically wrapping long labels. 24 | } 25 | \examples{ 26 | long_label <- "This is a very long label which needs wrapping." 27 | wrap(long_label) 28 | } 29 | 30 | -------------------------------------------------------------------------------- /incubator/multimelt.R: -------------------------------------------------------------------------------- 1 | df <- data.frame( 2 | id1=letters[1:5], 3 | id2=LETTERS[1:5], 4 | v1.Mean=1:5, 5 | v1.SD=6:10, 6 | z1.Mean=11:15, 7 | z1.SD=16:20 8 | ) 9 | 10 | data <- data.table(df) 11 | id.vars <- c("id1", "id2") 12 | measure.vars <- list( c("v1.Mean", "v1.SD"), c("z1.Mean", "z1.SD") ) 13 | variable.names <- c("v1", "v2") 14 | value.names <- c("Mean", "SD") 15 | 16 | multimelt <- function(data, ...) { 17 | UseMethod("multimelt") 18 | } 19 | 20 | multimelt.data.table <- function(data, id.vars, measure.vars, 21 | variable.names, ..., value.names) { 22 | 23 | tmp <- lapply(measure.vars, function(x) { 24 | melt_( data[, c(id.vars, x), with=FALSE], id.vars=id.vars ) 25 | }) 26 | 27 | output <- tmp[[1]][, c(id.vars, "variable"), with=FALSE] 28 | for (i in seq_along(tmp)) { 29 | output[, eval(value.names[i]) := tmp[[i]][["value"]]] 30 | } 31 | 32 | 33 | } 34 | -------------------------------------------------------------------------------- /man/pxt.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{pxt} 3 | \alias{pxt} 4 | \title{Make 2x2 HTML Contingency Table} 5 | \usage{ 6 | pxt(x, class = "twoDtable", id = NULL, ...) 7 | } 8 | \arguments{ 9 | \item{x}{a 2x2 table; typically something returned from 10 | \code{kTable(x,y)}} 11 | 12 | \item{class}{class to be passed to HTML table; used for 13 | CSS styling.} 14 | 15 | \item{id}{id to be passed to HTML table; used for CSS 16 | styling.} 17 | 18 | \item{...}{optional arguments passed to 19 | \code{\link{makeHTMLTable}}.} 20 | } 21 | \description{ 22 | Function for outputting cross-tabulated tables as marked-up HTML. 23 | CSS styling can be used to make these tables look especially nice. 24 | } 25 | \examples{ 26 | x <- rbinom( 100, 2, 0.2 ) 27 | y <- rbinom( 100, 2, 0.2 ) 28 | pxt( kTable(x, y) ) 29 | } 30 | \seealso{ 31 | \code{\link{kTable}} 32 | } 33 | 34 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # Sample .travis.yml for R projects. 2 | # 3 | # See README.md for instructions, or for more configuration options, 4 | # see the wiki: 5 | # https://github.com/craigcitro/r-travis/wiki 6 | 7 | language: c 8 | 9 | env: 10 | global: 11 | - R_BUILD_ARGS="--no-build-vignettes --no-manual" 12 | - R_CHECK_ARGS="--no-build-vignettes --no-manual --as-cran" 13 | 14 | before_install: 15 | - curl -OL http://raw.github.com/craigcitro/r-travis/master/scripts/travis-tool.sh 16 | - chmod 755 ./travis-tool.sh 17 | - ./travis-tool.sh bootstrap 18 | 19 | install: 20 | - ./travis-tool.sh install_r Rcpp data.table knitr markdown ggplot2 plyr reshape2 testthat rbenchmark fastmatch 21 | 22 | script: 23 | - ./travis-tool.sh run_tests 24 | 25 | after_failure: 26 | - ./travis-tool.sh dump_logs 27 | 28 | notifications: 29 | email: 30 | on_success: change 31 | on_failure: change 32 | 33 | 34 | -------------------------------------------------------------------------------- /man/counts.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{counts} 3 | \alias{counts} 4 | \title{Generate Counts of Values in a Vector} 5 | \usage{ 6 | counts(x) 7 | } 8 | \arguments{ 9 | \item{x}{A numeric, integer, character or logical vector, 10 | or a (potentially nested) list of such vectors. If 11 | \code{x} is a list, we recursively apply \code{counts} 12 | throughout elements in the list.} 13 | } 14 | \description{ 15 | This function uses Rcpp sugar to implement a fast \code{table}, for 16 | unique counts of a single vector. This implementation seeks to 17 | produce identical output to \code{table(x, useNA="ifany")}. 18 | } 19 | \details{ 20 | The order of \code{NA}, \code{NaN} in the output may differ -- even 21 | \R is inconsistent with the order that \code{NA} and \code{NaN} elements 22 | are inserted. 23 | } 24 | \examples{ 25 | x <- round( rnorm(1E2), 1 ) 26 | counts(x) 27 | } 28 | 29 | -------------------------------------------------------------------------------- /man/error-wrappers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{error-wrappers} 3 | \alias{error-wrappers} 4 | \alias{message_if} 5 | \alias{messagef} 6 | \alias{stop_if} 7 | \alias{stopf} 8 | \alias{warn_if} 9 | \alias{warnf} 10 | \title{Stop / Warning / Message Wrappers} 11 | \usage{ 12 | stopf(fmt, ...) 13 | 14 | warnf(fmt, ...) 15 | 16 | messagef(fmt, ...) 17 | 18 | stop_if(expr, fmt, ...) 19 | 20 | warn_if(expr, fmt, ...) 21 | 22 | message_if(expr, fmt, ...) 23 | } 24 | \arguments{ 25 | \item{expr}{An expression to be evaluated and checked for 26 | 'truthiness'.} 27 | 28 | \item{fmt}{A character vector of format strings. Passed 29 | to \code{\link{gettextf}}.} 30 | 31 | \item{...}{Optional arguments passed to 32 | \code{\link{gettextf}}.} 33 | } 34 | \description{ 35 | These are simple wrappers to functions \code{stop}, \code{warning}, and 36 | \code{message}. 37 | } 38 | 39 | -------------------------------------------------------------------------------- /man/p1t.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{p1t} 3 | \alias{p1t} 4 | \title{Make 1D HTML Table} 5 | \usage{ 6 | p1t(x, class = "table table-condensed table-striped table-hover", id = NULL, 7 | ...) 8 | } 9 | \arguments{ 10 | \item{x}{a \code{data.frame}, typically output of 11 | \code{kTable}.} 12 | 13 | \item{class}{class to be passed to HTML table; used for 14 | CSS styling.} 15 | 16 | \item{id}{id to be passed to HTML table; used for CSS 17 | styling.} 18 | 19 | \item{...}{optional arguments passed to 20 | \code{\link{makeHTMLTable}}.} 21 | } 22 | \description{ 23 | This tabling function is intended for the output of \code{kTable}, as 24 | generated when only one 'data' argument is passed. 25 | } 26 | \examples{ 27 | y <- factor( rbinom( 100, 2, 0.2 ) ) 28 | p1t( kTable( y ) ) 29 | } 30 | \seealso{ 31 | \code{\link{kTable}}, \code{\link{makeHTMLTable}} 32 | } 33 | 34 | -------------------------------------------------------------------------------- /man/chunk.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{chunk} 3 | \alias{chunk} 4 | \title{Generate a Sequence of Integers, and Split into Chunks} 5 | \usage{ 6 | chunk(min, max, size, by = 1) 7 | } 8 | \arguments{ 9 | \item{min}{The lower end (start point) of the sequence.} 10 | 11 | \item{max}{The upper end (end point) of the sequence.} 12 | 13 | \item{size}{The number of elements to place in each 14 | chunk.} 15 | 16 | \item{by}{The difference between consecutive elements.} 17 | } 18 | \description{ 19 | This function takes a set of endpoints, and 'chunks' the sequence from 20 | \code{min} to \code{max} into a list with each element of size \code{size}. 21 | } 22 | \details{ 23 | If \code{max} is not specified, then we generate a chunk of integers 24 | from 1 to \code{min}, each of size \code{size}. This allows you to 25 | specify chunks with syntax like \code{chunk(100, size=5)}. 26 | } 27 | 28 | -------------------------------------------------------------------------------- /tools/modernize.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env sh 2 | 3 | IN_KMISC=`pwd | grep Kmisc$` 4 | if [ ${#IN_KMISC} == 0 ]; then 5 | echo "Error: not in base Kmisc directory." 6 | exit 0 7 | fi; 8 | 9 | ## NOTE: For some reason, clang-modernize tries to add a second 10 | ## set of overrides to Rstreambuf.h, so we exclude it explicitly 11 | 12 | ## I also currently get assertion errors if I try to use 13 | ## '-use-auto', hence I explicitly set some parameters for modernizing 14 | 15 | clang-modernize src/*.cpp \ 16 | -final-syntax-check \ 17 | -style="Chromium" \ 18 | -risk=risky \ 19 | -pass-by-value \ 20 | -loop-convert \ 21 | -add-override \ 22 | -for-compilers=clang-3.5 \ 23 | -- \ 24 | -std=c++1y \ 25 | -I/Users/kevinushey/.llvm/libcxx/include \ 26 | -I/Library/Frameworks/R.framework/Headers \ 27 | -I/Library/Frameworks/R.framework/Resources/library/Rcpp/include \ 28 | -Iinst/include 29 | -------------------------------------------------------------------------------- /man/gradient.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{gradient} 3 | \alias{gradient} 4 | \title{Generate Gradient from Continuous Variable} 5 | \usage{ 6 | gradient(x, m = 10, cols = c("darkorange", "grey60", "darkblue")) 7 | } 8 | \arguments{ 9 | \item{x}{a continuous variable to generate colors over.} 10 | 11 | \item{m}{the number of distinct colors you wish to pull 12 | from the pallete.} 13 | 14 | \item{cols}{the colors to interpolate over. passed to 15 | \code{\link{colorRampPalette}}.} 16 | } 17 | \description{ 18 | Assign colors based on a continuous variable. Useful for plotting functions 19 | where you would like to generate a gradient based on (a function of) the 20 | continuous variables you are plotting quickly. 21 | } 22 | \examples{ 23 | dat <- data.frame(y=rnorm(100), x=rnorm(100)) 24 | with( dat, plot( y ~ x, col=gradient(y) ) ) 25 | } 26 | \seealso{ 27 | \code{\link{colorRampPalette}} 28 | } 29 | 30 | -------------------------------------------------------------------------------- /tests/testthat/test-apply.R: -------------------------------------------------------------------------------- 1 | context("*apply") 2 | 3 | m <- matrix(1:16, nrow=4, ncol=4) 4 | rownames(m) <- letters[1:4] 5 | colnames(m) <- LETTERS[1:4] 6 | 7 | expect_identical( 8 | colApply(m, sum), 9 | setNames( as.integer(c(10, 26, 42, 58)), LETTERS[1:4]) 10 | ) 11 | 12 | expect_identical( 13 | rowApply(m, sum), 14 | setNames( as.integer( c(28, 32, 36, 40) ), letters[1:4]) 15 | ) 16 | 17 | expect_identical( 18 | colApply(m, sum, drop=FALSE), 19 | `colnames<-`(matrix( as.integer(c(10, 26, 42, 58)), ncol=4 ), LETTERS[1:4]) 20 | ) 21 | 22 | expect_identical( 23 | rowApply(m, sum, drop=FALSE), 24 | `rownames<-`(matrix( as.integer(c(28, 32, 36, 40)), nrow=4 ), letters[1:4]) 25 | ) 26 | 27 | expect_identical( 28 | colApply(m, function(x) x / sum(x)), 29 | apply(m, 2, function(x) x / sum(x)) 30 | ) 31 | 32 | expect_identical( 33 | rowApply(m, function(x) x / sum(x)), 34 | t(apply(m, 1, function(x) x/sum(x))) 35 | ) 36 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: Kmisc 2 | Title: Kevin Miscellaneous 3 | Version: 0.5.1 4 | Date: 2013-12-12 5 | Authors@R: c( 6 | person("Kevin", "Ushey", role=c("aut", "cre"), email="kevinushey@gmail.com") 7 | ) 8 | Maintainer: Kevin Ushey 9 | Description: This package contains a collection of functions for common data 10 | extraction and reshaping operations, string manipulation, and 11 | functions for table and plot generation for R Markdown documents. 12 | License: GPL (>= 2) 13 | LazyData: TRUE 14 | LinkingTo: Rcpp 15 | URL: https://github.com/kevinushey/Kmisc 16 | BugReports: https://github.com/kevinushey/Kmisc/issues 17 | Imports: 18 | Rcpp (>= 0.11.0), 19 | data.table, 20 | lattice, 21 | grid, 22 | knitr, 23 | markdown, 24 | fastmatch 25 | Suggests: 26 | ggplot2, 27 | plyr, 28 | reshape2, 29 | testthat, 30 | rbenchmark 31 | ByteCompile: TRUE 32 | VignetteBuilder: knitr 33 | -------------------------------------------------------------------------------- /R/list_to_dataframe.R: -------------------------------------------------------------------------------- 1 | ##' Convert list to data.frame 2 | ##' 3 | ##' This function converts a list to a data frame, assuming that each 4 | ##' element of the list is of equal length. 5 | ##' 6 | ##' @param list A list. 7 | ##' @param inplace Boolean. If \code{TRUE}, we convert the list in place, 8 | ##' so that the \code{list} itself is transformed into a \code{data.frame}, 9 | ##' sans copying. 10 | ##' @export 11 | list2df <- function(list, inplace=FALSE) { 12 | return( .Call(Clist2df, list, inplace) ) 13 | } 14 | 15 | ##' Convert data.frame to list 16 | ##' 17 | ##' This function converts a \code{data.frame} to a list. 18 | ##' 19 | ##' @param df A data.frame. 20 | ##' @param inplace Boolean. If \code{TRUE}, we convert the list in place, 21 | ##' so that the \code{list} itself is transformed into a \code{data.frame}, 22 | ##' sans copying. 23 | ##' @export 24 | df2list <- function(df, inplace=FALSE) { 25 | return( .Call(Cdf2list, df, inplace) ) 26 | } 27 | -------------------------------------------------------------------------------- /R/read.R: -------------------------------------------------------------------------------- 1 | ##' Read a File 2 | ##' 3 | ##' These functions read a file into memory. We memory map the file for fast I/O. 4 | ##' The file is read in as a character vector (length one for \code{read}, 5 | ##' length \code{n} for \code{readlines}). 6 | ##' 7 | ##' @rdname read 8 | ##' @export 9 | read <- function(file) { 10 | file <- normalizePath( as.character(file) ) 11 | if (!file.exists(file)) { 12 | stop("No file at file location '", file, "'.") 13 | } 14 | .Call(CKmisc_read, file, FALSE) 15 | } 16 | 17 | ##' @rdname read 18 | ##' @param file Path to a file. 19 | ##' @export 20 | ##' @examples 21 | ##' p <- file.path( R.home(), "NEWS" ) 22 | ##' if (file.exists(p)) 23 | ##' stopifnot( identical( readLines(p), readlines(p) ) ) 24 | readlines <- function(file) { 25 | file <- normalizePath( as.character(file) ) 26 | if (!file.exists(file)) { 27 | stop("No file at file location '", file, "'.") 28 | } 29 | .Call(CKmisc_read, file, TRUE) 30 | } 31 | -------------------------------------------------------------------------------- /man/str_sort.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{str_sort} 3 | \alias{str_sort} 4 | \title{Sort a Vector of Strings} 5 | \usage{ 6 | str_sort(x, increasing = TRUE, ignore.case = FALSE, USE.NAMES = FALSE) 7 | } 8 | \arguments{ 9 | \item{x}{a character vector (a vector of 'strings' to 10 | sort)} 11 | 12 | \item{increasing}{boolean. sort the string in increasing 13 | lexical order?} 14 | 15 | \item{ignore.case}{boolean. ignore case (so that, eg, 16 | \code{a < A < b})} 17 | 18 | \item{USE.NAMES}{logical. if names attribute already 19 | exists on \code{x}, pass this through to the result?} 20 | } 21 | \description{ 22 | Sorts a vector of strings lexically, as based on their 23 | UTF-8 ordering scheme. Lower-case letters are, by default, 24 | 'larger' than upper-case letters. This function will safely sort a 25 | UTF-8 vector. 26 | } 27 | \examples{ 28 | stopifnot( all( str_sort(c("cba", "fed")) == c("abc", "def") ) ) 29 | } 30 | 31 | -------------------------------------------------------------------------------- /R/counts.R: -------------------------------------------------------------------------------- 1 | ##' Generate Counts of Values in a Vector 2 | ##' 3 | ##' This function uses Rcpp sugar to implement a fast \code{table}, for 4 | ##' unique counts of a single vector. This implementation seeks to 5 | ##' produce identical output to \code{table(x, useNA="ifany")}. 6 | ##' 7 | ##' The order of \code{NA}, \code{NaN} in the output may differ -- even 8 | ##' \R is inconsistent with the order that \code{NA} and \code{NaN} elements 9 | ##' are inserted. 10 | ##' 11 | ##' @param x A numeric, integer, character or logical vector, or a (potentially 12 | ##' nested) list of such vectors. If \code{x} is a list, we recursively apply 13 | ##' \code{counts} throughout elements in the list. 14 | ##' @export 15 | ##' @examples 16 | ##' x <- round( rnorm(1E2), 1 ) 17 | ##' counts(x) 18 | counts <- function(x) { 19 | if (is.list(x)) { 20 | output <- rapply(x, counts, how="list") 21 | return(output) 22 | } else { 23 | return(.Call(CKmisc_counts, x)) 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /man/apply.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{rowApply} 3 | \alias{colApply} 4 | \alias{rowApply} 5 | \title{Apply Wrappers} 6 | \usage{ 7 | rowApply(X, FUN, ..., drop = TRUE) 8 | 9 | colApply(X, FUN, ..., drop = TRUE) 10 | } 11 | \arguments{ 12 | \item{X}{A matrix, or a 2D array.} 13 | 14 | \item{FUN}{The function to be applied.} 15 | 16 | \item{...}{Optional arguments to \code{FUN}.} 17 | 18 | \item{drop}{Boolean. If \code{TRUE}, we 'drop' dimensions 19 | so that results of dimension \code{n x 1} or \code{1 x n} 20 | are coerced to vectors.} 21 | } 22 | \description{ 23 | These are thin but clearer wrappers to 24 | \code{apply(x, 1, FUN, ...)} (row apply) and 25 | \code{apply(x, 2, FUN, ...)} (column apply). 26 | Intended for use with 2D \R \code{matrix}s. 27 | We do a bit more work to ensure row names, 28 | column names are passed along if appropriate. 29 | } 30 | \details{ 31 | See \code{\link{apply}} for more info. 32 | } 33 | 34 | -------------------------------------------------------------------------------- /man/prepare_package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{prepare_package} 3 | \alias{prepare_package} 4 | \title{Prepare Package} 5 | \usage{ 6 | prepare_package(build = TRUE, check = TRUE, install = FALSE, 7 | copy.tarball = TRUE) 8 | } 9 | \arguments{ 10 | \item{build}{Build the package with \code{R CMD build}?} 11 | 12 | \item{check}{Check the package with \code{R CMD check}?} 13 | 14 | \item{install}{Install the package with \code{R CMD 15 | INSTALL}? Only done if \code{build} is \code{TRUE} as 16 | well.} 17 | 18 | \item{copy.tarball}{If \code{build && copy.tarball}, we 19 | copy the tarball generated by \code{R CMD build} to the 20 | \code{"dist"} folder.} 21 | } 22 | \description{ 23 | This function prepares the package such that all the C / C++ source files 24 | are concatenated into one file (for each source). This decreases 25 | compilation time, and produces a tarball that can be used for submission 26 | to CRAN. 27 | } 28 | 29 | -------------------------------------------------------------------------------- /man/factor_.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{factor_} 3 | \alias{factor_} 4 | \title{Fast Factor Generation} 5 | \usage{ 6 | factor_(x, levels = NULL, labels = levels, na.last = NA) 7 | } 8 | \arguments{ 9 | \item{x}{An object of atomic type \code{integer}, 10 | \code{numeric}, \code{character} or \code{logical}.} 11 | 12 | \item{levels}{An optional character vector of levels. Is 13 | coerced to the same type as \code{x}. By default, we 14 | compute the levels as \code{sort(unique.default(x))}.} 15 | 16 | \item{labels}{A set of labels used to rename the levels, 17 | if desired.} 18 | 19 | \item{na.last}{If \code{TRUE} and there are missing 20 | values, the last level is set as \code{NA}; otherwise; 21 | they are removed.} 22 | } 23 | \description{ 24 | This function generates factors more quickly, by leveraging 25 | \code{fastmatch::\link{fmatch}}. 26 | } 27 | \details{ 28 | \code{NaN}s are converted to \code{NA} when used on numerics. 29 | } 30 | 31 | -------------------------------------------------------------------------------- /man/kLoad.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{kLoad} 3 | \alias{getload} 4 | \alias{kLoad} 5 | \title{Load and Assign an R Object} 6 | \usage{ 7 | kLoad(...) 8 | 9 | getload(...) 10 | } 11 | \arguments{ 12 | \item{...}{args to pass to \code{load}} 13 | } 14 | \value{ 15 | the object stored in the \code{load}-ed object 16 | } 17 | \description{ 18 | The regular \code{load} function keeps the old variable name used when 19 | saving that object. Often, we would prefer to assign the \code{load}ed 20 | object to a new variable name. Hence, this function. 21 | } 22 | \details{ 23 | If multiple arguments are supplied, they will be concatenated through 24 | \code{file.path}. 25 | } 26 | \examples{ 27 | dat <- data.frame( x = c(1,2,3), y=c('a','b','c') ) 28 | save( dat, file="dat.rda" ) 29 | rm( dat ) 30 | my_data <- kLoad( "dat.rda" ) 31 | ## we protect ourselves from 'forgetting' the name of the 32 | ## object we saved 33 | } 34 | \seealso{ 35 | \code{\link{load}} 36 | } 37 | 38 | -------------------------------------------------------------------------------- /man/write.cb.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{write.cb} 3 | \alias{write.cb} 4 | \title{Write Tabular Data to the Clipboard} 5 | \usage{ 6 | write.cb(dat, row.names = FALSE, col.names = TRUE, sep = "\\t", 7 | quote = FALSE) 8 | } 9 | \arguments{ 10 | \item{dat}{the data file you want to write out; passed to 11 | \code{write.table}.} 12 | 13 | \item{row.names}{logical. include the row names of dat?} 14 | 15 | \item{col.names}{logical. include the column names of 16 | dat?} 17 | 18 | \item{sep}{the delimiter used to separate elements after 19 | exporting dat.} 20 | 21 | \item{quote}{logical. include quotes around character 22 | vectors in dat?} 23 | } 24 | \description{ 25 | Directs output of \code{write.table} to the clipboard. This can be 26 | useful if you want to quickly write some \R table out and paste it into 27 | some other file, eg. a Word document, Excel table, and so on. 28 | } 29 | \seealso{ 30 | \code{\link{write.table}} 31 | } 32 | 33 | -------------------------------------------------------------------------------- /tests/testthat/test-swap.R: -------------------------------------------------------------------------------- 1 | context("swap") 2 | 3 | Rswap <- function(vec, from, to) { 4 | tmp <- to[match(vec, from)] 5 | tmp[is.na(tmp)] <- vec[is.na(tmp)] 6 | return(tmp) 7 | } 8 | 9 | m <- 1:10 10 | x <- 1:5 11 | y <- (1:5)*10 12 | 13 | expect_identical( 14 | swap(m, x, y), 15 | Rswap(m, x, y) 16 | ) 17 | 18 | y <- as.character(y) 19 | 20 | expect_identical( 21 | swap(m, x, y), 22 | Rswap(m, x, y) 23 | ) 24 | 25 | y <- (1:5)*10 26 | m <- as.character(m) 27 | 28 | expect_identical( 29 | swap(m, x, y), 30 | Rswap(m, x, y) 31 | ) 32 | 33 | m[c(2, 5)] <- NA 34 | 35 | expect_identical( 36 | swap(m, x, y), 37 | Rswap(m, x, y) 38 | ) 39 | 40 | m <- as.integer(m) 41 | 42 | expect_identical( 43 | swap(m, x, y), 44 | Rswap(m, x, y) 45 | ) 46 | 47 | m <- as.numeric(m) 48 | x <- as.integer(x) 49 | 50 | expect_identical( 51 | swap(m, x, y), 52 | Rswap(m, x, y) 53 | ) 54 | 55 | x[c(2)] <- NA 56 | 57 | identical(swap(x, c(0, 1), c(10, 20)), Rswap(x, c(0, 1), c(10, 20))) 58 | -------------------------------------------------------------------------------- /R/Rcpp_gen_makevars.R: -------------------------------------------------------------------------------- 1 | ##' Reproduce Rcpp Makevars Files 2 | ##' 3 | ##' If you're building a package and want a simple set of 4 | ##' Makevars files to export, this function will handle it 5 | ##' for you. Borrowed from the Rcpp \code{rcpp.package.skeleton} 6 | ##' function. 7 | ##' 8 | ##' @param src the location to output the Makevars. 9 | Rcpp_gen_makevars <- function(src=file.path( getwd(), "src" )) { 10 | 11 | skeleton <- system.file("skeleton", package = "Rcpp") 12 | Makevars <- file.path(src, "Makevars") 13 | if (!file.exists(Makevars)) { 14 | file.copy(file.path(skeleton, "Makevars"), Makevars) 15 | message(" >> added Makevars file with Rcpp settings") 16 | } 17 | Makevars.win <- file.path(src, "Makevars.win") 18 | if (!file.exists(Makevars.win)) { 19 | file.copy(file.path(skeleton, "Makevars.win"), Makevars.win) 20 | message(" >> added Makevars.win file with Rcpp settings") 21 | } 22 | 23 | } 24 | 25 | ##' @rdname Rcpp_gen_makevars 26 | rcpp_gen_makevars <- Rcpp_gen_makevars 27 | -------------------------------------------------------------------------------- /inst/resources/highlight/styles/ascetic.css: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | Original style from softwaremaniacs.org (c) Ivan Sagalaev 4 | 5 | */ 6 | 7 | pre code { 8 | display: block; padding: 0.5em; 9 | background: white; color: black; 10 | } 11 | 12 | pre .string, 13 | pre .tag .value, 14 | pre .filter .argument, 15 | pre .addition, 16 | pre .change, 17 | pre .apache .tag, 18 | pre .apache .cbracket, 19 | pre .nginx .built_in, 20 | pre .tex .formula { 21 | color: #888; 22 | } 23 | 24 | pre .comment, 25 | pre .template_comment, 26 | pre .shebang, 27 | pre .doctype, 28 | pre .pi, 29 | pre .javadoc, 30 | pre .deletion, 31 | pre .apache .sqbracket { 32 | color: #CCC; 33 | } 34 | 35 | pre .keyword, 36 | pre .tag .title, 37 | pre .ini .title, 38 | pre .lisp .title, 39 | pre .clojure .title, 40 | pre .http .title, 41 | pre .nginx .title, 42 | pre .css .tag, 43 | pre .winutils, 44 | pre .flow, 45 | pre .apache .tag, 46 | pre .tex .command, 47 | pre .request, 48 | pre .status { 49 | font-weight: bold; 50 | } 51 | -------------------------------------------------------------------------------- /man/str_slice.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{str_slice} 3 | \alias{str_slice} 4 | \title{Slice a Vector at Consecutive Indices} 5 | \usage{ 6 | str_slice(x, n = 1) 7 | } 8 | \arguments{ 9 | \item{x}{a character vector.} 10 | 11 | \item{n}{integer (or numeric coercible to integer); index 12 | at which to slice.} 13 | } 14 | \value{ 15 | A list of length equal to the length of \code{x}, with each element 16 | made up of the substrings generated from \code{x[i]}. 17 | } 18 | \description{ 19 | This function 'slices' the strings of a character vector \code{x} at consecutive indices 20 | \code{n}, thereby generating consecutive substrings of length \code{n} 21 | and returning the result as a list. Not safe for use with unicode characters. 22 | } 23 | \note{ 24 | Underlying code is written in C for fast execution. 25 | } 26 | \examples{ 27 | x <- c("ABCD", "EFGH", "IJKLMN") 28 | str_slice(x, 2) 29 | } 30 | \seealso{ 31 | \code{\link{str_slice2}}, for slicing a UTF-8 encoded vector. 32 | } 33 | 34 | -------------------------------------------------------------------------------- /man/value_matching.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{value_matching} 3 | \alias{\%drop\%} 4 | \alias{\%keep\%} 5 | \alias{\%kin\%} 6 | \alias{\%knin\%} 7 | \alias{\%nin\%} 8 | \alias{value_matching} 9 | \title{Value Matching} 10 | \usage{ 11 | x \%nin\% y 12 | 13 | x \%kin\% y 14 | 15 | x \%knin\% y 16 | 17 | x \%drop\% y 18 | 19 | x \%keep\% y 20 | } 21 | \arguments{ 22 | \item{x}{Vector or \code{NULL}: the values to be 23 | matched.} 24 | 25 | \item{y}{Vector or \code{NULL}: the values to be matched 26 | against.} 27 | } 28 | \description{ 29 | These are a couple of mostly self-explanatory wrappers around \code{\%in\%}. 30 | } 31 | \details{ 32 | \code{\%nin\%} returns a logical vector indicating if there is 33 | no match for its left operand. It is the inverse of \code{x \%in\% y}. 34 | 35 | \code{\%kin\%} returns the actual values of \code{x} for which 36 | \code{x \%in\% y}. 37 | 38 | \code{\%knin\%} returns the actual values of \code{x} for which 39 | \code{x \%nin\% y}. 40 | } 41 | 42 | -------------------------------------------------------------------------------- /src/str_rev.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | // [[register]] 7 | SEXP str_rev( SEXP x ) { 8 | 9 | int len = length(x); 10 | SEXP out; 11 | PROTECT( out = allocVector( STRSXP, len ) ); 12 | 13 | // Loop through each string 14 | for( int i=0; i < len; ++i ) { 15 | 16 | // Get the current element of the string 17 | int len_elt = length( STRING_ELT(x, i) ); 18 | const char* element = CHAR( STRING_ELT(x, i) ); 19 | 20 | // Allocate space for the reversed string 21 | char* elt_rev = R_alloc( len_elt+1, sizeof(char) ); 22 | 23 | // Reverse 'elt' 24 | for( int j=0; j < len_elt; ++j ) { 25 | elt_rev[j] = element[ len_elt - j - 1]; 26 | } 27 | 28 | // Set the null terminator 29 | elt_rev[len_elt] = '\0'; 30 | 31 | // Set the i'th element of out to the reversed char 32 | SET_STRING_ELT( out, i, mkChar( elt_rev ) ); 33 | 34 | } 35 | 36 | UNPROTECT(1); 37 | return out; 38 | } 39 | 40 | #undef USE_RINTERNALS 41 | -------------------------------------------------------------------------------- /man/in_interval.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{in_interval} 3 | \alias{in_interval} 4 | \title{Determine if Value Lies within Interval} 5 | \usage{ 6 | in_interval(x, lo, hi, include.lower = TRUE, include.upper = FALSE) 7 | } 8 | \arguments{ 9 | \item{x}{numeric. vector of numbers.} 10 | 11 | \item{lo}{numeric, length 1. lower boundary.} 12 | 13 | \item{hi}{numeric, length 1. upper boundary.} 14 | 15 | \item{include.lower}{boolean. include the lower 16 | endpoint?} 17 | 18 | \item{include.upper}{boolean. include the upper 19 | endpoint?} 20 | } 21 | \description{ 22 | This function determines whether elements of a numeric vector \code{x} lie 23 | within boundaries \code{[lo, hi)}. Marginally slower than the \R equivalent 24 | code \code{x >= lo & x < hi} for small vectors; much faster for very large 25 | vectors. 26 | } 27 | \examples{ 28 | x <- runif(100); lo <- 0.5; hi <- 1 29 | f <- function(x, lo, hi) { 30 | return( x >= lo & x < hi ) 31 | } 32 | stopifnot( all( in_interval( x, lo, hi ) == f(x, lo, hi) ) ) 33 | } 34 | 35 | -------------------------------------------------------------------------------- /man/kSave.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{kSave} 3 | \alias{kSave} 4 | \title{Write out and Save a Tabular File} 5 | \usage{ 6 | kSave(x, file, lvl = 1, Rext = ".rda", ...) 7 | } 8 | \arguments{ 9 | \item{x}{the R object you want to save / write to file} 10 | 11 | \item{file}{the location to write the file to, with 12 | extension desired for object written by write.table} 13 | 14 | \item{lvl}{how many extensions do you want to strip from 15 | your output file?} 16 | 17 | \item{Rext}{the extension to use for the saved object.} 18 | 19 | \item{...}{optional arguments passed to 20 | \code{write.table}} 21 | } 22 | \description{ 23 | A function that both writes a file to table with \code{write.table}, 24 | and saves it with the same name but a separate file extension. 25 | } 26 | \examples{ 27 | dat <- data.frame( x=c(1,2,3), y=c('a','b','c') ) 28 | kSave( dat, file="dat.txt" ) 29 | ## the file 'dat.rda' is written as well - let's see if it exists 30 | dat2 <- kLoad( "dat.rda" ) 31 | stopifnot( identical(dat, dat2) ) ## TRUE 32 | } 33 | 34 | -------------------------------------------------------------------------------- /man/pymat.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{pymat} 3 | \alias{pymat} 4 | \title{Python-style Formatting of Strings.} 5 | \usage{ 6 | pymat(x, ..., collapse = ", ") 7 | } 8 | \arguments{ 9 | \item{x}{A string with arguments to be replaced in the 10 | form of \code{{0}, {1}, ..., {n}}.} 11 | 12 | \item{...}{Arguments to be substituted into \code{x}.} 13 | 14 | \item{collapse}{If vectors of length greater than 1 are 15 | passed to \code{...}, then we collapse the vectors with 16 | this separator.} 17 | } 18 | \description{ 19 | This function allows Python-style formatting of strings, whereby text of 20 | the form \code{{0}, {1}, ..., {n}} is substituted according to the 21 | matching argument passed to \code{...}. \code{0} corresponds to the 22 | first argument, \code{1} corresponds to the second, and so on. 23 | } 24 | \examples{ 25 | pymat( 26 | "My favourite fruits are: {0}, {1}, and {2}.", 27 | "apple", "banana", "orange" 28 | ) 29 | 30 | pymat( 31 | "My favourite fruits are: {0}.", 32 | c("apple", "banana", "orange"), collapse=", " 33 | ) 34 | } 35 | 36 | -------------------------------------------------------------------------------- /tests/testthat/test-read.R: -------------------------------------------------------------------------------- 1 | context("read") 2 | library(Rcpp) 3 | 4 | dat <- as.data.frame( replicate(5, rnorm(5), simplify=FALSE) ) 5 | tempfile <- tempfile() 6 | write.table(dat, file=tempfile) 7 | 8 | tmp1 <- readLines(tempfile) 9 | tmp2 <- readlines(tempfile) 10 | expect_identical(tmp1, tmp2) 11 | 12 | tmp3 <- read(tempfile) 13 | 14 | if (!is.null(Sys.info()) && Sys.info()[["sysname"]] == "Windows") { 15 | nl <- "\r\n" 16 | } else { 17 | nl <- "\n" 18 | } 19 | 20 | expect_identical(tmp2, unlist(strsplit(tmp3, nl, fixed=TRUE))) 21 | 22 | # cppFunction(verbose=TRUE, includes=" 23 | # #include 24 | # #include 25 | # ", code=' 26 | # CharacterVector read_lines(std::string path) { 27 | # using namespace std; 28 | # ifstream t(path.c_str()); 29 | # string tmp; 30 | # vector out; 31 | # while (getline(t, tmp)) { 32 | # out.push_back(tmp); 33 | # } 34 | # return wrap(out); 35 | # } 36 | # ') 37 | # 38 | # rbenchmark::benchmark( replications=5, 39 | # readlines(tempfile), 40 | # readLines(tempfile), 41 | # read_lines(tempfile) 42 | # ) 43 | # 44 | # unlink(tempfile) 45 | -------------------------------------------------------------------------------- /man/str_slice2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{str_slice2} 3 | \alias{str_slice2} 4 | \title{Slice a Vector at Consecutive Indices} 5 | \usage{ 6 | str_slice2(x, n = 1, USE.NAMES = TRUE) 7 | } 8 | \arguments{ 9 | \item{x}{a character vector.} 10 | 11 | \item{n}{integer (or numeric coercible to integer); index 12 | at which to slice.} 13 | 14 | \item{USE.NAMES}{logical. if names attribute already 15 | exists on \code{x}, pass this through to the result?} 16 | } 17 | \value{ 18 | A list of length equal to the length of \code{x}, with each element 19 | made up of the substrings generated from \code{x[i]}. 20 | } 21 | \description{ 22 | This function 'slices' the strings of a character vector \code{x} at consecutive indices 23 | \code{n}, thereby generating consecutive substrings of length \code{n} 24 | and returning the result as a list. This function will safely 'slice' a 25 | UTF-8 encoded vector. 26 | } 27 | \note{ 28 | Safe for use with UTF-8 characters, but slower than \code{str_slice}. 29 | } 30 | \seealso{ 31 | \code{\link{str_slice}}, for slicing an ASCII vector. 32 | } 33 | 34 | -------------------------------------------------------------------------------- /R/in_interval.R: -------------------------------------------------------------------------------- 1 | ##' Determine if Value Lies within Interval 2 | ##' 3 | ##' This function determines whether elements of a numeric vector \code{x} lie 4 | ##' within boundaries \code{[lo, hi)}. Marginally slower than the \R equivalent 5 | ##' code \code{x >= lo & x < hi} for small vectors; much faster for very large 6 | ##' vectors. 7 | ##' 8 | ##' @export 9 | ##' @param x numeric. vector of numbers. 10 | ##' @param lo numeric, length 1. lower boundary. 11 | ##' @param hi numeric, length 1. upper boundary. 12 | ##' @param include.lower boolean. include the lower endpoint? 13 | ##' @param include.upper boolean. include the upper endpoint? 14 | ##' @examples 15 | ##' x <- runif(100); lo <- 0.5; hi <- 1 16 | ##' f <- function(x, lo, hi) { 17 | ##' return( x >= lo & x < hi ) 18 | ##' } 19 | ##' stopifnot( all( in_interval( x, lo, hi ) == f(x, lo, hi) ) ) 20 | in_interval <- function(x, lo, hi, include.lower=TRUE, include.upper=FALSE) { 21 | 22 | .Call(Cin_interval, 23 | as.numeric(x), 24 | as.numeric(lo), 25 | as.numeric(hi), 26 | as.logical(include.lower), 27 | as.logical(include.upper) 28 | ) 29 | 30 | } 31 | -------------------------------------------------------------------------------- /man/without.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{without} 3 | \alias{without} 4 | \title{Remove Elements from a Named Object} 5 | \usage{ 6 | without(x, ...) 7 | } 8 | \arguments{ 9 | \item{x}{An \R object with a \code{names} attribute.} 10 | 11 | \item{...}{an optional number of 'names' to match in 12 | \code{x}.} 13 | } 14 | \description{ 15 | Removes elements from an \R object 16 | with the names attribute set in a 'lazy' way. 17 | The first argument is the object, while the second is a set of names 18 | parsed from \code{...}. We return the object, including 19 | only the elements with names not matched in \code{...}. 20 | } 21 | \details{ 22 | We can be 'lazy' with how we pass names. The \code{\link{name}}s 23 | passed to \code{...} are not evaluated directly; rather, their character 24 | representation is taken and used for extraction. 25 | } 26 | \examples{ 27 | dat <- data.frame( x=c(1, 2, 3), y=c("a", "b", "c"), z=c(4, 5, 6) ) 28 | ## all of these return identical output 29 | dat[ !( names(dat) \%in\% c("x","z") ) ] 30 | without(dat, x, z) 31 | } 32 | \seealso{ 33 | \code{\link{extract}} 34 | } 35 | 36 | -------------------------------------------------------------------------------- /man/makeHTMLTag.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{makeHTMLTag} 3 | \alias{makeHTMLTag} 4 | \title{Make HTML Elements} 5 | \usage{ 6 | makeHTMLTag(tag, ...) 7 | } 8 | \arguments{ 9 | \item{tag}{the HTML tag to use.} 10 | 11 | \item{...}{a collection of named and unnamed arguments; 12 | named arguments are parsed as attributes of the tag, 13 | unnamed arguments are pasted together into the inner data 14 | of the tag.} 15 | } 16 | \description{ 17 | Creates a function that returns a function that can be used to generate 18 | HTML elements. See examples for usage. 19 | } 20 | \details{ 21 | This function returns a function that can be called as an HTML tag 22 | generating function. For example, by calling 23 | \code{p <- makeHTMLTag("p")}, we can generate a function that interprets 24 | all named arguments as attributes, and all unnamed arguments as 25 | 'data', which is generated for a \code{p} HTML tag. 26 | } 27 | \examples{ 28 | div <- makeHTMLTag("div") 29 | my_class = "orange" 30 | x <- "some text" 31 | div( class=my_class, id="hello", "This is ", x ) 32 | } 33 | \seealso{ 34 | \code{\link{html}} 35 | } 36 | 37 | -------------------------------------------------------------------------------- /src/df2list.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | // [[register]] 7 | SEXP df2list(SEXP x_, SEXP inplace) { 8 | 9 | SEXP x; 10 | int unprotect_num = 0; 11 | 12 | if (TYPEOF(inplace) != LGLSXP || length(inplace) > 1) { 13 | error("'inplace' must be a logical vector of length 1; type is '%s'", 14 | type2char(TYPEOF(inplace))); 15 | } 16 | 17 | if (LOGICAL(inplace)[0] < 0) { 18 | error("'inplace' must be non-NA"); 19 | } 20 | 21 | if (TYPEOF(x_) != VECSXP || !inherits(x_, "data.frame")) { 22 | error("argument must be a data.frame"); 23 | } 24 | 25 | 26 | if (LOGICAL(inplace)[0]) { 27 | x = x_; 28 | } else { 29 | x = PROTECT( duplicate(x_) ); 30 | ++unprotect_num; 31 | } 32 | 33 | // strip off all attributes expect the name; make it appear 34 | // as a 'base' R object 35 | SEXP nm; 36 | PROTECT(nm = duplicate( getAttrib(x, R_NamesSymbol) )); 37 | SET_ATTRIB(x, R_NilValue); 38 | setAttrib(x, R_NamesSymbol, nm); 39 | UNPROTECT(1); 40 | SET_OBJECT(x, 0); 41 | 42 | UNPROTECT(unprotect_num); 43 | return x; 44 | 45 | } 46 | 47 | #undef USE_RINTERNALS 48 | -------------------------------------------------------------------------------- /incubator/install_svn.R: -------------------------------------------------------------------------------- 1 | ##' Install R Package from SVN Repository 2 | ##' 3 | ##' Use this function to install an R package from an SVN repository. This 4 | ##' requires an up-to-date version of \code{svn} on your machine. 5 | ##' 6 | ##' @examples 7 | ##' ## install the latest SVN version of Rcpp 8 | ##' install_svn("svn://svn.r-forge.r-project.org/svnroot/rcpp/pkg/Rcpp") 9 | install_svn <- function(url, pkg_name, build_opts="", install_opts="") { 10 | if( missing(pkg_name) ) { 11 | pkg_name <- gsub(".*/", "", url) 12 | } 13 | dir <- tempdir() 14 | owd <- getwd() 15 | on.exit( setwd(owd) ) 16 | setwd(dir) 17 | ## check to see if we can call 'svn' 18 | invisible( tryCatch( suppressWarnings(system("svn", intern=TRUE)), error=function(e) { 19 | stop("'svn' not available for calling from command line") 20 | }) ) 21 | system( paste("svn checkout", url) ) 22 | system( paste("R CMD build --no-vignettes --no-manual", pkg_name) ) 23 | pkg_file <- grep( paste0("^", pkg_name, "_(.*?)\\.tar\\.gz$"), list.files(), perl=TRUE, value=TRUE ) 24 | stopifnot( length(pkg_file) == 1 ) 25 | system( paste("R CMD INSTALL --no-multiarch", pkg_file) ) 26 | } 27 | -------------------------------------------------------------------------------- /man/extract.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{extract} 3 | \alias{extract} 4 | \title{Extract Elements from a Named Object} 5 | \usage{ 6 | extract(x, ...) 7 | } 8 | \arguments{ 9 | \item{x}{An \R object with a \code{names} attribute.} 10 | 11 | \item{...}{an optional number of 'names' to match in 12 | \code{dat}.} 13 | } 14 | \description{ 15 | Extracts elements from an \R object 16 | with the names attribute set in a 'lazy' way. 17 | The first argument is the object, while the second is a set of names 18 | parsed from \code{...}. We return the object, including 19 | only the elements with names matched from \code{...}. 20 | } 21 | \details{ 22 | We can be 'lazy' with how we pass names. The \code{\link{name}}s 23 | passed to \code{...} are not evaluated directly; rather, their character 24 | representation is taken and used for extraction. 25 | } 26 | \examples{ 27 | dat <- data.frame( x = c(1, 2, 3), y = c("a", "b", "c"), z=c(4, 5, 6) ) 28 | ## all of these return identical output 29 | dat[ names(dat) \%in\% c("x","z") ] 30 | extract( dat, x, z) 31 | } 32 | \seealso{ 33 | \code{\link{without}}, \code{\link{extract.re}} 34 | } 35 | 36 | -------------------------------------------------------------------------------- /man/extract_rows_from_file.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{extract_rows_from_file} 3 | \alias{extract_rows_from_file} 4 | \title{Extract Rows from File} 5 | \usage{ 6 | extract_rows_from_file(file, out = NULL, column, sep = NULL, keep) 7 | } 8 | \arguments{ 9 | \item{file}{The input file to extract rows from.} 10 | 11 | \item{out}{The location to output the file. If this is 12 | \code{NULL}, we redirect output back into the \R 13 | session.} 14 | 15 | \item{column}{The column to check, indexed from 1.} 16 | 17 | \item{sep}{The delimiter used in \code{file}. Must be a 18 | single character. If no delimiter is specified, we guess 19 | the delimiter from the first row of \code{file}.} 20 | 21 | \item{keep}{A character vector containing all items that 22 | we want to check and keep within the \code{column}th 23 | column of each row.} 24 | } 25 | \description{ 26 | This function reads through a delimited file on disk, determines if the 27 | entry at the specified column is in a character vector of items, and writes 28 | that line to file (or to \R) if it is. 29 | } 30 | \seealso{ 31 | \code{\link{split_file}} 32 | } 33 | 34 | -------------------------------------------------------------------------------- /R/clean_doc.R: -------------------------------------------------------------------------------- 1 | ##' Clean Documentation in Current Package 2 | ##' 3 | ##' This function removes all the .Rd documentation files present in 4 | ##' \code{/man}. This function is handy if you've 'polluted' your 5 | ##' \code{man} directory in prototyping different functions -- assuming that 6 | ##' you're documenting your code with eg. \code{roxygen}. 7 | ##' 8 | ##' @param dir the project directory. 9 | ##' @param ask boolean. ask before clearing directory? 10 | ##' @export 11 | clean_doc <- function(dir=getwd(), ask=TRUE) { 12 | 13 | man_dir <- file.path( dir, "man" ) 14 | files <- list.files( man_dir, full.names=TRUE ) 15 | if( length(files) == 0 ) { 16 | stop("No files in ", dir) 17 | } 18 | if( ask ) { 19 | cat("Are you sure you want to delete all the files in:\n\t", man_dir, "? (y/n):\n") 20 | if( re_exists( "^y", scan(what=character(), n=1, quiet=TRUE) ) ) { 21 | for( file in files ) file.remove(file) 22 | cat("Documentation files deleted.\n") 23 | } else { 24 | cat("No files deleted.\n") 25 | return( invisible(NULL) ) 26 | } 27 | } else { 28 | for( file in files ) file.remove(file) 29 | } 30 | 31 | } 32 | -------------------------------------------------------------------------------- /src/simp.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | // [[register]] 7 | SEXP simp( SEXP x, SEXP y ) { 8 | 9 | SEXP out; 10 | PROTECT( out = allocVector(REALSXP, 1) ); 11 | 12 | int nx = length(x); 13 | int ny = length(y); 14 | 15 | if( nx != ny ) { 16 | Rf_error("'x' must be the same length as 'y'"); 17 | } 18 | 19 | double out_num = 0; 20 | double mult = 1; 21 | 22 | for( int i=0; i < nx; ++i ) { 23 | 24 | // get the correct multiplier 25 | if( i == 0 ) { 26 | mult = 1.0; 27 | } else if( i == nx-1 ) { 28 | mult = 1.0; 29 | } else if( i % 2 == 1 ) { 30 | mult = 4.0; 31 | } else if( i % 2 == 0 ) { 32 | mult = 2.0; 33 | } 34 | 35 | out_num = out_num + (mult * REAL(y)[i]); 36 | // Rprintf("i = %i; REAL(y)[i] = %f; mult = %f; out_num = %f\n", i, REAL(y)[i], mult, out_num); 37 | } 38 | 39 | double h = (REAL(x)[nx-1] - REAL(x)[0]) / (double) nx; 40 | // Rprintf("h = %f\n", h); 41 | 42 | out_num = (h / 3.0) * out_num; 43 | // Rprintf("the final value of out_num is %f\n", out_num); 44 | 45 | REAL(out)[0] = out_num; 46 | UNPROTECT(1); 47 | return out; 48 | 49 | } 50 | 51 | #undef USE_RINTERNALS 52 | -------------------------------------------------------------------------------- /R/nametree.R: -------------------------------------------------------------------------------- 1 | ##' Print a Tree Representation of an Object of Nested Lists 2 | ##' 3 | ##' This function returns output similar to that of the command line 4 | ##' tool \code{tree}, except rather than directory/file structure, 5 | ##' we simply print the names of lists. 6 | ##' 7 | ##' @param x A (named) list. 8 | ##' @export 9 | ##' @seealso http://stackoverflow.com/questions/18122548/display-names-of-column-of-recursive-list-as-tree 10 | tree <- function(x) { 11 | if (is.list(x)) { 12 | return( .nametree(x) ) 13 | } else { 14 | stop("'x' must be a list") 15 | } 16 | } 17 | 18 | .nametree <- function(X, prefix1='', prefix2='', prefix3='', prefix4='') { 19 | 20 | if( is.list(X) ) { 21 | for( i in seq_along(X) ) { 22 | nm <- names(X)[i] 23 | if (is.null(nm)) { 24 | nm <- "." 25 | } 26 | cat( if(i 4 | #include 5 | 6 | SEXP recurse_factor_to_char( SEXP X, SEXP parent, int i ) { 7 | 8 | if( TYPEOF(X) == VECSXP ) { 9 | for( int j=0; j < length(X); ++j ) { 10 | recurse_factor_to_char( VECTOR_ELT(X, j), X, j ); 11 | } 12 | } else { 13 | if( isFactor(X) ) { 14 | SET_VECTOR_ELT( parent, i, asCharacterFactor(X) ); 15 | } 16 | } 17 | return X; 18 | 19 | } 20 | 21 | // [[register]] 22 | SEXP factor_to_char( SEXP X_, SEXP inplace_ ) { 23 | 24 | int inplace = asInteger(inplace_); 25 | int numprotect = 0; 26 | SEXP X; 27 | if (inplace) { 28 | X = X_; 29 | } else { 30 | PROTECT( X = duplicate(X_) ); 31 | ++numprotect; 32 | } 33 | if( TYPEOF(X) == VECSXP ) { 34 | SEXP out = recurse_factor_to_char( X, X, 0); 35 | UNPROTECT(numprotect); 36 | return out; 37 | } else { 38 | if( isFactor(X) ) { 39 | SEXP out = asCharacterFactor(X); 40 | UNPROTECT(numprotect); 41 | return out; 42 | } else { 43 | warning("X is neither a list nor a factor; no change done"); 44 | UNPROTECT(numprotect); 45 | return X; 46 | } 47 | } 48 | } 49 | 50 | #undef USE_RINTERNALS 51 | -------------------------------------------------------------------------------- /tests/testthat/test-extract_rows_from_file.R: -------------------------------------------------------------------------------- 1 | # library(Kmisc) 2 | # library(testthat) 3 | # 4 | # tmp <- tempfile(fileext=".txt") 5 | # out <- paste0( strip_extension(tmp), "_sub", ".txt" ) 6 | # dat <- data.frame( x=rnorm(100), y=rep(letters[1:5], each=20), stringsAsFactors=FALSE ) 7 | # write.table( dat, 8 | # file=tmp, 9 | # row.names=FALSE, 10 | # col.names=FALSE, 11 | # sep="\t", 12 | # quote=FALSE 13 | # ) 14 | # 15 | # extract_rows_from_file( tmp, out, column=2, keep="a" ) 16 | # extract_rows_from_file( tmp, out, column=2, sep="\t", keep="a") 17 | # dat_sub <- read.table( out, sep="\t", header=FALSE, as.is=TRUE ) 18 | # names(dat_sub) <- c("x", "y") 19 | # 20 | # expect_true( all.equal( dat_sub, dat[ dat$y == "a", ] ) ) 21 | # 22 | # extract_rows_from_file( tmp, out, column=2, sep="\t", keep=c("a","e") ) 23 | # dat_sub <- read.table( out, header=FALSE, as.is=TRUE ) 24 | # names(dat_sub) <- c("x", "y") 25 | # 26 | # expect_true( all.equal( dat_sub$x, dat$x[ dat$y %in% c("a", "e") ] ) ) 27 | # 28 | # dat <- str_split( extract_rows_from_file( tmp, column=2, sep="\t", keep=c("a", "e") ), 29 | # "\t" ) 30 | # expect_true( all( dat[,2] == dat_sub[,2] ) ) 31 | -------------------------------------------------------------------------------- /R/enumerate.R: -------------------------------------------------------------------------------- 1 | ##' Enumerate over a Vector 2 | ##' 3 | ##' This function extends \code{lapply} to operate on functions taking two 4 | ##' arguments -- the first refers to each element within a vector, while 5 | ##' the second refers to the current index. 6 | ##' 7 | ##' @param X A vector. 8 | ##' @param FUN A function, taking two arguments. 9 | ##' @param ... Optional arguments to \code{FUN}. 10 | ##' @export 11 | ##' @examples 12 | ##' data <- setNames( list(1, 2, 3), c('a', 'b', 'c') ) 13 | ##' v <- replicate(10, rnorm(1E3), simplify=FALSE) 14 | ##' identical( lapply(v, sum), enumerate(v, sum) ) 15 | ##' f <- function(x, i) i 16 | ##' enumerate(v, f) 17 | ##' enumerate(v, function(x, i) i) 18 | enumerate <- function(X, FUN, ...) { 19 | UseMethod("enumerate") 20 | } 21 | 22 | ##' @export 23 | enumerate.default <- function(X, FUN, ...) { 24 | call <- match.call(expand.dots = FALSE) 25 | nargs <- sum(as.character(formals(FUN)) == "") 26 | .Call(Cenumerate, call, environment(), as.integer(nargs)) 27 | } 28 | 29 | ##' @export 30 | enumerate.dict <- function(X, FUN, ...) { 31 | result <- vector("list", length(X)) 32 | keys <- keys(X) 33 | for (i in seq_along(keys)) { 34 | result[[i]] <- FUN(keys[i], X[[keys[i]]], ...) 35 | } 36 | result 37 | } 38 | -------------------------------------------------------------------------------- /man/split_runs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{split_runs} 3 | \alias{split_runs} 4 | \title{Split by Runs} 5 | \usage{ 6 | split_runs(x) 7 | } 8 | \arguments{ 9 | \item{x}{A numeric or character vector.} 10 | } 11 | \description{ 12 | Split a vector into a list of runs, such that each entry in the 13 | output list is a set of runs encountered. This function accepts two forms 14 | of inputs: either a vector where each element of the vector is of length 15 | 1 (e.g. \code{c("A", "A", "C", "T")}), or a vector of length 1 interpretted 16 | as a long string (e.g. \code{"AAAACCAGGGACGCCGCGGTTGG"}). 17 | } 18 | \details{ 19 | Factors will be coerced to character before splitting. 20 | } 21 | \examples{ 22 | x <- rbinom( 100, 2, 0.5 ) 23 | stopifnot( all( x == unlist( split_runs(x) ) ) ) 24 | stopifnot( all( as.character(x) == unlist( split_runs( as.character(x) ) ) ) ) 25 | y <- paste( collapse="", sample( LETTERS[1:5], 1E5, replace=TRUE ) ) 26 | stopifnot( y == paste( collapse="", split_runs(y) ) ) 27 | z <- replicate( 25, paste( collapse="", sample( LETTERS[1:5], 1E3, replace=TRUE ) ) ) 28 | system.time( lapply(z, split_runs) ) 29 | } 30 | \seealso{ 31 | \code{\link{rle}}, for a similar function with different output. 32 | } 33 | 34 | -------------------------------------------------------------------------------- /man/pMerge.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{pMerge} 3 | \alias{pMerge} 4 | \title{Merge a Data Frame 'into' Another} 5 | \usage{ 6 | pMerge(df1, df2, by = intersect(names(df1), names(df2)), doCheck = FALSE) 7 | } 8 | \arguments{ 9 | \item{df1}{the data.frame which we are preserving} 10 | 11 | \item{df2}{the data.frame we are merging into df1} 12 | 13 | \item{by}{character; name of the variable we are merging 14 | over} 15 | 16 | \item{doCheck}{boolean; set this if you want to perform 17 | more extensive (but slower) error checking} 18 | } 19 | \description{ 20 | This function will merge a data frame \code{df2} 'into' a data frame 21 | \code{df1}, preserving \code{df1} as much as possible in the merger. 22 | Hence I call this a 'preserving' merge, or \code{pMerge}. 23 | } 24 | \examples{ 25 | df1 <- data.frame( stringsAsFactors=FALSE, 26 | x=1:1000, 27 | y=sample(LETTERS, size=1000, replace=TRUE) 28 | ) 29 | 30 | df2 <- data.frame( stringsAsFactors=FALSE, 31 | x=sample( 1:2000, size=2000, replace=TRUE ), 32 | z=sample( letters, size=2000, replace=TRUE ), 33 | q=sample( LETTERS, size=2000, replace=TRUE ) 34 | ) 35 | 36 | dMerged <- pMerge( df1, df2, by="x" ) 37 | stopifnot( all.equal( df1, dMerged[1:ncol(df1)] ) ) 38 | } 39 | 40 | -------------------------------------------------------------------------------- /man/dapply.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{dapply} 3 | \alias{dapply} 4 | \title{Apply a Function over a List} 5 | \usage{ 6 | dapply(X, FUN, ...) 7 | } 8 | \arguments{ 9 | \item{X}{a vector, expression object, or a 10 | \code{data.frame}} 11 | 12 | \item{FUN}{function to be applied to each element of 13 | \code{X}.} 14 | 15 | \item{...}{optional arguments to \code{FUN}.} 16 | } 17 | \description{ 18 | A convenience function that works like \code{lapply}, but coerces the output 19 | to a \code{data.frame} if possible. We set \code{stringsAsFactors=FALSE}, and 20 | \code{optional=TRUE}, to minimize the amount of automatic coersion \R might 21 | try to do. 22 | } 23 | \details{ 24 | This function is preferable to \code{\link{sapply}} or \code{\link{lapply}} 25 | when you explicitly want a data frame returned. 26 | } 27 | \examples{ 28 | dat <- data.frame( 29 | x = rnorm(10), 30 | y = rnorm(10) 31 | ) 32 | 33 | ## Calculate 0.025, 0.975 quantiles for each column in a data.frame, 34 | ## and return result as data.frame . 35 | dapply( dat, function(x) { 36 | quantile(x, c(0.025, 0.975)) 37 | } ) 38 | 39 | dapply( dat, summary ) 40 | str( dapply( dat, summary ) ) 41 | } 42 | \seealso{ 43 | \code{\link{sapply}}, \code{\link{lapply}} 44 | } 45 | 46 | -------------------------------------------------------------------------------- /tests/testthat/test-factor_.R: -------------------------------------------------------------------------------- 1 | context("factor") 2 | 3 | set.seed(123) 4 | 5 | n <- 1E2 6 | 7 | ## integer 8 | gp <- sample( n, replace=TRUE ) 9 | expect_identical( factor(gp), factor_(gp) ) 10 | 11 | gp[ sample(length(gp), 1E1) ] <- NA 12 | expect_identical( factor(gp), factor_(gp) ) 13 | 14 | ## character 15 | gp <- sample( letters, n, replace=TRUE ) 16 | expect_identical( factor(gp), factor_(gp) ) 17 | 18 | gp[ sample(length(gp), 1E1) ] <- NA 19 | expect_identical( factor(gp), factor_(gp) ) 20 | 21 | ## logical 22 | gp <- sample( c(TRUE, FALSE), n, TRUE ) 23 | expect_identical( factor(gp), factor_(gp) ) 24 | 25 | gp[ sample(length(gp), 1E1) ] <- NA 26 | expect_identical( factor(gp), factor_(gp) ) 27 | 28 | num <- rnorm(10) 29 | int <- 1:10 30 | char <- letters[1:10] 31 | lgcl <- as.logical(int) 32 | 33 | for (x1 in list(num, int, char, lgcl)) { 34 | expect_identical( 35 | factor(x1), 36 | factor_(x1) 37 | ) 38 | } 39 | 40 | num[ sample(10, 5) ] <- NA 41 | int[ sample(10, 5) ] <- NA 42 | char[ sample(10, 5) ] <- NA 43 | lgcl[ sample(10, 5) ] <- NA 44 | 45 | for (x1 in list(num, int, char, lgcl)) { 46 | expect_identical( 47 | factor(x1), 48 | factor_(x1) 49 | ) 50 | } 51 | 52 | # num[ sample(10, 5) ] <- NaN 53 | # expect_identical( factor(num), factor_(num) ) 54 | -------------------------------------------------------------------------------- /src/in_interval.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | // [[register]] 7 | SEXP in_interval( SEXP x, SEXP lo, SEXP hi, 8 | SEXP include_lower, SEXP include_upper ) { 9 | 10 | int len = Rf_length(x); 11 | double lower = REAL(lo)[0], upper = REAL(hi)[0], *xp = REAL(x); 12 | 13 | int inc_lower = asLogical(include_lower); 14 | int inc_upper = asLogical(include_upper); 15 | 16 | SEXP out = PROTECT( allocVector( LGLSXP, len ) ); 17 | int *outp = LOGICAL(out); 18 | 19 | if( inc_lower == 1 && inc_upper == 1 ) { 20 | for( int i=0; i < len; ++i ) { 21 | outp[i] = xp[i] >= lower && xp[i] <= upper; 22 | } 23 | } 24 | 25 | if( inc_lower == 1 && inc_upper == 0 ) { 26 | for( int i=0; i < len; ++i ) { 27 | outp[i] = xp[i] >= lower && xp[i] < upper; 28 | } 29 | } 30 | 31 | if( inc_lower == 0 && inc_upper == 1 ) { 32 | for( int i=0; i < len; ++i ) { 33 | outp[i] = xp[i] > lower && xp[i] <= upper; 34 | } 35 | } 36 | 37 | if( inc_lower == 0 && inc_upper == 0 ) { 38 | for( int i=0; i < len; ++i ) { 39 | outp[i] = xp[i] > lower && xp[i] < upper; 40 | } 41 | } 42 | 43 | UNPROTECT(1); 44 | return out; 45 | 46 | } 47 | 48 | #undef USE_RINTERNALS 49 | -------------------------------------------------------------------------------- /R/pad.R: -------------------------------------------------------------------------------- 1 | ##' Pad an Object with NAs 2 | ##' 3 | ##' This function pads an \R object (list, data.frame, matrix, atomic vector) 4 | ##' with \code{NA}s. For matrices, lists and data.frames, this occurs by extending 5 | ##' each (column) vector in the object. 6 | ##' @param x An \R object (list, data.frame, matrix, atomic vector). 7 | ##' @param n The final length of each object. 8 | ##' @export 9 | pad <- function(x, n) { 10 | 11 | if (is.data.frame(x)) { 12 | 13 | nrow <- nrow(x) 14 | attr(x, "row.names") <- 1:n 15 | for( i in 1:ncol(x) ) { 16 | x[[i]] <- c( x[[i]], rep(NA, times=n-nrow) ) 17 | } 18 | return(x) 19 | 20 | } else if (is.list(x)) { 21 | if (missing(n)) { 22 | max_len <- max( sapply( x, length ) ) 23 | return( lapply(x, function(xx) { 24 | return( c(xx, rep(NA, times=max_len-length(xx))) ) 25 | })) 26 | } else { 27 | return( lapply(x, function(xx) { 28 | if (n > length(xx)) { 29 | return( c(xx, rep(NA, times=n-length(xx))) ) 30 | } else { 31 | return(xx) 32 | } 33 | })) 34 | } 35 | } else if (is.matrix(x)) { 36 | 37 | return( rbind( x, matrix(NA, nrow=n-nrow(x), ncol=ncol(x)) ) ) 38 | 39 | } else { 40 | 41 | return( c( x, rep(NA, n-length(x)) ) ) 42 | 43 | } 44 | 45 | } 46 | -------------------------------------------------------------------------------- /tests/testthat/test-coerce.R: -------------------------------------------------------------------------------- 1 | context("coerce") 2 | 3 | ## factor2char 4 | dat <- list( 5 | list( 6 | list( a=factor(1), b=factor(c(2,3,4)) ), 7 | list( c=factor(c("a", "b", "c")) ) ), 8 | factor(c(1,2,3)) 9 | ) 10 | 11 | expect_identical( factor_to_char(dat), rapply(dat, as.character, how="list") ) 12 | 13 | ## df2list 14 | df <- data.frame(x=1, y=2, z=3) 15 | df2 <- list2df( df2list(df) ) 16 | expect_identical( 17 | df, 18 | df2 19 | ) 20 | 21 | expect_warning( list2df(df) ) 22 | 23 | list <- list(x=1, y=2, z=3) 24 | list2 <- df2list( list2df( list ) ) 25 | expect_identical( 26 | list, 27 | list2 28 | ) 29 | 30 | expect_error( df2list(list) ) 31 | 32 | ## list2df 33 | l1 <- list( a=1:100, b=sample( c(TRUE, FALSE), 100, TRUE ) ) 34 | l1$c <- factor(l1$a) 35 | l1$d <- sample( letters, 100, TRUE ) 36 | 37 | list2df(l1) 38 | names(l1) <- NULL 39 | 40 | list2df(l1) 41 | expect_error(list2df(l1, inplace=NA)) 42 | 43 | l <- replicate(10, 1:10, simplify=FALSE) 44 | df <- list2df(l) 45 | m <- list2df(l, inplace=TRUE) 46 | 47 | ## mat2df 48 | m <- matrix(1:9, nrow=3) 49 | expect_identical( 50 | unname(as.matrix( mat2df(m) )), 51 | m 52 | ) 53 | 54 | m1 <- mat2df(m) 55 | gctorture(TRUE) 56 | m2 <- mat2df(m) 57 | gctorture(FALSE) 58 | expect_identical(m1, m2) 59 | 60 | expect_identical( 61 | mat2df(m), as.data.frame(m) 62 | ) 63 | -------------------------------------------------------------------------------- /man/htmlTable.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{htmlTable} 3 | \alias{htmlTable} 4 | \title{Generate an HTML Table} 5 | \usage{ 6 | htmlTable(x, class = "table table-condensed table-hover", id = NULL, 7 | style = NULL, attr = NULL, output = TRUE, ...) 8 | } 9 | \arguments{ 10 | \item{x}{A \code{data.frame} or \code{matrix}.} 11 | 12 | \item{class}{The CSS class to give the table. By default, 13 | we use Twitter bootstrap styling -- for this to take 14 | effect, your document must include bootstrap CSS.} 15 | 16 | \item{id}{The CSS id to give the table.} 17 | 18 | \item{style}{Custom styling to apply to the table.} 19 | 20 | \item{attr}{Other attributes we wish to apply to the 21 | table.} 22 | 23 | \item{output}{Whether we should write the output to the 24 | console. We hijack the \code{kable} argument.} 25 | 26 | \item{...}{Optional arguments passed to 27 | \code{\link{kable}}.} 28 | } 29 | \description{ 30 | This function is used to generate an HTML table; it wraps to 31 | \code{knitr::kable} but gives some 'extras'; in particular, it allows 32 | us to set the class, id, and other HTML attributes. 33 | } 34 | \examples{ 35 | df <- data.frame(`P Values`=runif(1000), Group=1:1000) 36 | htmlTable( head(df[ order(df$P, decreasing=FALSE), ]) ) 37 | ## wow! look at all that significance! ... 38 | } 39 | 40 | -------------------------------------------------------------------------------- /man/bwplot2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{bwplot2} 3 | \alias{bwplot2} 4 | \title{Custom Lattice Boxplot} 5 | \usage{ 6 | bwplot2(form, data = NULL, xlab = NULL, ylab = NULL, main = NULL, 7 | n = 10, ...) 8 | } 9 | \arguments{ 10 | \item{form}{a formula object as expected by 11 | \code{lattice}'s \code{xyplot}.} 12 | 13 | \item{data}{see \code{\link{xyplot}}.} 14 | 15 | \item{xlab}{see \code{\link{xyplot}}.} 16 | 17 | \item{ylab}{see \code{\link{xyplot}}.} 18 | 19 | \item{main}{see \code{\link{xyplot}}.} 20 | 21 | \item{n}{number of points necessary for a boxplot to be 22 | drawn.} 23 | 24 | \item{...}{additional arguments passed to \code{xyplot} 25 | call.} 26 | } 27 | \description{ 28 | This generates a custom lattice boxplot; we super-impose actual plot points 29 | for groups with a small number of points, and also restrict plotting of the 30 | boxplot for these as well (since they are really rather mis-representative 31 | of the distribution when there are so few points.) The downside is that 32 | functionality is not implemented for multi-panel plots. 33 | } 34 | \details{ 35 | Axis labels are inferred from the \code{form} object passed in when possible. 36 | } 37 | \examples{ 38 | set.seed(123) 39 | dat <- data.frame( y=rnorm(100), x=factor( rbinom(100,size=2,p=0.8) ) ) 40 | bwplot2( x ~ y , dat) 41 | } 42 | 43 | -------------------------------------------------------------------------------- /R/html_tags.R: -------------------------------------------------------------------------------- 1 | # Generate HTML tag environment 2 | # 3 | # Generates the environment used for the HTML utility functions. 4 | .html <- new.env() 5 | .tags <- c( 6 | "a", "abbr", "acronym", "address", "applet", "area", "article", 7 | "aside", "audio", "b", "base", "basefont", "bdi", "bdo", "big", 8 | "blockquote", "body", "br", "button", "canvas", "caption", "center", 9 | "cite", "code", "col", "colgroup", "command", "datalist", "dd", 10 | "del", "details", "dfn", "dir", "div", "dl", "dt", "em", "embed", 11 | "fieldset", "figcaption", "figure", "font", "footer", "form", 12 | "frame", "frameset", "h1", "h2", "h3", "h4", "h5", "h6", "head", 13 | "header", "hgroup", "hr", "html", "i", "iframe", "img", "input", 14 | "ins", "isindex", "kbd", "keygen", "label", "legend", "li", "link", 15 | "map", "mark", "menu", "meta", "meter", "nav", "noframes", "noscript", 16 | "object", "ol", "optgroup", "option", "output", "p", "param", 17 | "pre", "progress", "q", "rp", "rt", "ruby", "s", "samp", "script", 18 | "section", "select", "small", "span", "strike", "strong", "style", 19 | "sub", "summary", "sup", "table", "tbody", "td", "textarea", 20 | "tfoot", "th", "thead", "time", "title", "tr", "track", "tt", 21 | "u", "ul", "var", "video", "wbr" 22 | ) 23 | 24 | for ( tag in .tags ) { 25 | assign( tag, makeHTMLTag(tag), envir=.html ) 26 | } 27 | 28 | rm(.tags) 29 | -------------------------------------------------------------------------------- /incubator/replace_function.R: -------------------------------------------------------------------------------- 1 | ##' Replace a Function in a Package / Namespace 2 | ##' 3 | ##' This function can be used to replace the function definition in a locked 4 | ##' package or namespace with your own. 5 | ##' 6 | ##' @param old The old function name that you wish to replace. 7 | ##' @param pkg The name of the package / namespace in which the function 8 | ##' you plan to replace, resides. 9 | ##' @param FUN The function definition you plan on using to replace 10 | ##' \code{old} with. 11 | ##' @param compile Boolean, if \code{TRUE} we compile the function \code{FUN}. 12 | replace_function <- function(old, pkg, FUN, compile=TRUE) { 13 | 14 | if (!is.character(old)) { 15 | old <- as.character(match.call()$old) 16 | } 17 | 18 | if (!is.character(pkg)) { 19 | pkg <- as.character(match.call()$pkg) 20 | } 21 | 22 | if (length(old) != 1) { 23 | stop("'old' must be a character vector of length one") 24 | } 25 | 26 | FUN <- match.fun(FUN) 27 | 28 | env <- as.environment( paste0("package:", pkg) ) 29 | ns <- asNamespace(pkg) 30 | 31 | environment(FUN) <- ns 32 | if (compile) 33 | FUN <- compiler::cmpfun(FUN) 34 | 35 | unlockBinding(old, env) 36 | unlockBinding(old, ns) 37 | assign(old, FUN, envir=env) 38 | utils::assignInNamespace(old, FUN, ns=pkg, envir=env) 39 | lockBinding(old, env) 40 | lockBinding(old, ns) 41 | 42 | } 43 | -------------------------------------------------------------------------------- /man/labeller.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{labeller} 3 | \alias{labeller} 4 | \title{ggplot2 labeller} 5 | \usage{ 6 | labeller(..., .parse = TRUE) 7 | } 8 | \arguments{ 9 | \item{...}{A set of named arguments.} 10 | 11 | \item{.parse}{boolean; if \code{TRUE} we \code{parse} the 12 | text as though it were an expression.} 13 | } 14 | \description{ 15 | This function works as a labelling mapper for \code{ggplot2}, typically used 16 | in \code{facet_grid}. All arguments must be named. Items are mapped as 17 | \code{name => value}, where \code{name} represents the original 18 | levels of the factor used for facetting. 19 | } 20 | \examples{ 21 | if (require(ggplot2)) { 22 | 23 | df <- data.frame( 24 | x=1:100, 25 | y=rnorm(100), 26 | grp=rep( c("tau+", "tau-"), each=50 ) ## levels are "tau+", "tau-" 27 | ) 28 | 29 | f <- labeller( 30 | `tau-` = 'tau["-"]', 31 | `tau+` = 'tau["+"]' 32 | ) 33 | 34 | ggplot(df, aes(x=x, y=y)) + 35 | geom_point() + 36 | facet_grid(". ~ grp", labeller=f) 37 | 38 | df$grp2 <- factor(rep( c("beta+", "beta-"), each=50 )) 39 | 40 | f <- labeller( 41 | `tau-` = 'tau["-"]', 42 | `tau+` = 'tau["+"]', 43 | `beta+` = 'beta["+"]', 44 | `beta-` = 'beta["-"]' 45 | ) 46 | 47 | ggplot(df, aes(x=x, y=y)) + 48 | geom_point() + 49 | facet_grid("grp ~ grp2", labeller=f) 50 | } 51 | } 52 | 53 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/kevinushey/Kmisc.png)](https://travis-ci.org/kevinushey/Kmisc) 2 | 3 | # Kmisc 4 | 5 | Kmisc is a package chock full of miscellaneous functions that intend to make 6 | the R programming process easier. The functions range from: 7 | 8 | * A faster implementation of `reshape2::melt` for `data.frame`s and `matrix`'s, 9 | * Utility functions for generating and styling R Markdown documents, 10 | * A simple wrapper to `awk`, 11 | * Functions for reading in subsets of very large files: 12 | * * `extract_rows_from_file` pulls specific rows from a (potentially large) 13 | tabular data file, where we only take rows for which a particular column 14 | entry matches a list of desired elements, 15 | * * `split_file` splits a file on a particular column into separate, smaller 16 | files, so that these smaller files are more amenable to parallel processing, 17 | * Faster implementations of some common R functions; e.g. `counts` is a faster 18 | version of `table` for single vectors; `tapply_` is a faster `tapply` for the 19 | common case of splitting an atomic vector by another atomic vector, 20 | `factor_` is a faster `factor`... 21 | * And more! Browse the index to get an idea of everything that's there. 22 | 23 | Install me in R with `devtools::install_github()` with the following call: 24 | 25 | devtools::install_github("kevinushey/Kmisc") 26 | 27 | -------------------------------------------------------------------------------- /tests/testthat/test-counts.R: -------------------------------------------------------------------------------- 1 | context("counts") 2 | table_ <- function(x) { 3 | c(table(x, useNA="ifany")) 4 | } 5 | 6 | n <- 1E2 7 | 8 | set.seed(123) 9 | x <- round( rnorm(n), 0 ) 10 | expect_identical( counts(x), table_(x) ) 11 | 12 | 13 | x <- as.integer(x) 14 | expect_identical( counts(x), table_(x) ) 15 | 16 | 17 | x <- as.character(x) 18 | expect_identical( counts(x), table_(x) ) 19 | 20 | 21 | x <- as.logical( as.numeric(x) ) 22 | expect_identical( counts(x), table_(x) ) 23 | 24 | 25 | x <- round( rnorm(n), 0 ) 26 | x[ sample(1:length(x), 10) ] <- NA 27 | expect_identical( counts(x), table_(x) ) 28 | 29 | 30 | x <- as.integer(x) 31 | expect_identical( counts(x), table_(x) ) 32 | 33 | 34 | x <- as.character(x) 35 | expect_identical( counts(x), table_(x) ) 36 | 37 | 38 | x <- as.logical( as.numeric(x) ) 39 | expect_identical( counts(x), table_(x) ) 40 | 41 | 42 | x <- replicate(10, round( rnorm(n), 0 ), simplify=FALSE) 43 | expect_identical( 44 | counts(x), 45 | lapply(x, table_) 46 | ) 47 | 48 | ## test small, large numerics 49 | expect_identical( counts(1E-20), c(table(1E-20)) ) 50 | expect_identical( counts(1E20), c(table(1E20)) ) 51 | 52 | ## test logical 53 | expect_identical( counts(TRUE), c(table(TRUE)) ) 54 | expect_identical( counts(FALSE), c(table(FALSE)) ) 55 | 56 | ## test NA, NaN 57 | expect_identical( counts( c(1E-20, NA, NaN) ), c(table(c(1E-20, NA, NaN), useNA="ifany") ) ) 58 | -------------------------------------------------------------------------------- /R/error.R: -------------------------------------------------------------------------------- 1 | ##' Stop / Warning / Message Wrappers 2 | ##' 3 | ##' These are simple wrappers to functions \code{stop}, \code{warning}, and 4 | ##' \code{message}. 5 | ##' 6 | ##' @param expr An expression to be evaluated and checked for 'truthiness'. 7 | ##' @param fmt A character vector of format strings. Passed to \code{\link{gettextf}}. 8 | ##' @param ... Optional arguments passed to \code{\link{gettextf}}. 9 | ##' @name error-wrappers 10 | NULL 11 | 12 | ##' @rdname error-wrappers 13 | ##' @export 14 | stopf <- function(fmt, ...) { 15 | stop(gettextf(fmt, ...), call.=FALSE) 16 | } 17 | 18 | ##' @rdname error-wrappers 19 | ##' @export 20 | warnf <- function(fmt, ...) { 21 | warning(gettextf(fmt, ...)) 22 | } 23 | 24 | ##' @rdname error-wrappers 25 | ##' @export 26 | messagef <- function(fmt, ...) { 27 | message(gettextf(fmt, ...)) 28 | } 29 | 30 | ##' @rdname error-wrappers 31 | ##' @export 32 | stop_if <- function(expr, fmt, ...) { 33 | call <- match.call() 34 | if (eval(expr)) { 35 | stopf(gettextf(fmt, ...)) 36 | } 37 | } 38 | 39 | ##' @rdname error-wrappers 40 | ##' @export 41 | warn_if <- function(expr, fmt, ...) { 42 | call <- match.call() 43 | if (eval(expr)) { 44 | warnf(gettextf(fmt, ...)) 45 | } 46 | } 47 | 48 | ##' @rdname error-wrappers 49 | ##' @export 50 | message_if <- function(expr, fmt, ...) { 51 | call <- match.call() 52 | if (eval(expr)) { 53 | message(gettextf(fmt, ...)) 54 | } 55 | } 56 | -------------------------------------------------------------------------------- /man/sys.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{sys} 3 | \alias{sys} 4 | \title{Invoke a System Command} 5 | \usage{ 6 | sys(..., intern = FALSE, ignore.stdout = FALSE, ignore.stderr = FALSE, 7 | wait = TRUE, input = NULL, show.output.on.console = TRUE, 8 | minimized = FALSE, invisible = TRUE) 9 | } 10 | \arguments{ 11 | \item{...}{System command to be invoked; this gets passed 12 | into \code{paste(..., sep='', collapse='')}.} 13 | 14 | \item{intern}{A logical (not \code{NA}) which indicates 15 | whether to capture the output of the command as an \R 16 | character vector.} 17 | 18 | \item{ignore.stdout}{Ignore \code{stdout}?} 19 | 20 | \item{ignore.stderr}{Ignore \code{stderr}?} 21 | 22 | \item{wait}{Should the \R interpreter wait for the 23 | program to finish execution?} 24 | 25 | \item{input}{If a character vector is supplied, this is 26 | copied one string per line to a temporary file, and the 27 | standard input of \code{...} is redirected to the file.} 28 | 29 | \item{show.output.on.console}{Windows only -- show output 30 | on console?} 31 | 32 | \item{minimized}{Windows only -- run the shell 33 | minimized?} 34 | 35 | \item{invisible}{Windows only -- run invisibly?} 36 | } 37 | \description{ 38 | This function wraps to \code{system}, but interprets all un-named 39 | arguments as things to be \code{paste}-ed. See \code{\link{system}} 40 | for further details. 41 | } 42 | 43 | -------------------------------------------------------------------------------- /R/value_matching.R: -------------------------------------------------------------------------------- 1 | ##' Value Matching 2 | ##' 3 | ##' These are a couple of mostly self-explanatory wrappers around \code{\%in\%}. 4 | ##' 5 | ##' \code{\%nin\%} returns a logical vector indicating if there is 6 | ##' no match for its left operand. It is the inverse of \code{x \%in\% y}. 7 | ##' 8 | ##' \code{\%kin\%} returns the actual values of \code{x} for which 9 | ##' \code{x \%in\% y}. 10 | ##' 11 | ##' \code{\%knin\%} returns the actual values of \code{x} for which 12 | ##' \code{x \%nin\% y}. 13 | ##' 14 | ##' @param x Vector or \code{NULL}: the values to be matched. 15 | ##' @param y Vector or \code{NULL}: the values to be matched against. 16 | ##' @name value_matching 17 | NULL 18 | 19 | ##' @rdname value_matching 20 | ##' @usage x \%nin\% y 21 | ##' @export 22 | "%nin%" <- function(x, y) { 23 | return( !(x %in% y) ) 24 | } 25 | 26 | ##' @rdname value_matching 27 | ##' @usage x \%kin\% y 28 | ##' @export 29 | "%kin%" <- function(x, y) { 30 | return( x[ x %in% y] ) 31 | } 32 | 33 | ##' @rdname value_matching 34 | ##' @usage x \%knin\% y 35 | ##' @export 36 | "%knin%" <- function(x, y) { 37 | return( x[ x %nin% y ] ) 38 | } 39 | 40 | ##' @rdname value_matching 41 | ##' @usage x \%drop\% y 42 | ##' @export 43 | "%drop%" <- function(x, y) { 44 | return( x[ !x %in% y ] ) 45 | } 46 | 47 | ##' @rdname value_matching 48 | ##' @usage x \%keep\% y 49 | ##' @export 50 | "%keep%" <- function(x, y) { 51 | return( x[ x %in% y ] ) 52 | } 53 | -------------------------------------------------------------------------------- /R/pymat.R: -------------------------------------------------------------------------------- 1 | ##' Python-style Formatting of Strings. 2 | ##' 3 | ##' This function allows Python-style formatting of strings, whereby text of 4 | ##' the form \code{{0}, {1}, ..., {n}} is substituted according to the 5 | ##' matching argument passed to \code{...}. \code{0} corresponds to the 6 | ##' first argument, \code{1} corresponds to the second, and so on. 7 | ##' 8 | ##' @param x A string with arguments to be replaced in the form of 9 | ##' \code{{0}, {1}, ..., {n}}. 10 | ##' @param ... Arguments to be substituted into \code{x}. 11 | ##' @param collapse If vectors of length greater than 1 are passed to \code{...}, 12 | ##' then we collapse the vectors with this separator. 13 | ##' @export 14 | ##' @examples 15 | ##' pymat( 16 | ##' "My favourite fruits are: {0}, {1}, and {2}.", 17 | ##' "apple", "banana", "orange" 18 | ##' ) 19 | ##' 20 | ##' pymat( 21 | ##' "My favourite fruits are: {0}.", 22 | ##' c("apple", "banana", "orange"), collapse=", " 23 | ##' ) 24 | pymat <- function(x, ..., collapse=", ") { 25 | 26 | ## single strings only 27 | if( length(x) > 1 ) { 28 | stop("'x' must be a single string") 29 | } 30 | 31 | ## collapse vectors passed to dot args 32 | dotArgs <- sapply( list(...), paste, collapse=collapse ) 33 | 34 | i <- 0 35 | for( arg in dotArgs ) { 36 | to_replace <- paste( sep='', "{", i, "}" ) 37 | x <- gsub( to_replace, arg, x, fixed=TRUE ) 38 | i <- i + 1 39 | } 40 | return( x ) 41 | } 42 | -------------------------------------------------------------------------------- /R/overwrite.R: -------------------------------------------------------------------------------- 1 | ## Overwrite a Symbol in a Package 2 | ## 3 | ## Replaces a symbol with name \code{x} with a symbol \code{value}, in the 4 | ## package \code{package}. 5 | ## 6 | ## The value of the old symbol is returned. 7 | overwrite <- function(x, value, package=NULL) { 8 | 9 | if (!is.character(x)) { 10 | call <- match.call() 11 | x <- capture.output(call$x) 12 | } 13 | 14 | 15 | if (grepl("::", x)) { 16 | split <- unlist( strsplit(x, ":+", perl=TRUE) ) 17 | package <- split[[1]] 18 | x <- split[[2]] 19 | } 20 | 21 | package_ <- asNamespace(package) 22 | 23 | old <- tryCatch( 24 | get(x, envir=package_), 25 | error=function(e) NULL 26 | ) 27 | 28 | pkg_env <- as.environment(paste("package", package, sep=":")) 29 | environment(value) <- package_ 30 | 31 | ## Unlock bindings 32 | tryCatch( unlockBinding(x, pkg_env), error=function(e) { 33 | stop("Could not unlock binding: no symbol '", x, "' in namespace '", package, "'?") 34 | }) 35 | tryCatch( unlockBinding(x, package_), error=function(e) { 36 | stop("Could not unlock binding: no symbol '", x, "' in namespace '", package, "'?") 37 | }) 38 | 39 | ## Assign values 40 | assign(x, value, envir=pkg_env) 41 | utils::assignInNamespace(x, value, ns=package_, envir=pkg_env) 42 | 43 | ## Lock bindings 44 | lockBinding(x, pkg_env) 45 | lockBinding(x, package_) 46 | 47 | ## Return the old function 48 | return(old) 49 | } 50 | -------------------------------------------------------------------------------- /R/str_rev.R: -------------------------------------------------------------------------------- 1 | ##' Reverse a Vector of Strings 2 | ##' 3 | ##' Reverses a vector of 'strings' (a character vector). Not safe for 4 | ##' unicode (UTF-8) characters. 5 | ##' 6 | ##' This function is written in C for fast execution; however, we do not handle 7 | ##' non-ASCII characters. For a 'safe' version of \code{str_rev} that handles 8 | ##' unicode characters, see \code{\link{str_rev2}}. 9 | ##' @export 10 | ##' @param x a character vector. 11 | ##' @seealso \code{\link{str_rev2}} 12 | ##' @examples 13 | ##' x <- c("ABC", "DEF", "GHIJ") 14 | ##' str_rev(x) 15 | str_rev <- function(x) { 16 | tmp <- .Call(Cstr_rev, as.character(x)) 17 | tmp[ is.na(x) ] <- NA 18 | return(tmp) 19 | } 20 | 21 | ##' Reverse a Vector of Strings (UTF-8) 22 | ##' 23 | ##' Reverses a vector of 'strings' (a character vector). This will safely reverse a 24 | ##' vector of unicode (UTF-8) characters. 25 | ##' 26 | ##' This function will handle UTF-8 characters safely. If you 27 | ##' are working only with ASCII characters and require speed, 28 | ##' see \code{\link{str_rev2}}. 29 | ##' 30 | ##' @export 31 | ##' @param x a character vector. 32 | ##' @seealso \code{\link{str_rev}} 33 | ##' @examples 34 | ##' x <- c("ABC", "DEF", "GHIJ") 35 | ##' str_rev(x) 36 | str_rev2 <- function(x) { 37 | vapply( as.character(x), 38 | USE.NAMES=FALSE, 39 | FUN.VALUE="character", 40 | function(xx) { 41 | intToUtf8( rev( utf8ToInt( xx ) ) ) 42 | }) 43 | } 44 | -------------------------------------------------------------------------------- /R/str_sort.R: -------------------------------------------------------------------------------- 1 | .letters.UTF8 <- sapply( letters, utf8ToInt ) 2 | .LETTERS.UTF8 <- sapply( LETTERS, utf8ToInt ) 3 | 4 | .letters.from <- c( rbind( .letters.UTF8, .LETTERS.UTF8 ) ) 5 | .letters.to <- c( cbind( .letters.UTF8, .LETTERS.UTF8 ) ) 6 | 7 | ##' Sort a Vector of Strings 8 | ##' 9 | ##' Sorts a vector of strings lexically, as based on their 10 | ##' UTF-8 ordering scheme. Lower-case letters are, by default, 11 | ##' 'larger' than upper-case letters. This function will safely sort a 12 | ##' UTF-8 vector. 13 | ##' 14 | ##' @export 15 | ##' @param x a character vector (a vector of 'strings' to sort) 16 | ##' @param increasing boolean. sort the string in increasing lexical order? 17 | ##' @param ignore.case boolean. ignore case (so that, eg, \code{a < A < b}) 18 | ##' @param USE.NAMES logical. if names attribute already exists on \code{x}, 19 | ##' pass this through to the result? 20 | ##' @examples 21 | ##' stopifnot( all( str_sort(c("cba", "fed")) == c("abc", "def") ) ) 22 | str_sort <- function(x, increasing=TRUE, ignore.case=FALSE, USE.NAMES=FALSE) { 23 | vapply( x, USE.NAMES=USE.NAMES, FUN.VALUE="character", function(xx) { 24 | tmp <- utf8ToInt(xx) 25 | if( ignore.case ) { 26 | tmp <- swap( tmp, .letters.from, .letters.to ) 27 | tmp <- sort( tmp, decreasing=!increasing ) 28 | tmp <- swap( tmp, .letters.to, .letters.from ) 29 | } else { 30 | tmp <- sort( tmp, decreasing=!increasing ) 31 | } 32 | return( intToUtf8(tmp) ) 33 | }) 34 | } 35 | -------------------------------------------------------------------------------- /src/doublehex.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | #if defined(__GNUC__) || defined(__clang__) 7 | #define STATIC_ASSERT(x) \ 8 | do { \ 9 | const static char __attribute__((__unused__)) dummy[x ? 1 : -1]; \ 10 | } while (0) 11 | #else 12 | #define STATIC_ASSERT(x) \ 13 | do { \ 14 | const static char dummy[x ? 1 : -1]; \ 15 | } while (0) 16 | #endif 17 | 18 | // [[register]] 19 | SEXP double2hex(SEXP x) { 20 | 21 | STATIC_ASSERT( sizeof(unsigned long long) == sizeof(double) ); 22 | 23 | // double is 8 bytes, each byte can be represented by 2 hex chars, 24 | // so need a str with 16+1 slots 25 | int n = sizeof(unsigned long long) * 2 + 1; 26 | 27 | unsigned long long *xx = (unsigned long long*) REAL(x); 28 | char buf[n]; 29 | 30 | // windows specifies long longs differently under mingw 31 | #ifdef WIN32 32 | snprintf(buf, n, "%016I64X", *xx); 33 | #else 34 | snprintf(buf, n, "%016llX", *xx); 35 | #endif 36 | SEXP output = PROTECT(allocVector(STRSXP, 1)); 37 | SET_STRING_ELT(output, 0, mkChar(buf)); 38 | UNPROTECT(1); 39 | return output; 40 | } 41 | 42 | // [[register]] 43 | SEXP int2hex(SEXP x) { 44 | 45 | int n = sizeof(int) * 2 + 1; 46 | char buf[n]; 47 | snprintf(buf, n, "%08X", *(unsigned int*)INTEGER(x)); 48 | SEXP output = PROTECT(allocVector(STRSXP, 1)); 49 | SET_STRING_ELT(output, 0, mkChar(buf)); 50 | UNPROTECT(1); 51 | return output; 52 | } 53 | 54 | #undef USE_RINTERNALS 55 | -------------------------------------------------------------------------------- /tests/testthat/test-split_file.R: -------------------------------------------------------------------------------- 1 | # library(Kmisc) 2 | # library(testthat) 3 | # 4 | # n <- 1E4 5 | # 6 | # dat <- data.frame( x=sample(LETTERS, n, TRUE), y=rnorm(n), stringsAsFactors=FALSE ) 7 | # tempfile <- tempfile() 8 | # write.table( dat, 9 | # file=tempfile, 10 | # row.names=FALSE, 11 | # col.names=FALSE, 12 | # sep="\t", 13 | # quote=FALSE 14 | # ) 15 | # 16 | # outPath <- file.path( dirname(tempfile), "split" ) 17 | # list.files(outPath) 18 | # for( file in list.files(outPath, full.names=TRUE) ) { 19 | # unlink(file) 20 | # } 21 | # 22 | # split_file( tempfile, 23 | # column=1, 24 | # # sep="\t", 25 | # outDir=outPath, 26 | # verbose=FALSE 27 | # ) 28 | # 29 | # out <- NULL 30 | # for( file in list.files(outPath, full.names=TRUE) ) { 31 | # tmp <- read.table( file, header=FALSE, sep="\t", as.is=TRUE, colClasses=c("character", "numeric") ) 32 | # out <- rbind( out, tmp ) 33 | # } 34 | # names(out) <- c("x", "y") 35 | # dat_ordered <- dat[ order(dat$x), ] 36 | # rownames(dat_ordered) <- 1:nrow(dat_ordered) 37 | # 38 | # expect_equal( dat_ordered, out ) 39 | # 40 | # system.time( 41 | # split_file( tempfile, 42 | # column=1, 43 | # sep="\t", 44 | # outDir=outPath, 45 | # verbose=FALSE 46 | # ) 47 | # ) 48 | # 49 | # for( file in list.files(outPath, full.names=TRUE) ) { 50 | # unlink(file) 51 | # } 52 | -------------------------------------------------------------------------------- /src/any_na.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | // [[register]] 7 | SEXP any_na( SEXP x ) { 8 | SEXP out; 9 | PROTECT(out = allocVector(LGLSXP, 1)); 10 | int len = length(x); 11 | switch( TYPEOF(x) ) { 12 | case REALSXP: { 13 | double* ptr = REAL(x); 14 | for( int i=0; i < len; ++i ) { 15 | if( ISNA( ptr[i] ) || ISNAN( ptr[i] ) ) { 16 | LOGICAL(out)[0] = TRUE; 17 | UNPROTECT(1); 18 | return out; 19 | } 20 | } 21 | LOGICAL(out)[0] = FALSE; 22 | UNPROTECT(1); 23 | return out; 24 | } 25 | case INTSXP: { 26 | int* ptr = INTEGER(x); 27 | for( int i=0; i < len; ++i ) { 28 | if( ptr[i] == NA_INTEGER ) { 29 | LOGICAL(out)[0] = TRUE; 30 | UNPROTECT(1); 31 | return out; 32 | } 33 | } 34 | LOGICAL(out)[0] = FALSE; 35 | UNPROTECT(1); 36 | return out; 37 | } 38 | case LGLSXP: { 39 | int* ptr = LOGICAL(x); 40 | for( int i=0; i < len; ++i ) { 41 | if( ptr[i] == NA_LOGICAL ) { 42 | LOGICAL(out)[0] = TRUE; 43 | UNPROTECT(1); 44 | return out; 45 | } 46 | } 47 | LOGICAL(out)[0] = FALSE; 48 | UNPROTECT(1); 49 | return out; 50 | } 51 | case STRSXP: { 52 | for( int i=0; i < len; ++i ) { 53 | if( STRING_ELT(x, i) == NA_STRING ) { 54 | LOGICAL(out)[0] = TRUE; 55 | UNPROTECT(1); 56 | return out; 57 | } 58 | } 59 | LOGICAL(out)[0] = FALSE; 60 | UNPROTECT(1); 61 | return out; 62 | } 63 | } 64 | error("argument is of incompatible type '%s'", type2char( TYPEOF(x) ) ); 65 | return x; 66 | } 67 | 68 | #undef USE_RINTERNALS 69 | -------------------------------------------------------------------------------- /man/dict.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{dict} 3 | \alias{dict} 4 | \title{Python-style Dictionaries in R} 5 | \usage{ 6 | dict(..., `_size` = 29L) 7 | } 8 | \arguments{ 9 | \item{...}{Named arguments used in constructing the 10 | dictionary.} 11 | 12 | \item{`_size`}{The number of 'buckets' used. This is the 13 | maximum of \code{29L} and the number of named arguments 14 | passed to \code{...}.} 15 | } 16 | \description{ 17 | Dictionaries, i.e., hashed key-value pairs, are implemented in \R using 18 | environments as a backend. 19 | } 20 | \details{ 21 | Dictionaries are just hashed \R environments with \code{emptyenv()} as a 22 | parent. 23 | } 24 | \section{Warning}{ 25 | Dictionaries have \bold{reference semantics}, so 26 | modifying a dictionary within a function will modify the 27 | dictionary passed in, not a copy! Use the \code{copy} 28 | function to duplicate a \code{dict}. 29 | } 30 | \examples{ 31 | ## Reference semantics -- be careful! 32 | x <- dict() 33 | y <- x 34 | x[["a"]] <- 100 35 | print(y[["a"]]) 36 | 37 | ## Use copy to be explicit 38 | y <- copy(x) 39 | x[["b"]] <- 200 40 | try(y[["b"]], silent = TRUE) 41 | 42 | ## Named lookup can be much faster in a dictionary 43 | x <- as.list(1:1E5) 44 | names(x) <- paste0("Element_", 1:1E5) 45 | dict <- as.dict(x) 46 | if (require(microbenchmark)) { 47 | microbenchmark( 48 | x[["Element_1"]], 49 | dict[["Element_1"]], 50 | x[["Element_1000"]], 51 | dict[["Element_1000"]], 52 | x[["Element_100000"]], 53 | dict[["Element_100000"]] 54 | ) 55 | } 56 | } 57 | 58 | -------------------------------------------------------------------------------- /inst/resources/highlight/styles/tomorrow.css: -------------------------------------------------------------------------------- 1 | /* http://jmblog.github.com/color-themes-for-google-code-highlightjs */ 2 | .tomorrow-comment, pre .comment, pre .title { 3 | color: #8e908c; 4 | } 5 | 6 | .tomorrow-red, pre .variable, pre .attribute, pre .tag, pre .regexp, pre .ruby .constant, pre .xml .tag .title, pre .xml .pi, pre .xml .doctype, pre .html .doctype, pre .css .id, pre .css .class, pre .css .pseudo { 7 | color: #c82829; 8 | } 9 | 10 | .tomorrow-orange, pre .number, pre .preprocessor, pre .built_in, pre .literal, pre .params, pre .constant { 11 | color: #f5871f; 12 | } 13 | 14 | .tomorrow-yellow, pre .class, pre .ruby .class .title, pre .css .rules .attribute { 15 | color: #eab700; 16 | } 17 | 18 | .tomorrow-green, pre .string, pre .value, pre .inheritance, pre .header, pre .ruby .symbol, pre .xml .cdata { 19 | color: #718c00; 20 | } 21 | 22 | .tomorrow-aqua, pre .css .hexcolor { 23 | color: #3e999f; 24 | } 25 | 26 | .tomorrow-blue, pre .function, pre .python .decorator, pre .python .title, pre .ruby .function .title, pre .ruby .title .keyword, pre .perl .sub, pre .javascript .title, pre .coffeescript .title { 27 | color: #4271ae; 28 | } 29 | 30 | .tomorrow-purple, pre .keyword, pre .javascript .function { 31 | color: #8959a8; 32 | } 33 | 34 | pre code { 35 | display: block; 36 | background: white; 37 | color: #4d4d4c; 38 | padding: 0.5em; 39 | } 40 | 41 | pre .coffeescript .javascript, 42 | pre .javascript .xml, 43 | pre .tex .formula, 44 | pre .xml .javascript, 45 | pre .xml .vbscript, 46 | pre .xml .css, 47 | pre .xml .cdata { 48 | opacity: 0.5; 49 | } 50 | -------------------------------------------------------------------------------- /R/split_runs.R: -------------------------------------------------------------------------------- 1 | ##' Split by Runs 2 | ##' 3 | ##' Split a vector into a list of runs, such that each entry in the 4 | ##' output list is a set of runs encountered. This function accepts two forms 5 | ##' of inputs: either a vector where each element of the vector is of length 6 | ##' 1 (e.g. \code{c("A", "A", "C", "T")}), or a vector of length 1 interpretted 7 | ##' as a long string (e.g. \code{"AAAACCAGGGACGCCGCGGTTGG"}). 8 | ##' 9 | ##' Factors will be coerced to character before splitting. 10 | ##' 11 | ##' @param x A numeric or character vector. 12 | ##' @export 13 | ##' @seealso \code{\link{rle}}, for a similar function with different output. 14 | ##' @examples 15 | ##' x <- rbinom( 100, 2, 0.5 ) 16 | ##' stopifnot( all( x == unlist( split_runs(x) ) ) ) 17 | ##' stopifnot( all( as.character(x) == unlist( split_runs( as.character(x) ) ) ) ) 18 | ##' y <- paste( collapse="", sample( LETTERS[1:5], 1E5, replace=TRUE ) ) 19 | ##' stopifnot( y == paste( collapse="", split_runs(y) ) ) 20 | ##' z <- replicate( 25, paste( collapse="", sample( LETTERS[1:5], 1E3, replace=TRUE ) ) ) 21 | ##' system.time( lapply(z, split_runs) ) 22 | split_runs <- function(x) { 23 | 24 | if (is.factor(x)) { 25 | x <- factor_to_char(x) 26 | } 27 | 28 | if( length(x) == 1 ) { 29 | return( .Call(CKmisc_split_runs_one, as.character(x)) ) 30 | } 31 | 32 | if( is.character(x) ) { 33 | return( .Call(CKmisc_split_runs_character, x) ) 34 | } 35 | 36 | if( is.numeric(x) ) { 37 | return( .Call(CKmisc_split_runs_numeric, x) ) 38 | } 39 | 40 | stop("x is of incompatible type") 41 | 42 | } 43 | -------------------------------------------------------------------------------- /R/size.R: -------------------------------------------------------------------------------- 1 | ##' Print the Object Size, with Auto Units 2 | ##' 3 | ##' Provides an estimate of the memory that is being used to store an \R 4 | ##' object. Similar to \code{\link{object.size}}, but we set \code{units="auto"} 5 | ##' as default. 6 | ##' 7 | ##' @param x An \R object. 8 | ##' @param quote logical, indicating whether or not the result should be printed 9 | ##' with surrounding quotes. 10 | ##' @param units The units to be used in printing the size. Other allowed values are 11 | ##' \code{"Kb"}, \code{"Mb"}, \code{"Gb"} and \code{"auto"}. See \code{\link{object.size}} 12 | ##' for more details. 13 | ##' @param ... Arguments to be passed to or from other methods. 14 | ##' @export 15 | size <- function(x, quote=FALSE, units="auto", ...) { 16 | m <- object.size(x) 17 | .size(m, quote=quote, units=units, ...) 18 | return( invisible(m) ) 19 | } 20 | 21 | ## copied from utils:::print.object_size 22 | .size <- function(x, quote = FALSE, units = "b", ...) { 23 | units <- match.arg(units, c("b", "auto", "Kb", "Mb", "Gb", 24 | "B", "KB", "MB", "GB")) 25 | if (units == "auto") { 26 | if (x >= 1024^3) 27 | units <- "Gb" 28 | else if (x >= 1024^2) 29 | units <- "Mb" 30 | else if (x >= 1024) 31 | units <- "Kb" 32 | else units <- "b" 33 | } 34 | y <- switch(units, b = , B = paste(x, "bytes"), Kb = , KB = paste(round(x/1024, 35 | 1L), "Kb"), Mb = , MB = paste(round(x/1024^2, 1L), "Mb"), 36 | Gb = , GB = paste(round(x/1024^3, 1L), "Gb")) 37 | if (quote) 38 | print.default(y, ...) 39 | else cat(y, "\n", sep = "") 40 | invisible(x) 41 | } 42 | -------------------------------------------------------------------------------- /inst/resources/highlight/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2006, Ivan Sagalaev 2 | All rights reserved. 3 | Redistribution and use in source and binary forms, with or without 4 | modification, are permitted provided that the following conditions are met: 5 | 6 | * Redistributions of source code must retain the above copyright 7 | notice, this list of conditions and the following disclaimer. 8 | * Redistributions in binary form must reproduce the above copyright 9 | notice, this list of conditions and the following disclaimer in the 10 | documentation and/or other materials provided with the distribution. 11 | * Neither the name of highlight.js nor the names of its contributors 12 | may be used to endorse or promote products derived from this software 13 | without specific prior written permission. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY 16 | EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY 19 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 22 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /src/mat2list.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | inline size_t type2size(SEXP x) { 7 | switch (TYPEOF(x)) { 8 | case INTSXP: return sizeof(int); 9 | case REALSXP: return sizeof(double); 10 | case LGLSXP: return sizeof(int); 11 | case STRSXP: return sizeof(SEXP); 12 | default: error("unimplemented"); 13 | return -1; 14 | } 15 | } 16 | 17 | #define HANDLE_CASE(RTYPE, CTYPE, ACCESSOR) \ 18 | for (int i=0; i < ncol; ++i) { \ 19 | SEXP tmp = PROTECT( allocVector(RTYPE, nrow) ); \ 20 | for (int j=0; j < nrow; ++j) { \ 21 | ACCESSOR(tmp)[j] = ACCESSOR(x)[i*nrow+j]; \ 22 | } \ 23 | SET_VECTOR_ELT(output, i, tmp); \ 24 | UNPROTECT(1); \ 25 | } \ 26 | break 27 | 28 | // [[register]] 29 | SEXP mat2list(SEXP x) { 30 | if (!isMatrix(x)) { 31 | error("'x' must be a matrix"); 32 | } 33 | 34 | SEXP dims = getAttrib(x, R_DimSymbol); 35 | int nrow = INTEGER(dims)[0]; 36 | int ncol = INTEGER(dims)[1]; 37 | SEXP output = PROTECT(allocVector(VECSXP, ncol)); 38 | switch (TYPEOF(x)) { 39 | case INTSXP: HANDLE_CASE(INTSXP, int, INTEGER); 40 | case REALSXP: HANDLE_CASE(REALSXP, double, REAL); 41 | case LGLSXP: HANDLE_CASE(LGLSXP, int, LOGICAL); 42 | case STRSXP: HANDLE_CASE(STRSXP, SEXP, STRING_PTR); 43 | default: error("wtf"); 44 | } 45 | UNPROTECT(1); 46 | 47 | SEXP dimnames = getAttrib(x, R_DimNamesSymbol); 48 | if (!isNull(dimnames)) { 49 | setAttrib(output, R_NamesSymbol, VECTOR_ELT(dimnames, 1)); 50 | } 51 | return output; 52 | } 53 | 54 | #undef HANDLE_CASE 55 | 56 | #undef USE_RINTERNALS 57 | -------------------------------------------------------------------------------- /man/hImg.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{hImg} 3 | \alias{hImg} 4 | \title{Print Plot to File and Return HTML} 5 | \usage{ 6 | hImg(my_plot, file, width = 400, height = 300, dpi = 300, dim = NULL, 7 | scale = 100, device = "png", ...) 8 | } 9 | \arguments{ 10 | \item{my_plot}{a plot object, or code that generates a 11 | plot} 12 | 13 | \item{file}{file location to output image to} 14 | 15 | \item{width}{width (in pixels) of the plot} 16 | 17 | \item{height}{height (in pixels) of the plot} 18 | 19 | \item{dpi}{the number of dots per inch used. Default is 20 | high to ensure plots are crisp on all displays} 21 | 22 | \item{dim}{passed to \code{par( mfrow )}; used if making 23 | multiple base-R plots} 24 | 25 | \item{scale}{the scale factor to use when scaling plots 26 | for web display.} 27 | 28 | \item{device}{the device to use for the plot call.} 29 | 30 | \item{...}{optional arguments passed to 31 | \code{\link{png}}} 32 | } 33 | \description{ 34 | A convenience function that prints a plot to file, and then returns HTML 35 | to embed that image in the page. 36 | } 37 | \details{ 38 | The \code{dim} attribute is passed on to \code{par( mfrow='dim' )}; ie, it is used if 39 | you are calling a plot function that writes more than one plot. 40 | 41 | The \code{png} device is used. 42 | } 43 | \examples{ 44 | library(lattice) 45 | ## generate an xyplot, write it to file, and return HTML 46 | ## code that sources the generated image 47 | dat <- data.frame( x = rnorm(100), y = rnorm(100) ) 48 | hImg( file = "plot_output.png", 49 | xyplot( y ~ x, dat ) 50 | ) 51 | } 52 | 53 | -------------------------------------------------------------------------------- /inst/resources/js/fancyboxify.js: -------------------------------------------------------------------------------- 1 | $(document).ready( function() { 2 | 3 | // if we click on an image in the document, we should fancyboxify its larger 4 | // friend 5 | $("img.fancybox").click( function() { 6 | 7 | var $this = $(this); 8 | 9 | // blur everything else 10 | $("body > *").not($this).addClass("blur"); 11 | 12 | // get id of brother image 13 | var id = $this.attr("id") + "-large"; 14 | 15 | // get the actual width, height attributes of the image 16 | var img_width = $("#" + id)[0].width; 17 | var img_height = $("#" + id)[0].height; 18 | var padding = 20; 19 | 20 | // get the browser dimensions 21 | var width = $(window).width(); 22 | var height = $(window).height(); 23 | 24 | var top = Math.abs( (height - img_height) / 2 ); 25 | var left = Math.abs( (width - img_width) / 2 ); 26 | 27 | // make it large and in charge 28 | $("#" + id).parent() 29 | .css("display", "block") 30 | .css("margin", "0 auto") 31 | .css("top", (top - 2*padding) + "px") 32 | .css("left", (left - 2*padding) + "px") 33 | .css("width", (img_width + 50) + "px") 34 | .css("position", "fixed") 35 | .css("padding", padding + "px") 36 | .css("background-color", "#444") 37 | .css("border-radius", padding + "px") 38 | .css("box-shadow", "0 0 10px #333") 39 | ; 40 | 41 | }); 42 | 43 | // if we click on a fancyboxed image, we should hide it again 44 | $("img.fancybox-large").click( function() { 45 | $("*").removeClass("blur"); 46 | $(this).parent().css("display", "none"); 47 | }); 48 | 49 | }); 50 | -------------------------------------------------------------------------------- /man/registerFunctions.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{registerFunctions} 3 | \alias{registerFunctions} 4 | \title{Automatically Register C/C++ Functions in a Package} 5 | \usage{ 6 | registerFunctions(prefix = "C_") 7 | } 8 | \arguments{ 9 | \item{prefix}{A prefix to append to the exported name, so 10 | that a function called \code{myfun} is registered as 11 | \code{myfun}.} 12 | } 13 | \description{ 14 | This function can be used to automatically register the native routines 15 | in a package. It searches all of the \code{.c} and \code{.cpp} files in 16 | \code{src}, excluding the file \code{_init.c}, finds functions 17 | annotated with \code{// [[register]]}, and extracts the 18 | required information needed to register routines in the package. 19 | The necessary routines are written to a file called 20 | \code{src/_init.c}. 21 | } 22 | \details{ 23 | This function should be called from the base directory of an 24 | \R package you are developing. 25 | 26 | Currently, the assumption is that all functions in a package use the 27 | \code{.Call} interface; i.e., there are no functions using the \code{.C}, 28 | \code{.Fortran}, or \code{.External} interfaces -- this may be 29 | added in a future version. 30 | 31 | After calling this function, ensure that you have 32 | \code{useDynLib(, .registration=TRUE)} in your \code{NAMESPACE}. 33 | If you use \code{roxygen} to document your package, you can 34 | use 35 | 36 | \describe{ 37 | \item{ }{\code{##' @useDynLib , .registration=TRUE}} 38 | } 39 | 40 | somewhere in your \code{roxygen} documentation to achieve the same effect. 41 | } 42 | 43 | -------------------------------------------------------------------------------- /inst/resources/highlight/styles/solarized_dark.css: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | Orginal Style from ethanschoonover.com/solarized (c) Jeremy Hull 4 | 5 | */ 6 | 7 | pre code { 8 | display: block; padding: 0.5em; 9 | background: #002b36; color: #839496; 10 | } 11 | 12 | pre .comment, 13 | pre .template_comment, 14 | pre .diff .header, 15 | pre .doctype, 16 | pre .pi, 17 | pre .lisp .string, 18 | pre .javadoc { 19 | color: #586e75; 20 | font-style: italic; 21 | } 22 | 23 | pre .keyword, 24 | pre .winutils, 25 | pre .method, 26 | pre .addition, 27 | pre .css .tag, 28 | pre .request, 29 | pre .status, 30 | pre .nginx .title { 31 | color: #859900; 32 | } 33 | 34 | pre .number, 35 | pre .command, 36 | pre .string, 37 | pre .tag .value, 38 | pre .phpdoc, 39 | pre .tex .formula, 40 | pre .regexp, 41 | pre .hexcolor { 42 | color: #2aa198; 43 | } 44 | 45 | pre .title, 46 | pre .localvars, 47 | pre .chunk, 48 | pre .decorator, 49 | pre .built_in, 50 | pre .identifier, 51 | pre .vhdl .literal, 52 | pre .id { 53 | color: #268bd2; 54 | } 55 | 56 | pre .attribute, 57 | pre .variable, 58 | pre .lisp .body, 59 | pre .smalltalk .number, 60 | pre .constant, 61 | pre .class .title, 62 | pre .parent, 63 | pre .haskell .type { 64 | color: #b58900; 65 | } 66 | 67 | pre .preprocessor, 68 | pre .preprocessor .keyword, 69 | pre .shebang, 70 | pre .symbol, 71 | pre .symbol .string, 72 | pre .diff .change, 73 | pre .special, 74 | pre .attr_selector, 75 | pre .important, 76 | pre .subst, 77 | pre .cdata, 78 | pre .clojure .title { 79 | color: #cb4b16; 80 | } 81 | 82 | pre .deletion { 83 | color: #dc322f; 84 | } 85 | 86 | pre .tex .formula { 87 | background: #073642; 88 | } 89 | -------------------------------------------------------------------------------- /inst/resources/highlight/styles/solarized_light.css: -------------------------------------------------------------------------------- 1 | /* 2 | 3 | Orginal Style from ethanschoonover.com/solarized (c) Jeremy Hull 4 | 5 | */ 6 | 7 | pre code { 8 | display: block; padding: 0.5em; 9 | background: #fdf6e3; color: #657b83; 10 | } 11 | 12 | pre .comment, 13 | pre .template_comment, 14 | pre .diff .header, 15 | pre .doctype, 16 | pre .pi, 17 | pre .lisp .string, 18 | pre .javadoc { 19 | color: #93a1a1; 20 | font-style: italic; 21 | } 22 | 23 | pre .keyword, 24 | pre .winutils, 25 | pre .method, 26 | pre .addition, 27 | pre .css .tag, 28 | pre .request, 29 | pre .status, 30 | pre .nginx .title { 31 | color: #859900; 32 | } 33 | 34 | pre .number, 35 | pre .command, 36 | pre .string, 37 | pre .tag .value, 38 | pre .phpdoc, 39 | pre .tex .formula, 40 | pre .regexp, 41 | pre .hexcolor { 42 | color: #2aa198; 43 | } 44 | 45 | pre .title, 46 | pre .localvars, 47 | pre .chunk, 48 | pre .decorator, 49 | pre .built_in, 50 | pre .identifier, 51 | pre .vhdl .literal, 52 | pre .id { 53 | color: #268bd2; 54 | } 55 | 56 | pre .attribute, 57 | pre .variable, 58 | pre .lisp .body, 59 | pre .smalltalk .number, 60 | pre .constant, 61 | pre .class .title, 62 | pre .parent, 63 | pre .haskell .type { 64 | color: #b58900; 65 | } 66 | 67 | pre .preprocessor, 68 | pre .preprocessor .keyword, 69 | pre .shebang, 70 | pre .symbol, 71 | pre .symbol .string, 72 | pre .diff .change, 73 | pre .special, 74 | pre .attr_selector, 75 | pre .important, 76 | pre .subst, 77 | pre .cdata, 78 | pre .clojure .title { 79 | color: #cb4b16; 80 | } 81 | 82 | pre .deletion { 83 | color: #dc322f; 84 | } 85 | 86 | pre .tex .formula { 87 | background: #eee8d5; 88 | } 89 | -------------------------------------------------------------------------------- /R/apply.R: -------------------------------------------------------------------------------- 1 | ##' Apply Wrappers 2 | ##' 3 | ##' These are thin but clearer wrappers to 4 | ##' \code{apply(x, 1, FUN, ...)} (row apply) and 5 | ##' \code{apply(x, 2, FUN, ...)} (column apply). 6 | ##' Intended for use with 2D \R \code{matrix}s. 7 | ##' We do a bit more work to ensure row names, 8 | ##' column names are passed along if appropriate. 9 | ##' 10 | ##' See \code{\link{apply}} for more info. 11 | ##' 12 | ##' @param X A matrix, or a 2D array. 13 | ##' @param FUN The function to be applied. 14 | ##' @param ... Optional arguments to \code{FUN}. 15 | ##' @param drop Boolean. If \code{TRUE}, we 'drop' dimensions so that results 16 | ##' of dimension \code{n x 1} or \code{1 x n} are coerced to vectors. 17 | ##' @rdname apply 18 | ##' @export 19 | rowApply <- function(X, FUN, ..., drop=TRUE) { 20 | output <- apply(X, 1, FUN, ...) 21 | if (is.matrix(output)) { 22 | output <- t(output) 23 | rownames(output) <- rownames(X) 24 | } else { 25 | if (drop) { 26 | output <- c(output) 27 | names(output) <- rownames(X) 28 | } else { 29 | if (!is.matrix(output)) { 30 | output <- matrix(output, nrow=nrow(X)) 31 | } 32 | rownames(output) <- rownames(X) 33 | } 34 | } 35 | return(output) 36 | } 37 | 38 | ##' @rdname apply 39 | ##' @export 40 | colApply <- function(X, FUN, ..., drop=TRUE) { 41 | if (drop) { 42 | output <- apply(X, 2, FUN, ...) 43 | if (!is.matrix(output)) 44 | names(output) <- colnames(X) 45 | return(output) 46 | } else { 47 | output <- matrix( ncol=ncol(X), 48 | apply(X, 2, FUN, ...) 49 | ) 50 | colnames(output) <- colnames(X) 51 | return(output) 52 | } 53 | } 54 | -------------------------------------------------------------------------------- /man/tapply_.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{tapply_} 3 | \alias{tapply_} 4 | \title{Faster tapply} 5 | \usage{ 6 | tapply_(X, INDEX, FUN = NULL, FUN.VALUE = NULL, ..., simplify = TRUE, 7 | USE.NAMES = TRUE, na.last = TRUE) 8 | } 9 | \arguments{ 10 | \item{X}{An atomic vector.} 11 | 12 | \item{INDEX}{A vector coercable to factor; must be one of 13 | the common atomic types: factor, integer, numeric, or 14 | character.} 15 | 16 | \item{FUN}{The function to be applied. See more details 17 | at \code{\link{lapply}}.} 18 | 19 | \item{FUN.VALUE}{Optional; if specified we try to 20 | leverage \code{vapply} for computation of results.} 21 | 22 | \item{...}{Optional arguments to pass to \code{FUN}.} 23 | 24 | \item{simplify}{boolean; if \code{TRUE}, we unlist the 25 | output and hence return a named vector of values.} 26 | 27 | \item{USE.NAMES}{boolean; if \code{TRUE} use \code{X} as 28 | \code{\link{names}} for the result unless it had names 29 | already. Sometimes, one can achieve substantial speedups 30 | by setting this to \code{FALSE}. This option is only used 31 | when \code{FUN.VALUE} is not \code{NULL}.} 32 | 33 | \item{na.last}{Boolean, if \code{TRUE} \code{NA} values 34 | are grouped at the end. Ie, we group on the \code{NA}s 35 | as well.} 36 | } 37 | \description{ 38 | This function acts as a faster version of \code{tapply} for the common case of 39 | splitting an atomic vector by another atomic vector, and then applying a 40 | function. 41 | } 42 | \examples{ 43 | x <- rnorm(100) 44 | gp <- sample( 1:10, 100, TRUE ) 45 | stopifnot( all( 46 | tapply(x, gp, mean) == tapply_(x, gp, mean) 47 | ) ) 48 | } 49 | 50 | -------------------------------------------------------------------------------- /inst/resources/highlight/styles/tomorrow-night-bright.css: -------------------------------------------------------------------------------- 1 | /* Tomorrow Night Bright Theme */ 2 | /* Original theme - https://github.com/chriskempson/tomorrow-theme */ 3 | /* http://jmblog.github.com/color-themes-for-google-code-highlightjs */ 4 | .tomorrow-comment, pre .comment, pre .title { 5 | color: #969896; 6 | } 7 | 8 | .tomorrow-red, pre .variable, pre .attribute, pre .tag, pre .regexp, pre .ruby .constant, pre .xml .tag .title, pre .xml .pi, pre .xml .doctype, pre .html .doctype, pre .css .id, pre .css .class, pre .css .pseudo { 9 | color: #d54e53; 10 | } 11 | 12 | .tomorrow-orange, pre .number, pre .preprocessor, pre .built_in, pre .literal, pre .params, pre .constant { 13 | color: #e78c45; 14 | } 15 | 16 | .tomorrow-yellow, pre .class, pre .ruby .class .title, pre .css .rules .attribute { 17 | color: #e7c547; 18 | } 19 | 20 | .tomorrow-green, pre .string, pre .value, pre .inheritance, pre .header, pre .ruby .symbol, pre .xml .cdata { 21 | color: #b9ca4a; 22 | } 23 | 24 | .tomorrow-aqua, pre .css .hexcolor { 25 | color: #70c0b1; 26 | } 27 | 28 | .tomorrow-blue, pre .function, pre .python .decorator, pre .python .title, pre .ruby .function .title, pre .ruby .title .keyword, pre .perl .sub, pre .javascript .title, pre .coffeescript .title { 29 | color: #7aa6da; 30 | } 31 | 32 | .tomorrow-purple, pre .keyword, pre .javascript .function { 33 | color: #c397d8; 34 | } 35 | 36 | pre code { 37 | display: block; 38 | background: black; 39 | color: #eaeaea; 40 | padding: 0.5em; 41 | } 42 | 43 | pre .coffeescript .javascript, 44 | pre .javascript .xml, 45 | pre .tex .formula, 46 | pre .xml .javascript, 47 | pre .xml .vbscript, 48 | pre .xml .css, 49 | pre .xml .cdata { 50 | opacity: 0.5; 51 | } 52 | -------------------------------------------------------------------------------- /man/awk.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{awk} 3 | \alias{awk} 4 | \title{A Simple Front-end to Awk} 5 | \usage{ 6 | awk(code, file, BEGIN = NULL, END = NULL, vars = NULL, fs = NULL, 7 | out = TRUE, verbose = FALSE) 8 | } 9 | \arguments{ 10 | \item{code}{The \code{awk} code you want to put in the 11 | main execution block.} 12 | 13 | \item{file}{The file we are running \code{awk} on.} 14 | 15 | \item{BEGIN}{A block of code to include as though it were 16 | within the \code{BEGIN} block.} 17 | 18 | \item{END}{A block of code to include as though it were 19 | within the \code{END} block.} 20 | 21 | \item{vars}{A named list, whereby variables are assigned 22 | so that \code{name=value}.} 23 | 24 | \item{fs}{The field separator (passed to \code{-F}).} 25 | 26 | \item{out}{The location to output the result of the 27 | computation. If this is \code{TRUE}, we intern the 28 | process and bring the results back into the \R session. 29 | Otherwise, it should be a string specifying the output 30 | path for a file.} 31 | 32 | \item{verbose}{Output the generated \code{awk} code?} 33 | } 34 | \description{ 35 | This function provides a simple front-end to \code{awk}. It assumes that 36 | you have \code{awk} available and in your \code{PATH}. 37 | } 38 | \examples{ 39 | \dontrun{ 40 | dat <- data.frame( 41 | x=1:10, 42 | y=letters[1:10], 43 | z=LETTERS[1:10] 44 | ) 45 | 46 | tempfile <- tempfile() 47 | 48 | write.table(dat, 49 | file=tempfile, 50 | row.names=FALSE, 51 | col.names=FALSE, 52 | quote=FALSE 53 | ) 54 | 55 | x <- awk("print $1", tempfile) 56 | ## note that it is read in as type 'character' 57 | print( cbind( x, dat$x ) ) 58 | } 59 | } 60 | 61 | -------------------------------------------------------------------------------- /inst/resources/highlight/styles/tomorrow-night-eighties.css: -------------------------------------------------------------------------------- 1 | /* Tomorrow Night Eighties Theme */ 2 | /* Original theme - https://github.com/chriskempson/tomorrow-theme */ 3 | /* http://jmblog.github.com/color-themes-for-google-code-highlightjs */ 4 | .tomorrow-comment, pre .comment, pre .title { 5 | color: #999999; 6 | } 7 | 8 | .tomorrow-red, pre .variable, pre .attribute, pre .tag, pre .regexp, pre .ruby .constant, pre .xml .tag .title, pre .xml .pi, pre .xml .doctype, pre .html .doctype, pre .css .id, pre .css .class, pre .css .pseudo { 9 | color: #f2777a; 10 | } 11 | 12 | .tomorrow-orange, pre .number, pre .preprocessor, pre .built_in, pre .literal, pre .params, pre .constant { 13 | color: #f99157; 14 | } 15 | 16 | .tomorrow-yellow, pre .class, pre .ruby .class .title, pre .css .rules .attribute { 17 | color: #ffcc66; 18 | } 19 | 20 | .tomorrow-green, pre .string, pre .value, pre .inheritance, pre .header, pre .ruby .symbol, pre .xml .cdata { 21 | color: #99cc99; 22 | } 23 | 24 | .tomorrow-aqua, pre .css .hexcolor { 25 | color: #66cccc; 26 | } 27 | 28 | .tomorrow-blue, pre .function, pre .python .decorator, pre .python .title, pre .ruby .function .title, pre .ruby .title .keyword, pre .perl .sub, pre .javascript .title, pre .coffeescript .title { 29 | color: #6699cc; 30 | } 31 | 32 | .tomorrow-purple, pre .keyword, pre .javascript .function { 33 | color: #cc99cc; 34 | } 35 | 36 | pre code { 37 | display: block; 38 | background: #2d2d2d; 39 | color: #cccccc; 40 | padding: 0.5em; 41 | } 42 | 43 | pre .coffeescript .javascript, 44 | pre .javascript .xml, 45 | pre .tex .formula, 46 | pre .xml .javascript, 47 | pre .xml .vbscript, 48 | pre .xml .css, 49 | pre .xml .cdata { 50 | opacity: 0.5; 51 | } 52 | -------------------------------------------------------------------------------- /man/kCoef.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{kCoef} 3 | \alias{kCoef} 4 | \title{Nicely Formatted Model Coefficient Output} 5 | \usage{ 6 | kCoef(fit, remove_underscore = TRUE, remove_dollar = TRUE, 7 | swap_periods = TRUE) 8 | } 9 | \arguments{ 10 | \item{fit}{the model fit we wish to generate coefficients 11 | from.} 12 | 13 | \item{remove_underscore}{remove underscores (and all 14 | elements after) in a variable?} 15 | 16 | \item{remove_dollar}{remove all elements before and 17 | including a $ in a variable name?} 18 | 19 | \item{swap_periods}{swap periods with spaces?} 20 | } 21 | \value{ 22 | a matrix of coefficients with nicely formatted names. 23 | } 24 | \description{ 25 | A customized coefficient function that assigns better row names to the 26 | coefficient matrix returned by \code{\link{coef}}() for a model fit. Also 27 | includes some arguments for parsing of variable names. 28 | } 29 | \details{ 30 | NOTE: 31 | 32 | Models with interaction effects are currently not handled. 33 | } 34 | \note{ 35 | The names given assume default contrasts in your model fit; ie, 36 | the default is \code{contr.treatment}, where each level of a factor is 37 | compared to a reference. 38 | } 39 | \examples{ 40 | ## How the remove_underscore and remove_dollar arguments act: 41 | ## An example: 42 | ## kDat$variable_other_stuff 43 | ## remove_underscore: +++++++++++++------------ 44 | ## remove_dollar: -----++++++++++++++++++++ 45 | 46 | x <- rnorm(100); y <- x * runif(100) 47 | z <- as.factor( rep( c("apple", "banana", "cherry", "date"), each=25 ) ) 48 | myFit <- lm( y ~ x + z ) 49 | 50 | ## compare the output of these two: which do you prefer? 51 | coef( summary( myFit ) ) 52 | kCoef( myFit ) 53 | } 54 | 55 | -------------------------------------------------------------------------------- /inst/resources/highlight/styles/tomorrow-night.css: -------------------------------------------------------------------------------- 1 | /* Tomorrow Night Theme */ 2 | /* http://jmblog.github.com/color-themes-for-google-code-highlightjs */ 3 | /* Original theme - https://github.com/chriskempson/tomorrow-theme */ 4 | /* http://jmblog.github.com/color-themes-for-google-code-highlightjs */ 5 | .tomorrow-comment, pre .comment, pre .title { 6 | color: #969896; 7 | } 8 | 9 | .tomorrow-red, pre .variable, pre .attribute, pre .tag, pre .regexp, pre .ruby .constant, pre .xml .tag .title, pre .xml .pi, pre .xml .doctype, pre .html .doctype, pre .css .id, pre .css .class, pre .css .pseudo { 10 | color: #cc6666; 11 | } 12 | 13 | .tomorrow-orange, pre .number, pre .preprocessor, pre .built_in, pre .literal, pre .params, pre .constant { 14 | color: #de935f; 15 | } 16 | 17 | .tomorrow-yellow, pre .class, pre .ruby .class .title, pre .css .rules .attribute { 18 | color: #f0c674; 19 | } 20 | 21 | .tomorrow-green, pre .string, pre .value, pre .inheritance, pre .header, pre .ruby .symbol, pre .xml .cdata { 22 | color: #b5bd68; 23 | } 24 | 25 | .tomorrow-aqua, pre .css .hexcolor { 26 | color: #8abeb7; 27 | } 28 | 29 | .tomorrow-blue, pre .function, pre .python .decorator, pre .python .title, pre .ruby .function .title, pre .ruby .title .keyword, pre .perl .sub, pre .javascript .title, pre .coffeescript .title { 30 | color: #81a2be; 31 | } 32 | 33 | .tomorrow-purple, pre .keyword, pre .javascript .function { 34 | color: #b294bb; 35 | } 36 | 37 | pre code { 38 | display: block; 39 | background: #1d1f21; 40 | color: #c5c8c6; 41 | padding: 0.5em; 42 | } 43 | 44 | pre .coffeescript .javascript, 45 | pre .javascript .xml, 46 | pre .tex .formula, 47 | pre .xml .javascript, 48 | pre .xml .vbscript, 49 | pre .xml .css, 50 | pre .xml .cdata { 51 | opacity: 0.5; 52 | } 53 | -------------------------------------------------------------------------------- /R/htmlTable.R: -------------------------------------------------------------------------------- 1 | ##' Generate an HTML Table 2 | ##' 3 | ##' This function is used to generate an HTML table; it wraps to 4 | ##' \code{knitr::kable} but gives some 'extras'; in particular, it allows 5 | ##' us to set the class, id, and other HTML attributes. 6 | ##' 7 | ##' @importFrom knitr kable 8 | ##' @param x A \code{data.frame} or \code{matrix}. 9 | ##' @param class The CSS class to give the table. By default, we use Twitter 10 | ##' bootstrap styling -- for this to take effect, your document must include 11 | ##' bootstrap CSS. 12 | ##' @param id The CSS id to give the table. 13 | ##' @param style Custom styling to apply to the table. 14 | ##' @param attr Other attributes we wish to apply to the table. 15 | ##' @param output Whether we should write the output to the console. We hijack 16 | ##' the \code{kable} argument. 17 | ##' @param ... Optional arguments passed to \code{\link{kable}}. 18 | ##' @export 19 | ##' @examples 20 | ##' df <- data.frame(`P Values`=runif(1000), Group=1:1000) 21 | ##' htmlTable( head(df[ order(df$P, decreasing=FALSE), ]) ) 22 | ##' ## wow! look at all that significance! ... 23 | htmlTable <- function(x, 24 | class="table table-condensed table-hover", 25 | id=NULL, 26 | style=NULL, 27 | attr=NULL, 28 | output=TRUE, 29 | ...) { 30 | tbl <- kable(x, format='html', output=FALSE, ...) 31 | tbl_tag <- paste0("" 37 | ) 38 | if (tbl_tag == "
") tbl_tag <- "
" ## pedantic 39 | tbl <- sub("
", tbl_tag, tbl, fixed=TRUE) 40 | if (output) { 41 | cat(tbl) 42 | } 43 | invisible(tbl) 44 | } 45 | -------------------------------------------------------------------------------- /inst/resources/highlight/styles/tomorrow-night-blue.css: -------------------------------------------------------------------------------- 1 | /* Tomorrow Night Blue Theme */ 2 | /* http://jmblog.github.com/color-themes-for-google-code-highlightjs */ 3 | /* Original theme - https://github.com/chriskempson/tomorrow-theme */ 4 | /* http://jmblog.github.com/color-themes-for-google-code-highlightjs */ 5 | .tomorrow-comment, pre .comment, pre .title { 6 | color: #7285b7; 7 | } 8 | 9 | .tomorrow-red, pre .variable, pre .attribute, pre .tag, pre .regexp, pre .ruby .constant, pre .xml .tag .title, pre .xml .pi, pre .xml .doctype, pre .html .doctype, pre .css .id, pre .css .class, pre .css .pseudo { 10 | color: #ff9da4; 11 | } 12 | 13 | .tomorrow-orange, pre .number, pre .preprocessor, pre .built_in, pre .literal, pre .params, pre .constant { 14 | color: #ffc58f; 15 | } 16 | 17 | .tomorrow-yellow, pre .class, pre .ruby .class .title, pre .css .rules .attribute { 18 | color: #ffeead; 19 | } 20 | 21 | .tomorrow-green, pre .string, pre .value, pre .inheritance, pre .header, pre .ruby .symbol, pre .xml .cdata { 22 | color: #d1f1a9; 23 | } 24 | 25 | .tomorrow-aqua, pre .css .hexcolor { 26 | color: #99ffff; 27 | } 28 | 29 | .tomorrow-blue, pre .function, pre .python .decorator, pre .python .title, pre .ruby .function .title, pre .ruby .title .keyword, pre .perl .sub, pre .javascript .title, pre .coffeescript .title { 30 | color: #bbdaff; 31 | } 32 | 33 | .tomorrow-purple, pre .keyword, pre .javascript .function { 34 | color: #ebbbff; 35 | } 36 | 37 | pre code { 38 | display: block; 39 | background: #002451; 40 | color: white; 41 | padding: 0.5em; 42 | } 43 | 44 | pre .coffeescript .javascript, 45 | pre .javascript .xml, 46 | pre .tex .formula, 47 | pre .xml .javascript, 48 | pre .xml .vbscript, 49 | pre .xml .css, 50 | pre .xml .cdata { 51 | opacity: 0.5; 52 | } 53 | -------------------------------------------------------------------------------- /man/melt_.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{melt_} 3 | \alias{melt_} 4 | \alias{melt_.data.frame} 5 | \alias{melt_.matrix} 6 | \title{Make a 'Wide' data set 'Long'} 7 | \usage{ 8 | melt_(data, ...) 9 | 10 | \method{melt_}{data.frame}(data, id.vars, measure.vars, 11 | variable.name = "variable", ..., value.name = "value") 12 | 13 | \method{melt_}{matrix}(data, ...) 14 | } 15 | \arguments{ 16 | \item{data}{The \code{data.frame} to melt.} 17 | 18 | \item{...}{Arguments passed to other methods.} 19 | 20 | \item{id.vars}{Vector of id variables. Can be integer 21 | (variable position) or string (variable name). If blank, 22 | we use all variables not in \code{measure.vars}.} 23 | 24 | \item{measure.vars}{Vector of measured variables. Can be 25 | integer (variable position) or string (variable name). If 26 | blank, we use all variables not in \code{id.vars}.} 27 | 28 | \item{variable.name}{Name of variable used to store 29 | measured variable names.} 30 | 31 | \item{value.name}{Name of variable used to store values.} 32 | } 33 | \description{ 34 | Inspired by \code{reshape2:::melt}, we melt \code{data.frame}s and 35 | \code{matrix}s. This function is built for speed. 36 | } 37 | \details{ 38 | If items to be stacked are not of the same internal type, they will be 39 | promoted in the order \code{logical} > \code{integer} > \code{numeric} > 40 | \code{character}. 41 | } 42 | \examples{ 43 | n <- 20 44 | tmp <- data.frame( stringsAsFactors=FALSE, 45 | x=sample(letters, n, TRUE), 46 | y=sample(LETTERS, n, TRUE), 47 | za=rnorm(n), 48 | zb=rnorm(n), 49 | zc=rnorm(n) 50 | ) 51 | 52 | stopifnot( 53 | identical( 54 | melt_(tmp, id.vars=c('x', 'y')), 55 | melt_(tmp, measure.vars=c('za', 'zb', 'zc')) 56 | ) 57 | ) 58 | } 59 | 60 | -------------------------------------------------------------------------------- /src/charlist_transpose_to_df.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | // [[register]] 7 | SEXP charlist_transpose_to_df( SEXP x, SEXP names ) { 8 | 9 | if( TYPEOF(x) != VECSXP ) { 10 | error("argument must be a list; type is '%s'", type2char( TYPEOF(x))); 11 | } 12 | 13 | int out_nRow = length(x); 14 | int out_nCol = length( VECTOR_ELT(x, 0) ); 15 | for (int i=0; i < out_nRow; ++i) { 16 | if (length( VECTOR_ELT(x, i)) != out_nCol) { 17 | error("each column of 'x' must be of equal length"); 18 | } 19 | } 20 | 21 | SEXP out = PROTECT( allocVector( VECSXP, out_nCol ) ); 22 | 23 | for( int j=0; j < out_nCol; ++j ) { 24 | SEXP tmp = PROTECT( allocVector( STRSXP, out_nRow ) ); 25 | for( int i=0; i < out_nRow; ++i ) { 26 | SET_STRING_ELT( tmp, i, STRING_ELT( VECTOR_ELT( x, i ), j ) ); 27 | } 28 | SET_VECTOR_ELT( out, j, tmp ); 29 | UNPROTECT(1); 30 | } 31 | 32 | SEXP row_names = PROTECT( allocVector( INTSXP, out_nRow ) ); 33 | int* row_names_ptr = INTEGER(row_names); 34 | for( int i=0; i < out_nRow; ++i ) { 35 | row_names_ptr[i] = i+1; 36 | } 37 | 38 | setAttrib(out, R_ClassSymbol, mkString("data.frame")); 39 | setAttrib(out, R_RowNamesSymbol, row_names); 40 | 41 | // make the names 42 | #define m out_nCol 43 | if (isNull(names)) { 44 | SEXP nm = PROTECT( allocVector(STRSXP, out_nCol) ); 45 | char str[ (int) log10(m) + 3]; 46 | for (int i = 0; i < m; ++i) { 47 | sprintf(str, "%s%i", "V", i + 1); 48 | SET_STRING_ELT(nm, i, mkChar(str)); 49 | } 50 | setAttrib(out, R_NamesSymbol, nm); 51 | UNPROTECT(1); 52 | } else { 53 | setAttrib(out, R_NamesSymbol, names); 54 | } 55 | #undef m 56 | 57 | 58 | UNPROTECT(2); 59 | return out; 60 | } 61 | 62 | #undef USE_RINTERNALS 63 | -------------------------------------------------------------------------------- /src/str_slice.c: -------------------------------------------------------------------------------- 1 | #define USE_RINTERNALS 2 | 3 | #include 4 | #include 5 | 6 | // [[register]] 7 | SEXP str_slice(SEXP x, SEXP n) { 8 | 9 | // Treat x as a vector of characters 10 | int x_len = length(x); 11 | int len_substr = INTEGER(n)[0]; 12 | 13 | // Allocate memory for a list 14 | SEXP out; 15 | PROTECT( out = allocVector(VECSXP, x_len) ); 16 | 17 | for( int k=0; k < x_len; ++k ) { 18 | 19 | // The string as a pointer to an array of characters 20 | const char* xx = CHAR(STRING_ELT( x, k ) ); 21 | 22 | // The length of the string supplied 23 | int len = length( STRING_ELT( x, k ) ); 24 | 25 | // The number of substrings 26 | int num_substr = len / len_substr; 27 | 28 | // Allocate memory for the vector of substrings 29 | SEXP substring; 30 | PROTECT( substring = allocVector(STRSXP, num_substr) ); 31 | 32 | int string_counter = 0; 33 | for( int i=0; i < num_substr; ++i ) { 34 | 35 | // allocate memory for a string 36 | char* elt = R_alloc( len_substr+1, sizeof(char) ); 37 | 38 | // Push items onto the element 39 | for( int j=0; j < len_substr; ++j ) { 40 | elt[j] = xx[string_counter]; 41 | string_counter++; 42 | } 43 | 44 | // Set the terminator 45 | elt[len_substr] = '\0'; 46 | 47 | SET_STRING_ELT( substring, i, mkChar(elt) ); 48 | } 49 | 50 | // Set the list element to the substring 51 | SET_VECTOR_ELT(out, k, substring); 52 | UNPROTECT(1); 53 | 54 | } 55 | 56 | UNPROTECT(1); 57 | return( out ); 58 | 59 | } 60 | 61 | #undef USE_RINTERNALS 62 | -------------------------------------------------------------------------------- /R/ChangeLog.R: -------------------------------------------------------------------------------- 1 | ChangeLog <- function(msg="") { 2 | 3 | if (!exists(".Start.time")) { 4 | stop("No variable '.Start.time' available; unable to infer what ", 5 | "files have been modified in the current session!\n", 6 | "Try adding `.Start.time <- as.numeric( Sys.time() )` to your .Rprofile.") 7 | } 8 | 9 | if (!file.exists("ChangeLog")) { 10 | message("Creating a new ChangeLog file...") 11 | file.create("ChangeLog") 12 | } 13 | 14 | ## Find out what files have been modified in the current session 15 | files <- list.files(full.names=TRUE, include.dirs=FALSE, recursive=TRUE) 16 | 17 | times <- unlist( lapply(files, function(x) { 18 | as.numeric(system(paste("stat -f%c", x), intern=TRUE)) 19 | })) 20 | 21 | modified <- files[ times > .Start.time ] 22 | 23 | ## The ChangeLog is not a candidate for listing in modifies 24 | modified <- modified[ modified != "./ChangeLog" ] 25 | 26 | ## Strip off the initial './' 27 | modified <- substring(modified, 3, nchar(modified)) 28 | 29 | if (length(modified)) { 30 | 31 | ## Generate the header 32 | header <- paste0( Sys.Date(), " ", Sys.getenv("USERNAME"), " <", Sys.getenv("EMAIL"), ">" ) 33 | 34 | ## Stubs for each modified file 35 | body <- paste0(" * ", modified, ": ", msg) 36 | 37 | changes <- c(header, "", body) 38 | 39 | ## Read in the ChangeLog, put the new changes on top, and write it back out 40 | ChangeLog <- readLines("ChangeLog") 41 | New <- c(changes, ChangeLog) 42 | 43 | ## Write out the new ChangeLog, and open it in an editor 44 | cat(New, file="ChangeLog", sep="\n") 45 | return( file.edit("ChangeLog") ) 46 | } else { 47 | message("No files have been modified in the current session.") 48 | return (invisible(NULL)) 49 | } 50 | 51 | } 52 | -------------------------------------------------------------------------------- /man/kMerge.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2 (4.0.0): do not edit by hand 2 | \name{kMerge} 3 | \alias{kMerge} 4 | \title{Merge (Left Join) with Order Retainment} 5 | \usage{ 6 | kMerge(x, y, by = intersect(names(x), names(y)), by.x = by, by.y = by, 7 | ...) 8 | } 9 | \arguments{ 10 | \item{x}{the \code{data.frame} you wish to merge \code{y} 11 | into.} 12 | 13 | \item{y}{the \code{data.frame} to be merged.} 14 | 15 | \item{by}{specifications of the columns used for merging. 16 | See 'Details' of \code{\link{merge}}.} 17 | 18 | \item{by.x}{specifications of the columns used for 19 | merging. See 'Details' of \code{\link{merge}}.} 20 | 21 | \item{by.y}{specifications of the columns used for 22 | merging. See 'Details' of \code{\link{merge}}.} 23 | 24 | \item{...}{optional arguments passed to \code{merge}.} 25 | } 26 | \value{ 27 | \code{data.frame} 28 | } 29 | \description{ 30 | \code{merge} will mangle the order of the data frames it is merging. This is 31 | a simple modification to ensure that the order in data frame \code{x} is preserved 32 | when doing a 'left join'; ie, \code{merge( x, y, all.x=TRUE, ... )}. 33 | That is, if we want to merge a data frame \code{x} with another 34 | data frame \code{y}, we can merge in the parts of \code{y} whose index matches 35 | with that of \code{x}, while preserving the ordering of \code{x}. 36 | } 37 | \examples{ 38 | x <- data.frame( id=5:1, nums=rnorm(5) ) 39 | y <- data.frame( id=1:3, labels=c(1, 2, 2) ) 40 | merge(x, y, all.x=TRUE) ## re-ordered the data.frame 41 | merge(x, y, all.x=TRUE, sort=FALSE) ## nope - NAs cause problems 42 | kMerge(x, y, by="id") ## preserves ordering of x, even with NAs 43 | 44 | ## an id entry appears more than once in y 45 | y <- data.frame( id=c(1, 1, 2), labels=c(1, 2, 3) ) 46 | kMerge(x, y, by="id") 47 | } 48 | \seealso{ 49 | \code{\link{merge}} 50 | } 51 | 52 | --------------------------------------------------------------------------------