In developing an R package, in order to extend the generic plot function, what is the difference between plot.class_name and ggplot.class_name.
library(ggplot2)
add_values <- function(a, b){
out <- list()
class(out) <- "myclass"
c <- a + b
out$a <- a
out$b <- b
out$c <- c
return(out)
}
plot.myclass <- function(x, ...){
cat("Called by plot.")
plot(x$a,x$b)
}
ggplot.myclass <- function(x, ...){
cat("Called by ggplot.")
plot(x$b,x$a)
}
a <- seq(0,10,0.01)
b <- a^2
x <- add_values(a,b)
plot(x) # Prints out: Called by plot.
ggplot(x) # Prints out: Called by ggplot.
For a simple test, it seems both of them work fine. I prefer to use ggplot inside the package. There are a couple of options:
Developing two separate methods for plot.myclass and ggplot.myclass
Use ggplot inside plot.myclass then plot(object) will return ggplot results.
Use ggplot inside ggplot.myclass and do not support plot(object) command.
Does CRAN have any restriction on using any of these options?
Related
I'm working with raster package and I try to switch to terra but for some reasons that I don't understand, terra cannot reproduce the same operation of raster when working in parallel with packages such snowfall and future.apply. Here is a reproducible example.
library(terra)
r <- rast()
r[] <- 1:ncell(r)
m <- rast()
m[] <- c(rep(1,ncell(m)/5),rep(2,ncell(m)/5),rep(3,ncell(m)/5),rep(4,ncell(m)/5),rep(5,ncell(m)/5))
ms <- separate(m,other=NA)
plot(ms)
mymask <- function(ind){
tipo <- tipo_tav[ind]
mask <- ms[[ind]]
masked <-
terra::mask(
r,
mask
)
richard <- function(x){
k <-0.2
v <-0.3
a <-200
y0 <-2
y <- k/v*x*(1-((x/a)^v))+y0
return(y)
}
pred <- richard(masked)
pred <- clamp(pred,lower=0)
return(pred)
}
#the sequential usage works fine, faster than the `raster` counterpart
system.time(x <- mymask(1))#0.03
#when I try to run my function in parallel I receive an error
plan(multisession,workers=5)
system.time(pred_list <- future_lapply(1:5, FUN = mymask))
Error in .External(list(name = "CppMethod__invoke_notvoid", address = <pointer: (nil)>, :
NULL value as symbol address.
the exactly same code works well if I change rast with raster and terra::mask with raster::mask. See below:
library(raster)
r <- raster(r)
ms <- stack(ms)
mymask <- function(ind){
tipo <- tipo_tav[ind]
mask <- ms[[ind]]
masked <-
raster::mask(
r,
mask
)
richard <- function(x){
k <-0.2
v <-0.3
a <-200
y0 <-2
y <- k/v*x*(1-((x/a)^v))+y0
return(y)
}
pred <- richard(masked)
pred <- clamp(pred,lower=0)
return(pred)
}
#this works fine
system.time(x <- mymask(1))#0.06
#this works too
plan(multisession,workers=5)
system.time(pred_list <- future_lapply(1:5, FUN = mymask))#15.48
The same behavior if I use snowfall instead of future
library(snowfall)
sfInit(parallel = TRUE, cpus =5)
sfLibrary(terra)
sfExportAll()
system.time(pred_list <- sfLapply(1:5, fun = mymask))
sfStop()
this return the same error of future_lapply
Why is this happening? I've never seen such an error. I was hoping to take advantage of the higher speed of terra but so I'm stuck.
A SpatRaster cannot be serialized, you cannot send it to parallel compute nodes. Have a look here for more discussion.
Instead you can (a) send and receive filenames; (b) parallelize your custom function that you supply to app or lapp; (c) use the cores=n argument (where available, e.g. app and predict); (d) use a mechanism like wrap; (e) send a filename and a vector to make a SpatExtent to process and create a virtual raster from the output tiles (see ?vrt).
For example, you could do use a function like this (Option "a")
prich <- function(filein, fileout) {
r <- rast(filein)
richard <- function(x) {
k <-0.2
v <-0.3
a <-200
y0 <-2
y <- k/v*x*(1-((x/a)^v))+y0
y[y<0] <- 0
return(y)
}
x <- app(masked, richard, filename=fileout, overwrite=TRUE)
return(TRUE)
}
I use app because it is much more efficient for large rasters --- as it could avoid writing temp files for each of the 10 arithmetic operations with a SpatRaster. Given that you want to parallelize this relatively simple function, I assume the files are very large.
Or option "c":
richard <- function(x) {
k <-0.2
v <-0.3
a <-200
y0 <-2
y <- k/v*x*(1-((x/a)^v))+y0
y[y<0] <- 0
return(y)
}
x <- app(masked, richard, cores=12)
In neither case I included the masking. You could include it in option "a" but mask is disk I/O intensive, not computationally intensive, so it might be as efficient to do it in one step rather than in parallel.
With wrap you could do something like this
f <- function(w) {
x <- rast(w)
y <- richard(x)
wrap(y)
}
r <- rast(nrow=10, ncol=10, vals=1:100)
x <- f(wrap(r))
x <- rast(x)
Where f would be run in parallel. That only works for small rasters, but you could parallelize over tiles, and you can create tiles with terra::makeTiles.
More internal parallelization options will be coming, but don't hold your breath.
I'm saving objects to a list and I'd like to clear the plots pane and viewer pane whenever I load those objects. I basically want the back button to grey out after I've gone through the charts in that element of the list.
This is my code
gg <- ggplot(iris, aes(width, length)) + geom_point
l <- list()
l[["element"]] <- gg
I want it so that when I run l$element, it's like I first clicked the broom on the plots and viewer tab in rstudio.
You can do this as long as you store the ggplot inside a custom S3 class whose default print method calls dev.off then plots the enclosed ggplot:
gg_wipe <- function(x) structure(list(plot = x), class = "gg_wipe")
print.gg_wipe <- function(x) {dev.off(); print(x$plot)}
gg <- ggplot(iris, aes(Sepal.Width, Sepal.Length)) + geom_point()
l <- list()
l[["element"]] <- gg_wipe(gg)
l[["element"]]
Or rather than wrapping the plot as Allan did (which is a good idea) you can provide a helper function and then provide different ways to get at it. So this calls the helper function directly
l <- list(
apple=ggplot(data.frame(x=1:3, y=1:3)) + geom_point(aes(x,y)),
banana=ggplot(data.frame(x=1:3, y=3:1)) + geom_point(aes(x,y))
)
clear_and_print <- function(x, ele) {
graphics.off(); invisible(print(x[[deparse(substitute(ele))]]))
}
clear_and_print(l, apple)
You can define some new operators but they have to be syntactically valid. You can't have ^^^ bur you could have %^%
`%^%` <- clear_and_print
l %^% apple
l %^% banana
Or you can create a special class for your container
`$.plot_clear` <- function(x, ele) {
graphics.off(); x[[ele]]
}
class(l) <- "plot_clear"
l$apple
l$banana
I need a function created by a list of commands to fully evaluate so that it is identical to the "manual" version of the function.
Background: I am using ScaleR functions in Microsoft R Server and need to apply a set of transformations as a function. ScaleR is very picky about needing to be passed a function that is phrased exactly as specified below:
functionThatWorks <- function(data) {
data$marital_status_p1_ismarried <- impute(data$marital_status_p1_ismarried)
return(data)
}
I have a function that creates this list of transformations (and hundreds more, hence the need to functionalize its writing).
transformList <- list ("data$ismarried <- impute(data$ismarried)",
"data$issingle <- impute(data$issingle)")
This line outputs the evaluated string that I want to the console, but I am unaware of a way to move it from console output to being used in a function:
cat(noquote(unlist(bquote( .(noquote(transformList[1]))))))
I need to evaluate functionIWant so that it is identical to functionThatWorks.
functionIWant <- function(data){
eval( cat(noquote(unlist(bquote( .(noquote(transformList[1])))))) )
return(data)
}
identical(functionThatWorks, functionIWant)
EDIT: Adding in the answer based on #dww 's code. It works well in ScaleR. It is identical, minus meaningless spacing.
functionIWant <- function(){}
formals(functionIWant) <- alist(data=NULL)
functionIWant.text <- parse(text = c(
paste( bquote( .(noquote(transformList[1]))), ";", "return(data)\n")
))
body(functionIWant) <- as.call(c(as.name("{"), functionIWant.text))
Maybe something like this?
# 1st define a 'hard-coded' function
f1 <- function (x = 2)
{
y <- x + 1
y^2
}
f1(3)
# [1] 16
# now create a similar function from a character vector
f2 <- function(){}
formals(f2) <- alist(x=2)
f2.text <- parse(text = c('y <- x + 1', 'y^2'))
body(f2) <- as.call(c(as.name("{"), f2.text))
f2(3)
# [1] 16
how I can use the progress bar like this example inside of a function written for use for use in calc raster function?
I have a huge dataset to process and I desire to use the progress bar to control the duration of process. I tryied to use like this, the function (of process) works prefectly, but, do not show the progress bar.
# PROGRESS BAR IN CALC RASTER EXAMPLE
# create data
r <- raster(nrow=10, ncol=10)
dataset <- list()
for (i in 1:20) {
dataset[i] <- setValues(r, rnorm(ncell(r), i, 3) )
}
dataset <- stack(dataset)
## function to apply
pixel <-getValuesBlock(s1, row=1, nrows=1, col=1, ncols=1, lyrs=1:nlayers(s1))
CropAnalysis <- function (pixel, ...){
gc()
pb <- txtProgressBar(...)
# test : if is No data the return is
if (identical(x = is.na(pixel), y = rep(TRUE,length(pixel)))) {NA}else{
averageOfhigher <- mean(pixel[pixel > 10], na.rm=T)
averageOflower <- mean(pixel[pixel < 10], na.rm=T)
return(c(averageOfhigher, averageOflower))
}
setTxtProgressBar(pb)}
# applying calc finction
data_process<-calc(x=dataset, fun=CropAnalysis, forcefun=TRUE, forceapply=TRUE)
You can use the progress argument that is build in to most functions in the raster package. It is only shown when writing in chunks (because the dataset is large).
# example data
library(raster)
r <- raster(nrow=10, ncol=10)
d <- stack(lapply(1:20, function(i) setValues(r, rnorm(ncell(r), i, 3) )) )
f <- function(pixel, ...){
if (all(is.na(pixel))) {
c(NA, NA) # note the two NAs to match the other case
} else {
averageOfhigher <- mean(pixel[pixel > 10], na.rm=TRUE)
averageOflower <- mean(pixel[pixel < 10], na.rm=TRUE)
c(averageOfhigher, averageOflower)
}
}
Do not use the line below in a script. It is only needed in this
toy example to trigger writing in chunks such that the progress bar appears
rasterOptions(todisk=TRUE)
But do use the progress argument (either "text" or "window")
r <- calc(d, fun=f, progress='text')
One simple solution
you can use the rasterOptions function that is built in the raster package.
as an example
rasterOptions(progress = 'text',timer=TRUE) will show you the progress, as the example you showed, and the time for each used function from the raster package.
check this link for more advanced options:
https://rdrr.io/cran/raster/man/rasterOptions.html
I want to construct
f <- function(...) {
g <- function(x) x ^ 2
list(...)
}
so that I can invoke using f(g(4)) and have list(...) result in list(16).
In general I will define several temporary functions inside f that the user can invoke when calling f(...).
I have experimented with assign and newenvironment but have just gotten more confused. Help with an elegant solution is appreciated.
The reason for wanting this is that I want a function in the Hmisc package, drawPlot to be able to let the users specify generically named functions as input for building up a series of graphical elements, and I don't want to reserve these generic-type names. E.g.:
d <- drawPlot(Curve(), Points()) # interactively make a curve and
# a set of points
I'm guessing you in fact need something more elaborate than this, but the following does what you've asked for in your supplied example:
f <- function(...) {
g <- function(x) x ^ 2
list(eval(substitute(...)))
}
f(g(4))
# [[1]]
# [1] 16
Or, if users may supply one or more function calls, something like this:
f <- function(...) {
g <- function(x) x ^ 2
h <- function(x) 100*x
cc <- as.list(substitute(list(...))[-1])
res <- list()
for(i in seq_along(cc)) {
res[[i]] <- eval(cc[[i]])
}
res
}
f(g(4), h(5))
# [[1]]
# [1] 16
#
# [[2]]
# [1] 500
Very similar to this answer but I think maybe more extensible and closer to your original idea:
match.fun_wrapper <- function(...) {
# `match.fun` searches in the parent environment of the environment that
# calls `match.fun`, so this wrapper is a hack to be able to search in
# the current environment rather than the parent of the current environemnt
match.fun(...)
}
f <- function(fun, ...) {
g <- function(x) x ^ 2
fun <- match.fun_wrapper(substitute(fun))
fun(...)
}
If you wanted to do away with match.fun, you could also do away with the wrapper hack:
f <- function(fun, ...) {
g <- function(x) x ^ 2
fun(...)
}
It looks to me like what you're trying to do is something like this:
f <- function(fun, ...) {
g <- function(x) x ^ 2
h <- function(x) x ^ 3
i <- function(x) x ^ 4
switch(fun,
'g' = g(...),
'h' = h(...),
'i' = i(...))
}
> f('g', 3)
[1] 9
> f('h', 3)
[1] 27
> f('i', 3)
[1] 81
It's not obvious why you would want to, unless you're just trying to encapsulate functions with similar names inside different namespaces and using this as a hacky workaround for the fact R doesn't offer fully-featured classes. If that's the case, you can also just use actual namespaces, i.e. put your functions inside a package so they're called by package::g(arg) instead of f('g', arg).