Build a RStudio addin to debug pipe chains - r

I wrote a function that helps executing pipe chains step by step.
To use it the users has to copy the instruction to clipboard, then execute the function, and move to the console to proceed.
I would like to build an addin that would allow me to select the instructions and run the function with Ctrl + P without the awkward steps.
Ideally, the addin would :
capture the selection
run the function
move the cursor to the console
be triggered by Ctrl + P
I believe it's extremely similar to what the reprex addin is doing but I don't know where to start as I'm 100% new to addins.
I looked into rstudioapi::getActiveDocumentContext() but there was nothing there of interest to me.
How can I make this work ?
The function
debug_pipe <- function(.expr){
.pchain <-
if (missing(.expr)) readClipboard() # windows only , else try clipr::read_clip()
else deparse(substitute(.expr))
.lhs <- if (grepl("^\\s*[[:alnum:]_.]*\\s*<-",.pchain[1])) {
sub("^\\s*([[:alnum:]_.]*)\\s*<-.*","\\1",.pchain[1])
} else NA
.pchain <- sub("[^%]*<-\\s*","",.pchain) # remove lhs of assignment if exists
.pchain <- paste(.pchain,collapse = " ") # collapse
.pchain <- gsub("\\s+"," ",.pchain) # multiple spaces to single
.pchain <- strsplit(.pchain,"\\s*%>%\\s*")[[1]] # split by pipe
.pchain <- as.list(.pchain)
for (i in rev(seq_along(.pchain))) {
# function to count matches
.f <- function(x) sum(gregexpr(x,.pchain[i],fixed = TRUE)[[1]] != -1)
# check if unbalanced operators
.balanced <-
all(c(.f("{"),.f("("),.f("[")) == c(.f("}"),.f(")"),.f("]"))) &
!.f("'") %% 2 &
!.f('"') %% 2
if (!.balanced) {
# if unbalanced, combine with previous
.pchain[[i - 1]] <- paste(.pchain[[i - 1]],"%>%", .pchain[[i]])
.pchain[[i]] <- NULL
}
}
.calls <- Reduce( # build calls to display
function(x,y) paste0(x," %>%\n ",y),
.pchain, accumulate = TRUE)
.xinit <- eval(parse(text = .pchain[1]))
.values <- Reduce(function(x,y){ # compute all values
if (inherits(x,"try-error")) NULL
else try(eval(parse(text = paste("x %>%", y))),silent = TRUE)},
.pchain[-1], .xinit, accumulate = TRUE)
message("press enter to show, 's' to skip, 'q' to quit, lhs can be accessed with `.`")
for (.i in (seq_along(.pchain))) {
cat("\n",.calls[.i])
.rdl_ <- readline()
. <- .values[[.i]]
# while environment is explored
while (!.rdl_ %in% c("q","s","")) {
# if not an assignment, should be printed
if (!grepl("^\\s*[[:alnum:]_.]*\\s*<-",.rdl_)) .rdl_ <- paste0("print(",.rdl_,")")
# wrap into `try` to safely fail
try(eval(parse(text = .rdl_)))
.rdl_ <- readline()
}
if (.rdl_ == "q") return(invisible(NULL))
if (.rdl_ != "s") {
if (inherits(.values[[.i]],"try-error")) {
# a trick to be able to use stop without showing that
# debug_pipe failed in the output
opt <- options(show.error.messages = FALSE)
on.exit(options(opt))
message(.values[[.i]])
stop()
} else
{
print(.)
}
}
}
if (!is.na(.lhs)) assign(.lhs,tail(.values,1),envir = parent.frame())
invisible(NULL)
}
Example code:
library(dplyr)
# copy following 4 lines to clipboard, no need to execute
test <- iris %>%
slice(1:2) %>%
select(1:3) %>%
mutate(x=3)
debug_pipe()
# or wrap expression
debug_pipe(
test <- iris %>%
slice(1:2) %>%
select(1:3) %>%
mutate(x=3)
)

