Aside from a vignette, I wish to add an additional document as PDF to my package. I can, of course, copy it to the inst/doc directory and it will then be included in the package documentation.
However, I would like to make it easy for the user to display this file. The authors of the edgeR package decided to do the following: the main users manual is distributed as PDF (and is not a regular vignette), and the authors include a function called edgeRUsersGuide() which shows the PDF by means of the following code:
edgeRUsersGuide <- function (view = TRUE) {
f <- system.file("doc", "edgeRUsersGuide.pdf", package = "edgeR")
if (view) {
if (.Platform$OS.type == "windows")
shell.exec(f)
else system(paste(Sys.getenv("R_PDFVIEWER"), f, "&"))
}
return(f)
}
It appears to work. Do you think it is a reasonable approach?
Or should one use something else? Potentially, the following code would also work and be more robust:
z <- list(PDF="edgeR.pdf", Dir=system.file(package="edgeR"))
class(z) <- "vignette"
return(z)
My solution was to ape the code in utils:::print.vignette():
function(docfile) {
## code inspired by tools:::print.vignette
pdfviewer <- getOption("pdfviewer")
f <- system.file("doc", docfile, package = "tmod")
if(identical(pdfviewer, "false"))
stop(sprintf("Cannot display the file %s", f))
if (.Platform$OS.type == "windows" &&
identical(pdfviewer, file.path(R.home("bin"), "open.exe"))) {
shell.exec(f)
} else {
system2(pdfviewer, shQuote(f), wait = FALSE)
}
return(invisible(f))
}
Related
I am using R. I am working with a library called "mco" : https://cran.r-project.org/web/packages/mco/index.html
I was looking over some of the function definitions used in this library at the github repository, for example: https://github.com/olafmersmann/mco/blob/master/R/nsga2.R
Over here, I came across the following lines of code:
res <- .Call(do_nsga2,
ff, cf, sys.frame(),
as.integer(odim),
as.integer(cdim),
as.integer(idim),
lower.bounds, upper.bounds,
as.integer(popsize), as.integer(generations),
cprob, as.integer(cdist),
mprob, as.integer(mdist))
if (1 == length(res)) {
res <- res[[1]]
names(res) <- c("par", "value", "pareto.optimal")
class(res) <- c("nsga2", "mco")
} else {
for (i in 1:length(res)) {
names(res[[i]]) <- c("par", "value", "pareto.optimal")
class(res[[i]]) <- c("nsga2", "mco")
}
class(res) <- "nsga2.collection"
}
return (res)
}
In the very first line of this code, it makes reference to some object called "do_nsga2". But apart from this function, I can't find any reference to "do_nsga2" within the entire package.
Does anyone know what exactly is being "called"?
Thanks
Note: I am trying to copy/paste all the functions from the github repository into my R session, since I am working with an older computer in which directly installing libraries from CRAN is not possible. When I tried to copy/paste all these functions, I got the following error:
Error in nsga2....
object 'do_nsga2' not found
There are several code snippets that are invaluable to my workflow and play nicely with functions in my custom R package. Can I include these code snippets in my R package so that they are added to users' code snippets (with permissions of course) when they install my package?
Rmd snippet example that creates a sql chunk:
snippet sql
```{sql, connection = conn, output.var = "${1:df}"}
${2}
```
Short answer: Yes
One way to achieve what you want (that works for my package) is:
Store the packages snippet definitions in two text files somewhere in the packages inst/ directory. It's important that the snippets follow exactly the formatting rules (e.g. tabs at the start of the lines, not spaces). I have one file for R code snippets and one for markdown.
Define a function that reads these files and copies their content into RStudios user snippets files. These files are generated at the first attempt to edit the snippets (Tools -> Global Options -> Code -> Edit Snippets) (I think RStudio uses an other, not user exposed file before one tries to edit, not sure though). On ubuntu the RStudio files are called 'r.snippets' and 'markdown.snippets' and are in '~/.R/snippets/'. I also check if the snipped definition already exists, and double check the tabs at the start of the lines before using cat(..., append=TRUE) to add the packages snippet definitions.
I first used an elaborate .onLoad function with configs and all but now I just export a addPackageSnippets function ;)
Edit
Some code:
Part that checks for already existing snippet definitons:
I just read the rstudio file and extract the lines starting with 'snippet'. I do the same for the packages snipptes definition file and use setdiff (one might want to also use trimws on the lists, just in case there is some trailing white-space)
# load package snippets definitions
#
pckgSnippetsFileContent <- readLines(pckgSnippetsFilesPath)
# Extract names of package snippets
#
pckgSnippetsFileDefinitions <- pckgSnippetsFileContent[grepl("^snippet (.*)", pckgSnippetsFileContent)]
# Extract 'names' of already existing snitppets
#
rstudioSnippetsFileContent <- readLines(rstudioSnippetsFilePath)
rstudioSnippetDefinitions <- rstudioSnippetsFileContent[grepl("^snippet (.*)", rstudioSnippetsFileContent)]
# find definitions appearing in packageSnippets but not in rstudioSnippets
# if no snippets are missing go to next file
#
snippetsToCopy <- setdiff(pckgSnippetsFileDefinitions, rstudioSnippetDefinitions)
For context here is the whole 'addPackageSnippets' function. The function is using only the base package, except getOS which returns one of 'linux', 'windows' or 'mac' (i.e. a wrapper around Sys.info()
#' #title Export snippets
#'
#' #description \code{addPackageSnippets} copies all (missing) snippet definitions
#' in 'inst/rstudio/Rsnippets.txt' and 'Rmdsnippets.txt' to the RStudios user snippet location.
#'
#' #return boolean invisible(FALSE) if nothing was added, invisible(TRUE) if snipped definitions were added
#' #export
#'
#' #examples \dontrun{addPackageSnippets()}
addPackageSnippets <- function() {
added <- FALSE
# if not on RStudio or RStudioServer exit
#
if (!nzchar(Sys.getenv("RSTUDIO_USER_IDENTITY"))) {
return(NULL)
}
# Name of files containing snippet code to copy
#
pckgSnippetsFiles <- c("Rsnippets.txt", "Rmdsnippets.txt")
# Name of files to copy into. Order has to be the same
# as in 'pckgSnippetsFiles'
#
rstudioSnippetsFiles <- c("r.snippets", "markdown.snippets")
# Path to directory for RStudios user files depends on OS
#
if (getOS() == "linux") {
rstudioSnippetsPathBase <- "~/.R/snippets"
} else if (getOS() == "windows") {
rstudioSnippetsPathBase <- file.path(path.expand('~'), ".R", "snippets")
} else {
warning(paste0("goSnippets() is only implemented on linux and windows"))
return(NULL)
}
# Read each file in pckgSnippetsFiles and add its contents
#
for (i in seq_along(pckgSnippetsFiles)) {
# Try to get template, if template is not found skip it
#
pckgSnippetsFilesPath <- system.file("rstudio", pckgSnippetsFiles[i], package = "myFunc")
if (pckgSnippetsFilesPath == "") {
next()
}
# load package snippets definitions
#
pckgSnippetsFileContent <- readLines(pckgSnippetsFilesPath)
# Extract names of package snippets
#
pckgSnippetsFileDefinitions <- pckgSnippetsFileContent[grepl("^snippet (.*)", pckgSnippetsFileContent)]
# Construct path for destination file
#
rstudioSnippetsFilePath <- file.path(rstudioSnippetsPathBase, rstudioSnippetsFiles[i])
# If targeted RStudios user file does not exist, raise error (otherwise we would 'remove')
# the default snippets from the 'user file'
#
if (!file.exists(rstudioSnippetsFilePath)) {
stop(paste0( "'", rstudioSnippetsFilePath, "' does not exist yet\n.",
"Use RStudio -> Tools -> Global Options -> Code -> Edit Snippets\n",
"To initalize user defined snippets file by adding dummy snippet\n"))
}
# Extract 'names' of already existing snitppets
#
rstudioSnippetsFileContent <- readLines(rstudioSnippetsFilePath)
rstudioSnippetDefinitions <- rstudioSnippetsFileContent[grepl("^snippet (.*)", rstudioSnippetsFileContent)]
# replace two spaces with tab, ONLY at beginning of string
#
pckgSnippetsFileContentSanitized <- gsub("(?:^ {2})|\\G {2}|\\G\t", "\t", pckgSnippetsFileContent, perl = TRUE)
# find defintions appearing in packageSnippets but not in rstudioSnippets
# if no snippets are missing go to next file
#
snippetsToCopy <- setdiff(trimws(pckgSnippetsFileDefinitions), trimws(rstudioSnippetDefinitions))
snippetsNotToCopy <- intersect(trimws(pckgSnippetsFileDefinitions), trimws(rstudioSnippetDefinitions))
if (length(snippetsToCopy) == 0) {
# cat(paste0("(\nFollowing snippets will NOT be added because there is already a snippet with that name: ",
# paste0(snippetsNotToCopy, collapse=", ") ,")"))
next()
}
# Inform user about changes, ask to confirm action
#
if (interactive()) {
cat(paste0("You are about to add the following ", length(snippetsToCopy),
" snippets to '", rstudioSnippetsFilePath, "':\n",
paste0(paste0("-", snippetsToCopy), collapse="\n")))
if (length(snippetsNotToCopy) > 0) {
cat(paste0("\n(The following snippets will NOT be added because there is already a snippet with that name:\n",
paste0(snippetsNotToCopy, collapse=", ") ,")"))
}
answer <- readline(prompt="Do you want to procedd (y/n): ")
if (substr(answer, 1, 1) == "n") {
next()
}
}
# Create list of line numbers where snippet definitons start
# This list is used to determine the end of each definition block
#
allPckgSnippetDefinitonStarts <- grep("^snippet .*", pckgSnippetsFileContentSanitized)
for (s in snippetsToCopy) {
startLine <- grep(paste0("^", s, ".*"), pckgSnippetsFileContentSanitized)
# Find last line of snippet definition:
# First find start of next defintion and return
# previous line number or lastline if already in last definiton
#
endLine <- allPckgSnippetDefinitonStarts[allPckgSnippetDefinitonStarts > startLine][1] -1
if (is.na(endLine)) {
endLine <- length(pckgSnippetsFileContentSanitized)
}
snippetText <- paste0(pckgSnippetsFileContentSanitized[startLine:endLine], collapse = "\n")
# Make sure there is at least one empty line between entries
#
if (tail(readLines(rstudioSnippetsFilePath), n=1) != "") {
snippetText <- paste0("\n", snippetText)
}
# Append snippet block, print message
#
cat(paste0(snippetText, "\n"), file = rstudioSnippetsFilePath, append = TRUE)
cat(paste0("* Added '", s, "' to '", rstudioSnippetsFilePath, "'\n"))
added <- TRUE
}
}
if (added) {
cat("Restart RStudio to use new snippets")
}
return(invisible(added))
}
For anyone who comes across this thread, and to add to Dario's great answer: from RStudio v1.3, the filepaths have changes. So in his function, the section for setting rstudioSnippetsPathBase would need to change into something like the following
if (rstudioapi::versionInfo()$version < "1.3") {
rstudioSnippetsPathBase <- file.path(path.expand('~'),".R", "snippets")
} else {
if (.Platform$OS.type == "windows") {
rstudioSnippetsPathBase <- file.path(Sys.getenv("APPDATA"), "RStudio", "snippets")
} else {
rstudioSnippetsPathBase <- file.path(path.expand('~'), ".config/rstudio", "snippets")
}
}
I'm currently working on an add in for RStudio which opens an "enchanced" view of a data frame in Shiny, allows you to filter and select columns, then passes that code to the command line wrapped in View().
One feature which was suggested to me was to replace the default View in RStudio when the package is loaded to always load my new viewer.
I wanted this, but also to preserve the ability to use RStudio's View if you wanted. So I tried code like this:
View <- function(data_in, replace = T){
if (replace){
print('example')
}else{
utils::View(data_in)
}
This does not work, however, as utils::View is not the same as the View in RStudio. However, a search for ?View only gets the utils version. I'm assuming RStudio is overwriting View when loading, but I have no idea how to access it. I'd be happy to copy the function into something called save_view (or similar) but don't know how to access it! Entering View into the command line gives me the following code
function (...)
.rs.callAs(name, hook, original, ...)
<environment: 0x516d648>
But copying that to a new function will just give me something that errors (I'm wondering if it's something to do with the environment the function exists on)
RStudio replaces the internal View function with the one you saw. You can get it using
RStudioView <- as.environment("package:utils")$View
If you call that one, it should do what RStudio does.
You get the original one using utils::View.
This seems to be the source of the View() (from utils):
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])
as.num.or.char <- function(x) {
if (is.character(x))
x
else if (is.numeric(x)) {
storage.mode(x) <- "double"
x
}
else as.character(x)
}
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))
}
And very clearly it's calling the C_dataviwer and this is the dataviewer https://support.rstudio.com/hc/en-us/articles/205175388-Using-the-Data-Viewer#starting-the-viewer
Edit:
Here's the actual code of dataviewer https://github.com/rstudio/rstudio/blob/5719361179d1020dc3157c4e24b21bcd17c483e6/src/cpp/session/modules/data/DataViewer.cpp
I am trying to load a package at start-up if it's already installed. If it isn't then I want to first install it and then load it. So, I created the following function:
RLoadPackage <- function(packname)
{
if((packname %in% rownames(installed.packages()))==FALSE)
{
install.packages(packname,dependencies = TRUE)
}
library(packname,character.only = TRUE)
}
This works well once RStudio is opened, but it doesn't quite work at start-up. I added this function to my local .RProfile file as:
RLoadPackage("ggplot2")
RLoadPackage <- function(packname)
{
if((packname %in% rownames(installed.packages()))==FALSE)
{
install.packages(packname,dependencies = TRUE)
}
library(packname,character.only = TRUE)
}
However, I get the error message as:
Error: could not find function "RLoadPackage"
One option is to install packages manually and then add a bunch of library("xyz")
However, the above option is very clunky. So, I created a function.
I've 2 questions:
1) Can someone please help me with it?
2) Is there more efficient way of doing this?
My post is inspired from the following two links:
1) Check for installed packages before running install.packages()
2) http://www.statmethods.net/interface/customizing.html
I'd appreciate any help.
Thanks
Ok. This piece of code works:
library("utils")
RLoadPackage <- function(packname)
{
if((packname %in% rownames(installed.packages()))==FALSE)
{
install.packages(packname,dependencies = TRUE)
}
library(packname,character.only = TRUE)
}
RLoadPackage("ggplot2")
RLoadPackage("dplyr")
RLoadPackage("lubridate")
However, is there more efficient way of loading multiple packages--maybe a vectorized version of this? I am just curious.
Is it possible to go from compiled R code found in packages back to R source code? I would like to get the source code for various functions from packages installed from CRAN or other sources. I know I can download the full source via separate downloads.
You can extract the text of functions in a package using args() and body(). To list all the objects in a package you can use ls() and specify the package environment.
Caveat: The approach below will give you the source code, but not the NAMESPACE or DESCRIPTION.
For example, to print the source code of everything in ggplot2, try this:
library(ggplot2)
pkg <- as.environment("package:ggplot2")
allfuns <- ls(envir = pkg)
for(f in allfuns[1:2]){
args <- capture.output(print(args(f)))[1]
body <- paste(capture.output(print(body(f))), collapse = "\n")
cat(sprintf("%s <- %s\n%s\n\n", f, args, body))
}
This will give you:
%+% <- function (e1, e2)
{
e2name <- deparse(substitute(e2))
if (is.theme(e1))
add_theme(e1, e2, e2name)
else if (is.ggplot(e1))
add_ggplot(e1, e2, e2name)
}
%+replace% <- function (e1, e2)
{
if (!is.theme(e1) || !is.theme(e2)) {
stop("%+replace% requires two theme objects", call. = FALSE)
}
e1[names(e2)] <- e2
e1
}
Andrie's answer above has been hugely helpful for me. I had to use a package that is not on CRAN or git, and was only distributed as a compiled package built for R 3.0.1. Obviously when I tried to use it with R 4 it didn't work, and I didn't want to keep switching back and forth between R versions, so I had to decompile the package, rebuild the source, and reinstall.
However, Andrie's code example has a few shortcomings, most importantly that it only decompiles exported functions, not internal ones. Obviously this post is pretty old, but I'm posting my updates here in case it's helpful for anyone else trying to do the same thing.
packagename <- "ggplot2" #input package name here
pkg <- asNamespace(packagename) # importing as namespace rather than package accesses internals
allfuns <- ls(name = pkg)
for(f in allfuns){
# Andrie's [1] subset didn't work if the function arguments were more than one line long
args <- head(capture.output(print(args(getFromNamespace(f, packagename)))), -1)
body <- paste(capture.output(print(body(getFromNamespace(f, packagename)))),
collapse = "\n")
# This now writes directly to an R code file, rather than the console, to avoid copy/paste
# You could tweak this to create a separate file for each function, if desired.
cat(sprintf("%s <- %s\n%s\n\n", f, args, body),
file = paste(packagename, "functions.R"),
append = TRUE)
}