When writing tests, I sometimes want to check how R would react to conflicts.
For instance, my package contains a compact() function that conflicts with purrr::compact(), and I wrote some code so that this latter is still used on regular lists.
In my tests, I want to check that purrr::compact() will still work on regular lists if my package is loaded.
Therefore, I wrote a unit-test that looks a bit like this:
test_that("Test A", {
library(purrr, include.only="compact", warn.conflicts=FALSE)
compact = crosstable::compact
x = list(a = "a", b = NULL, c = integer(0), d = NA, e = list())
expect_identical(compact(x), list(a="a",d=NA))
})
However, the library() call has a global effect that kind of messes up with some other unrelated tests.
Is there a way to import a library locally?
I'm thinking about something like rlang::local_options().
My first idea is a great package withr which helps with all temp related problems. Take into account that namespace will be still there, loadedNamespaces().
Example of usage from .GlobalEnv:
search()
#> [1] ".GlobalEnv" "package:stats" "package:graphics"
#> [4] "package:grDevices" "package:utils" "package:datasets"
#> [7] "package:methods" "Autoloads" "tools:callr"
#> [10] "package:base"
withr::with_package("dplyr", {airquality %>% mutate(n = 2) %>% head()})
#> Ozone Solar.R Wind Temp Month Day n
#> 1 41 190 7.4 67 5 1 2
#> 2 36 118 8.0 72 5 2 2
#> 3 12 149 12.6 74 5 3 2
#> 4 18 313 11.5 62 5 4 2
#> 5 NA NA 14.3 56 5 5 2
#> 6 28 NA 14.9 66 5 6 2
mutate
#> Error in eval(expr, envir, enclos): object 'mutate' not found
search()
#> [1] ".GlobalEnv" "package:stats" "package:graphics"
#> [4] "package:grDevices" "package:utils" "package:datasets"
#> [7] "package:methods" "Autoloads" "tools:callr"
#> [10] "package:base"
Created on 2021-06-21 by the reprex package (v2.0.0)
Another idea is usage of utils::getFromNamespace:
fun <- utils::getFromNamespace("fun", "pkg")
Related
I'm trying to build a tool that interacts with an R subprocess, but the process exits whenever R encounters an error.
Is there a way to prevent that?
Here is a simple exemple: as you can see, the process exits as soon as it encounters an error:
library(subprocess)
# Spawning an R process
r <- spawn_process(
Sys.which("R"), c("--vanilla", "--quiet")
)
Sys.sleep(1)
# Checking and reading the state
process_state(r)
#> [1] "running"
process_read(r)
#> $stdout
#> [1] "> "
#>
#> $stderr
#> character(0)
# Writing a normal call
process_write(r, "print(2)\n")
#> [1] 9
Sys.sleep(1)
process_state(r)
#> [1] "running"
process_read(r)
#> $stdout
#> [1] "print(2)" "[1] 2" "> "
#>
#> $stderr
#> character(0)
# Writing a call that will fail
process_write(r, "a\n")
#> [1] 2
Sys.sleep(1)
# The process has exited
process_state(r)
#> [1] "exited"
Created on 2019-11-17 by the reprex package (v0.3.0)
For example, if we compare with a NodeJS process, it doesn't exits after an error:
library(subprocess)
n <- spawn_process(
Sys.which("node"), "-i"
)
process_write(n, "a\n")
#> [1] 2
Sys.sleep(1)
process_read(n)
#> $stdout
#> [1] "> Thrown:" "ReferenceError: a is not defined"
#> [3] "> "
#>
#> $stderr
#> character(0)
process_state(n)
#> [1] "running"
process_write(n, "console.error('a')\n")
#> [1] 19
Sys.sleep(1)
process_read(n)
#> $stdout
#> [1] "undefined" "> "
#>
#> $stderr
#> [1] "a"
process_state(n)
#> [1] "running"
Created on 2019-11-17 by the reprex package (v0.3.0)
or with bash:
library(subprocess)
n <-spawn_process(
Sys.which("bash"),
)
process_write(n, "a\n")
#> [1] 2
Sys.sleep(1)
process_read(n)
#> $stdout
#> character(0)
#>
#> $stderr
#> [1] "/bin/bash: line 1: a: command not found"
process_state(n)
#> [1] "running"
Created on 2019-11-17 by the reprex package (v0.3.0)
It seems as though R is being run in batch mode, in which case R will exit if an error is thrown at the top level. If you add the --interactive option then R will continue to run after errors.
r <- spawn_process(
Sys.which("R"), c("--vanilla", "--quiet", "--interactive")
)
I want to use the function skim from R package skimr on Windows. Unfortunately, in many situations column, hist is printed incorrectly (with many <U+2587>-like symbols), as in the example below.
Question: is there an easy way to either disable column "hist" and prevent it from being printed or prevent it from being calculated at all? Is there an option like hist = FALSE?
capture.output(skimr::skim(iris))
#> [1] "Skim summary statistics"
#> [2] " n obs: 150 "
#> [3] " n variables: 5 "
#> [4] ""
#> [5] "-- Variable type:factor ------------------------------------------------------------------------"
#> [6] " variable missing complete n n_unique top_counts"
#> [7] " Species 0 150 150 3 set: 50, ver: 50, vir: 50, NA: 0"
#> [8] " ordered"
#> [9] " FALSE"
#> [10] ""
#> [11] "-- Variable type:numeric -----------------------------------------------------------------------"
#> [12] " variable missing complete n mean sd p0 p25 p50 p75 p100"
#> [13] " Petal.Length 0 150 150 3.76 1.77 1 1.6 4.35 5.1 6.9"
#> [14] " Petal.Width 0 150 150 1.2 0.76 0.1 0.3 1.3 1.8 2.5"
#> [15] " Sepal.Length 0 150 150 5.84 0.83 4.3 5.1 5.8 6.4 7.9"
#> [16] " Sepal.Width 0 150 150 3.06 0.44 2 2.8 3 3.3 4.4"
#> [17] " hist"
#> [18] " <U+2587><U+2581><U+2581><U+2582><U+2585><U+2585><U+2583><U+2581>"
#> [19] " <U+2587><U+2581><U+2581><U+2585><U+2583><U+2583><U+2582><U+2582>"
#> [20] " <U+2582><U+2587><U+2585><U+2587><U+2586><U+2585><U+2582><U+2582>"
#> [21] " <U+2581><U+2582><U+2585><U+2587><U+2583><U+2582><U+2581><U+2581>"
Changing the locale to Chinese (as in this answer) does not solve the problem, but makes it worse:
Sys.setlocale(locale = "Lithuanian")
df <- data.frame(x = 1:5, y = c("Ą", "Č", "Ę", "ū", "ž"))
Sys.setlocale(locale = "Chinese")
capture.output(skimr::skim(df))
#> Error in substr(names(x), 1, options$formats$.levels$max_char) : invalid multibyte string at '<c0>'
skim_with(numeric = list(hist = NULL)) This is in the "Using Skimr" vignette.
You could also use skim_without_charts instead of skim.
More details in the docs here:
https://www.rdocumentation.org/packages/skimr/versions/2.0.2/topics/skim
Also keep in mind that the output from skimr is a dataframe so you can do:
# I'm using tidyverse here
iris %>%
skim() %>%
select(-numeric.hist)
The catch is that the name of the column is not hist but numeric.hist.
I actually got to this question because I wanted to do the opposite: keep only the histograms.
I am looking at the code from here which has this at the beginning:
## generate data for medical example
clinical.trial <-
data.frame(patient = 1:100,
age = rnorm(100, mean = 60, sd = 6),
treatment = gl(2, 50,
labels = c("Treatment", "Control")),
center = sample(paste("Center", LETTERS[1:5]), 100, replace =
TRUE))
## set some ages to NA (missing)
is.na(clinical.trial$age) <- sample(1:100, 20)
I cannot understand this last line.
The LHS is a vector of all FALSE values. The RHS is a vector of 20 numbers selected from the vector 1:100.
I don't understand this kind of assignment. How is this result in clinical.trial$age getting some NA values? Does this kind of assignment have a name? At best I would say that the boolean vector on the RHS gets numbers assigned to it with recycling.
is.na(x) <- value is translated as 'is.na<-'(x, value).
You can think of 'is.na<-'(x, value) as 'assign NA to x, at position value'.
A perhaps better and intuitive phrasing could be assign_NA(to = x, pos = value).
Regarding other similar function, we can find those in the base package:
x <- as.character(lsf.str("package:base"))
x[grep('<-', x)]
#> [1] "$<-" "$<-.data.frame"
#> [3] "#<-" "[[<-"
#> [5] "[[<-.data.frame" "[[<-.factor"
#> [7] "[[<-.numeric_version" "[<-"
#> [9] "[<-.data.frame" "[<-.Date"
#> [11] "[<-.factor" "[<-.numeric_version"
#> [13] "[<-.POSIXct" "[<-.POSIXlt"
#> [15] "<-" "<<-"
#> [17] "attr<-" "attributes<-"
#> [19] "body<-" "class<-"
#> [21] "colnames<-" "comment<-"
#> [23] "diag<-" "dim<-"
#> [25] "dimnames<-" "dimnames<-.data.frame"
#> [27] "Encoding<-" "environment<-"
#> [29] "formals<-" "is.na<-"
#> [31] "is.na<-.default" "is.na<-.factor"
#> [33] "is.na<-.numeric_version" "length<-"
#> [35] "length<-.factor" "levels<-"
#> [37] "levels<-.factor" "mode<-"
#> [39] "mostattributes<-" "names<-"
#> [41] "names<-.POSIXlt" "oldClass<-"
#> [43] "parent.env<-" "regmatches<-"
#> [45] "row.names<-" "row.names<-.data.frame"
#> [47] "row.names<-.default" "rownames<-"
#> [49] "split<-" "split<-.data.frame"
#> [51] "split<-.default" "storage.mode<-"
#> [53] "substr<-" "substring<-"
#> [55] "units<-" "units<-.difftime"
All works the same in the sense that 'fun<-'(x, val) is equivalent to fun(x) <- val. But after that they all behave like any normal functions.
R manuals: 3.4.4 Subset assignment
The help tells us, that:
(xx <- c(0:4))
is.na(xx) <- c(2, 4)
xx #> 0 NA 2 NA 4
So,
is.na(xx) <- 1
behaves more like
set NA at position 1 on variable xx
#matt, to respond to your question asked above in the comments, here's an alternative way to do the same assignment that I think is easier to follow :-)
clinical.trial$age[sample(1:100, 20)] <- NA
I am attempting the exercise in R for data science (7.5.2.1, #2): Use geom_tile() together with dplyr to explore how average flight delays vary by destination and month of year. What makes the plot difficult to read? How could you improve it?
First, transmute columns.
library(nycflights13)
foo <- nycflights13::flights %>%
transmute(tot_delay = dep_delay + arr_delay, m = month, d = dest) %>%
filter(!is.na(tot_delay)) %>%
group_by(m, d) %>%
summarise(avg_delay = mean(tot_delay))
Now foo appears to be a data frame based on the 'Source' output.
> foo
Source: local data frame [1,112 x 3]
Groups: m [?]
m d avg_delay
<int> <chr> <dbl>
1 1 ALB 76.571429
2 1 ATL 8.567982
3 1 AUS 19.017751
4 1 AVL 49.000000
5 1 BDL 32.081081
6 1 BHM 47.043478
7 1 BNA 25.930233
8 1 BOS 2.698517
9 1 BQN 8.516129
10 1 BTV 18.393665
# ... with 1,102 more rows
It doesn't appear that as_tibble is working, what could I be doing wrong?
> as_tibble(foo)
Source: local data frame [1,112 x 3]
Groups: m [?]
m d avg_delay
<int> <chr> <dbl>
1 1 ALB 76.571429
2 1 ATL 8.567982
3 1 AUS 19.017751
4 1 AVL 49.000000
5 1 BDL 32.081081
6 1 BHM 47.043478
7 1 BNA 25.930233
8 1 BOS 2.698517
9 1 BQN 8.516129
10 1 BTV 18.393665
# ... with 1,102 more rows
Shouldn't the internals be different for a tibble?
> str(foo)
Classes ‘grouped_df’, ‘tbl_df’, ‘tbl’ and 'data.frame': 1112 obs. of 3 variables:
$ m : int 1 1 1 1 1 1 1 1 1 1 ...
$ d : chr "ALB" "ATL" "AUS" "AVL" ...
$ avg_delay: num 76.57 8.57 19.02 49 32.08 ...
- attr(*, "vars")=List of 1
..$ : symbol m
- attr(*, "drop")= logi TRUE
> str(as_tibble(foo))
Classes ‘grouped_df’, ‘tbl_df’, ‘tbl’ and 'data.frame': 1112 obs. of 3 variables:
$ m : int 1 1 1 1 1 1 1 1 1 1 ...
$ d : chr "ALB" "ATL" "AUS" "AVL" ...
$ avg_delay: num 76.57 8.57 19.02 49 32.08 ...
- attr(*, "vars")=List of 1
..$ : symbol m
- attr(*, "drop")= logi TRUE
Note that as_tibble() works as expected
> packageDescription("tibble")
Package: tibble
Encoding: UTF-8
Version: 1.3.0
> is_tibble(foo)
[1] TRUE
Works for me - foo is a "tibble" and is announced as "A tibble: 112 x 3" in the print:
> foo
Source: local data frame [1,112 x 3]
Groups: m [?]
# A tibble: 1,112 x 3
m d avg_delay
<int> <chr> <dbl>
1 1 ALB 76.571429
2 1 ATL 8.567982
So you possibly have an old version of dplyr. Mine is:
> packageDescription("dplyr")
Package: dplyr
Type: Package
Version: 0.5.0
And everything else:
> sessionInfo()
R version 3.3.1 (2016-06-21)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Ubuntu 14.04.4 LTS
locale:
[1] LC_CTYPE=en_GB.UTF-8 LC_NUMERIC=C
[3] LC_TIME=en_GB.UTF-8 LC_COLLATE=en_GB.UTF-8
[5] LC_MONETARY=en_GB.UTF-8 LC_MESSAGES=en_GB.UTF-8
[7] LC_PAPER=en_GB.UTF-8 LC_NAME=C
[9] LC_ADDRESS=C LC_TELEPHONE=C
[11] LC_MEASUREMENT=en_GB.UTF-8 LC_IDENTIFICATION=C
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] dplyr_0.5.0 tibble_1.3.1
loaded via a namespace (and not attached):
[1] magrittr_1.5 R6_2.2.0 assertthat_0.2.0 DBI_0.5-1
[5] tools_3.3.1 Rcpp_0.12.11 rlang_0.1.1
I'm looking for a way to query all S4 methods implemented by a particular package (given through its namespace environment). I think I could enumerate all objects that start with .__T__, but I'd rather prefer using a documented and/or less hackish way.
> ls(asNamespace("RSQLite"), all.names = TRUE, pattern = "^[.]__T__")
[1] ".__T__dbBegin:DBI" ".__T__dbBeginTransaction:RSQLite"
[3] ".__T__dbBind:DBI" ".__T__dbClearResult:DBI"
[5] ".__T__dbColumnInfo:DBI" ".__T__dbCommit:DBI"
[7] ".__T__dbConnect:DBI" ".__T__dbDataType:DBI"
[9] ".__T__dbDisconnect:DBI" ".__T__dbExistsTable:DBI"
[11] ".__T__dbFetch:DBI" ".__T__dbGetException:DBI"
[13] ".__T__dbGetInfo:DBI" ".__T__dbGetPreparedQuery:RSQLite"
[15] ".__T__dbGetQuery:DBI" ".__T__dbGetRowCount:DBI"
[17] ".__T__dbGetRowsAffected:DBI" ".__T__dbGetStatement:DBI"
[19] ".__T__dbHasCompleted:DBI" ".__T__dbIsValid:DBI"
[21] ".__T__dbListFields:DBI" ".__T__dbListResults:DBI"
[23] ".__T__dbListTables:DBI" ".__T__dbReadTable:DBI"
[25] ".__T__dbRemoveTable:DBI" ".__T__dbRollback:DBI"
[27] ".__T__dbSendPreparedQuery:RSQLite" ".__T__dbSendQuery:DBI"
[29] ".__T__dbUnloadDriver:DBI" ".__T__dbWriteTable:DBI"
[31] ".__T__fetch:DBI" ".__T__isSQLKeyword:DBI"
[33] ".__T__make.db.names:DBI" ".__T__show:methods"
[35] ".__T__sqlData:DBI" ".__T__SQLKeywords:DBI"
I think showMethods is the only thing available in methods, but it does not actually return the functions as an object, just prints them to the screen.
The following will return a list of the methods defined in an environment. Adapted from covr::replacements_S4(), which is used to modify all methods in a package to track coverage.
S4_methods <- function(env) {
generics <- methods::getGenerics(env)
res <- Map(generics#.Data, generics#package, USE.NAMES = FALSE,
f = function(name, package) {
what <- methods::methodsPackageMetaName("T", paste(name, package, sep = ":"))
table <- get(what, envir = env)
mget(ls(table, all.names = TRUE), envir = table)
})
res[lengths(res) > 0]
}
m <- S4_methods(asNamespace("DBI"))
length(m)
#> [1] 21
m[1:3]
#> [[1]]
#> [[1]]$DBIObject
#> function(dbObj, obj, ...) {
#> dbiDataType(obj)
#> }
#> <environment: namespace:DBI>
#> attr(,"target")
#> An object of class "signature"
#> dbObj
#> "DBIObject"
#> attr(,"defined")
#> An object of class "signature"
#> dbObj
#> "DBIObject"
#> attr(,"generic")
#> [1] "dbDataType"
#> attr(,"generic")attr(,"package")
#> [1] "DBI"
#> attr(,"class")
#> [1] "MethodDefinition"
#> attr(,"class")attr(,"package")
#> [1] "methods"
#>
#>
#> [[2]]
#> [[2]]$character
#> function(drvName, ...) {
#> findDriver(drvName)(...)
#> }
#> <environment: namespace:DBI>
#> attr(,"target")
#> An object of class "signature"
#> drvName
#> "character"
#> attr(,"defined")
#> An object of class "signature"
#> drvName
#> "character"
#> attr(,"generic")
#> [1] "dbDriver"
#> attr(,"generic")attr(,"package")
#> [1] "DBI"
#> attr(,"class")
#> [1] "MethodDefinition"
#> attr(,"class")attr(,"package")
#> [1] "methods"
#>
#>
#> [[3]]
#> [[3]]$`DBIConnection#character`
#> function(conn, statement, ...) {
#> rs <- dbSendStatement(conn, statement, ...)
#> on.exit(dbClearResult(rs))
#> dbGetRowsAffected(rs)
#> }
#> <environment: namespace:DBI>
#> attr(,"target")
#> An object of class "signature"
#> conn statement
#> "DBIConnection" "character"
#> attr(,"defined")
#> An object of class "signature"
#> conn statement
#> "DBIConnection" "character"
#> attr(,"generic")
#> [1] "dbExecute"
#> attr(,"generic")attr(,"package")
#> [1] "DBI"
#> attr(,"class")
#> [1] "MethodDefinition"
#> attr(,"class")attr(,"package")
#> [1] "methods"
I think you want the showMethods function, as in:
showMethods(where=asNamespace("RSQLite"))
The output is:
Function: dbBegin (package DBI)
conn="SQLiteConnection"
Function: dbBeginTransaction (package RSQLite)
conn="ANY"
Function: dbClearResult (package DBI)
res="SQLiteConnection"
res="SQLiteResult"
Function: dbColumnInfo (package DBI)
res="SQLiteResult"
and this goes on for many more rows. ?showMethods will has some additional arguments for tailoring the results.