Here are the steps I came with :
Two good ressources were :
The reprex addin's code from Jenny Bryan
This RStudio webinar
1. create a new package
New Project/R package/Name package as pipedebug
2. build R file
Put the function's code into a .R file in the R folder. We rename the function pdbg as I realised that magrittr already has a function called debug_pipe that does something different (it executes browser and returns input).
We must add a second function, without parameter, that the addin will trigger, we can name it however we want:
pdbg_addin <- function(){
selection <- rstudioapi::primary_selection(
rstudioapi::getSourceEditorContext())[["text"]]
rstudioapi::sendToConsole("",execute = F)
eval(parse(text=paste0("pdbg(",selection,")")))
}
The first line captures the selection, adapted from reprex's code.
The second line is sending an empty string to the console and not executing it, that's all I found to move the cursor, but there might be a better way.
The third line is running the main function with the selection as an argument.
3. Create dcf file
Next step is to create file inst/rstudio/addins.dcf with following content:
Name: debug pipe
Description: debug pipes step by step
Binding: pdbg_addin
Interactive: false
usethis::use_addin("pdbg_addin") will create the file, fill it with a template and open it so you can edit it.
4. build package
Ctrl+Shift+B
5. Add shortcut
Tools / addins / browse addins / keyboard shortcuts / debug pipe / Ctrl+P
6. Test it
Copy in text editor / select / Ctrl+P
test <- iris %>%
slice(1:2) %>%
select(1:3) %>%
mutate(x=3)
find a rough version here:
devtools::install_github("moodymudskipper/pipedebug")
?pdbg
similar efforts:
#Alistaire did this and advertised this other effort on his page.

Related

RStudio data.frame Viewer turns data.frames to lists on user-defined `View` methods

