├── .github └── FUNDING.yml ├── R ├── stackoverflow.R ├── is.knitr.in.progress.R ├── Mode.R ├── strReverse.R ├── chunk2.R ├── duplicated2.R ├── readkey.R ├── unique_columns.R ├── copyEnv.R ├── replace_null_recursively.R ├── calcBMI.R ├── Comment.R ├── rstudio.R ├── split_path.R ├── resave.R ├── clamp.R ├── is_inst.R ├── tlist.R ├── substituteExpr.R ├── approxpDirichlet.R ├── logLik_kmeans.R ├── zip.R ├── flatten2.R ├── permutations.R ├── approxAUC.R ├── triangle.R ├── trim_trailing.R ├── randomRows.R ├── cor2cov.R ├── rcweibull.R ├── bsearch7.R ├── coalesce.R ├── bat_passes.R ├── frontier.R ├── horner.R ├── rsplit.R ├── partial.R ├── sprintf_named.R ├── parseldap.R ├── sincos.R ├── read.directory.R ├── invinteraction.R ├── invwhich.R ├── classMethods.R ├── lsos.R ├── unscale.R ├── match.call.default.R ├── rdensity.R ├── bag.R ├── na_dummy.R └── Tarone.R ├── stackoverflow.Rproj ├── man ├── stackoverflow.Rd ├── lsos.Rd ├── is.knitr.in.progress.Rd ├── strReverse.Rd ├── split_path.Rd ├── permutations.Rd ├── replace_null_recursively.Rd ├── chunk2.Rd ├── parseLDAP.Rd ├── duplicated2.Rd ├── resave.Rd ├── copyEnv.Rd ├── Mode.Rd ├── unique_columns.Rd ├── is.rstudio.Rd ├── calcBMI.Rd ├── readkey.Rd ├── approxpDirichlet.Rd ├── sincos.Rd ├── clamp.Rd ├── t.list.Rd ├── Comment.Rd ├── bsearch7.Rd ├── is_inst.Rd ├── zip2.Rd ├── trim_trailing.Rd ├── approxAUC.Rd ├── classMethods.Rd ├── reflect_triangle.Rd ├── flatten2.Rd ├── rsplit.Rd ├── substituteExpr.Rd ├── logLik.kmeans.Rd ├── frontier.Rd ├── sprintf_named.Rd ├── Tarone.test.Rd ├── rcweibull.Rd ├── cor2cov.Rd ├── coalesce.Rd ├── randomRows.Rd ├── horner.poly.Rd ├── bat_passes.Rd ├── partial.Rd ├── invinteraction.Rd ├── na.dummy.Rd ├── read.directory.Rd ├── unscale.Rd ├── invwhich.Rd ├── rdensity.Rd ├── match.call.defaults.Rd └── bag.Rd ├── DESCRIPTION ├── README.md ├── NEWS ├── NAMESPACE └── data └── bat_passes.R /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: nfultz 2 | custom: https://paypal.me/NealFultz 3 | -------------------------------------------------------------------------------- /R/stackoverflow.R: -------------------------------------------------------------------------------- 1 | #' Stack Overflow's Greatest Hits 2 | #' 3 | #' The stackoverflow package consists of helper functions 4 | #' collected from StackOverflow.com, a question and answer site for professional 5 | #' and enthusiast programmers. 6 | #' 7 | #' @name stackoverflow 8 | #' @docType package 9 | #' 10 | #' @references \url{http://stackoverflow.com}, 11 | #' \url{https://github.com/nfultz/stackoverflow} 12 | NULL -------------------------------------------------------------------------------- /R/is.knitr.in.progress.R: -------------------------------------------------------------------------------- 1 | #' Is knitr in progress? 2 | #' 3 | #' @return TRUE if knitr is executing 4 | #' 5 | #' @author Yihui Xie and 6 | #' \href{https://stackoverflow.com/users/2706569/cl}{CL}, 7 | #' @references \url{https://stackoverflow.com/questions/33107908/how-to-tell-if-code-is-executed-within-a-knitr-rmarkdown-context} 8 | #' @export 9 | 10 | is.knitr.in.progress <- function() { 11 | isTRUE(getOption('knitr.in.progress')) 12 | } 13 | 14 | -------------------------------------------------------------------------------- /stackoverflow.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | BuildType: Package 16 | PackageUseDevtools: Yes 17 | PackageInstallArgs: --no-multiarch --with-keep.source 18 | PackageCheckArgs: --as-cran 19 | PackageRoxygenize: rd,namespace 20 | -------------------------------------------------------------------------------- /R/Mode.R: -------------------------------------------------------------------------------- 1 | #' Calculate mode (most common element) of a vector 2 | #' 3 | #' @param x a vector 4 | #' @param ux vector of values x may take 5 | #' 6 | #' @section Changes: 7 | #' Factored \code{ux} into argument -- njf, May 18, 2015 8 | #' 9 | #' @export 10 | #' @author \href{http://stackoverflow.com/users/169947/ken-williams}{Ken Williams} 11 | #' @references \url{http://stackoverflow.com/questions/2547402/standard-library-function-in-r-for-finding-the-mode} 12 | 13 | Mode <- function(x, ux=unique(x)) ux[which.max(tabulate(match(x, ux)))] -------------------------------------------------------------------------------- /R/strReverse.R: -------------------------------------------------------------------------------- 1 | #' Reverse each string of a vector 2 | #' 3 | #' A function which will reverse every string in a vector of strings. 4 | #' 5 | #' @param x a character vector 6 | #' 7 | #' @export 8 | #' @author \href{http://stackoverflow.com/users/980833/josh-obrien}{Josh O'Brien} 9 | #' @references \url{https://stackoverflow.com/questions/13612967/how-to-reverse-a-string-in-r} 10 | #' 11 | #' @examples 12 | #' strReverse(c("abc", "Statistics")) 13 | 14 | strReverse <- function(x) { 15 | sapply(lapply(strsplit(x, NULL), rev), paste0) 16 | } 17 | -------------------------------------------------------------------------------- /man/stackoverflow.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/stackoverflow.R 3 | \docType{package} 4 | \name{stackoverflow} 5 | \alias{stackoverflow} 6 | \title{Stack Overflow's Greatest Hits} 7 | \description{ 8 | The stackoverflow package consists of helper functions 9 | collected from StackOverflow.com, a question and answer site for professional 10 | and enthusiast programmers. 11 | } 12 | \references{ 13 | \url{http://stackoverflow.com}, 14 | \url{https://github.com/nfultz/stackoverflow} 15 | } 16 | -------------------------------------------------------------------------------- /R/chunk2.R: -------------------------------------------------------------------------------- 1 | #' Split a vector into n chunks 2 | #' 3 | #' @param x a vector 4 | #' @param n number of chunks 5 | #' 6 | #' @author 7 | #' \href{http://stackoverflow.com/users/1563634/mathheadinclouds}{mathheadinclouds}, 8 | #' \href{http://stackoverflow.com/users/1737569/dis-shishkov}{Dis Shishkov} 9 | #' @references \url{http://stackoverflow.com/questions/3318333/split-a-vector-into-chunks-in-r} 10 | #' @export 11 | #' @examples 12 | #' chunk2(1:30, 6) 13 | 14 | chunk2 <- function(x,n) split(x, cut(seq_along(x), n, labels = FALSE)) 15 | 16 | -------------------------------------------------------------------------------- /R/duplicated2.R: -------------------------------------------------------------------------------- 1 | #' Find duplicates in a vector 2 | #' 3 | #' This will find all duplicates in a run, unlike \code{\link{duplicated}} which 4 | #' finds duplicates globally. 5 | #' 6 | #' @param x a vector 7 | #' 8 | #' @export 9 | #' @author \href{http://stackoverflow.com/users/980833/josh-obrien}{Josh O'Brien}, Neal Fultz 10 | #' @references \url{http://stackoverflow.com/questions/30260507/exclude-subsequent-duplicated-rows-in-r} 11 | #' 12 | #' @examples 13 | #' duplicated2(c(2,3,3,2,2,3,3,3,3,2,2)) 14 | 15 | duplicated2 <- function(x) { 16 | sequence(rle(x)$lengths) > 1 17 | } -------------------------------------------------------------------------------- /R/readkey.R: -------------------------------------------------------------------------------- 1 | #' Wait for a keypress 2 | #' 3 | #' @section Changed Feb 23, 2015 by njf: 4 | #' \code{prompt} may be set by a parameter rather than hard coding it. 5 | #' 6 | #' 7 | #' @param prompt the text to display 8 | #' 9 | #' @author \href{http://stackoverflow.com/users/2427707/nnn}{nnn}, 10 | #' \href{http://stackoverflow.com/users/1095090/arulmr}{arulmr}, 11 | #' Neal Fultz 12 | #' @references \url{http://stackoverflow.com/questions/15272916/how-to-wait-for-a-keypress-in-r} 13 | #' @export 14 | readkey <- function(prompt="Press [enter] to continue") invisible(readline(prompt)) -------------------------------------------------------------------------------- /R/unique_columns.R: -------------------------------------------------------------------------------- 1 | #' Remove duplicated columns 2 | #' 3 | #' Drops duplicated columns from a data.frame (or other list-like object). 4 | #' 5 | #' @param df a data.frame 6 | #' @return data.frame without duplicated columns 7 | #' 8 | #' @references \url{https://stackoverflow.com/a/58475153/986793} 9 | #' @author \href{https://stackoverflow.com/users/3732271/akrun}{akrun} 10 | #' 11 | #' @examples 12 | #' 13 | #' df <- data.frame(a=1:10, b=1:10, c=2:11) 14 | #' 15 | #' unique_columns(df) 16 | #' 17 | #' @export 18 | 19 | 20 | unique_columns <- function(df) df[!duplicated(as.list(df))] 21 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: stackoverflow 2 | Type: Package 3 | Title: Stack Overflow's Greatest Hits 4 | Version: 0.7.0 5 | Date: 2020-01-03 6 | Author: Neal Fultz and the StackOverflow.com community 7 | Maintainer: Neal Fultz 8 | Description: Helper functions collected from StackOverflow.com, a 9 | question and answer site for professional and enthusiast programmers. 10 | License: CC BY-SA 4.0 11 | URL: https://github.com/nfultz/stackoverflow 12 | http://stackoverflow.com 13 | http://stats.stackexchange.com/ 14 | RoxygenNote: 7.1.0 15 | Encoding: UTF-8 16 | -------------------------------------------------------------------------------- /man/lsos.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lsos.R 3 | \name{lsos} 4 | \alias{lsos} 5 | \title{Improved list of objects} 6 | \usage{ 7 | lsos(..., n = 10) 8 | } 9 | \arguments{ 10 | \item{...}{to be passed along to internal} 11 | 12 | \item{n}{to be given to head} 13 | } 14 | \description{ 15 | Improved list of objects 16 | } 17 | \references{ 18 | \url{http://stackoverflow.com/questions/1358003/tricks-to-manage-the-available-memory-in-an-r-session} 19 | } 20 | \author{ 21 | \href{http://stackoverflow.com/users/143305/dirk-eddelbuettel}{Dirk Eddelbuettel} 22 | } 23 | -------------------------------------------------------------------------------- /man/is.knitr.in.progress.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is.knitr.in.progress.R 3 | \name{is.knitr.in.progress} 4 | \alias{is.knitr.in.progress} 5 | \title{Is knitr in progress?} 6 | \usage{ 7 | is.knitr.in.progress() 8 | } 9 | \value{ 10 | TRUE if knitr is executing 11 | } 12 | \description{ 13 | Is knitr in progress? 14 | } 15 | \references{ 16 | \url{https://stackoverflow.com/questions/33107908/how-to-tell-if-code-is-executed-within-a-knitr-rmarkdown-context} 17 | } 18 | \author{ 19 | Yihui Xie and 20 | \href{https://stackoverflow.com/users/2706569/cl}{CL}, 21 | } 22 | -------------------------------------------------------------------------------- /R/copyEnv.R: -------------------------------------------------------------------------------- 1 | #' Copy objects from one environment to another 2 | #' 3 | #' @param from source environment 4 | #' @param to target environment 5 | #' @param names names of objects to copy 6 | #' 7 | #' @author Neal Fultz 8 | #' @references \url{http://stackoverflow.com/a/33465113/986793} 9 | #' @export 10 | #' @examples 11 | #' 12 | #' e1 <- list2env(list(a=1, b=2)) 13 | #' e2 <- new.env() 14 | #' copyEnv(e1,e2) 15 | #' ls(e2) 16 | 17 | copyEnv <- function(from, to, names=ls(from, all.names=TRUE)) { 18 | mapply(assign, names, mget(names, from), list(to), 19 | SIMPLIFY = FALSE, USE.NAMES = FALSE) 20 | invisible(NULL) 21 | } 22 | -------------------------------------------------------------------------------- /R/replace_null_recursively.R: -------------------------------------------------------------------------------- 1 | #' Replace NULLs in nested lists 2 | #' 3 | #' 4 | #' @param x a nested list 5 | #' @param what a value 6 | #' @return x with NULLs replaced with what 7 | #' 8 | #' @author \href{https://stackoverflow.com/users/6621998/shayaa}{shayaa}, 9 | #' @references \url{https://stackoverflow.com/a/38950427/986793} 10 | #' 11 | #' @export 12 | replace_null_recursively <- function(x, what=NA_character_) { 13 | lapply(x, function(x) { 14 | if (is.list(x)) { 15 | replace_null_recursively(x) 16 | } else if (is.null(x)) { 17 | what 18 | } 19 | else { 20 | x 21 | } 22 | }) 23 | } 24 | 25 | -------------------------------------------------------------------------------- /man/strReverse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/strReverse.R 3 | \name{strReverse} 4 | \alias{strReverse} 5 | \title{Reverse each string of a vector} 6 | \usage{ 7 | strReverse(x) 8 | } 9 | \arguments{ 10 | \item{x}{a character vector} 11 | } 12 | \description{ 13 | A function which will reverse every string in a vector of strings. 14 | } 15 | \examples{ 16 | strReverse(c("abc", "Statistics")) 17 | } 18 | \references{ 19 | \url{https://stackoverflow.com/questions/13612967/how-to-reverse-a-string-in-r} 20 | } 21 | \author{ 22 | \href{http://stackoverflow.com/users/980833/josh-obrien}{Josh O'Brien} 23 | } 24 | -------------------------------------------------------------------------------- /man/split_path.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/split_path.R 3 | \name{split_path} 4 | \alias{split_path} 5 | \title{Split paths into folders} 6 | \usage{ 7 | split_path(x) 8 | } 9 | \arguments{ 10 | \item{x}{character vector of file paths} 11 | } 12 | \description{ 13 | Splits paths into folders. 14 | } 15 | \examples{ 16 | 17 | split_path("~") 18 | 19 | } 20 | \references{ 21 | \url{https://stackoverflow.com/questions/29214932/split-a-file-path-into-folder-names-vector/29232017#29232017} 22 | } 23 | \author{ 24 | \href{https://stackoverflow.com/users/269476/james}{James}, Neal Fultz for vectorized version 25 | } 26 | -------------------------------------------------------------------------------- /R/calcBMI.R: -------------------------------------------------------------------------------- 1 | #' Calculate Body Mass Index 2 | #' 3 | #' This calculates Body Mass Index 4 | #' 5 | #' @param w Weight (in pounds) 6 | #' @param f Height (feet) 7 | #' @param i Height (inches) 8 | #' 9 | #' @return BMI 10 | #' 11 | #' 12 | #' @references \url{https://stackoverflow.com/questions/16782598/declaring-dynamic-variable-in-r/16782661#16782661} 13 | #' @author \href{https://stackoverflow.com/users/190277/ben-bolker}{Ben Bolker} 14 | #' 15 | #' @examples 16 | #' calcBMI(199, 5, 9) 17 | #' @importFrom stats setNames 18 | #' @seealso \code{\link{sprintf}} 19 | #' @export 20 | calcBMI <- function (w=204, f=6, i=1) { 21 | i <- f * 12 + i 22 | 703.06958 * w / i / i 23 | } 24 | -------------------------------------------------------------------------------- /man/permutations.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/permutations.R 3 | \name{permutations} 4 | \alias{permutations} 5 | \title{Generate all distinct permutations of a vector} 6 | \usage{ 7 | permutations(x) 8 | } 9 | \arguments{ 10 | \item{x}{vector to permute} 11 | } 12 | \value{ 13 | A matrix of all distinct permutations (by row) 14 | } 15 | \description{ 16 | Generate all distinct permutations of a vector 17 | } 18 | \examples{ 19 | permutations(LETTERS[1:4]) 20 | } 21 | \references{ 22 | \url{https://stackoverflow.com/a/20199902/986793} 23 | } 24 | \author{ 25 | \href{https://stackoverflow.com/users/827280/museful}{Museful} 26 | } 27 | -------------------------------------------------------------------------------- /man/replace_null_recursively.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/replace_null_recursively.R 3 | \name{replace_null_recursively} 4 | \alias{replace_null_recursively} 5 | \title{Replace NULLs in nested lists} 6 | \usage{ 7 | replace_null_recursively(x, what = NA_character_) 8 | } 9 | \arguments{ 10 | \item{x}{a nested list} 11 | 12 | \item{what}{a value} 13 | } 14 | \value{ 15 | x with NULLs replaced with what 16 | } 17 | \description{ 18 | Replace NULLs in nested lists 19 | } 20 | \references{ 21 | \url{https://stackoverflow.com/a/38950427/986793} 22 | } 23 | \author{ 24 | \href{https://stackoverflow.com/users/6621998/shayaa}{shayaa}, 25 | } 26 | -------------------------------------------------------------------------------- /R/Comment.R: -------------------------------------------------------------------------------- 1 | #' Multi-line Comments 2 | #' 3 | #' @param ... comment, not evaluated. 4 | #' 5 | #' @examples 6 | #' Comment( ` 7 | #' 8 | #' # Put anything in here except back-ticks. 9 | #' 10 | #' api_idea <- function() { 11 | #' return TRUE 12 | #' } 13 | #' 14 | #' # Just to show api_idea isn't really there... 15 | #' print( api_idea ) 16 | #' 17 | #' `) 18 | #### 19 | #' 20 | #' @export 21 | #' @author \href{http://stackoverflow.com/users/173985/thell}{Thell}, 22 | #' \href{http://stackoverflow.com/users/211116/spacedman}{Spacedman} 23 | #' Neal Fultz 24 | #' @references \url{http://stackoverflow.com/questions/1231195/multiline-comment-workarounds} 25 | Comment <- function(...) {invisible()} -------------------------------------------------------------------------------- /R/rstudio.R: -------------------------------------------------------------------------------- 1 | #' Is this in Rstudio? 2 | #' 3 | #' Tests if inside RStudio. 4 | #' 5 | #' @return TRUE if running in RStudio child process, or Rstudio console specifically. 6 | #' 7 | #' @references \url{https://stackoverflow.com/a/17804414/986793} 8 | #' @author \href{https://stackoverflow.com/users/1345455/coatless}{coatless}, \href{https://stackoverflow.com/users/946850/krlmlr}{krlmr} 9 | #' 10 | #' @examples 11 | #' 12 | #' is.rstudio() && is.rstudio.console() 13 | #' 14 | #' @export 15 | 16 | is.rstudio = function() { 17 | Sys.getenv("RSTUDIO") == 1 18 | } 19 | 20 | #' @export 21 | #' @rdname is.rstudio 22 | is.rstudio.console = function(){ 23 | .Platform$GUI == "RStudio" 24 | } 25 | 26 | 27 | -------------------------------------------------------------------------------- /man/chunk2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/chunk2.R 3 | \name{chunk2} 4 | \alias{chunk2} 5 | \title{Split a vector into n chunks} 6 | \usage{ 7 | chunk2(x, n) 8 | } 9 | \arguments{ 10 | \item{x}{a vector} 11 | 12 | \item{n}{number of chunks} 13 | } 14 | \description{ 15 | Split a vector into n chunks 16 | } 17 | \examples{ 18 | chunk2(1:30, 6) 19 | } 20 | \references{ 21 | \url{http://stackoverflow.com/questions/3318333/split-a-vector-into-chunks-in-r} 22 | } 23 | \author{ 24 | \href{http://stackoverflow.com/users/1563634/mathheadinclouds}{mathheadinclouds}, 25 | \href{http://stackoverflow.com/users/1737569/dis-shishkov}{Dis Shishkov} 26 | } 27 | -------------------------------------------------------------------------------- /man/parseLDAP.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/parseldap.R 3 | \name{parseLDAP} 4 | \alias{parseLDAP} 5 | \title{Parse LDAP output into dataframe} 6 | \usage{ 7 | parseLDAP(ldapraw) 8 | } 9 | \arguments{ 10 | \item{ldapraw}{A length-one character vector containing the raw LDAP output} 11 | } 12 | \value{ 13 | a data.frame with one row per person 14 | } 15 | \description{ 16 | Parse LDAP output into dataframe 17 | } 18 | \references{ 19 | \url{https://stackoverflow.com/questions/22793855/how-do-i-run-a-ldap-query-using-r} 20 | } 21 | \author{ 22 | \href{https://stackoverflow.com/users/3792484/user3792484}{user3792484}, 23 | rewrite by Neal Fultz 24 | } 25 | -------------------------------------------------------------------------------- /man/duplicated2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/duplicated2.R 3 | \name{duplicated2} 4 | \alias{duplicated2} 5 | \title{Find duplicates in a vector} 6 | \usage{ 7 | duplicated2(x) 8 | } 9 | \arguments{ 10 | \item{x}{a vector} 11 | } 12 | \description{ 13 | This will find all duplicates in a run, unlike \code{\link{duplicated}} which 14 | finds duplicates globally. 15 | } 16 | \examples{ 17 | duplicated2(c(2,3,3,2,2,3,3,3,3,2,2)) 18 | } 19 | \references{ 20 | \url{http://stackoverflow.com/questions/30260507/exclude-subsequent-duplicated-rows-in-r} 21 | } 22 | \author{ 23 | \href{http://stackoverflow.com/users/980833/josh-obrien}{Josh O'Brien}, Neal Fultz 24 | } 25 | -------------------------------------------------------------------------------- /man/resave.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/resave.R 3 | \name{resave} 4 | \alias{resave} 5 | \title{Resave a session} 6 | \usage{ 7 | resave(..., list = character(), file) 8 | } 9 | \arguments{ 10 | \item{...}{symbols of objects} 11 | 12 | \item{list}{a character vector of object names; unfortunately named} 13 | 14 | \item{file}{the file to update} 15 | } 16 | \description{ 17 | Resave a session 18 | } 19 | \references{ 20 | \url{http://stackoverflow.com/a/11813377/986793} 21 | } 22 | \seealso{ 23 | \code{\link[base]{load}}, \code{\link[base]{save}} 24 | } 25 | \author{ 26 | Neal Fultz and 27 | \href{http://stackoverflow.com/users/1201032/flodel}{flodel}, 28 | } 29 | -------------------------------------------------------------------------------- /R/split_path.R: -------------------------------------------------------------------------------- 1 | #' Split paths into folders 2 | #' 3 | #' Splits paths into folders. 4 | #' 5 | #' @param x character vector of file paths 6 | #' 7 | #' @references \url{https://stackoverflow.com/questions/29214932/split-a-file-path-into-folder-names-vector/29232017#29232017} 8 | #' @author \href{https://stackoverflow.com/users/269476/james}{James}, Neal Fultz for vectorized version 9 | #' 10 | #' @examples 11 | #' 12 | #' split_path("~") 13 | #' 14 | #' @export 15 | split_path <- function(x) { 16 | dname <- dirname(x) 17 | bname <- basename(x) 18 | i <- !is.na(x) & (x == dname) 19 | bname[i] <- x[i] 20 | dname[i] <- NA 21 | if(all(is.na(bname))) NULL else cbind(bname, split_path(dname), deparse.level=0) 22 | } 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # stackoverflow 2 | 3 | [![status](https://tinyverse.netlify.com/badge/stackoverflow)](https://CRAN.R-project.org/package=stackoverflow) 4 | 5 | An R package for snippets from stackoverflow 6 | 7 | When we want to use a function from stack overflow, add it here. It's cleaner, 8 | gives credit where credit is due, and is better for lawyers if it's seperate. 9 | 10 | ## Installation 11 | 12 | Using R 3.3.1 or greater: 13 | 14 | install.packages("https://github.com/nfultz/stackoverflow/releases/download/v0.1.2/stackoverflow_0.1.2.tar.gz") 15 | 16 | 17 | ## Contributing 18 | 19 | If you see something great on SO, please email me with a link at nfultz@gmail.com ; 20 | alternatively, PRs are always welcome as well :) -------------------------------------------------------------------------------- /man/copyEnv.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/copyEnv.R 3 | \name{copyEnv} 4 | \alias{copyEnv} 5 | \title{Copy objects from one environment to another} 6 | \usage{ 7 | copyEnv(from, to, names = ls(from, all.names = TRUE)) 8 | } 9 | \arguments{ 10 | \item{from}{source environment} 11 | 12 | \item{to}{target environment} 13 | 14 | \item{names}{names of objects to copy} 15 | } 16 | \description{ 17 | Copy objects from one environment to another 18 | } 19 | \examples{ 20 | 21 | e1 <- list2env(list(a=1, b=2)) 22 | e2 <- new.env() 23 | copyEnv(e1,e2) 24 | ls(e2) 25 | } 26 | \references{ 27 | \url{http://stackoverflow.com/a/33465113/986793} 28 | } 29 | \author{ 30 | Neal Fultz 31 | } 32 | -------------------------------------------------------------------------------- /R/resave.R: -------------------------------------------------------------------------------- 1 | #' Resave a session 2 | #' 3 | #' @param ... symbols of objects 4 | #' @param list a character vector of object names; unfortunately named 5 | #' @param file the file to update 6 | #' 7 | #' @author Neal Fultz and 8 | #' \href{http://stackoverflow.com/users/1201032/flodel}{flodel}, 9 | #' @references \url{http://stackoverflow.com/a/11813377/986793} 10 | #' @export 11 | #' @seealso \code{\link[base]{load}}, \code{\link[base]{save}} 12 | 13 | resave <- function(..., list = character(), file) { 14 | e <- new.env() 15 | load(file, e) 16 | list <- union(list, as.character(substitute((...)))[-1L]) 17 | copyEnv(parent.frame(), e, list) 18 | save(list = ls(e, all.names=TRUE), envir = e, file = file) 19 | } 20 | 21 | -------------------------------------------------------------------------------- /R/clamp.R: -------------------------------------------------------------------------------- 1 | #' Clamp a value into a range 2 | #' 3 | #' Splits paths into folders. 4 | #' 5 | #' @param x vector 6 | #' @param e1 the first edge 7 | #' @param e2 the other edge, defaults to the negation of e1. 8 | #' 9 | #' @return x, with values outside the boundaries replaced with the boundary points. 10 | #' 11 | #' @references \url{https://stackoverflow.com/questions/32599695/clamp-variable-within-range} 12 | #' @author \href{https://stackoverflow.com/users/3093387/josliber}{josliber}, 13 | #' 14 | #' @examples 15 | #' 16 | #' clamp(-10:10, 2, -2) 17 | #' clamp(-10:10, -2) 18 | #' clamp(-10:10, 2) 19 | #' 20 | #' @export 21 | clamp <- function(x, e1, e2=-e1){ 22 | e1 <- sort(c(e1,e2)) 23 | pmin(pmax(x, e1[1]), e1[2]) 24 | } 25 | -------------------------------------------------------------------------------- /man/Mode.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Mode.R 3 | \name{Mode} 4 | \alias{Mode} 5 | \title{Calculate mode (most common element) of a vector} 6 | \usage{ 7 | Mode(x, ux = unique(x)) 8 | } 9 | \arguments{ 10 | \item{x}{a vector} 11 | 12 | \item{ux}{vector of values x may take} 13 | } 14 | \description{ 15 | Calculate mode (most common element) of a vector 16 | } 17 | \section{Changes}{ 18 | 19 | Factored \code{ux} into argument -- njf, May 18, 2015 20 | } 21 | 22 | \references{ 23 | \url{http://stackoverflow.com/questions/2547402/standard-library-function-in-r-for-finding-the-mode} 24 | } 25 | \author{ 26 | \href{http://stackoverflow.com/users/169947/ken-williams}{Ken Williams} 27 | } 28 | -------------------------------------------------------------------------------- /man/unique_columns.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/unique_columns.R 3 | \name{unique_columns} 4 | \alias{unique_columns} 5 | \title{Remove duplicated columns} 6 | \usage{ 7 | unique_columns(df) 8 | } 9 | \arguments{ 10 | \item{df}{a data.frame} 11 | } 12 | \value{ 13 | data.frame without duplicated columns 14 | } 15 | \description{ 16 | Drops duplicated columns from a data.frame (or other list-like object). 17 | } 18 | \examples{ 19 | 20 | df <- data.frame(a=1:10, b=1:10, c=2:11) 21 | 22 | unique_columns(df) 23 | 24 | } 25 | \references{ 26 | \url{https://stackoverflow.com/a/58475153/986793} 27 | } 28 | \author{ 29 | \href{https://stackoverflow.com/users/3732271/akrun}{akrun} 30 | } 31 | -------------------------------------------------------------------------------- /man/is.rstudio.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rstudio.R 3 | \name{is.rstudio} 4 | \alias{is.rstudio} 5 | \alias{is.rstudio.console} 6 | \title{Is this in Rstudio?} 7 | \usage{ 8 | is.rstudio() 9 | 10 | is.rstudio.console() 11 | } 12 | \value{ 13 | TRUE if running in RStudio child process, or Rstudio console specifically. 14 | } 15 | \description{ 16 | Tests if inside RStudio. 17 | } 18 | \examples{ 19 | 20 | is.rstudio() && is.rstudio.console() 21 | 22 | } 23 | \references{ 24 | \url{https://stackoverflow.com/a/17804414/986793} 25 | } 26 | \author{ 27 | \href{https://stackoverflow.com/users/1345455/coatless}{coatless}, \href{https://stackoverflow.com/users/946850/krlmlr}{krlmr} 28 | } 29 | -------------------------------------------------------------------------------- /R/is_inst.R: -------------------------------------------------------------------------------- 1 | #' Check if package is available 2 | #' 3 | #' A predicate for whether a package is installed 4 | #' 5 | #' @param pkg a character string with the name of a single package. An error occurs if more than one package name is given. 6 | #' 7 | #' @return \code{TRUE} if a package is installed, and \code{FALSE} otherwise. 8 | #' 9 | #' @references \url{https://stackoverflow.com/questions/9341635/check-for-installed-packages-before-running-install-packages/38082613#38082613} 10 | #' @author \href{https://stackoverflow.com/users/1863950/artem-klevtsov}{Artem Klevtsov} 11 | #' 12 | #' @examples 13 | #' 14 | #' is_inst("grDevices") 15 | #' 16 | #' @export 17 | 18 | is_inst <- function(pkg) { 19 | nzchar(system.file(package = pkg)) 20 | } 21 | -------------------------------------------------------------------------------- /R/tlist.R: -------------------------------------------------------------------------------- 1 | #' Transpose a list-of-lists 2 | #' 3 | #' For a nested list \code{x}, returns another nested list \code{y} such that 4 | #' \code{x[[a]][[b]] == y[[b]][[a]]} for all indices in the original list. 5 | #' 6 | #' Occasionally, sparse matrices are represented this way. 7 | #' 8 | #' @seealso \code{\link[purrr]{transpose}} and \code{\link[data.table]{transpose}} 9 | #' 10 | #' @param x a list of lists 11 | #' @export 12 | #' @author \href{https://stackoverflow.com/users/2902647/zerweck}{zerweck}, 13 | #' Neal Fultz 14 | #' @references \url{https://stackoverflow.com/questions/45734380/transpose-nested-list} 15 | t.list <- function(x){ 16 | x <- do.call(rbind, x) 17 | lapply(setNames(seq(ncol(x)), colnames(x)), function(j) x[,j]) 18 | } 19 | -------------------------------------------------------------------------------- /man/calcBMI.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/calcBMI.R 3 | \name{calcBMI} 4 | \alias{calcBMI} 5 | \title{Calculate Body Mass Index} 6 | \usage{ 7 | calcBMI(w = 204, f = 6, i = 1) 8 | } 9 | \arguments{ 10 | \item{w}{Weight (in pounds)} 11 | 12 | \item{f}{Height (feet)} 13 | 14 | \item{i}{Height (inches)} 15 | } 16 | \value{ 17 | BMI 18 | } 19 | \description{ 20 | This calculates Body Mass Index 21 | } 22 | \examples{ 23 | calcBMI(199, 5, 9) 24 | } 25 | \references{ 26 | \url{https://stackoverflow.com/questions/16782598/declaring-dynamic-variable-in-r/16782661#16782661} 27 | } 28 | \seealso{ 29 | \code{\link{sprintf}} 30 | } 31 | \author{ 32 | \href{https://stackoverflow.com/users/190277/ben-bolker}{Ben Bolker} 33 | } 34 | -------------------------------------------------------------------------------- /man/readkey.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/readkey.R 3 | \name{readkey} 4 | \alias{readkey} 5 | \title{Wait for a keypress} 6 | \usage{ 7 | readkey(prompt = "Press [enter] to continue") 8 | } 9 | \arguments{ 10 | \item{prompt}{the text to display} 11 | } 12 | \description{ 13 | Wait for a keypress 14 | } 15 | \section{Changed Feb 23, 2015 by njf}{ 16 | 17 | \code{prompt} may be set by a parameter rather than hard coding it. 18 | } 19 | 20 | \references{ 21 | \url{http://stackoverflow.com/questions/15272916/how-to-wait-for-a-keypress-in-r} 22 | } 23 | \author{ 24 | \href{http://stackoverflow.com/users/2427707/nnn}{nnn}, 25 | \href{http://stackoverflow.com/users/1095090/arulmr}{arulmr}, 26 | Neal Fultz 27 | } 28 | -------------------------------------------------------------------------------- /R/substituteExpr.R: -------------------------------------------------------------------------------- 1 | #' Substitute on an expression in a value 2 | #' 3 | #' If expr's value is an expression, substitute in any variables bound in \code{env}. 4 | #' 5 | #' Differs in that substitute uses expr's expression and not value. 6 | #' 7 | #' @param expr an expression value 8 | #' @param env an environment or a list object. 9 | #' 10 | #' @author \href{https://stackoverflow.com/users/516548/g-grothendieck}{G. Grothendieck} 11 | #' @references \url{https://stackoverflow.com/questions/47780150/use-variable-in-r-substitute/986793} 12 | #' @seealso \link{substitute} 13 | #' @examples 14 | #' a <- expression(z = y + x + 2) 15 | #' substituteExpr(a, list(x=4)) 16 | #' @export 17 | substituteExpr <- function(expr, env) { 18 | do.call(substitute, list(expr=expr[[1]], env=env)) 19 | } 20 | -------------------------------------------------------------------------------- /man/approxpDirichlet.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/approxpDirichlet.R 3 | \name{approxpDirichlet} 4 | \alias{approxpDirichlet} 5 | \title{Approximate CDF of Dirichlet} 6 | \usage{ 7 | approxpDirichlet(a, t, N = 10000) 8 | } 9 | \arguments{ 10 | \item{a}{Dirichlet parameters} 11 | 12 | \item{t}{the proportions} 13 | 14 | \item{N}{number of samples to draw} 15 | } 16 | \description{ 17 | A monte-carlo approximation of the Dirichlet CDF. 18 | } 19 | \examples{ 20 | approxpDirichlet(c(1,3,1), c(0.299, 0.528, 0.204)) 21 | 22 | } 23 | \references{ 24 | \url{http://stats.stackexchange.com/questions/57262/implementation-of-dirichlet-cdf} 25 | } 26 | \author{ 27 | \href{http://stats.stackexchange.com/users/9394/zen}{Zen}, Neal Fultz 28 | } 29 | -------------------------------------------------------------------------------- /man/sincos.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sincos.R 3 | \name{sincos} 4 | \alias{sincos} 5 | \title{sin/cos pairs for modeling} 6 | \usage{ 7 | sincos(x, period = 168/2/pi) 8 | } 9 | \arguments{ 10 | \item{x}{a vector} 11 | 12 | \item{period}{a scalar, which x is scaled by} 13 | } 14 | \value{ 15 | a matrix containing a _sin and _cos column 16 | } 17 | \description{ 18 | Compute the sin and cos of x. 19 | } 20 | \examples{ 21 | 22 | data(sunspots) 23 | lm(sunspots~sincos(time(sunspots), 5/pi)) 24 | 25 | } 26 | \references{ 27 | \url{https://stackoverflow.com/questions/51874305/tuple-variable-in-r-regression-model/54393605#54393605} 28 | } 29 | \author{ 30 | \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 31 | } 32 | -------------------------------------------------------------------------------- /R/approxpDirichlet.R: -------------------------------------------------------------------------------- 1 | #' Approximate CDF of Dirichlet 2 | #' 3 | #' A monte-carlo approximation of the Dirichlet CDF. 4 | #' 5 | #' @param a Dirichlet parameters 6 | #' @param t the proportions 7 | #' @param N number of samples to draw 8 | #' 9 | #' @examples 10 | #' approxpDirichlet(c(1,3,1), c(0.299, 0.528, 0.204)) 11 | #' 12 | #' @importFrom stats rgamma 13 | #' @export 14 | #' @author \href{http://stats.stackexchange.com/users/9394/zen}{Zen}, Neal Fultz 15 | #' @references \url{http://stats.stackexchange.com/questions/57262/implementation-of-dirichlet-cdf} 16 | 17 | approxpDirichlet <- function(a, t, N=10000) { 18 | if(sum(t) <= 1) return(0) 19 | 20 | X <- rgamma(length(a)*N, a, 1) 21 | dim(X) <- c(length(a), N) 22 | X <- X <= tcrossprod(t, colSums(X)) 23 | 24 | sum(apply(X, 2, all)) / N 25 | } 26 | -------------------------------------------------------------------------------- /R/logLik_kmeans.R: -------------------------------------------------------------------------------- 1 | #' Log-Likelihood for k-means clustering (for calculating AIC and BIC) 2 | #' 3 | #' @param object a \code{kmeans} object 4 | #' @param ... unused 5 | #' 6 | #' @author Neal Fultz, inspired by Sherry Towers and 7 | #' \href{http://stackoverflow.com/users/2514568/andy-clifton}{Andy Clifton}, 8 | #' @references \url{http://stackoverflow.com/questions/15839774/how-to-calculate-bic-for-k-means-clustering-in-r} 9 | #' @export 10 | #' @seealso \code{\link[stats]{logLik}}, \code{\link[stats]{AIC}}, \code{\link[stats]{BIC}} 11 | #' @examples 12 | #' cl <- kmeans(iris[-5], 3) 13 | #' AIC(cl) 14 | 15 | logLik.kmeans <- function(object, ...) structure( 16 | -object$tot.withinss, 17 | nobs = length(object$cluster), 18 | df = nrow(object$centers) * ncol(object$centers), 19 | class = 'logLik' 20 | ) 21 | -------------------------------------------------------------------------------- /R/zip.R: -------------------------------------------------------------------------------- 1 | #' Zip / Enumerate from python 2 | #' 3 | #' \code{zip2}s together parallel lists into a list-of-lists. It is named zip2 to not collide with utils. 4 | #' 5 | #' \code{enumerate} zips together a list with it's indices. 6 | #' 7 | #' @param ... Objects to be zipped together. 8 | #' 9 | #' @return a list of lists 10 | #' 11 | #' @references \url{https://stackoverflow.com/questions/9281323/zip-or-enumerate-in-r/57564884#57564884} 12 | #' @author \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 13 | #' 14 | #' @examples 15 | #' zip2(1:5,1:10) 16 | #' @export 17 | zip2 <- function(...) { 18 | mapply(list, ..., SIMPLIFY = FALSE) 19 | } 20 | 21 | #' @rdname zip2 22 | #' @examples 23 | #' enumerate(l=LETTERS) 24 | #' @export 25 | enumerate <- function(...) { 26 | zip2(ix=seq_along(..1), ...) 27 | } -------------------------------------------------------------------------------- /man/clamp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/clamp.R 3 | \name{clamp} 4 | \alias{clamp} 5 | \title{Clamp a value into a range} 6 | \usage{ 7 | clamp(x, e1, e2 = -e1) 8 | } 9 | \arguments{ 10 | \item{x}{vector} 11 | 12 | \item{e1}{the first edge} 13 | 14 | \item{e2}{the other edge, defaults to the negation of e1.} 15 | } 16 | \value{ 17 | x, with values outside the boundaries replaced with the boundary points. 18 | } 19 | \description{ 20 | Splits paths into folders. 21 | } 22 | \examples{ 23 | 24 | clamp(-10:10, 2, -2) 25 | clamp(-10:10, -2) 26 | clamp(-10:10, 2) 27 | 28 | } 29 | \references{ 30 | \url{https://stackoverflow.com/questions/32599695/clamp-variable-within-range} 31 | } 32 | \author{ 33 | \href{https://stackoverflow.com/users/3093387/josliber}{josliber}, 34 | } 35 | -------------------------------------------------------------------------------- /R/flatten2.R: -------------------------------------------------------------------------------- 1 | #' Flatten a list without type coercion 2 | #' 3 | #' @section Changed Feb 19, 2015 by njf: 4 | #' Rather than calculating length, preallocate more than needed. 5 | #' 6 | #' @param x a nested list 7 | #' @param len guess of output length 8 | #' 9 | #' @author \href{http://stackoverflow.com/users/662787/tommy}{Tommy}, 10 | #' \href{http://stackoverflow.com/users/271616/joshua-ulrich}{Joshua Ulrich}, 11 | #' \href{http://stackoverflow.com/users/980833/josh-obrien}{Josh O'Brien}, 12 | #' Neal Fultz 13 | #' @references \url{http://stackoverflow.com/questions/8139677/how-to-flatten-a-list-to-a-list-without-coercion} 14 | #' @export 15 | 16 | flatten2 <- function(x, len=1024) { 17 | y <- vector('list', len) 18 | i <- 1L 19 | rapply(x, function(x) { y[[i]] <<- x; i <<- i + 1L }) 20 | y[seq_len(i - 1L)] 21 | } -------------------------------------------------------------------------------- /R/permutations.R: -------------------------------------------------------------------------------- 1 | #' Generate all distinct permutations of a vector 2 | #' 3 | #' 4 | #' @param x vector to permute 5 | #' 6 | #' @return A matrix of all distinct permutations (by row) 7 | #' 8 | #' @author \href{https://stackoverflow.com/users/827280/museful}{Museful} 9 | #' @references \url{https://stackoverflow.com/a/20199902/986793} 10 | #' @export 11 | #' @examples 12 | #' permutations(LETTERS[1:4]) 13 | permutations <- function(x){ 14 | pi <- permutations_impl(length(x)) 15 | x <- x[pi] 16 | dim(x) <- dim(pi) 17 | x 18 | } 19 | 20 | 21 | permutations_impl <- function(n) { 22 | if(n==1) { 23 | return(matrix(1)) 24 | } 25 | sp <- Recall(n-1) 26 | p <- nrow(sp) 27 | A <- matrix(nrow=n*p,ncol=n) 28 | for(i in 1:n){ 29 | A[(i-1)*p+1:p,] <- cbind(i,sp+(sp>=i)) 30 | } 31 | A 32 | 33 | } 34 | -------------------------------------------------------------------------------- /R/approxAUC.R: -------------------------------------------------------------------------------- 1 | #' Approximate AUC 2 | #' 3 | #' AUC can be computed exactly by sorting the fitted values, which is often 4 | #' computationally slow. Instead, we can approximate the AUC numerically using 5 | #' monte carlo. 6 | #' 7 | #' @param y the actual class labels [0-1] 8 | #' @param yhat the predicted probabilities 9 | #' @param n number of samples to draw 10 | #' 11 | #' @examples 12 | #' g <- glm(y~x,data=data.frame(x=1:10,y=1:10)) 13 | #' classMethods(g) 14 | #### 15 | #' 16 | #' @export 17 | #' @author \href{http://stackoverflow.com/users/227734/erik}{erik}, Neal Fultz 18 | #' @references \url{http://stackoverflow.com/questions/4903092/calculate-auc-in-r} 19 | approxAUC <- function(y, yhat, n=1000) { 20 | pos <- sample(yhat, n, replace=TRUE, prob=y) 21 | neg <- sample(yhat, n, replace=TRUE, prob=1-y) 22 | mean(pos > neg) 23 | } -------------------------------------------------------------------------------- /man/t.list.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tlist.R 3 | \name{t.list} 4 | \alias{t.list} 5 | \title{Transpose a list-of-lists} 6 | \usage{ 7 | \method{t}{list}(x) 8 | } 9 | \arguments{ 10 | \item{x}{a list of lists} 11 | } 12 | \description{ 13 | For a nested list \code{x}, returns another nested list \code{y} such that 14 | \code{x[[a]][[b]] == y[[b]][[a]]} for all indices in the original list. 15 | } 16 | \details{ 17 | Occasionally, sparse matrices are represented this way. 18 | } 19 | \references{ 20 | \url{https://stackoverflow.com/questions/45734380/transpose-nested-list} 21 | } 22 | \seealso{ 23 | \code{\link[purrr]{transpose}} and \code{\link[data.table]{transpose}} 24 | } 25 | \author{ 26 | \href{https://stackoverflow.com/users/2902647/zerweck}{zerweck}, 27 | Neal Fultz 28 | } 29 | -------------------------------------------------------------------------------- /R/triangle.R: -------------------------------------------------------------------------------- 1 | #' Reflect upper/lower triangle across diagonal 2 | #' 3 | #' Create a new matrix by copying the lower(upper) triangle to the other half. 4 | #' 5 | #' @param m a square matrix 6 | #' @param from lower or upper triangle 7 | #' 8 | #' @return a symmetric square matrix 9 | #' 10 | #' @author \href{https://stackoverflow.com/users/980833/josh-obrien}{Josh O'Brien} 11 | #' @references \url{https://stackoverflow.com/questions/26166569/copy-upper-triangle-to-lower-triangle-for-several-matrices-in-a-list} 12 | #' @export 13 | #' @examples 14 | #' x <- matrix(1:9,3,3) 15 | #' reflect_triangle(x, "lower") 16 | #' reflect_triangle(x, "upper") 17 | reflect_triangle <- function(m, from=c("lower", "upper")) { 18 | ix <- switch(match.arg(from), lower=upper.tri, upper=lower.tri)(m, diag=FALSE) 19 | m[ix] <- t(m)[ix] 20 | m 21 | } 22 | -------------------------------------------------------------------------------- /R/trim_trailing.R: -------------------------------------------------------------------------------- 1 | #' Strip leading / trailing zeros 2 | #' 3 | #' Removes \code{value} from rightmost/leftmost elements of a vector. 4 | #' 5 | #' @param x a vector 6 | #' @param value a value to strip from x 7 | #' 8 | #' @return a new vector, with values at the right removed 9 | #' 10 | #' @examples 11 | #' trim_leading(c(0,0,0,0,1:5)) 12 | #' 13 | #' @export 14 | #' @author \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 15 | #' @references \url{https://stackoverflow.com/questions/24009982/remove-zeros-in-the-start-and-end-of-a-vector/} 16 | 17 | trim_trailing <- function(x, value=0) { 18 | w <- which.max(cumsum(x != value)) 19 | x[seq.int(w)] 20 | } 21 | 22 | #' @export 23 | #' @rdname trim_trailing 24 | trim_leading <- function(x, value=0) { 25 | w <- which.max(cummax(x != value)) 26 | x[seq.int(w, length(x))] 27 | } -------------------------------------------------------------------------------- /man/Comment.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Comment.R 3 | \name{Comment} 4 | \alias{Comment} 5 | \title{Multi-line Comments} 6 | \usage{ 7 | Comment(...) 8 | } 9 | \arguments{ 10 | \item{...}{comment, not evaluated.} 11 | } 12 | \description{ 13 | Multi-line Comments 14 | } 15 | \examples{ 16 | Comment( ` 17 | 18 | # Put anything in here except back-ticks. 19 | 20 | api_idea <- function() { 21 | return TRUE 22 | } 23 | 24 | # Just to show api_idea isn't really there... 25 | print( api_idea ) 26 | 27 | `) 28 | 29 | } 30 | \references{ 31 | \url{http://stackoverflow.com/questions/1231195/multiline-comment-workarounds} 32 | } 33 | \author{ 34 | \href{http://stackoverflow.com/users/173985/thell}{Thell}, 35 | \href{http://stackoverflow.com/users/211116/spacedman}{Spacedman} 36 | Neal Fultz 37 | } 38 | -------------------------------------------------------------------------------- /man/bsearch7.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bsearch7.R 3 | \name{bsearch7} 4 | \alias{bsearch7} 5 | \title{Efficient binary search for character vectors} 6 | \usage{ 7 | bsearch7(val, tab, L = 1L, H = length(tab)) 8 | } 9 | \arguments{ 10 | \item{val}{values} 11 | 12 | \item{tab}{table to find values in} 13 | 14 | \item{L}{lower bound} 15 | 16 | \item{H}{upper bound} 17 | } 18 | \description{ 19 | Efficient binary search for character vectors 20 | } 21 | \examples{ 22 | bsearch7(sample(letters, 5000, replace=TRUE), letters) 23 | } 24 | \references{ 25 | \url{http://stackoverflow.com/questions/20133344/find-closest-value-in-a-vector-with-binary-search/} and 26 | \url{https://stat.ethz.ch/pipermail/r-help/2011-April/274182.html} 27 | } 28 | \author{ 29 | Martin Morgan, Neal Fultz 30 | } 31 | -------------------------------------------------------------------------------- /man/is_inst.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/is_inst.R 3 | \name{is_inst} 4 | \alias{is_inst} 5 | \title{Check if package is available} 6 | \usage{ 7 | is_inst(pkg) 8 | } 9 | \arguments{ 10 | \item{pkg}{a character string with the name of a single package. An error occurs if more than one package name is given.} 11 | } 12 | \value{ 13 | \code{TRUE} if a package is installed, and \code{FALSE} otherwise. 14 | } 15 | \description{ 16 | A predicate for whether a package is installed 17 | } 18 | \examples{ 19 | 20 | is_inst("grDevices") 21 | 22 | } 23 | \references{ 24 | \url{https://stackoverflow.com/questions/9341635/check-for-installed-packages-before-running-install-packages/38082613#38082613} 25 | } 26 | \author{ 27 | \href{https://stackoverflow.com/users/1863950/artem-klevtsov}{Artem Klevtsov} 28 | } 29 | -------------------------------------------------------------------------------- /man/zip2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/zip.R 3 | \name{zip2} 4 | \alias{zip2} 5 | \alias{enumerate} 6 | \title{Zip / Enumerate from python} 7 | \usage{ 8 | zip2(...) 9 | 10 | enumerate(...) 11 | } 12 | \arguments{ 13 | \item{...}{Objects to be zipped together.} 14 | } 15 | \value{ 16 | a list of lists 17 | } 18 | \description{ 19 | \code{zip2}s together parallel lists into a list-of-lists. It is named zip2 to not collide with utils. 20 | } 21 | \details{ 22 | \code{enumerate} zips together a list with it's indices. 23 | } 24 | \examples{ 25 | zip2(1:5,1:10) 26 | enumerate(l=LETTERS) 27 | } 28 | \references{ 29 | \url{https://stackoverflow.com/questions/9281323/zip-or-enumerate-in-r/57564884#57564884} 30 | } 31 | \author{ 32 | \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 33 | } 34 | -------------------------------------------------------------------------------- /R/randomRows.R: -------------------------------------------------------------------------------- 1 | #' Sample rows from a dataframe or matrix 2 | #' 3 | #' @param x a data frame or matrix 4 | #' @param size a non-negative integer giving the number of items to choose. 5 | #' @param replace Should sampling be with replacement? 6 | #' @param prob A vector of probability weights for obtaining the elements of the vector being sampled. 7 | #' 8 | #' @section Changes: 9 | #' Matched parameters to sample -- njf, May 18, 2015 10 | #' 11 | #' @seealso \code{\link{sample}} 12 | #' @seealso \code{\link[dplyr]{sample_n}} for dplyr users 13 | #' 14 | #' @export 15 | #' @author \href{http://stackoverflow.com/users/211116/spacedman}{Spacedman} 16 | #' @references \url{http://stackoverflow.com/questions/8273313/random-rows-in-dataframe-in-r} 17 | 18 | randomRows <- function(x, size, replace=FALSE, prob=NULL){ 19 | x[sample(nrow(x), size, replace, prob),] 20 | } -------------------------------------------------------------------------------- /man/trim_trailing.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/trim_trailing.R 3 | \name{trim_trailing} 4 | \alias{trim_trailing} 5 | \alias{trim_leading} 6 | \title{Strip leading / trailing zeros} 7 | \usage{ 8 | trim_trailing(x, value = 0) 9 | 10 | trim_leading(x, value = 0) 11 | } 12 | \arguments{ 13 | \item{x}{a vector} 14 | 15 | \item{value}{a value to strip from x} 16 | } 17 | \value{ 18 | a new vector, with values at the right removed 19 | } 20 | \description{ 21 | Removes \code{value} from rightmost/leftmost elements of a vector. 22 | } 23 | \examples{ 24 | trim_leading(c(0,0,0,0,1:5)) 25 | 26 | } 27 | \references{ 28 | \url{https://stackoverflow.com/questions/24009982/remove-zeros-in-the-start-and-end-of-a-vector/} 29 | } 30 | \author{ 31 | \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 32 | } 33 | -------------------------------------------------------------------------------- /R/cor2cov.R: -------------------------------------------------------------------------------- 1 | #' Back transform correlation matrix to variance-covariance matrix 2 | #' 3 | #' Compute a variance-covariance matrix from a correlation matrix and standard deviations. 4 | #' 5 | #' @param V a variance covariance matrix 6 | #' @param sd a vector of standard deviations - if ommitted, use the sqrt of the diagonal of V 7 | #' 8 | #' @return a variance-covariance matrix 9 | #' 10 | #' @author \href{https://stackoverflow.com/users/767760/s4m}{S4M}, 11 | #' @references \url{https://stackoverflow.com/questions/18740796/generate-covariance-matrix-from-correlation-matrix} 12 | #' @export 13 | #' @seealso \code{\link[stats]{cor}} 14 | #' @examples 15 | #' stopifnot(all.equal( 16 | #' cor2cov(cor(mtcars), sapply(mtcars, sd)), 17 | #' cov(mtcars) 18 | #' )) 19 | cor2cov <- function(V, sd=sqrt(diag(V))) { 20 | stopifnot(is.matrix(V)) 21 | V * tcrossprod(sd) 22 | } -------------------------------------------------------------------------------- /man/approxAUC.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/approxAUC.R 3 | \name{approxAUC} 4 | \alias{approxAUC} 5 | \title{Approximate AUC} 6 | \usage{ 7 | approxAUC(y, yhat, n = 1000) 8 | } 9 | \arguments{ 10 | \item{y}{the actual class labels [0-1]} 11 | 12 | \item{yhat}{the predicted probabilities} 13 | 14 | \item{n}{number of samples to draw} 15 | } 16 | \description{ 17 | AUC can be computed exactly by sorting the fitted values, which is often 18 | computationally slow. Instead, we can approximate the AUC numerically using 19 | monte carlo. 20 | } 21 | \examples{ 22 | g <- glm(y~x,data=data.frame(x=1:10,y=1:10)) 23 | classMethods(g) 24 | 25 | } 26 | \references{ 27 | \url{http://stackoverflow.com/questions/4903092/calculate-auc-in-r} 28 | } 29 | \author{ 30 | \href{http://stackoverflow.com/users/227734/erik}{erik}, Neal Fultz 31 | } 32 | -------------------------------------------------------------------------------- /man/classMethods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/classMethods.R 3 | \name{classMethods} 4 | \alias{classMethods} 5 | \title{List all methods for an object} 6 | \usage{ 7 | classMethods(cl) 8 | } 9 | \arguments{ 10 | \item{cl}{a vector of class names, or an object} 11 | } 12 | \description{ 13 | The built-in methods() function will give all available methods for a specified class, 14 | or for a specified generic function, but not for an object. Objects can have multiple 15 | classes, so this can be complicated to calculate. 16 | } 17 | \examples{ 18 | g <- glm(y~x,data=data.frame(x=1:10,y=1:10)) 19 | classMethods(g) 20 | 21 | } 22 | \references{ 23 | \url{http://stackoverflow.com/questions/23840404/function-to-return-all-s3-methods-applicable-to-an-object} 24 | } 25 | \author{ 26 | \href{http://stackoverflow.com/users/2372064/mrflick}{MrFlick} 27 | } 28 | -------------------------------------------------------------------------------- /man/reflect_triangle.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/triangle.R 3 | \name{reflect_triangle} 4 | \alias{reflect_triangle} 5 | \title{Reflect upper/lower triangle across diagonal} 6 | \usage{ 7 | reflect_triangle(m, from = c("lower", "upper")) 8 | } 9 | \arguments{ 10 | \item{m}{a square matrix} 11 | 12 | \item{from}{lower or upper triangle} 13 | } 14 | \value{ 15 | a symmetric square matrix 16 | } 17 | \description{ 18 | Create a new matrix by copying the lower(upper) triangle to the other half. 19 | } 20 | \examples{ 21 | x <- matrix(1:9,3,3) 22 | reflect_triangle(x, "lower") 23 | reflect_triangle(x, "upper") 24 | } 25 | \references{ 26 | \url{https://stackoverflow.com/questions/26166569/copy-upper-triangle-to-lower-triangle-for-several-matrices-in-a-list} 27 | } 28 | \author{ 29 | \href{https://stackoverflow.com/users/980833/josh-obrien}{Josh O'Brien} 30 | } 31 | -------------------------------------------------------------------------------- /man/flatten2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/flatten2.R 3 | \name{flatten2} 4 | \alias{flatten2} 5 | \title{Flatten a list without type coercion} 6 | \usage{ 7 | flatten2(x, len = 1024) 8 | } 9 | \arguments{ 10 | \item{x}{a nested list} 11 | 12 | \item{len}{guess of output length} 13 | } 14 | \description{ 15 | Flatten a list without type coercion 16 | } 17 | \section{Changed Feb 19, 2015 by njf}{ 18 | 19 | Rather than calculating length, preallocate more than needed. 20 | } 21 | 22 | \references{ 23 | \url{http://stackoverflow.com/questions/8139677/how-to-flatten-a-list-to-a-list-without-coercion} 24 | } 25 | \author{ 26 | \href{http://stackoverflow.com/users/662787/tommy}{Tommy}, 27 | \href{http://stackoverflow.com/users/271616/joshua-ulrich}{Joshua Ulrich}, 28 | \href{http://stackoverflow.com/users/980833/josh-obrien}{Josh O'Brien}, 29 | Neal Fultz 30 | } 31 | -------------------------------------------------------------------------------- /man/rsplit.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rsplit.R 3 | \name{rsplit} 4 | \alias{rsplit} 5 | \title{Recursivly split a data.frame} 6 | \usage{ 7 | rsplit(x, by, drop = FALSE) 8 | } 9 | \arguments{ 10 | \item{x}{a data.frame or vector} 11 | 12 | \item{by}{a data.frame of factors} 13 | 14 | \item{drop}{drop unused factor levels} 15 | } 16 | \value{ 17 | a nested list of dataframes, split by each element of \code{by} 18 | 19 | 20 | Inspired by, but different from the below 21 | } 22 | \description{ 23 | When there are multiple factors to split by, Base R split returns a 24 | flattened structure by splitting on the interaction of all factors. 25 | rsplit instead returns a nested list-of-lists. 26 | } 27 | \references{ 28 | \url{https://stackoverflow.com/questions/47802545/converting-data-frame-into-deeply-nested-list/47802935#47802935} 29 | } 30 | \author{ 31 | Neal Fultz 32 | } 33 | -------------------------------------------------------------------------------- /R/rcweibull.R: -------------------------------------------------------------------------------- 1 | #' Sample from conditional Weibull 2 | #' 3 | #' The conditional weibull distribution is a truncated version - the condition is that the observation has already survived 4 | #' 5 | #' @param n Number of samples to draw 6 | #' @param lambda Weibull parameter 7 | #' @param kappa Weibull parameter 8 | #' @param T0 Left boundary 9 | #' 10 | #' @author \href{https://stats.stackexchange.com/users/283201/jcken}{jcken}, 11 | #' Neal Fultz 12 | #' @references \url{hhttps://stats.stackexchange.com/questions/470058/how-to-draw-from-conditional-weibull-distribution/470064#470064} 13 | #' 14 | #' @seealso \code{\link[stats]{rweibull}} 15 | #' @importFrom stats rexp 16 | #' 17 | #' @examples 18 | #' 19 | #' rcweibull(n=20, lambda=1:2, kappa=1:5, T0=1:20) 20 | #' 21 | #' @export 22 | rcweibull <- function(n, lambda, kappa, T0){ 23 | p <- rexp(n) 24 | 25 | ( T0^kappa + lambda^kappa * p)^(1/kappa) 26 | 27 | } 28 | 29 | -------------------------------------------------------------------------------- /man/substituteExpr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/substituteExpr.R 3 | \name{substituteExpr} 4 | \alias{substituteExpr} 5 | \title{Substitute on an expression in a value} 6 | \usage{ 7 | substituteExpr(expr, env) 8 | } 9 | \arguments{ 10 | \item{expr}{an expression value} 11 | 12 | \item{env}{an environment or a list object.} 13 | } 14 | \description{ 15 | If expr's value is an expression, substitute in any variables bound in \code{env}. 16 | } 17 | \details{ 18 | Differs in that substitute uses expr's expression and not value. 19 | } 20 | \examples{ 21 | a <- expression(z = y + x + 2) 22 | substituteExpr(a, list(x=4)) 23 | } 24 | \references{ 25 | \url{https://stackoverflow.com/questions/47780150/use-variable-in-r-substitute/986793} 26 | } 27 | \seealso{ 28 | \link{substitute} 29 | } 30 | \author{ 31 | \href{https://stackoverflow.com/users/516548/g-grothendieck}{G. Grothendieck} 32 | } 33 | -------------------------------------------------------------------------------- /man/logLik.kmeans.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/logLik_kmeans.R 3 | \name{logLik.kmeans} 4 | \alias{logLik.kmeans} 5 | \title{Log-Likelihood for k-means clustering (for calculating AIC and BIC)} 6 | \usage{ 7 | \method{logLik}{kmeans}(object, ...) 8 | } 9 | \arguments{ 10 | \item{object}{a \code{kmeans} object} 11 | 12 | \item{...}{unused} 13 | } 14 | \description{ 15 | Log-Likelihood for k-means clustering (for calculating AIC and BIC) 16 | } 17 | \examples{ 18 | cl <- kmeans(iris[-5], 3) 19 | AIC(cl) 20 | } 21 | \references{ 22 | \url{http://stackoverflow.com/questions/15839774/how-to-calculate-bic-for-k-means-clustering-in-r} 23 | } 24 | \seealso{ 25 | \code{\link[stats]{logLik}}, \code{\link[stats]{AIC}}, \code{\link[stats]{BIC}} 26 | } 27 | \author{ 28 | Neal Fultz, inspired by Sherry Towers and 29 | \href{http://stackoverflow.com/users/2514568/andy-clifton}{Andy Clifton}, 30 | } 31 | -------------------------------------------------------------------------------- /R/bsearch7.R: -------------------------------------------------------------------------------- 1 | #' Efficient binary search for character vectors 2 | #' 3 | #' @param val values 4 | #' @param tab table to find values in 5 | #' @param L lower bound 6 | #' @param H upper bound 7 | #' 8 | #' @author Martin Morgan, Neal Fultz 9 | #' @references \url{http://stackoverflow.com/questions/20133344/find-closest-value-in-a-vector-with-binary-search/} and 10 | #' \url{https://stat.ethz.ch/pipermail/r-help/2011-April/274182.html} 11 | #' @export 12 | #' @examples 13 | #' bsearch7(sample(letters, 5000, replace=TRUE), letters) 14 | bsearch7 <- 15 | function(val, tab, L=1L, H=length(tab)) 16 | { 17 | n <- length(val) 18 | b <- matrix(c(L,H), n, 2, byrow=TRUE) 19 | i0 <- seq_along(val) 20 | 21 | repeat { 22 | M <- (b[,1] + b[,2]) %/% 2L 23 | i <- tab[M] > val 24 | b[i0 + i * n] <- M - i - i + 1L 25 | if(all(b[,2] < b[,1])) break; 26 | } 27 | b[,1] - 1L 28 | } 29 | 30 | -------------------------------------------------------------------------------- /man/frontier.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/frontier.R 3 | \name{frontier} 4 | \alias{frontier} 5 | \title{Find efficient frontier} 6 | \usage{ 7 | frontier(...) 8 | } 9 | \arguments{ 10 | \item{...}{coordinates to scan} 11 | } 12 | \value{ 13 | logical vector, TRUE if point is on efficient frontier 14 | } 15 | \description{ 16 | A predicate that is TRUE if a point is on the efficient frontier. 17 | } 18 | \examples{ 19 | 20 | df <- data.frame(x=rnorm(100), y=rnorm(100)) 21 | plot(df) 22 | points(subset(df, frontier(x,y)), col='red', pch=15) 23 | points(subset(df, frontier(-x,y)), col='green', pch=15) 24 | points(subset(df, frontier(x,-y)), col='blue', pch=15) 25 | points(subset(df, frontier(-x,-y)), col='orange', pch=15) 26 | 27 | } 28 | \references{ 29 | \url{https://stackoverflow.com/a/36209989/986793} 30 | } 31 | \author{ 32 | \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 33 | } 34 | -------------------------------------------------------------------------------- /man/sprintf_named.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sprintf_named.R 3 | \name{sprintf_named} 4 | \alias{sprintf_named} 5 | \title{sprintf, with named references} 6 | \usage{ 7 | sprintf_named(fmt, ...) 8 | } 9 | \arguments{ 10 | \item{fmt}{a character vector of format strings, each of up to 8192 bytes.} 11 | 12 | \item{...}{values to be interpolated, optionally with names.} 13 | } 14 | \value{ 15 | a character vector. 16 | } 17 | \description{ 18 | This converts named references in a format string (marked by curly braces), and passes through to \code{\link{sprintf}}. 19 | } 20 | \examples{ 21 | sprintf_named("\%{HIA}s!!! \%{RYLAH}s", RYLAH="Rock You Like a Hurricane", HIA="Here I Am") 22 | } 23 | \references{ 24 | \url{https://stackoverflow.com/questions/17475803/sprintf-format-strings-reference-by-name/55423080#55423080} 25 | } 26 | \seealso{ 27 | \code{\link{sprintf}} 28 | } 29 | \author{ 30 | Neal Fultz 31 | } 32 | -------------------------------------------------------------------------------- /man/Tarone.test.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Tarone.R 3 | \name{Tarone.test} 4 | \alias{Tarone.test} 5 | \title{Tarone's Z Test} 6 | \usage{ 7 | Tarone.test(N, M) 8 | } 9 | \arguments{ 10 | \item{N}{Trials} 11 | 12 | \item{M}{Counts} 13 | } 14 | \value{ 15 | a \code{htest} object 16 | } 17 | \description{ 18 | Tests the goodness of fit of the binomial distribution. 19 | } 20 | \examples{ 21 | #Generate example data 22 | N <- c(30, 32, 40, 28, 29, 35, 30, 34, 31, 39) 23 | M <- c( 9, 10, 22, 15, 8, 19, 16, 19, 15, 10) 24 | Tarone.test(N, M) 25 | } 26 | \references{ 27 | \url{https://stats.stackexchange.com/a/410376/6378} and 28 | R. E. TARONE, Testing the goodness of fit of the binomial distribution, Biometrika, Volume 66, Issue 3, December 1979, Pages 585–590, \url{https://doi.org/10.1093/biomet/66.3.585} 29 | } 30 | \author{ 31 | \href{https://stats.stackexchange.com/users/173082/reinstate-monica}{Ben O'Neill} 32 | } 33 | -------------------------------------------------------------------------------- /man/rcweibull.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rcweibull.R 3 | \name{rcweibull} 4 | \alias{rcweibull} 5 | \title{Sample from conditional Weibull} 6 | \usage{ 7 | rcweibull(n, lambda, kappa, T0) 8 | } 9 | \arguments{ 10 | \item{n}{Number of samples to draw} 11 | 12 | \item{lambda}{Weibull parameter} 13 | 14 | \item{kappa}{Weibull parameter} 15 | 16 | \item{T0}{Left boundary} 17 | } 18 | \description{ 19 | The conditional weibull distribution is a truncated version - the condition is that the observation has already survived 20 | } 21 | \examples{ 22 | 23 | rcweibull(n=20, lambda=1:2, kappa=1:5, T0=1:20) 24 | 25 | } 26 | \references{ 27 | \url{hhttps://stats.stackexchange.com/questions/470058/how-to-draw-from-conditional-weibull-distribution/470064#470064} 28 | } 29 | \seealso{ 30 | \code{\link[stats]{rweibull}} 31 | } 32 | \author{ 33 | \href{https://stats.stackexchange.com/users/283201/jcken}{jcken}, 34 | Neal Fultz 35 | } 36 | -------------------------------------------------------------------------------- /man/cor2cov.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cor2cov.R 3 | \name{cor2cov} 4 | \alias{cor2cov} 5 | \title{Back transform correlation matrix to variance-covariance matrix} 6 | \usage{ 7 | cor2cov(V, sd = sqrt(diag(V))) 8 | } 9 | \arguments{ 10 | \item{V}{a variance covariance matrix} 11 | 12 | \item{sd}{a vector of standard deviations - if ommitted, use the sqrt of the diagonal of V} 13 | } 14 | \value{ 15 | a variance-covariance matrix 16 | } 17 | \description{ 18 | Compute a variance-covariance matrix from a correlation matrix and standard deviations. 19 | } 20 | \examples{ 21 | stopifnot(all.equal( 22 | cor2cov(cor(mtcars), sapply(mtcars, sd)), 23 | cov(mtcars) 24 | )) 25 | } 26 | \references{ 27 | \url{https://stackoverflow.com/questions/18740796/generate-covariance-matrix-from-correlation-matrix} 28 | } 29 | \seealso{ 30 | \code{\link[stats]{cor}} 31 | } 32 | \author{ 33 | \href{https://stackoverflow.com/users/767760/s4m}{S4M}, 34 | } 35 | -------------------------------------------------------------------------------- /R/coalesce.R: -------------------------------------------------------------------------------- 1 | #' Replace NAs in parallel vectors 2 | #' 3 | #' Replaces NA elements of x with corresponding element of y, and NA elements of 4 | #' that with corresponding element from dots. 5 | #' 6 | #' @section Changes: 7 | #' 8 | #' Rather than using eagerly evaluating the dot arguments and Reducing over them, 9 | #' instead we use recursion to evaluate them lazily. 10 | #' 11 | #' @param x a vector 12 | #' @param y replacement values 13 | #' @param ... further replacement values 14 | #' @return x with NAs replaced with y 15 | #' 16 | #' @author \href{https://stackoverflow.com/users/903061/gregor}{Gregor Thomas}, 17 | #' @references \url{https://stackoverflow.com/a/19254510/986793} 18 | #' 19 | #' @examples 20 | #' 21 | #' x <- c(1:4, NA, 1:4, NA) 22 | #' y <- c(1:9, NA) 23 | #' z <- c(NA, NA, 1:8) 24 | #' coalesce(x,y,z) 25 | #' 26 | #' @export 27 | coalesce <- function(x,y,...) { 28 | i <- which(is.na(x)) 29 | x[i] <- y[i] 30 | if(...length() && length(i)) Recall(x, ...) else x 31 | } 32 | -------------------------------------------------------------------------------- /R/bat_passes.R: -------------------------------------------------------------------------------- 1 | #' Bat passes 2 | #' 3 | #' Data from a study on the effect of light on bats. 4 | #' 5 | #' @docType data 6 | #' 7 | #' @usage data(bat_passes) 8 | #' 9 | #' @format A data.frame with 80 observations and 5 variables. 10 | #' 11 | #' \describe{ 12 | #' \item{Location}{Five locations in the study} 13 | #' \item{Al.N}{Dark or Light condition} 14 | #' \item{Buzzes}{Count of buzzes per day} 15 | #' \item{Passes}{Count of passes per day} 16 | #' \item{Date}{Date of observation} 17 | #' } 18 | #' 19 | #' @keywords datasets 20 | #' 21 | #' @references nausicaa (\url{https://stats.stackexchange.com/users/190274/nausicaa}), 22 | #' poisson glm to observe whether effects of artificial light on the number of bat passes in each location were significant, 23 | #' URL (version: 2018-03-09): \url{https://stats.stackexchange.com/q/325334} 24 | 25 | #' 26 | #' @source \url{https://stats.stackexchange.com/q/325334} 27 | #' 28 | #' @examples 29 | #' data(bat_passes) 30 | #' head(bat_passes) 31 | "bat_passes" -------------------------------------------------------------------------------- /R/frontier.R: -------------------------------------------------------------------------------- 1 | #' Find efficient frontier 2 | #' 3 | #' A predicate that is TRUE if a point is on the efficient frontier. 4 | #' 5 | #' @param ... coordinates to scan 6 | #' @return logical vector, TRUE if point is on efficient frontier 7 | #' 8 | #' @references \url{https://stackoverflow.com/a/36209989/986793} 9 | #' @author \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 10 | #' 11 | #' @examples 12 | #' 13 | #' df <- data.frame(x=rnorm(100), y=rnorm(100)) 14 | #' plot(df) 15 | #' points(subset(df, frontier(x,y)), col='red', pch=15) 16 | #' points(subset(df, frontier(-x,y)), col='green', pch=15) 17 | #' points(subset(df, frontier(x,-y)), col='blue', pch=15) 18 | #' points(subset(df, frontier(-x,-y)), col='orange', pch=15) 19 | #' 20 | #' @export 21 | 22 | 23 | 24 | 25 | frontier <- function(...) { 26 | X <- list(...) 27 | 28 | i <- order(..., decreasing = TRUE) 29 | ret <- logical(length(i)) 30 | 31 | for(z in X[-1]){ 32 | i <- i[z[i] == cummax(z[i])] 33 | } 34 | 35 | 36 | ret[i] <- TRUE 37 | ret 38 | } 39 | -------------------------------------------------------------------------------- /man/coalesce.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/coalesce.R 3 | \name{coalesce} 4 | \alias{coalesce} 5 | \title{Replace NAs in parallel vectors} 6 | \usage{ 7 | coalesce(x, y, ...) 8 | } 9 | \arguments{ 10 | \item{x}{a vector} 11 | 12 | \item{y}{replacement values} 13 | 14 | \item{...}{further replacement values} 15 | } 16 | \value{ 17 | x with NAs replaced with y 18 | } 19 | \description{ 20 | Replaces NA elements of x with corresponding element of y, and NA elements of 21 | that with corresponding element from dots. 22 | } 23 | \section{Changes}{ 24 | 25 | 26 | Rather than using eagerly evaluating the dot arguments and Reducing over them, 27 | instead we use recursion to evaluate them lazily. 28 | } 29 | 30 | \examples{ 31 | 32 | x <- c(1:4, NA, 1:4, NA) 33 | y <- c(1:9, NA) 34 | z <- c(NA, NA, 1:8) 35 | coalesce(x,y,z) 36 | 37 | } 38 | \references{ 39 | \url{https://stackoverflow.com/a/19254510/986793} 40 | } 41 | \author{ 42 | \href{https://stackoverflow.com/users/903061/gregor}{Gregor Thomas}, 43 | } 44 | -------------------------------------------------------------------------------- /man/randomRows.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/randomRows.R 3 | \name{randomRows} 4 | \alias{randomRows} 5 | \title{Sample rows from a dataframe or matrix} 6 | \usage{ 7 | randomRows(x, size, replace = FALSE, prob = NULL) 8 | } 9 | \arguments{ 10 | \item{x}{a data frame or matrix} 11 | 12 | \item{size}{a non-negative integer giving the number of items to choose.} 13 | 14 | \item{replace}{Should sampling be with replacement?} 15 | 16 | \item{prob}{A vector of probability weights for obtaining the elements of the vector being sampled.} 17 | } 18 | \description{ 19 | Sample rows from a dataframe or matrix 20 | } 21 | \section{Changes}{ 22 | 23 | Matched parameters to sample -- njf, May 18, 2015 24 | } 25 | 26 | \references{ 27 | \url{http://stackoverflow.com/questions/8273313/random-rows-in-dataframe-in-r} 28 | } 29 | \seealso{ 30 | \code{\link{sample}} 31 | 32 | \code{\link[dplyr]{sample_n}} for dplyr users 33 | } 34 | \author{ 35 | \href{http://stackoverflow.com/users/211116/spacedman}{Spacedman} 36 | } 37 | -------------------------------------------------------------------------------- /man/horner.poly.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/horner.R 3 | \name{horner.poly} 4 | \alias{horner.poly} 5 | \alias{horner.rational} 6 | \title{Evaluate Polynomial and Rational Functions using Horner's method} 7 | \usage{ 8 | horner.poly(x, P) 9 | 10 | horner.rational(x, P, Q) 11 | } 12 | \arguments{ 13 | \item{x}{a vector} 14 | 15 | \item{P}{the coefficients of the polynomial in the numerator, in increasing order} 16 | 17 | \item{Q}{the coefficients of the polynomial in the denominator} 18 | } 19 | \value{ 20 | a vector 21 | } 22 | \description{ 23 | Calculate 24 | } 25 | \details{ 26 | \deqn{y = (P_1 + P_2*x + P_3*x^2 + ... ) / ( Q_1 + Q_2*x + Q_3*x^2 + ...)} 27 | 28 | If the coefficients have zeros as highest powers, those are ignored. 29 | } 30 | \examples{ 31 | 32 | P <- c(1,-2,1) 33 | horner.poly(polyroot(P), P) 34 | 35 | } 36 | \references{ 37 | \url{https://stackoverflow.com/questions/53256945/evaluate-polynominal-function} 38 | } 39 | \author{ 40 | \href{https://stackoverflow.com/users/9957245/torvin}{torvin} 41 | } 42 | -------------------------------------------------------------------------------- /R/horner.R: -------------------------------------------------------------------------------- 1 | #' Evaluate Polynomial and Rational Functions using Horner's method 2 | #' 3 | #' Calculate 4 | #' 5 | #' \deqn{y = (P_1 + P_2*x + P_3*x^2 + ... ) / ( Q_1 + Q_2*x + Q_3*x^2 + ...)} 6 | #' 7 | #' If the coefficients have zeros as highest powers, those are ignored. 8 | #' 9 | #' @param x a vector 10 | #' @param P the coefficients of the polynomial in the numerator, in increasing order 11 | #' @param Q the coefficients of the polynomial in the denominator 12 | #' 13 | #' @return a vector 14 | #' 15 | #' @examples 16 | #' 17 | #' P <- c(1,-2,1) 18 | #' horner.poly(polyroot(P), P) 19 | #' 20 | #' @export 21 | #' @author \href{https://stackoverflow.com/users/9957245/torvin}{torvin} 22 | #' @references \url{https://stackoverflow.com/questions/53256945/evaluate-polynominal-function} 23 | horner.poly <- function(x, P) { 24 | 25 | z <- 0 26 | 27 | P <- trim_trailing(P, 0) 28 | 29 | for(p in rev(P)) { 30 | z <- z*x + p 31 | } 32 | 33 | z 34 | } 35 | 36 | #' @export 37 | #' @rdname horner.poly 38 | horner.rational <- function(x, P, Q) horner.poly(x, P) / horner.poly(x, Q) 39 | 40 | -------------------------------------------------------------------------------- /man/bat_passes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bat_passes.R 3 | \docType{data} 4 | \name{bat_passes} 5 | \alias{bat_passes} 6 | \title{Bat passes} 7 | \format{ 8 | A data.frame with 80 observations and 5 variables. 9 | 10 | \describe{ 11 | \item{Location}{Five locations in the study} 12 | \item{Al.N}{Dark or Light condition} 13 | \item{Buzzes}{Count of buzzes per day} 14 | \item{Passes}{Count of passes per day} 15 | \item{Date}{Date of observation} 16 | } 17 | } 18 | \source{ 19 | \url{https://stats.stackexchange.com/q/325334} 20 | } 21 | \usage{ 22 | data(bat_passes) 23 | } 24 | \description{ 25 | Data from a study on the effect of light on bats. 26 | } 27 | \examples{ 28 | data(bat_passes) 29 | head(bat_passes) 30 | } 31 | \references{ 32 | nausicaa (\url{https://stats.stackexchange.com/users/190274/nausicaa}), 33 | poisson glm to observe whether effects of artificial light on the number of bat passes in each location were significant, 34 | URL (version: 2018-03-09): \url{https://stats.stackexchange.com/q/325334} 35 | } 36 | \keyword{datasets} 37 | -------------------------------------------------------------------------------- /R/rsplit.R: -------------------------------------------------------------------------------- 1 | #' Recursivly split a data.frame 2 | #' 3 | #' When there are multiple factors to split by, Base R split returns a 4 | #' flattened structure by splitting on the interaction of all factors. 5 | #' rsplit instead returns a nested list-of-lists. 6 | #' 7 | #' @param x a data.frame or vector 8 | #' @param by a data.frame of factors 9 | #' @param drop drop unused factor levels 10 | #' 11 | #' @return a nested list of dataframes, split by each element of \code{by} 12 | #' 13 | #' 14 | #' Inspired by, but different from the below 15 | #' 16 | #' @references \url{https://stackoverflow.com/questions/47802545/converting-data-frame-into-deeply-nested-list/47802935#47802935} 17 | #' @author Neal Fultz 18 | #' 19 | #' @importFrom stats setNames 20 | #' @export 21 | rsplit <- function(x, by, drop=FALSE){ 22 | if(is.atomic(by)) return(split(x,by,drop=drop)) 23 | if(length(by) == 1) return(split(x,by[[1]],drop=drop)) 24 | mapply(rsplit, 25 | x=split(x, by[[1]], drop=drop), 26 | by=t(lapply(by[, -1, drop=FALSE], split, by[[1]], drop=drop)), 27 | drop=drop, SIMPLIFY = FALSE) 28 | } 29 | -------------------------------------------------------------------------------- /R/partial.R: -------------------------------------------------------------------------------- 1 | #' Partially apply a function 2 | #' 3 | #' Simplify a function by setting some arguments to pre-specified values 4 | #' 5 | #' @param f a function 6 | #' @param ... arguments to capture 7 | #' 8 | #' @author \href{http://stackoverflow.com/users/3093387/josilber}{John Silberholz}, \href{https://stackoverflow.com/users/1756702/a-webb}{A Webb} 9 | #' @references \url{http://stackoverflow.com/questions/32173901/how-to-efficiently-partially-apply-a-function-in-r}, \url{https://stackoverflow.com/a/31900149/986793} 10 | #' 11 | #' @seealso \code{\link[pryr]{partial}} 12 | #' @seealso \code{\link[functional]{Curry}} 13 | #' 14 | #' @examples 15 | #' # Example 1: 16 | #' f <- function(a, b, c, d) a+b+c+d 17 | #' p <- partial(f, a=2, c=3) 18 | #' p(b=0, d=1) 19 | #' 20 | #' # captures a format string for printing out sleep data 21 | #' labeller <- partial(sprintf, fmt="extra=%3.2f, group=%d, ID=%d") 22 | #' do.call(labeller, sleep[1, , drop=FALSE]) 23 | #' 24 | #' @export 25 | partial <- function(f, ...) { 26 | force(f) 27 | l <- list(...) 28 | function(...) { 29 | do.call(f, c(l, list(...))) 30 | } 31 | } 32 | 33 | -------------------------------------------------------------------------------- /R/sprintf_named.R: -------------------------------------------------------------------------------- 1 | #' sprintf, with named references 2 | #' 3 | #' This converts named references in a format string (marked by curly braces), and passes through to \code{\link{sprintf}}. 4 | #' 5 | #' @param fmt a character vector of format strings, each of up to 8192 bytes. 6 | #' @param ... values to be interpolated, optionally with names. 7 | #' 8 | #' @return a character vector. 9 | #' 10 | #' 11 | #' @references \url{https://stackoverflow.com/questions/17475803/sprintf-format-strings-reference-by-name/55423080#55423080} 12 | #' @author Neal Fultz 13 | #' 14 | #' @examples 15 | #' sprintf_named("%{HIA}s!!! %{RYLAH}s", RYLAH="Rock You Like a Hurricane", HIA="Here I Am") 16 | #' @importFrom stats setNames 17 | #' @seealso \code{\link{sprintf}} 18 | #' @export 19 | sprintf_named <- function(fmt, ...) { 20 | args <- list(...) 21 | argn <- names(args) 22 | if(is.null(argn)) return(sprintf(fmt, ...)) 23 | 24 | for(i in seq_along(args)) { 25 | if(argn[i] == "") next; 26 | fmt <- gsub(sprintf("%%{%s}", argn[i]), sprintf("%%%d$", i), fmt, fixed = TRUE) 27 | } 28 | 29 | do.call(sprintf, append(args, fmt, 0)) 30 | } 31 | -------------------------------------------------------------------------------- /man/partial.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/partial.R 3 | \name{partial} 4 | \alias{partial} 5 | \title{Partially apply a function} 6 | \usage{ 7 | partial(f, ...) 8 | } 9 | \arguments{ 10 | \item{f}{a function} 11 | 12 | \item{...}{arguments to capture} 13 | } 14 | \description{ 15 | Simplify a function by setting some arguments to pre-specified values 16 | } 17 | \examples{ 18 | # Example 1: 19 | f <- function(a, b, c, d) a+b+c+d 20 | p <- partial(f, a=2, c=3) 21 | p(b=0, d=1) 22 | 23 | # captures a format string for printing out sleep data 24 | labeller <- partial(sprintf, fmt="extra=\%3.2f, group=\%d, ID=\%d") 25 | do.call(labeller, sleep[1, , drop=FALSE]) 26 | 27 | } 28 | \references{ 29 | \url{http://stackoverflow.com/questions/32173901/how-to-efficiently-partially-apply-a-function-in-r}, \url{https://stackoverflow.com/a/31900149/986793} 30 | } 31 | \seealso{ 32 | \code{\link[pryr]{partial}} 33 | 34 | \code{\link[functional]{Curry}} 35 | } 36 | \author{ 37 | \href{http://stackoverflow.com/users/3093387/josilber}{John Silberholz}, \href{https://stackoverflow.com/users/1756702/a-webb}{A Webb} 38 | } 39 | -------------------------------------------------------------------------------- /R/parseldap.R: -------------------------------------------------------------------------------- 1 | #' Parse LDAP output into dataframe 2 | #' 3 | #' @param ldapraw A length-one character vector containing the raw LDAP output 4 | #' @return a data.frame with one row per person 5 | #' 6 | #' @author \href{https://stackoverflow.com/users/3792484/user3792484}{user3792484}, 7 | #' rewrite by Neal Fultz 8 | #' @references \url{https://stackoverflow.com/questions/22793855/how-do-i-run-a-ldap-query-using-r} 9 | 10 | #' @export 11 | parseLDAP<-function(ldapraw) 12 | { 13 | # seperate by two new lines 14 | lines <- readLines(textConnection(ldapraw)) 15 | i <- grepl("^DN: ", lines) 16 | recs <- cumsum(i) 17 | i <- i | nchar(lines) == 0 18 | recs <- split(lines[!i], recs[!i]) 19 | 20 | recs <- sapply(recs, function(x){ 21 | m <- regmatches(x, regexec("^\t([^:]*): (.*)$", x)) 22 | k <- as.character(lapply(m, `[`, 2)) 23 | v <- as.character(lapply(m, `[`, 3)) 24 | list2env(lapply(split(v, k), paste, collapse=" ")) 25 | }) 26 | 27 | all_cols <- Reduce(union, lapply(recs, names)) 28 | 29 | recs <- lapply(recs, mget, x=all_cols, ifnotfound=NA_character_) 30 | 31 | do.call(rbind.data.frame, c(recs, stringsAsFactors = FALSE, row.names = NULL)) 32 | } -------------------------------------------------------------------------------- /man/invinteraction.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/invinteraction.R 3 | \name{invinteraction} 4 | \alias{invinteraction} 5 | \title{Split an interaction'ed factor back into seperate variables} 6 | \usage{ 7 | invinteraction(fac, ..., sep = ".") 8 | } 9 | \arguments{ 10 | \item{fac}{the factor to split} 11 | 12 | \item{...}{optional, names for variables} 13 | 14 | \item{sep}{the seperator between levels} 15 | } 16 | \value{ 17 | a data.frame of factors 18 | } 19 | \description{ 20 | Inverse of \code{interaction} 21 | } 22 | \section{Changes}{ 23 | 24 | 25 | Refactored to process the levels vector, rather than entire factor vector. 26 | } 27 | 28 | \examples{ 29 | 30 | f1 <- gl(2, 3) 31 | f2 <- gl(3, 2) 32 | invinteraction(f1:f2, sep=':') 33 | 34 | ppl <- interaction( 35 | eyes = as.factor(sample(colors(), 10)), 36 | hair = as.factor(sample(colors(), 10)) 37 | ) 38 | str(invinteraction(ppl, "eyes", "hair")) 39 | 40 | } 41 | \references{ 42 | \url{http://stackoverflow.com/a/10521926/986793} 43 | } 44 | \seealso{ 45 | \code{\link[base]{interaction}} 46 | } 47 | \author{ 48 | \href{http://stackoverflow.com/users/1855677/42}{42}, Neal Fultz 49 | } 50 | -------------------------------------------------------------------------------- /man/na.dummy.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/na_dummy.R 3 | \name{na.dummy} 4 | \alias{na.dummy} 5 | \alias{fix_predvars} 6 | \title{Handle Missing Values with Fill + Dummy} 7 | \usage{ 8 | na.dummy(object, ...) 9 | 10 | fix_predvars(object) 11 | } 12 | \arguments{ 13 | \item{object}{an R object, typically a data.frame} 14 | 15 | \item{...}{other arguments (not used)} 16 | } 17 | \description{ 18 | Handles missing values by filling in with mean, and adding a dummy variable. 19 | } 20 | \examples{ 21 | 22 | df <- structure(list(Y = c(3.83, 22.73, 13.85, 14.09, 20.55, 18.51, 23 | 17.76, 9.42, 15.88, 27.81), X1 = 1:10, X2 = c(2L, NA, NA, 4L, 24 | 8L, 7L, 6L, 1L, 3L, 9L)), .Names = c("Y", "X1", "X2"), row.names = c(NA, 25 | -10L), class = "data.frame") 26 | 27 | (m <- lm(Y~X1+X2, df, na.action = na.dummy)) 28 | m2 <- fix_predvars(m) 29 | attr(terms(m2), "predvars") 30 | predict(m2, newdata = data.frame(X1=2,X2=NA_real_)) 31 | 32 | } 33 | \references{ 34 | \url{https://stackoverflow.com/questions/54642599/impute-constant-and-create-missingness-dummy/54757973#54757973} 35 | } 36 | \author{ 37 | \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 38 | } 39 | -------------------------------------------------------------------------------- /man/read.directory.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/read.directory.R 3 | \name{read.directory} 4 | \alias{read.directory} 5 | \title{Bulk import data files} 6 | \usage{ 7 | read.directory( 8 | path = ".", 9 | pattern = NULL, 10 | reader = utils::read.csv, 11 | ..., 12 | reducer = NULL, 13 | recursive = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{path}{a character vector of full path names} 18 | 19 | \item{pattern}{an optional \link[=regex]{regular expression}. Only file names which match the regular expression will be returned.} 20 | 21 | \item{reader}{a function that can read data from a file name.} 22 | 23 | \item{...}{optional arguments to pass to the reader function (eg \code{stringsAsFactors}).} 24 | 25 | \item{reducer}{a function to unnest the individual data files. Use I to retain the nested structure.} 26 | 27 | \item{recursive}{logical. Should the listing recurse into directories?} 28 | } 29 | \description{ 30 | Read in each file at a path and then unnest them. Defaults to csv format. 31 | } 32 | \references{ 33 | \url{https://stackoverflow.com/questions/11433432/how-to-import-multiple-csv-files-at-once} 34 | } 35 | \author{ 36 | Neal Fultz 37 | } 38 | -------------------------------------------------------------------------------- /man/unscale.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/unscale.R 3 | \name{unscale} 4 | \alias{unscale} 5 | \title{Reverse a scale} 6 | \usage{ 7 | unscale(z, center = attr(z, "scaled:center"), scale = attr(z, "scaled:scale")) 8 | } 9 | \arguments{ 10 | \item{z}{a numeric matrix(like) object} 11 | 12 | \item{center}{either NULL or a numeric vector of length 13 | equal to the number of columns of z} 14 | 15 | \item{scale}{either NULL or a numeric vector of length 16 | equal to the number of columns of z} 17 | } 18 | \description{ 19 | Computes x = sz+c, which is the inverse of z = (x - c)/s 20 | provided by the \code{scale} function. 21 | } 22 | \examples{ 23 | mtcs <- scale(mtcars) 24 | 25 | all.equal( 26 | unscale(mtcs), 27 | as.matrix(mtcars), 28 | check.attributes=FALSE 29 | ) 30 | 31 | oldSeed <- .Random.seed 32 | z <- unscale(rnorm(10), 2, .5) 33 | .Random.seed <- oldSeed 34 | x <- rnorm(10, 2, .5) 35 | all.equal(z, x, check.attributes=FALSE) 36 | 37 | 38 | } 39 | \references{ 40 | \url{https://stackoverflow.com/questions/10287545/backtransform-scale-for-plotting/46840073} 41 | } 42 | \seealso{ 43 | \code{\link{scale}} 44 | } 45 | \author{ 46 | Neal Fultz 47 | } 48 | -------------------------------------------------------------------------------- /R/sincos.R: -------------------------------------------------------------------------------- 1 | #' sin/cos pairs for modeling 2 | #' 3 | #' Compute the sin and cos of x. 4 | #' 5 | #' @param x a vector 6 | #' @param period a scalar, which x is scaled by 7 | #' 8 | #' @return a matrix containing a _sin and _cos column 9 | #' 10 | #' @references \url{https://stackoverflow.com/questions/51874305/tuple-variable-in-r-regression-model/54393605#54393605} 11 | #' @author \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 12 | #' 13 | #' @examples 14 | #' 15 | #' data(sunspots) 16 | #' lm(sunspots~sincos(time(sunspots), 5/pi)) 17 | #' 18 | #' @export 19 | sincos <- function(x, period=168/2/pi) { 20 | a <- array(x %o% (1/period), dim=c(length(x), 2, length(period))) 21 | 22 | a[,1,] <- sin(a[,1,]) 23 | a[,2,] <- cos(a[,2,]) 24 | 25 | dim(a) <- c(length(x), 2 *length(period)) 26 | colnames(a) <- outer(c("_sin","_cos"), seq_along(period), paste, sep='.') 27 | 28 | structure(a, class="sincos", period=period) 29 | } 30 | 31 | #' @importFrom stats makepredictcall 32 | #' @export 33 | makepredictcall.sincos <- function(var, call){ 34 | if (as.character(call)[1L] != "sincos") 35 | return(call) 36 | call = match.call(sincos, call) 37 | call[["period"]] <- attr(var, "period") 38 | call 39 | } -------------------------------------------------------------------------------- /R/read.directory.R: -------------------------------------------------------------------------------- 1 | #' Bulk import data files 2 | #' 3 | #' Read in each file at a path and then unnest them. Defaults to csv format. 4 | #' 5 | #' @param path a character vector of full path names 6 | #' @param pattern an optional \link[=regex]{regular expression}. Only file names which match the regular expression will be returned. 7 | #' @param reader a function that can read data from a file name. 8 | #' @param ... optional arguments to pass to the reader function (eg \code{stringsAsFactors}). 9 | #' @param reducer a function to unnest the individual data files. Use I to retain the nested structure. 10 | #' @param recursive logical. Should the listing recurse into directories? 11 | #' 12 | #' @author Neal Fultz 13 | #' @references \url{https://stackoverflow.com/questions/11433432/how-to-import-multiple-csv-files-at-once} 14 | #' 15 | #' @export 16 | read.directory <- function(path='.', pattern=NULL, reader=utils::read.csv, ..., 17 | reducer=NULL, recursive=FALSE) { 18 | if(is.null(reducer)) reducer <- function(dfs) do.call(rbind.data.frame, dfs) 19 | files <- list.files(path, pattern, full.names = TRUE, recursive = recursive) 20 | 21 | reducer(lapply(files, reader, ...)) 22 | } 23 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | stackoverflow 0.1.4 2 | ---------------------------------------------------------------- 3 | 4 | This release adds the following functions: 5 | 6 | * Inverses of which and interaction 7 | 8 | 9 | stackoverflow 0.1.3 10 | ---------------------------------------------------------------- 11 | 12 | This release adds the following functions: 13 | 14 | * distribution functions for density objects 15 | 16 | * partial function evaluation / currying 17 | 18 | * a log-likelihood function for kmeans objects 19 | 20 | * resave a dataset 21 | 22 | * clone environments 23 | 24 | stackoverflow 0.1.2 25 | ---------------------------------------------------------------- 26 | 27 | This release only changes package metadata: 28 | 29 | * License is forward ported to CC-BY-SA 4.0 for CRAN acceptance; see 30 | http://meta.stackexchange.com/questions/214549/does-se-need-to-switch-to-cc-by-sa-4-0 31 | 32 | * Authors are now hyperlinked in documentation as required by 33 | http://blog.stackoverflow.com/2009/06/attribution-required/ 34 | 35 | 36 | stackoverflow 0.1.1 37 | ---------------------------------------------------------------- 38 | 39 | NEW FEATURES 40 | 41 | * bsearch7() provides a fast binary search for lower bound; supports character 42 | vectors. -------------------------------------------------------------------------------- /R/invinteraction.R: -------------------------------------------------------------------------------- 1 | #' Split an interaction'ed factor back into seperate variables 2 | #' 3 | #' Inverse of \code{interaction} 4 | #' 5 | #' @param fac the factor to split 6 | #' @param ... optional, names for variables 7 | #' @param sep the seperator between levels 8 | #' 9 | #' @return a data.frame of factors 10 | #' 11 | #' @section Changes: 12 | #' 13 | #' Refactored to process the levels vector, rather than entire factor vector. 14 | #' 15 | #' @author \href{http://stackoverflow.com/users/1855677/42}{42}, Neal Fultz 16 | #' @references \url{http://stackoverflow.com/a/10521926/986793} 17 | #' @seealso \code{\link[base]{interaction}} 18 | #' @export 19 | #' @examples 20 | #' 21 | #' f1 <- gl(2, 3) 22 | #' f2 <- gl(3, 2) 23 | #' invinteraction(f1:f2, sep=':') 24 | #' 25 | #' ppl <- interaction( 26 | #' eyes = as.factor(sample(colors(), 10)), 27 | #' hair = as.factor(sample(colors(), 10)) 28 | #' ) 29 | #' str(invinteraction(ppl, "eyes", "hair")) 30 | #' 31 | 32 | invinteraction <- function(fac, ..., sep='.') { 33 | 34 | stbl <- do.call(rbind.data.frame, strsplit(levels(fac), sep, TRUE)) 35 | stbl[] <- lapply(stbl, as.factor) 36 | 37 | colnames(stbl) <- if(missing(...)) paste0('V', seq_along(stbl)) else c(...) 38 | 39 | `rownames<-`(stbl[fac, , drop=FALSE], NULL) 40 | } -------------------------------------------------------------------------------- /R/invwhich.R: -------------------------------------------------------------------------------- 1 | #' Convert indices to logical vector 2 | #' 3 | #' Gives a logical vector which is TRUE for the indices provided 4 | #' 5 | #' @param ix an vector of indices 6 | #' @param n the length of the output vector; defaults to the maximum index 7 | #' @param nm (optional) names for the vector 8 | #' 9 | #' @return a logical vector of length \code{n} and names \code{nm} 10 | #' 11 | #' If \code{nm} is specified, \code{ix} may be a character vector instead. 12 | #' 13 | #' @section Changes: 14 | #' 15 | #' Rather than using a \code{useNames} logical to copy the names attribute from 16 | #' one vector to another, you may specify names via the \code{nm} argument. 17 | #' 18 | #' @author \href{http://stackoverflow.com/users/709529/nick-sabbe}{Nick Sabbe}, Neal Fultz 19 | #' @references \url{http://stackoverflow.com/a/7661128/986793} 20 | #' @seealso \code{\link[base]{interaction}} 21 | #' @export 22 | #' @examples 23 | #' 24 | #' x <- rnorm(50) > 1 25 | #' ix <- which(x) 26 | #' all.equal(x, invwhich(ix, 50)) 27 | #' 28 | #' all.equal( 29 | #' invwhich(grep('O', state.abb), 50), 30 | #' grepl('O', state.abb) 31 | #' ) 32 | 33 | invwhich <- function(ix, n=max(if(is.numeric(ix))ix, length(nm)), nm) { 34 | i <- logical(n) 35 | if(!missing(nm)) names(i) <- nm 36 | i[ix]<-TRUE 37 | i 38 | } 39 | 40 | -------------------------------------------------------------------------------- /man/invwhich.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/invwhich.R 3 | \name{invwhich} 4 | \alias{invwhich} 5 | \title{Convert indices to logical vector} 6 | \usage{ 7 | invwhich(ix, n = max(if (is.numeric(ix)) ix, length(nm)), nm) 8 | } 9 | \arguments{ 10 | \item{ix}{an vector of indices} 11 | 12 | \item{n}{the length of the output vector; defaults to the maximum index} 13 | 14 | \item{nm}{(optional) names for the vector} 15 | } 16 | \value{ 17 | a logical vector of length \code{n} and names \code{nm} 18 | 19 | If \code{nm} is specified, \code{ix} may be a character vector instead. 20 | } 21 | \description{ 22 | Gives a logical vector which is TRUE for the indices provided 23 | } 24 | \section{Changes}{ 25 | 26 | 27 | Rather than using a \code{useNames} logical to copy the names attribute from 28 | one vector to another, you may specify names via the \code{nm} argument. 29 | } 30 | 31 | \examples{ 32 | 33 | x <- rnorm(50) > 1 34 | ix <- which(x) 35 | all.equal(x, invwhich(ix, 50)) 36 | 37 | all.equal( 38 | invwhich(grep('O', state.abb), 50), 39 | grepl('O', state.abb) 40 | ) 41 | } 42 | \references{ 43 | \url{http://stackoverflow.com/a/7661128/986793} 44 | } 45 | \seealso{ 46 | \code{\link[base]{interaction}} 47 | } 48 | \author{ 49 | \href{http://stackoverflow.com/users/709529/nick-sabbe}{Nick Sabbe}, Neal Fultz 50 | } 51 | -------------------------------------------------------------------------------- /man/rdensity.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rdensity.R 3 | \name{ddensity} 4 | \alias{ddensity} 5 | \alias{pdensity} 6 | \alias{qdensity} 7 | \alias{rdensity} 8 | \title{Distribution methods for density objects} 9 | \usage{ 10 | ddensity(x, d) 11 | 12 | pdensity(q, d) 13 | 14 | qdensity(p, d) 15 | 16 | rdensity(n, d) 17 | } 18 | \arguments{ 19 | \item{x}{a vector} 20 | 21 | \item{d}{a \code{density} object} 22 | 23 | \item{q}{a vector} 24 | 25 | \item{p}{a vector of probabilities} 26 | 27 | \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number of required} 28 | } 29 | \description{ 30 | Density, distribution function, quantile function and random generation 31 | from a kernel density estimate (using linear approximation). 32 | } 33 | \examples{ 34 | x <- rnorm(100, mean=0:5) 35 | d <- density(x) 36 | r <- rdensity(10000, d) 37 | plot(d) 38 | lines(density(r), new=TRUE, col='blue', lty='dashed') 39 | } 40 | \references{ 41 | \url{http://stackoverflow.com/questions/32871602/r-generate-data-from-a-probability-density-distribution} 42 | } 43 | \seealso{ 44 | \code{\link[stats]{density}} 45 | 46 | \code{\link[stats]{approxfun}} 47 | 48 | \code{\link[ks]{rkde}} 49 | } 50 | \author{ 51 | \href{http://stackoverflow.com/users/295691/user295691}{user295691}, 52 | Neal Fultz 53 | } 54 | -------------------------------------------------------------------------------- /R/classMethods.R: -------------------------------------------------------------------------------- 1 | #' List all methods for an object 2 | #' 3 | #' The built-in methods() function will give all available methods for a specified class, 4 | #' or for a specified generic function, but not for an object. Objects can have multiple 5 | #' classes, so this can be complicated to calculate. 6 | #' 7 | #' @param cl a vector of class names, or an object 8 | #' 9 | #' @examples 10 | #' g <- glm(y~x,data=data.frame(x=1:10,y=1:10)) 11 | #' classMethods(g) 12 | #### 13 | #' 14 | #' @importFrom utils methods 15 | #' @export 16 | #' @author \href{http://stackoverflow.com/users/2372064/mrflick}{MrFlick} 17 | #' @references \url{http://stackoverflow.com/questions/23840404/function-to-return-all-s3-methods-applicable-to-an-object} 18 | classMethods <- function(cl) { 19 | if(!is.character(cl)) { 20 | cl<-class(cl) 21 | } 22 | ml<-lapply(cl, function(x) { 23 | sname <- gsub("([.[])", "\\\\\\1", paste0(".", x, "$")) 24 | m <- methods(class=x) 25 | data.frame( 26 | m=as.vector(m), 27 | c=x, n=sub(sname, "", as.vector(m)), 28 | attr(m,"info"), 29 | stringsAsFactors=F 30 | ) 31 | }) 32 | df<-do.call(rbind, ml) 33 | df<-df[!duplicated(df$n),] 34 | structure(df$m, 35 | byclass=FALSE, 36 | info=data.frame(visible=df$visible, from=df$from, row.names = df$m), 37 | class="MethodsFunction") 38 | } -------------------------------------------------------------------------------- /man/match.call.defaults.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/match.call.default.R 3 | \name{match.call.defaults} 4 | \alias{match.call.defaults} 5 | \title{Argument matching with defaults} 6 | \usage{ 7 | match.call.defaults( 8 | definition = sys.function(sys.parent()), 9 | call = sys.call(sys.parent()), 10 | expand.dots = TRUE, 11 | envir = parent.frame(2L) 12 | ) 13 | } 14 | \arguments{ 15 | \item{definition}{a function, by default the function from which match.call is called. See details.} 16 | 17 | \item{call}{an unevaluated call to the function specified by definition, as generated by call.} 18 | 19 | \item{expand.dots}{ogical. Should arguments matching \code{...} in the call be included or left as a \code{...} argument?} 20 | 21 | \item{envir}{an environment, from which the \code{...} in call are retrieved, if any.} 22 | } 23 | \value{ 24 | An object of class call. 25 | } 26 | \description{ 27 | This is a version of \code{\link{match.call}} which also includes default arguments. 28 | } 29 | \examples{ 30 | 31 | foo <- function(x=NULL,y=NULL,z=4, dots=TRUE, ...) { 32 | match.call.defaults(expand.dots=dots) 33 | } 34 | 35 | foo(4,nugan='hand') 36 | foo(dots=FALSE,who='ami') 37 | 38 | } 39 | \references{ 40 | \url{http://stackoverflow.com/questions/14397364/match-call-with-default-arguments/} 41 | } 42 | \author{ 43 | Neal Fultz 44 | } 45 | -------------------------------------------------------------------------------- /man/bag.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/bag.R 3 | \name{bag} 4 | \alias{bag} 5 | \title{Multi-indicators / "Bag o Words"} 6 | \usage{ 7 | bag(..., prefix = ".", levels = NULL) 8 | } 9 | \arguments{ 10 | \item{...}{the columns to bag} 11 | 12 | \item{prefix}{a prefix for the column names} 13 | 14 | \item{levels}{levels shared among all columns} 15 | } 16 | \value{ 17 | a n*p indicator matrix 18 | } 19 | \description{ 20 | This creates an indicator matrix from several columns. 21 | } 22 | \examples{ 23 | 24 | df2 <- structure(list(Dx1 = c("231", "231", "001", "245", "231", "001", 25 | "231", "001", "231", "001", "001", "245", "001", "231", "245", 26 | "245", "001", "231", "245", "001"), Dx2 = c("001", "001", "001", 27 | "001", "001", "001", "001", "234", "001", "234", "001", "001", 28 | "001", "001", "001", "777", "777", "234", "001", "234"), Dx3 = c("456", 29 | "001", "444", "444", "001", "001", "444", "001", "001", "001", 30 | "444", "001", "444", "456", "456", "444", "444", "456", "001", 31 | "456")), class = "data.frame", row.names = c(NA, -20L)) 32 | 33 | Y <- 1:nrow(df2) 34 | m <- lm(Y~bag(Dx1, Dx2, Dx3), df2) 35 | summary(m) 36 | 37 | 38 | 39 | 40 | } 41 | \references{ 42 | \url{https://stackoverflow.com/questions/47055856/search-multiple-columns-for-string-to-set-indicator-variable/57381877#57381877} 43 | } 44 | \author{ 45 | \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 46 | } 47 | -------------------------------------------------------------------------------- /R/lsos.R: -------------------------------------------------------------------------------- 1 | #' Improved list of objects 2 | #' 3 | #' @param ... to be passed along to internal 4 | #' @param n to be given to head 5 | #' 6 | #' @importFrom utils object.size 7 | #' @export 8 | #' @author \href{http://stackoverflow.com/users/143305/dirk-eddelbuettel}{Dirk Eddelbuettel} 9 | #' @references \url{http://stackoverflow.com/questions/1358003/tricks-to-manage-the-available-memory-in-an-r-session} 10 | lsos <- function(..., n=10) { 11 | .ls.objects(..., order.by="Size", decreasing=TRUE, head=TRUE, n=n) 12 | } 13 | 14 | # improved list of objects 15 | .ls.objects <- function (pos = 1, pattern, order.by, 16 | decreasing=FALSE, head=FALSE, n=5) { 17 | napply <- function(names, fn) sapply(names, function(x) 18 | fn(get(x, pos = pos))) 19 | names <- ls(pos = pos, pattern = pattern) 20 | obj.class <- napply(names, function(x) as.character(class(x))[1]) 21 | obj.mode <- napply(names, mode) 22 | obj.type <- ifelse(is.na(obj.class), obj.mode, obj.class) 23 | obj.size <- napply(names, object.size) 24 | obj.dim <- t(napply(names, function(x) 25 | as.numeric(dim(x))[1:2])) 26 | vec <- is.na(obj.dim)[, 1] & (obj.type != "function") 27 | obj.dim[vec, 1] <- napply(names, length)[vec] 28 | out <- data.frame(obj.type, obj.size, obj.dim) 29 | names(out) <- c("Type", "Size", "Rows", "Columns") 30 | if (!missing(order.by)) 31 | out <- out[order(out[[order.by]], decreasing=decreasing), ] 32 | if (head) 33 | out <- head(out, n) 34 | out 35 | } 36 | -------------------------------------------------------------------------------- /R/unscale.R: -------------------------------------------------------------------------------- 1 | #' Reverse a scale 2 | #' 3 | #' Computes x = sz+c, which is the inverse of z = (x - c)/s 4 | #' provided by the \code{scale} function. 5 | #' 6 | #' 7 | #' @param z a numeric matrix(like) object 8 | #' 9 | #' @param center either NULL or a numeric vector of length 10 | #' equal to the number of columns of z 11 | #' 12 | #' @param scale either NULL or a numeric vector of length 13 | #' equal to the number of columns of z 14 | #' 15 | #' @seealso \code{\link{scale}} 16 | #' 17 | #' @examples 18 | #' mtcs <- scale(mtcars) 19 | #' 20 | #' all.equal( 21 | #' unscale(mtcs), 22 | #' as.matrix(mtcars), 23 | #' check.attributes=FALSE 24 | #' ) 25 | #' 26 | #' oldSeed <- .Random.seed 27 | #' z <- unscale(rnorm(10), 2, .5) 28 | #' .Random.seed <- oldSeed 29 | #' x <- rnorm(10, 2, .5) 30 | #' all.equal(z, x, check.attributes=FALSE) 31 | #' 32 | #' 33 | #' @author Neal Fultz 34 | #' @references \url{https://stackoverflow.com/questions/10287545/backtransform-scale-for-plotting/46840073} 35 | #' 36 | #' @export 37 | unscale <- function(z, center = attr(z, "scaled:center"), scale = attr(z, "scaled:scale")) { 38 | z <- as.matrix(z) 39 | if (!is.null(scale)) z <- sweep(z, 2, scale, `*`) 40 | if (!is.null(center)) z <- sweep(z, 2, center, `+`) 41 | structure(z, 42 | "scaled:center" = NULL, 43 | "scaled:scale" = NULL, 44 | "unscaled:center" = center, 45 | "unscaled:scale" = scale 46 | ) 47 | } 48 | 49 | -------------------------------------------------------------------------------- /R/match.call.default.R: -------------------------------------------------------------------------------- 1 | 2 | #' Argument matching with defaults 3 | #' 4 | #' This is a version of \code{\link{match.call}} which also includes default arguments. 5 | #' 6 | #' @param definition a function, by default the function from which match.call is called. See details. 7 | #' @param call an unevaluated call to the function specified by definition, as generated by call. 8 | #' @param expand.dots ogical. Should arguments matching \code{...} in the call be included or left as a \code{...} argument? 9 | #' @param envir an environment, from which the \code{...} in call are retrieved, if any. 10 | #' 11 | #' @return An object of class call. 12 | #' 13 | #' @author Neal Fultz 14 | #' @references \url{http://stackoverflow.com/questions/14397364/match-call-with-default-arguments/} 15 | #' @export 16 | #' 17 | #' @examples 18 | #' 19 | #' foo <- function(x=NULL,y=NULL,z=4, dots=TRUE, ...) { 20 | #' match.call.defaults(expand.dots=dots) 21 | #' } 22 | #' 23 | #' foo(4,nugan='hand') 24 | #' foo(dots=FALSE,who='ami') 25 | #' 26 | 27 | match.call.defaults <- function(definition = sys.function(sys.parent()), 28 | call = sys.call(sys.parent()), 29 | expand.dots = TRUE, 30 | envir = parent.frame(2L)) { 31 | call <- match.call(definition, call, expand.dots, envir) 32 | formals <- formals(definition) 33 | 34 | if(expand.dots && '...' %in% names(formals)) 35 | formals[['...']] <- NULL 36 | 37 | for(i in setdiff(names(formals), names(call))) 38 | call[i] <- list( formals[[i]] ) 39 | 40 | 41 | match.call(definition, call, TRUE, envir) 42 | } 43 | 44 | -------------------------------------------------------------------------------- /R/rdensity.R: -------------------------------------------------------------------------------- 1 | #' Distribution methods for density objects 2 | #' 3 | #' Density, distribution function, quantile function and random generation 4 | #' from a kernel density estimate (using linear approximation). 5 | #' 6 | #' @param d a \code{density} object 7 | #' 8 | #' @author \href{http://stackoverflow.com/users/295691/user295691}{user295691}, 9 | #' Neal Fultz 10 | #' @references \url{http://stackoverflow.com/questions/32871602/r-generate-data-from-a-probability-density-distribution} 11 | #' 12 | #' @seealso \code{\link[stats]{density}} 13 | #' @seealso \code{\link[stats]{approxfun}} 14 | #' @seealso \code{\link[ks]{rkde}} 15 | #' 16 | #' @importFrom stats approx runif 17 | #' 18 | #' @examples 19 | #' x <- rnorm(100, mean=0:5) 20 | #' d <- density(x) 21 | #' r <- rdensity(10000, d) 22 | #' plot(d) 23 | #' lines(density(r), new=TRUE, col='blue', lty='dashed') 24 | 25 | #' @param x a vector 26 | #' @export 27 | #' @rdname rdensity 28 | ddensity <- function(x, d) approx(d$x, d$y, x, yleft=0, yright=0)$y 29 | 30 | #' @param q a vector 31 | #' @export 32 | #' @rdname rdensity 33 | pdensity <- function(q, d) approx(d$x, cdf(d$y), q, yleft=0, yright=1)$y 34 | 35 | #' @param p a vector of probabilities 36 | #' @export 37 | #' @rdname rdensity 38 | qdensity <- function(p, d) approx(cdf(d$y), d$x, p, yleft=-Inf, yright=Inf)$y 39 | 40 | #' @param n number of observations. If \code{length(n) > 1}, the length is taken to be the number of required 41 | #' @export 42 | #' @rdname rdensity 43 | rdensity <- function(n, d) qdensity(runif(n), d) 44 | 45 | 46 | 47 | cdf <- function(x) { 48 | x <- cumsum(x) 49 | x / x[length(x)] 50 | } -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(logLik,kmeans) 4 | S3method(makepredictcall,bag) 5 | S3method(makepredictcall,na.dummy) 6 | S3method(makepredictcall,sincos) 7 | S3method(na.dummy,data.frame) 8 | S3method(na.dummy,numeric) 9 | S3method(t,list) 10 | export(Comment) 11 | export(Mode) 12 | export(Tarone.test) 13 | export(approxAUC) 14 | export(approxpDirichlet) 15 | export(bag) 16 | export(bsearch7) 17 | export(calcBMI) 18 | export(chunk2) 19 | export(clamp) 20 | export(classMethods) 21 | export(coalesce) 22 | export(copyEnv) 23 | export(cor2cov) 24 | export(ddensity) 25 | export(duplicated2) 26 | export(enumerate) 27 | export(fix_predvars) 28 | export(flatten2) 29 | export(frontier) 30 | export(horner.poly) 31 | export(horner.rational) 32 | export(invinteraction) 33 | export(invwhich) 34 | export(is.knitr.in.progress) 35 | export(is.rstudio) 36 | export(is.rstudio.console) 37 | export(is_inst) 38 | export(lsos) 39 | export(match.call.defaults) 40 | export(na.dummy) 41 | export(parseLDAP) 42 | export(partial) 43 | export(pdensity) 44 | export(permutations) 45 | export(qdensity) 46 | export(randomRows) 47 | export(rcweibull) 48 | export(rdensity) 49 | export(read.directory) 50 | export(readkey) 51 | export(reflect_triangle) 52 | export(replace_null_recursively) 53 | export(resave) 54 | export(rsplit) 55 | export(sincos) 56 | export(split_path) 57 | export(sprintf_named) 58 | export(strReverse) 59 | export(substituteExpr) 60 | export(trim_leading) 61 | export(trim_trailing) 62 | export(unique_columns) 63 | export(unscale) 64 | export(zip2) 65 | importFrom(stats,approx) 66 | importFrom(stats,makepredictcall) 67 | importFrom(stats,na.action) 68 | importFrom(stats,pnorm) 69 | importFrom(stats,rexp) 70 | importFrom(stats,rgamma) 71 | importFrom(stats,runif) 72 | importFrom(stats,setNames) 73 | importFrom(stats,terms) 74 | importFrom(utils,methods) 75 | importFrom(utils,object.size) 76 | -------------------------------------------------------------------------------- /R/bag.R: -------------------------------------------------------------------------------- 1 | #' Multi-indicators / "Bag o Words" 2 | #' 3 | #' This creates an indicator matrix from several columns. 4 | #' 5 | #' @param ... the columns to bag 6 | #' @param prefix a prefix for the column names 7 | #' @param levels levels shared among all columns 8 | #' 9 | #' @return a n*p indicator matrix 10 | #' 11 | #' 12 | #' @references \url{https://stackoverflow.com/questions/47055856/search-multiple-columns-for-string-to-set-indicator-variable/57381877#57381877} 13 | #' @author \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 14 | #' 15 | #' @examples 16 | #' 17 | #' df2 <- structure(list(Dx1 = c("231", "231", "001", "245", "231", "001", 18 | #' "231", "001", "231", "001", "001", "245", "001", "231", "245", 19 | #' "245", "001", "231", "245", "001"), Dx2 = c("001", "001", "001", 20 | #' "001", "001", "001", "001", "234", "001", "234", "001", "001", 21 | #' "001", "001", "001", "777", "777", "234", "001", "234"), Dx3 = c("456", 22 | #' "001", "444", "444", "001", "001", "444", "001", "001", "001", 23 | #' "444", "001", "444", "456", "456", "444", "444", "456", "001", 24 | #' "456")), class = "data.frame", row.names = c(NA, -20L)) 25 | #' 26 | #' Y <- 1:nrow(df2) 27 | #' m <- lm(Y~bag(Dx1, Dx2, Dx3), df2) 28 | #' summary(m) 29 | #' 30 | #' 31 | #' 32 | #' 33 | #' @importFrom stats setNames 34 | #' @export 35 | bag <- function(..., prefix=".", levels=NULL) { 36 | 37 | # Go from multiple columns to list of vectors 38 | bags <- mapply(c, ..., SIMPLIFY = FALSE, USE.NAMES = FALSE) 39 | 40 | # Find unique levels 41 | if(is.null(levels)) { 42 | levels <- sort(Reduce(union, bags)) 43 | 44 | # names persist through outer 45 | names(levels) <- paste0(prefix, levels) 46 | } 47 | 48 | # Calculate out[level,bag] = level %in% bag 49 | out <- outer(levels, bags, Vectorize(`%in%`)) 50 | 51 | # Output a data structure 52 | structure(+t(out), class='bag', levels=levels, prefix=prefix) 53 | } 54 | 55 | 56 | 57 | #' @export 58 | makepredictcall.bag <- function(var, call){ 59 | # Stolen from splines package 60 | if (as.character(call)[1L] != "bag") 61 | return(call) 62 | args <- c("prefix", "levels") 63 | 64 | 65 | at <- attributes(var)[args] 66 | xxx <- call 67 | xxx[args] <- NULL 68 | xxx[names(at)] <- at 69 | xxx 70 | } -------------------------------------------------------------------------------- /R/na_dummy.R: -------------------------------------------------------------------------------- 1 | #' Handle Missing Values with Fill + Dummy 2 | #' 3 | #' Handles missing values by filling in with mean, and adding a dummy variable. 4 | #' 5 | #' @param object an R object, typically a data.frame 6 | #' @param ... other arguments (not used) 7 | #' 8 | #' @references \url{https://stackoverflow.com/questions/54642599/impute-constant-and-create-missingness-dummy/54757973#54757973} 9 | #' @author \href{https://stackoverflow.com/users/986793/neal-fultz}{Neal Fultz} 10 | #' 11 | #' @examples 12 | #' 13 | #' df <- structure(list(Y = c(3.83, 22.73, 13.85, 14.09, 20.55, 18.51, 14 | #' 17.76, 9.42, 15.88, 27.81), X1 = 1:10, X2 = c(2L, NA, NA, 4L, 15 | #' 8L, 7L, 6L, 1L, 3L, 9L)), .Names = c("Y", "X1", "X2"), row.names = c(NA, 16 | #' -10L), class = "data.frame") 17 | #' 18 | #' (m <- lm(Y~X1+X2, df, na.action = na.dummy)) 19 | #' m2 <- fix_predvars(m) 20 | #' attr(terms(m2), "predvars") 21 | #' predict(m2, newdata = data.frame(X1=2,X2=NA_real_)) 22 | #' 23 | #' @export 24 | na.dummy <- function(object, ...) { 25 | UseMethod("na.dummy", object) 26 | } 27 | 28 | #' @export 29 | na.dummy.numeric <- function(object, ..., m=mean(object, na.rm=TRUE)) { 30 | i <- is.na(object) 31 | 32 | structure(cbind(replace(object, i, m), `NA`=+i), 33 | class='na.dummy', m=m) 34 | } 35 | 36 | #' @export 37 | na.dummy.data.frame <- function(object, ...) { 38 | 39 | w <- vapply(object, anyNA, TRUE) 40 | cm <- rep(NA, length(object)) 41 | 42 | for(j in which(w)) { 43 | object[[j]] <- na.dummy(object[[j]]) 44 | cm[j] <- attr(object[[j]], 'm') 45 | } 46 | 47 | structure(object, na.action=structure(cm, class='dummy')) 48 | } 49 | 50 | #' @importFrom stats terms na.action 51 | #' @export 52 | #' @rdname na.dummy 53 | fix_predvars <- function(object){ 54 | 55 | 56 | pv <- attr(terms(object), "predvars") 57 | 58 | cm <- na.action(object) 59 | 60 | 61 | for(j in seq_along(cm)) { 62 | if(is.na(cm[j])) next 63 | 64 | newpv <- quote(na.dummy()) 65 | newpv[[2]] <- pv[[j+1]] 66 | newpv[["m"]] <- cm[j] 67 | pv[[j+1]] <- newpv 68 | 69 | } 70 | attr(object$terms, 'predvars') <- pv 71 | 72 | object 73 | } 74 | 75 | #' @importFrom stats makepredictcall 76 | #' @export 77 | makepredictcall.na.dummy <- function(var, call){ 78 | if (as.character(call)[1L] != "na.dummy") 79 | return(call) 80 | call["m"] <- attr(var, "m") 81 | call 82 | } 83 | -------------------------------------------------------------------------------- /R/Tarone.R: -------------------------------------------------------------------------------- 1 | #' Tarone's Z Test 2 | #' 3 | #' Tests the goodness of fit of the binomial distribution. 4 | #' 5 | #' @param M Counts 6 | #' @param N Trials 7 | #' 8 | #' @return a \code{htest} object 9 | #' 10 | #' @author \href{https://stats.stackexchange.com/users/173082/reinstate-monica}{Ben O'Neill} 11 | #' @references \url{https://stats.stackexchange.com/a/410376/6378} and 12 | #' R. E. TARONE, Testing the goodness of fit of the binomial distribution, Biometrika, Volume 66, Issue 3, December 1979, Pages 585–590, \url{https://doi.org/10.1093/biomet/66.3.585} 13 | #' @importFrom stats pnorm 14 | #' @export 15 | #' @examples 16 | #' #Generate example data 17 | #' N <- c(30, 32, 40, 28, 29, 35, 30, 34, 31, 39) 18 | #' M <- c( 9, 10, 22, 15, 8, 19, 16, 19, 15, 10) 19 | #' Tarone.test(N, M) 20 | Tarone.test <- function(N, M) { 21 | 22 | #Check validity of inputs 23 | if(!(all(N == as.integer(N)))) { stop("Error: Number of trials should be integers"); } 24 | if(min(N) < 1) { stop("Error: Number of trials should be positive"); } 25 | if(!(all(M == as.integer(M)))) { stop("Error: Count values should be integers"); } 26 | if(min(M) < 0) { stop("Error: Count values cannot be negative"); } 27 | if(any(M > N)) { stop("Error: Observed count value exceeds number of trials"); } 28 | 29 | #Set description of test and data 30 | method <- "Tarone's Z test"; 31 | data.name <- paste0(deparse(substitute(M)), " successes from ", 32 | deparse(substitute(N)), " trials"); 33 | 34 | #Set null and alternative hypotheses 35 | null.value <- 0; 36 | attr(null.value, "names") <- "dispersion parameter"; 37 | alternative <- "greater"; 38 | 39 | #Calculate test statistics 40 | estimate <- sum(M)/sum(N); 41 | attr(estimate, "names") <- "proportion parameter"; 42 | S <- ifelse(estimate == 1, sum(N), 43 | sum((M - N*estimate)^2/(estimate*(1 - estimate)))); 44 | statistic <- (S - sum(N))/sqrt(2*sum(N*(N-1))); 45 | attr(statistic, "names") <- "z"; 46 | 47 | #Calculate p-value 48 | p.value <- 2*pnorm(-abs(statistic), 0, 1); 49 | attr(p.value, "names") <- NULL; 50 | 51 | #Create htest object 52 | TEST <- list(method = method, data.name = data.name, 53 | null.value = null.value, alternative = alternative, 54 | estimate = estimate, statistic = statistic, p.value = p.value); 55 | class(TEST) <- "htest"; 56 | TEST; 57 | } -------------------------------------------------------------------------------- /data/bat_passes.R: -------------------------------------------------------------------------------- 1 | # 2 | # nausicaa (https://stats.stackexchange.com/users/190274/nausicaa), poisson glm to observe whether effects of artificial light on the number of bat passes in each location were significant, URL (version: 2018-03-09): https://stats.stackexchange.com/q/325334 3 | 4 | 5 | 6 | 7 | bat_passes <- structure(list( 8 | Location = structure(c(3L, 3L, 3L, 3L, 3L, 3L, 9 | 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 10 | 5L, 5L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 11 | 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 12 | 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 1L, 1L, 1L, 1L, 1L, 1L, 13 | 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Forest", 14 | "Grace", "Martinshaw", "Old", "Swithland"), class = "factor"), 15 | Al.N = structure(c(2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 16 | 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 17 | 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 18 | 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 19 | 1L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 20 | 1L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L), .Label = c("Dark", 21 | "light"), class = "factor"), 22 | Buzzes = c(2L, 4L, 3L, 2L, 88L, 23 | 68L, 1L, 63L, 3L, 1L, 20L, 15L, 24L, 24L, 17L, 15L, 0L, 0L, 24 | 2L, 6L, 8L, 3L, 5L, 7L, 6L, 2L, 2L, 2L, 7L, 4L, 5L, 4L, 7L, 25 | 10L, 5L, 0L, 5L, 1L, 4L, 3L, 1L, 0L, 0L, 2L, 28L, 32L, 2L, 26 | 21L, 2L, 2L, 6L, 3L, 17L, 22L, 31L, 29L, 0L, 9L, 3L, 3L, 27 | 2L, 1L, 13L, 11L, 14L, 9L, 31L, 16L, 2L, 1L, 0L, 2L, 18L, 28 | 29L, 22L, 3L, 18L, 2L, 15L, 6L), 29 | Passes = c(37L, 48L, 34L, 30 | 28L, 279L, 216L, 7L, 198L, 29L, 17L, 154L, 120L, 68L, 134L, 31 | 157L, 144L, 5L, 19L, 45L, 67L, 72L, 48L, 51L, 58L, 48L, 23L, 32 | 25L, 20L, 39L, 25L, 23L, 34L, 53L, 57L, 48L, 26L, 57L, 25L, 33 | 17L, 29L, 15L, 12L, 9L, 24L, 61L, 79L, 8L, 84L, 40L, 46L, 34 | 55L, 46L, 50L, 98L, 104L, 99L, 24L, 93L, 74L, 54L, 15L, 39L, 35 | 45L, 61L, 123L, 150L, 376L, 104L, 24L, 35L, 15L, 32L, 125L, 36 | 156L, 107L, 47L, 142L, 51L, 59L, 35L), 37 | Date = structure(c(4L, 38 | 19L, 35L, 13L, 2L, 21L, 34L, 15L, 39L, 16L, 33L, 10L, 37L, 39 | 17L, 32L, 11L, 14L, 30L, 6L, 25L, 12L, 31L, 6L, 27L, 7L, 40 | 24L, 38L, 18L, 5L, 26L, 36L, 20L, 9L, 28L, 3L, 22L, 8L, 29L, 41 | 1L, 23L, 4L, 19L, 35L, 13L, 2L, 21L, 34L, 15L, 39L, 16L, 42 | 33L, 10L, 37L, 17L, 32L, 11L, 14L, 30L, 6L, 25L, 12L, 31L, 43 | 6L, 27L, 7L, 24L, 38L, 18L, 5L, 26L, 36L, 20L, 9L, 28L, 3L, 44 | 22L, 8L, 29L, 1L, 23L), .Label = c("01/09/2017", "02/08/2017", 45 | "02/09/2017", "03/08/2017", "04/08/2017", "04/09/2017", "05/08/2017", 46 | "06/08/2017", "07/08/2017", "07/09/2017", "08/09/2017", "09/08/2017", 47 | "09/09/2017", "10/08/2017", "10/09/2017", "11/08/2017", "12/08/2017", 48 | "12/09/2017", "13/08/2017", "13/09/2017", "14/08/2017", "14/09/2017", 49 | "15/09/2017", "16/08/2017", "16/09/2017", "17/08/2017", "17/09/2017", 50 | "18/08/2017", "19/08/2017", "21/08/2017", "22/08/2017", "25/08/2017", 51 | "26/08/2017", "27/08/2017", "28/08/2017", "29/08/2017", "30/07/2017", 52 | "30/08/2017", "31/07/2017"), class = "factor")), 53 | .Names = c("Location", "Al.N", "Buzzes", "Passes", "Date"), 54 | class = "data.frame", row.names = c(NA, -80L)) 55 | --------------------------------------------------------------------------------