r 我的.Rprofile

Posted 2021-05-24

# Place in /Users/Username/.Rprofile
"
sys.source('~/Dropbox/appdata/Rprofile.r')
"


## Create a new invisible environment for all the functions to go in so it doesn't clutter your workspace.
.env <- new.env()


# Annoying syntax
install <- function(l) {
  install.packages(l)
}

library(devtools)
library(ggplot2)
library(plyr)
library(dplyr)
library(stringr)
library(knitr)
library(reshape2)
library(BiocInstaller)


# Load BiocLite
source("http://bioconductor.org/biocLite.R")

install <- function(t) {
  biocLite(as.character(substitute(t)))
}


#-----------------------------------------------------------------------
#                             Functions
#-----------------------------------------------------------------------

## Single character shortcuts for summary() and head().
.env$s <- base::summary
.env$h <- utils::head

## Strip row names from a data frame (stolen from plyr)
.env$unrowname <- function(x) {
    rownames(x) <- NULL
    x
}


## List all functions in a package (also from @_inundata)
.env$lsp <- function(package, all.names = FALSE, pattern) {
    package <- deparse(substitute(package))
    ls(
        pos = paste("package", package, sep = ":"),
        all.names = all.names,
        pattern = pattern
    )
}

## Open Finder to the current directory on mac
.env$macopen <- function(...) if(Sys.info()[1]=="Darwin") system("open .")
.env$o       <- function(...) if(Sys.info()[1]=="Darwin") system("open .")

## Transpose a numeric data frame with ID in first column
.env$tdf <- function(d) {
    row.names(d) <- d[[1]]
	d[[1]] <- NULL
	d <- as.data.frame(t(d))
    d$id <- row.names(d)
    d <- cbind(d[ncol(d)], d[-ncol(d)])
    row.names(d) <- NULL
    d
}

z.test = function(a, mu, var){
  zeta = (mean(a) - mu) / (sqrt(var / length(a)))
  return(zeta)
}
 
## Convert selected columns of a data frame to factor variables
.env$factorcols <- function(d, ...) lapply(d, function(x) factor(x, ...)) 
 
## Returns a logical vector TRUE for elements of X not in Y
"%nin%" <- function(x, y) !(x %in% y) 

# Order variables in a data frame.

corder <- function(df,...) {
  cols <-as.vector(eval(substitute((alist(...)))),mode="character")
  stopifnot(is.data.frame(df))
  df[,c(cols,unlist(setdiff(names(df),cols)))]
}

# Drop Variables from a data frame.
# Usage:
# df <- cdrop(df, <list of vars to drop>)

.env$cdrop <- function(df, ...) {
  cols <-as.vector(eval(substitute((alist(...)))),mode="character")
  stopifnot(is.data.frame(df))
  df[,c(unlist(setdiff(names(df),cols)))]
}

# Preview a data frame in Excel [Only works on Mac]
.env$excel <- function(df) {
  f <- paste0(tempdir(),'/', make.names(deparse(substitute(df))),'.',paste0(sample(letters)[1:5],collapse=""), '.csv')
  write.csv(df,f)
  system(sprintf("open -a 'Microsoft Excel' %s",f))
}

# Sample a random set of rows
.env$randomRows = function(df,n){
  return(df[sample(nrow(df),n),])
}


.env$pp <- function(header = TRUE, ...) {
  # Taken from the psych package; Thank you William Revelle!
  # Type pp() to fetch data from the clipboard.
    MAC <- Sys.info()[1] == "Darwin"
    if (!MAC) {
        if (header) 
            return(read.table(file("clipboard"), header = TRUE, 
                ...))
        else return(read.table(file("clipboard"), ...))
    }
    else {
        if (header) {
            return(read.table(pipe("pbpaste"), header = TRUE, 
                ...))
        }
        else {
            return(read.table(pipe("pbpaste"), ...))
        }
    }
}



attach(.env)
message("\n******************************\nSuccessfully loaded Rprofile.r\n******************************")