Does anyone have an idea (or a 'solution') that in case you define a View() method for a S4 class in which you would like to access a certain slot in the RStudio data.frame Viewer it just won't return it as expected?
What I mean is if you start a fresh R session eg
View(mtcars)
will work as expected and deliver
(works as expected including Filters etc in the Viewer)
But then if you define some S4 class eg
foo <- setClass("foo", slots = c(df = "data.frame"))
myfoo <- new('foo', df = mtcars)
and then a View method
setMethod("View", "foo", function(x, title) View(x#df, title))
You will suddenly face one of these (two differing) messages:
Creating a generic function for 'View' from package 'stats' in the global environment
OR this one
Creating a generic function for 'View' from package 'utils' in the global environment
Which imo is already "disturbing" since afaik the stats package does not seem to even have a View function.
But lets continue and get to what I really wonder about. Which is why I do not get the expected same result in RStudio's data.frame Viewer but some form of list view?
Can this somehow be avoided and made to produce the expected ie same type of "View" as for the standalone data.frame?
And to top it all off once you do that within a R package you end up with this (final pic below) where in the background you see View(mtcars) output before devtools::load_all() was run and in the foreground you see the result of View(mtcars) after load_all() picked up all methods/functions in the package? Is that a RStudio bug, or am I doing something wrong here?
Here is a (not-so-nice) workaround until a better solution comes along.
foo <- setClass("foo", slots = c(df = "data.frame"))
myfoo <- new('foo', df = mtcars)
old <- View
View <- function(...) {
if(isS4(...)) {
unclass(...)#df |> format.data.frame() |> old()
} else {
old(...)
}
}
The viewer with the red lines is the default utils::View,
function (x, title)
{
check <- Sys.getenv("_R_CHECK_SCREEN_DEVICE_", "")
msg <- "View() should not be used in examples etc"
if (identical(check, "stop"))
stop(msg, domain = NA)
else if (identical(check, "warn"))
warning(msg, immediate. = TRUE, noBreaks. = TRUE, domain = NA)
if (missing(title))
title <- paste("Data:", deparse(substitute(x))[1])
x0 <- as.data.frame(x)
x <- as.list(format.data.frame(x0))
rn <- row.names(x0)
if (any(rn != seq_along(rn)))
x <- c(list(row.names = rn), x)
if (!is.list(x) || !length(x) || !all(sapply(x, is.atomic)) ||
!max(lengths(x)))
stop("invalid 'x' argument")
if (grepl("darwin", R.version$os))
check_for_XQuartz()
invisible(.External2(C_dataviewer, x, title))
}
RStudio modifies View somewhere1, maybe here to a more user friendly interface, via
function (...)
.rs.callAs(name, hook, original, ...)
where original is utils::View, ( see e <- environment(View); e$original).
1 I have not figured out (yet) where exactly.

How to get all objects in a script

I am trying to determine all the objects in a script. ( specifically to get all the dataframes but I'll settle for all the assigned objects ie vectors lists etc.)
Is there a way of doing this. Should I make the script run in its own session and then somehow get the objects from that session rather than rely on the global environment.
Use the second argument to source() when you execute the script. For example, here's a script:
x <- y + 1
z <- 2
which I can put in script.R. Then I will execute it in its own environment using the following code:
x <- 1 # This value will *not* change
y <- 2 # This value will be visible to the script
env <- new.env()
source("script.R", local = env)
Now I can print the values, and see that the comments are correct
x # the original one
# [1] 1
ls(env) # what was created?
# [1] "x" "z"
env$x # this is the one from the script
# [1] 3
I had a similar question and found an answer. I am copying the answer from my other post here.
I wrote the following function, get.objects(), that returns all the objects created in a script:
get.objects <- function(path2file = NULL, exception = NULL, source = FALSE, message = TRUE) {
library("utils")
library("tools")
# Step 0-1: Possibility to leave path2file = NULL if using RStudio.
# We are using rstudioapi to get the path to the current file
if(is.null(path2file)) path2file <- rstudioapi::getSourceEditorContext()$path
# Check that file exists
if (!file.exists(path2file)) {
stop("couldn't find file ", path2file)
}
# Step 0-2: If .Rmd file, need to extract the code in R chunks first
# Use code in https://felixfan.github.io/extract-r-code/
if(file_ext(path2file)=="Rmd") {
require("knitr")
tmp <- purl(path2file)
path2file <- paste(getwd(),tmp,sep="/")
source = TRUE # Must be changed to TRUE here
}
# Step 0-3: Start by running the script if you are calling an external script.
if(source) source(path2file)
# Step 1: screen the script
summ_script <- getParseData(parse(path2file, keep.source = TRUE))
# Step 2: extract the objects
list_objects <- summ_script$text[which(summ_script$token == "SYMBOL")]
# List unique
list_objects <- unique(list_objects)
# Step 3: find where the objects are.
src <- paste(as.vector(sapply(list_objects, find)))
src <- tapply(list_objects, factor(src), c)
# List of the objects in the Global Environment
# They can be in both the Global Environment and some packages.
src_names <- names(src)
list_objects = NULL
for (i in grep("GlobalEnv", src_names)) {
list_objects <- c(list_objects, src[[i]])
}
# Step 3bis: if any exception, remove from the list
if(!is.null(exception)) {
list_objects <- list_objects[!list_objects %in% exception]
}
# Step 4: done!
# If message, print message:
if(message) {
cat(paste0(" ",length(list_objects)," objects were created in the script \n ", path2file,"\n"))
}
return(list_objects)
}
To run it, you need a saved script. Here is an example of a script:
# This must be saved as a script, e.g, "test.R".
# Create a bunch of objects
temp <- LETTERS[1:3]
data <- data.frame(x = 1:10, y = 10:1)
p1 <- ggplot(data, aes(x, y)) + geom_point()
# List the objects. If you want to list all the objects except some, you can use the argument exception. Here, I listed as exception "p1.
get.objects()
get.objects(exception = "p1", message = FALSE)
Note that the function also works for external script and R markdown.
If you run an external script, you will have to run the script before. To do so, change the argument source to TRUE.

Anonymous function in R using sparklyr spark_apply

I am trying to use the spark_apply() function from library(sparklyr) I am using the spark_apply() function because the sparklyr package does not support using subsets. I am a bit lost about where I need to include the function(e) within the following dplyr syntax.
Here is the original syntax I am trying to adapt with an anonymous function (I'm not 100% this is the term)
match_cat3 <- match_cat2 %>%
group_by(VarE, VarF) %>%
mutate(Var_G = if(any(Var_C ==1)) ((VarG - VarG[Var_C ==
1])/(Var_G + Var_G[Var_C == 1])/2) else NA)
Here is my attempt at using the spark_apply() function with the mutate equation from above. I would love some help with how to use the function(e) and where the e goes within the syntax. I don't have any experience using a function within another function like this.
match_cat3 <- spark_apply(
function(e)
match_cat2 %>%
group_by(e$VarE, e$VarF) %>%
mutate(e$Var_G = if(any(e$Var_C ==1)) ((e$VarG -
e$VarG[e$Var_C == 1])/(e$Var_G + e$Var_G[e$Var_C == 1])/2) else NA, e)
)
```
This gives me an out of bounds error.
I was basing the syntax off of the following block from the spark_apply() documentation.
trees_tbl %>%
spark_apply(
function(e) data.frame(2.54 * e$Girth, e),
names = c("Girth(cm)", colnames(trees)))
Thanks!
You seem to be having trouble writing a sparklyr::spark_apply() function. The template that might be more useful for you starts with your Spark DataFrame.
##### data_sf is a Spark DataFrame that will be sent to all workers for R
data_sf <- sparklyr::copy_to(sc, iris, overwrite = TRUE)
data2_sf <- sparklyr::spark_apply(
x = data_sf,
f = function(x) { ##### data_sf will be the argument passed to this x parameter
x$Petal_Length <- x$Petal_Length + 10 ##### data_sf will now be converted to an R object used here (Spark doesn't like `Petal.Length` so automatically changes column names)
return(x)
})
In your case:
you're missing the x argument, the first in sparklyr::spark_apply()
you're bringing in external stuff (match_cat2) through the e argument of your anonymous function but improperly putting it inside the definition of the function as well
you're missing brackets around your multiline expression and so you aren't defining a function
you're trying to use dplyr (and magrittr) with wrong syntax--you can refer to variables like group_by(VarE) not group_by(e$VarE)
Functions are defined as function(data, context) {} where you can provide arbitrary code within the {}. Chapter 11.7 Functions
you're trying to do some conditional stuff in your if else (you could also use the ifelse() function here) but I'm not sure what your intent is
##### Rewritten, maybe helpful?
match_cat3 <- spark_apply(
x = match_cat2, ##### the Spark DataFrame you give to spark_apply()
function(e) { ##### the opening bracket
e %>% ##### the function's argument, NOT `match_cat2 %>%`
group_by(VarE, VarF) %>% ##### remove `e$`
mutate(Var_G = something_good) ##### not sure of your intent here
})

Test interaction with users in R package

I am developing an R package and one of the function implements interaction with users through standard input via readline. I now wonder how to test the behavior of this function, preferably with testthat library.
It seems test_that function assumes the answer is "" for user-input. I wish I could test the behavior conditional of various answers users may type in.
Below is a small example code. In the actual development, the marryme function is defined in a separate file and exported to the namespace.
devtools::test() gets me an error on the last line because the answer never becomes yes. I would like to test if the function correctly returns true when user types "y".
library(testthat)
test_that("input", {
marryme <- function() {
ans <- readline("will you marry me? (y/n) > ")
return(ans == "y")
}
expect_false(marryme()) # this is good
expect_true(marryme()) # this is no good
})
Use readLines() with a custom connection
By using readLines() instead of readline(), you can define the connection, which allows you to customize it using global options.
There are two steps that you need to do:
set a default option in your package in zzz.R that points to stdin:
.onAttach <- function(libname, pkgname){
options(mypkg.connection = stdin())
}
In your function, change readline to readLines(n = 1) and set the connection in readLines() to getOption("mypkg.connection")
Example
Based on your MWE:
library(testthat)
options(mypkg.connection = stdin())
marryme <- function() {
cat("will you marry me? (y/n) > ")
ans <- readLines(con = getOption("mypkg.connection"), n = 1)
cat("\n")
return(ans == "y")
}
test_that("input", {
f <- file()
options(mypkg.connection = f)
ans <- paste(c("n", "y"), collapse = "\n") # set this to the number of tests you want to run
write(ans, f)
expect_false(marryme()) # this is good
expect_true(marryme()) # this is no good
# reset connection
options(mypkg.connection = stdin())
# close the file
close(f)
})
#> will you marry me? (y/n) >
#> will you marry me? (y/n) >

Customizing R profile [duplicate]

As it currently stands, this question is not a good fit for our Q&A format. We expect answers to be supported by facts, references, or expertise, but this question will likely solicit debate, arguments, polling, or extended discussion. If you feel that this question can be improved and possibly reopened, visit the help center for guidance.
Closed 10 years ago.
I have always found startup profile files of other people both useful and instructive about the language. Moreover, while I have some customization for Bash and Vim, I have nothing for R.
For example, one thing I always wanted is different colors for input and output text in a window terminal, and maybe even syntax highlighting.
Here is mine. It won't help you with the coloring but I get that from ESS and Emacs...
options("width"=160) # wide display with multiple monitors
options("digits.secs"=3) # show sub-second time stamps
r <- getOption("repos") # hard code the US repo for CRAN
r["CRAN"] <- "http://cran.us.r-project.org"
options(repos = r)
rm(r)
## put something this is your .Rprofile to customize the defaults
setHook(packageEvent("grDevices", "onLoad"),
function(...) grDevices::X11.options(width=8, height=8,
xpos=0, pointsize=10,
#type="nbcairo")) # Cairo device
#type="cairo")) # other Cairo dev
type="xlib")) # old default
## from the AER book by Zeileis and Kleiber
options(prompt="R> ", digits=4, show.signif.stars=FALSE)
options("pdfviewer"="okular") # on Linux, use okular as the pdf viewer
I hate to type the full words 'head', 'summary', 'names' every time, so I use aliases.
You can put aliases into your .Rprofile file, but you have to use the full path to the function (e.g. utils::head) otherwise it won't work.
# aliases
s <- base::summary
h <- utils::head
n <- base::names
EDIT: to answer your question, you can use the colorout package to have different colors in the terminal. Cool! :-)
options(stringsAsFactors=FALSE)
Although I don't actually have that in my .Rprofile, because it might breaks my coauthors' code, I wish it was the default. Why?
1) Character vectors use less memory (but only barely);
2) More importantly, we would avoid problems such as:
> x <- factor(c("a","b","c"))
> x
[1] a b c
Levels: a b c
> x <- c(x, "d")
> x
[1] "1" "2" "3" "d"
and
> x <- factor(c("a","b","c"))
> x[1:2] <- c("c", "d")
Warning message:
In `[<-.factor`(`*tmp*`, 1:2, value = c("c", "d")) :
invalid factor level, NAs generated
Factors are great when you need them (e.g. implementing ordering in graphs) but a nuisance most of the time.
I like saving my R command history and having it available each time I run R:
In the shell or .bashrc:
export R_HISTFILE=~/.Rhistory
in .Rprofile:
.Last <- function() {
if (!any(commandArgs()=='--no-readline') && interactive()){
require(utils)
try(savehistory(Sys.getenv("R_HISTFILE")))
}
}
Here are two functions I find handy for working with windows.
The first converts the \s to /.
.repath <- function() {
cat('Paste windows file path and hit RETURN twice')
x <- scan(what = "")
xa <- gsub('\\\\', '/', x)
writeClipboard(paste(xa, collapse=" "))
cat('Here\'s your de-windowsified path. (It\'s also on the clipboard.)\n', xa, '\n')
}
The second opens the working directory in a new explorer window.
getw <- function() {
suppressWarnings(shell(paste("explorer", gsub('/', '\\\\', getwd()))))
}
Here's mine. I always use the main cran repository, and have code to make it easy to source in-development package code.
.First <- function() {
library(graphics)
options("repos" = c(CRAN = "http://cran.r-project.org/"))
options("device" = "quartz")
}
packages <- list(
"describedisplay" = "~/ggobi/describedisplay",
"linval" = "~/ggobi/linval",
"ggplot2" = "~/documents/ggplot/ggplot",
"qtpaint" = "~/documents/cranvas/qtpaint",
"tourr" = "~/documents/tour/tourr",
"tourrgui" = "~/documents/tour/tourr-gui",
"prodplot" = "~/documents/categorical-grammar"
)
l <- function(pkg) {
pkg <- tolower(deparse(substitute(pkg)))
if (is.null(packages[[pkg]])) {
path <- file.path("~/documents", pkg, pkg)
} else {
path <- packages[pkg]
}
source(file.path(path, "load.r"))
}
test <- function(path) {
path <- deparse(substitute(path))
source(file.path("~/documents", path, path, "test.r"))
}
I've got this, more dynamic trick to use full terminal width, which tries to read from the COLUMNS environment variable (on Linux):
tryCatch(
{options(
width = as.integer(Sys.getenv("COLUMNS")))},
error = function(err) {
write("Can't get your terminal width. Put ``export COLUMNS'' in your \
.bashrc. Or something. Setting width to 120 chars",
stderr());
options(width=120)}
)
This way R will use the full width even as you resize your terminal window.
Most of my personal functions and loaded libraries are in the Rfunctions.r script
source("c:\\data\\rprojects\\functions\\Rfunctions.r")
.First <- function(){
cat("\n Rrrr! The statistics program for Pirates !\n\n")
}
.Last <- function(){
cat("\n Rrrr! Avast Ye, YO HO!\n\n")
}
#===============================================================
# Tinn-R: necessary packages
#===============================================================
library(utils)
necessary = c('svIDE', 'svIO', 'svSocket', 'R2HTML')
if(!all(necessary %in% installed.packages()[, 'Package']))
install.packages(c('SciViews', 'R2HTML'), dep = T)
options(IDE = 'C:/Tinn-R/bin/Tinn-R.exe')
options(use.DDE = T)
library(svIDE)
library(svIO)
library(svSocket)
library(R2HTML)
guiDDEInstall()
shell(paste("mkdir C:\\data\\rplots\\plottemp", gsub('-','',Sys.Date()), sep=""))
pldir <- paste("C:\\data\\rplots\\plottemp", gsub('-','',Sys.Date()), sep="")
plot.str <-c('savePlot(paste(pldir,script,"\\BeachSurveyFreq.pdf",sep=""),type="pdf")')
Here's from my ~/.Rprofile, designed for Mac and Linux.
These make errors easier to see.
options(showWarnCalls=T, showErrorCalls=T)
I hate the CRAN menu choice, so set to a good one.
options(repos=c("http://cran.cnr.Berkeley.edu","http://cran.stat.ucla.edu"))
More history!
Sys.setenv(R_HISTSIZE='100000')
The following is for running on Mac OSX from the terminal (which I greatly prefer to R.app because it's more stable, and you can organize your work by directory; also make sure to get a good ~/.inputrc). By default, you get an X11 display, which doesn't look as nice; this instead gives a quartz display same as the GUI. The if statement is supposed to catch the case when you're running R from the terminal on Mac.
f = pipe("uname")
if (.Platform$GUI == "X11" && readLines(f)=="Darwin") {
# http://www.rforge.net/CarbonEL/
library("grDevices")
library("CarbonEL")
options(device='quartz')
Sys.unsetenv("DISPLAY")
}
close(f); rm(f)
And preload a few libraries,
library(plyr)
library(stringr)
library(RColorBrewer)
if (file.exists("~/util.r")) {
source("~/util.r")
}
where util.r is a random bag of stuff I use, under flux.
Also, since other people were mentioning console width, here's how I do it.
if ( (numcol <-Sys.getenv("COLUMNS")) != "") {
numcol = as.integer(numcol)
options(width= numcol - 1)
} else if (system("stty -a &>/dev/null") == 0) {
# mac specific? probably bad in the R GUI too.
numcol = as.integer(sub(".* ([0-9]+) column.*", "\\1", system("stty -a", intern=T)[1]))
if (numcol > 0)
options(width= numcol - 1 )
}
rm(numcol)
This actually isn't in .Rprofile because you have to re-run it every time you resize the terminal window. I have it in util.r then I just source it as necessary.
Here are mine:
.First <- function () {
options(device="quartz")
}
.Last <- function () {
if (!any(commandArgs() == '--no-readline') && interactive()) {
require(utils)
try(savehistory(Sys.getenv("R_HISTFILE")))
}
}
# Slightly more flexible than as.Date
# my.as.Date("2009-01-01") == my.as.Date(2009, 1, 1) == as.Date("2009-01-01")
my.as.Date <- function (a, b=NULL, c=NULL, ...) {
if (class(a) != "character")
return (as.Date(sprintf("%d-%02d-%02d", a, b, c)))
else
return (as.Date(a))
}
# Some useful aliases
cd <- setwd
pwd <- getwd
lss <- dir
asd <- my.as.Date # examples: asd("2009-01-01") == asd(2009, 1, 1) == as.Date("2009-01-01")
last <- function (x, n=1, ...) tail(x, n=n, ...)
# Set proxy for all web requests
Sys.setenv(http_proxy="http://192.168.0.200:80/")
# Search RPATH for file <fn>. If found, return full path to it
search.path <- function(fn,
paths = strsplit(chartr("\\", "/", Sys.getenv("RPATH")), split =
switch(.Platform$OS.type, windows = ";", ":"))[[1]]) {
for(d in paths)
if (file.exists(f <- file.path(d, fn)))
return(f)
return(NULL)
}
# If loading in an environment that doesn't respect my RPATH environment
# variable, set it here
if (Sys.getenv("RPATH") == "") {
Sys.setenv(RPATH=file.path(path.expand("~"), "Library", "R", "source"))
}
# Load commonly used functions
if (interactive())
source(search.path("afazio.r"))
# If no R_HISTFILE environment variable, set default
if (Sys.getenv("R_HISTFILE") == "") {
Sys.setenv(R_HISTFILE=file.path("~", ".Rhistory"))
}
# Override q() to not save by default.
# Same as saying q("no")
q <- function (save="no", ...) {
quit(save=save, ...)
}
# ---------- My Environments ----------
#
# Rather than starting R from within different directories, I prefer to
# switch my "environment" easily with these functions. An "environment" is
# simply a directory that contains analysis of a particular topic.
# Example usage:
# > load.env("markets") # Load US equity markets analysis environment
# > # ... edit some .r files in my environment
# > reload() # Re-source .r/.R files in my environment
#
# On next startup of R, I will automatically be placed into the last
# environment I entered
# My current environment
.curr.env = NULL
# File contains name of the last environment I entered
.last.env.file = file.path(path.expand("~"), ".Rlastenv")
# Parent directory where all of my "environment"s are contained
.parent.env.dir = file.path(path.expand("~"), "Analysis")
# Create parent directory if it doesn't already exist
if (!file.exists(.parent.env.dir))
dir.create(.parent.env.dir)
load.env <- function (string, save=TRUE) {
# Load all .r/.R files in <.parent.env.dir>/<string>/
cd(file.path(.parent.env.dir, string))
for (file in lss()) {
if (substr(file, nchar(file)-1, nchar(file)+1) %in% c(".r", ".R"))
source(file)
}
.curr.env <<- string
# Save current environment name to file
if (save == TRUE) writeLines(.curr.env, .last.env.file)
# Let user know environment switch was successful
print (paste(" -- in ", string, " environment -- "))
}
# "reload" current environment.
reload <- resource <- function () {
if (!is.null(.curr.env))
load.env(.curr.env, save=FALSE)
else
print (" -- not in environment -- ")
}
# On startup, go straight to the environment I was last working in
if (interactive() && file.exists(.last.env.file)) {
load.env(readLines(.last.env.file))
}
sink(file = 'R.log', split=T)
options(scipen=5)
.ls.objects <- function (pos = 1, pattern, order.by = "Size", decreasing=TRUE, head = TRUE, n = 10) {
# based on postings by Petr Pikal and David Hinds to the r-help list in 2004
# modified by: Dirk Eddelbuettel (http://stackoverflow.com/questions/1358003/tricks-to- manage-the-available-memory-in-an-r-session)
# I then gave it a few tweaks (show size as megabytes and use defaults that I like)
# a data frame of the objects and their associated storage needs.
napply <- function(names, fn) sapply(names, function(x)
fn(get(x, pos = pos)))
names <- ls(pos = pos, pattern = pattern)
obj.class <- napply(names, function(x) as.character(class(x))[1])
obj.mode <- napply(names, mode)
obj.type <- ifelse(is.na(obj.class), obj.mode, obj.class)
obj.size <- napply(names, object.size) / 10^6 # megabytes
obj.dim <- t(napply(names, function(x)
as.numeric(dim(x))[1:2]))
vec <- is.na(obj.dim)[, 1] & (obj.type != "function")
obj.dim[vec, 1] <- napply(names, length)[vec]
out <- data.frame(obj.type, obj.size, obj.dim)
names(out) <- c("Type", "Size", "Rows", "Columns")
out <- out[order(out[[order.by]], decreasing=decreasing), ]
if (head)
out <- head(out, n)
out
}
Make data.frames display somewhat like 'head', only without having to type 'head'
print.data.frame <- function(df) {
if (nrow(df) > 10) {
base::print.data.frame(head(df, 5))
cat("----\n")
base::print.data.frame(tail(df, 5))
} else {
base::print.data.frame(df)
}
}
(From How to make 'head' be applied automatically to output? )
I often have a chain of debug calls I need to call and uncommenting them can be very tedious. With the help of the SO community, I went for the following solution and inserted this into my .Rprofile.site. # BROWSER is there for my Eclipse Tasks so that I have an overview of browser calls in the Task View window.
# turn debugging on or off
# place "browser(expr = isTRUE(getOption("debug"))) # BROWSER" in your function
# and turn debugging on or off by bugon() or bugoff()
bugon <- function() options("debug" = TRUE)
bugoff <- function() options("debug" = FALSE) #pun intended
Mine is not too fancy:
# So the mac gui can find latex
Sys.setenv("PATH" = paste(Sys.getenv("PATH"),"/usr/texbin",sep=":"))
#Use last(x) instead of x[length(x)], works on matrices too
last <- function(x) { tail(x, n = 1) }
#For tikzDevice caching
options( tikzMetricsDictionary='/Users/cameron/.tikzMetricsDictionary' )
setwd("C://path//to//my//prefered//working//directory")
library("ggplot2")
library("RMySQL")
library("foreign")
answer <- readline("What database would you like to connect to? ")
con <- dbConnect(MySQL(),user="root",password="mypass", dbname=answer)
I do a lot of work from mysql databases, so connecting right away is a godsend. I only wish there was a way of listing the avaialble databases so I wouldn't have to remember all the different names.
Stephen Turner's post on .Rprofiles has several useful aliases and starter functions.
I find myself using his ht and hh often.
#ht==headtail, i.e., show the first and last 10 items of an object
ht <- function(d) rbind(head(d,10),tail(d,10))
# Show the first 5 rows and first 5 columns of a data frame or matrix
hh <- function(d) d[1:5,1:5]
Here's mine, including some of the mentioned ideas.
Two things you might want to look at:
.set.width() / w() update your print width to the one of the terminal. Unfortunately I did not find a way to do this automatically on terminal resize - R documentation mentions this is done by some R interpreters.
history is saved every time together with a timestamp and the working directory
.
.set.width <- function() {
cols <- as.integer(Sys.getenv("COLUMNS"))
if (is.na(cols) || cols > 10000 || cols < 10)
options(width=100)
options(width=cols)
}
.First <- function() {
options(digits.secs=3) # show sub-second time stamps
options(max.print=1000) # do not print more than 1000 lines
options("report" = c(CRAN="http://cran.at.r-project.org"))
options(prompt="R> ", digits=4, show.signif.stars=FALSE)
}
# aliases
w <- .set.width
.Last <- function() {
if (!any(commandArgs()=='--no-readline') && interactive()){
timestamp(,prefix=paste("##------ [",getwd(),"] ",sep=""))
try(savehistory("~/.Rhistory"))
}
}
I use the following to get cacheSweave (or pgfSweave) to work with the "Compile PDF" button in RStudio:
library(cacheSweave)
assignInNamespace("RweaveLatex", cacheSweave::cacheSweaveDriver, "utils")
Mine includes options(menu.graphics=FALSE) because I like to Disable/suppress tcltk popup for CRAN mirror selection in R.
Here's mine. Nothing too innovative. Thoughts on why particular choices:
I went with setting a default for stringsAsFactors because I find
it extremely draining to pass it as an argument each time I read a CSV in. That said, it has already caused me some minor vexation when using code written on my usual computer on a computer which did not have my .Rprofile. I'm keeping it, though, as the troubles it has caused pale in comparison to the troubles not having it set everyday used to cause.
If you don't load the utils package before options(error=recover), it cannot find recover when placed inside an interactive() block.
I used .db for my dropbox setting rather than options(dropbox=...) because I use it all the time inside file.path and it saves much typing. The leading . keeps it from appearing with ls().
Without further ado:
if(interactive()) {
options(stringsAsFactors=FALSE)
options(max.print=50)
options(repos="http://cran.mirrors.hoobly.com")
}
.db <- "~/Dropbox"
# `=` <- function(...) stop("Assignment by = disabled, use <- instead")
options(BingMapsKey="blahblahblah") # Used by taRifx.geo::geocode()
.First <- function() {
if(interactive()) {
require(functional)
require(taRifx)
require(taRifx.geo)
require(ggplot2)
require(foreign)
require(R.utils)
require(stringr)
require(reshape2)
require(devtools)
require(codetools)
require(testthat)
require(utils)
options(error=recover)
}
}
Here's a little snippet for use exporting tables to LaTeX. It changes all the column names to math mode for the many reports I write. The rest of my .Rprofile is pretty standard and mostly covered above.
# Puts $dollar signs in front and behind all column names col_{sub} -> $col_{sub}$
amscols<-function(x){
colnames(x) <- paste("$", colnames(x), "$", sep = "")
x
}
I set my lattice color theme in my profile. Here are two other tweaks I use:
# Display working directory in the titlebar
# Note: This causes demo(graphics) to fail
utils::setWindowTitle(base::getwd())
utils::assignInNamespace("setwd",function(dir) {.Internal(setwd(dir));setWindowTitle(base::getwd())},"base")
# Don't print more than 1000 lines
options(max.print=2000)
I have an environment variable R_USER_WORKSPACE which points to the top directory of my packages. In .Rprofile I define a function devlib which sets the working directory (so that data() works) and sources all .R files in the R subdirectory. It is quite similar to Hadley's l() function above.
devlib <- function(pkg) {
setwd(file.path(Sys.getenv("R_USER_WORKSPACE", "."), deparse(substitute(pkg)), "dev"))
sapply(list.files("R", pattern=".r$", ignore.case=TRUE, full.names=TRUE), source)
invisible(NULL)
}
.First <- function() {
setwd(Sys.getenv("R_USER_WORKSPACE", "."))
options("repos" = c(CRAN = "http://mirrors.softliste.de/cran/", CRANextra="http://www.stats.ox.ac.uk/pub/RWin"))
}
.Last <- function() update.packages(ask="graphics")
I found two functions really necessary: First when I have set debug() on several functions and I have resolved the bug, so I want to undebug() all functions - not one by one. The undebug_all() function added as the accepted answer here is the best.
Second, when I have defined many functions and I am looking for a specific variable name, it's hard to find it within all results of the the ls(), including the function names. The lsnofun() function posted here is really good.

Resources