My problem is very basic (I am a beginner user in R). I am trying to collect the value selected from a gradio widget (gwidgets2 package for R).
I am using a similar script as this simplified one :
U=vector(mode="character")
DF=function() {
Win=gbasicdialog(handler=function(h,...) {
T=svalue(A)
print(T)
# I can print but not assign the value using : assign (U,T, .GlobalEnv)
})
A<-gradio(c("1","2","3"), selected=1,container=Win,)
out <- visible(Win)
}
DF()
Using this script, I am able to print the value selected in the gradio widget, but when I try to assign this value to another variable passed to the global environment, I get an error.
It is strange as this structure of script works fine to collect values from other widgets (like gtable). What am I doing wrong ?
Thanks for the help.
I am not sure what goes wrong, but was able to run your code with a small change:
DF <- function() {
Win <- gbasicdialog(
handler = function(h, ...) {
.GlobalEnv$varT = svalue(A)
print(varT)
}
)
A <- gradio(c("1", "2", "3"), selected = 1, container = Win)
out <- visible(Win)
}
DF()
A small advice: avoid using the single letters T or F, as in your code T might be interpreted as TRUE and not object T.
Related
I'm developing an R package (https://github.com/rcst/rmaxima) that provides an interface to the computer algebra system Maxima. I want to include a knitr engine, so that it can directly be used with knitr. The package has functions to start/ spawn a child process and then send commands to and fetch results from Maxima. This way, it should be possible to carry over results between different chunks.
The interface works by creating a new object of an Rcpp-class of the interface. Creating the object spawns a child process, deleting the objects stops that process.
I want the engine to start a new child process each time the document is knit()ed, so that the result is reproducible. I'm thinking that I could create an extra environment that binds the interface object. The engine checks whether this objects exists in that environment. If it doesn't exist, it will be created, otherwise the engine can directly proceed to send code to the interface. When knit() exits, it exits the scope of it's environment and all variables within that environment are deleted automatically. This way, I need not stop the child process, because the object of the interface class get's deleted and the process is stopped automatically.
But I have no clue how to go about it. Any hints very much appreciated.
yihui provides an answer here.
In essence, (a) one sets a temporary variable in the parent frame to check if the engine is running and (b) inspects the lists of chunk labels to determine if the current one is the last and therefore trigger deletion and tear down after it's been processed:
last_label <- function(label = knitr::opts_current$get('label')) {
if (knitr:::child_mode()) return(FALSE)
labels <- names(knitr::knit_code$get())
tail(labels, 1) == label
}
knitr::knit_engines$set(maxima = local({
mx <- FALSE
function(options) {
if (!mx) {
maxima$startMaxima()
mx <<- TRUE
}
... # run maxima code
if (last_label(options$label)) {
maxima$stopMaxima()
mx <<- FALSE
}
}
}))
For completeness, I also came up with a solution which works, but is less robust.
Objects that go out of scope are automatically removed in R. However, actual deletion happens during R's garbage collection gc(), which cannot be controlled directly. So to get an object removed when knit() finishes, that object needs to be created in the environment of knit(), which is some levels above the engine call.
In principle one can register a function that does the actual clean-up via on.exit() of knit(), who's environment can be retrieved by parent.frame(n=...). Note that all objects of that scope are still present the moment the expressions registered to on.exit() get called.
maxima.engine <- function(options) {
e <- parent.frame(n = sys.parent() - 2)
if(!exists("mx", envir = e)) {
message("starting maxima on first chunk")
assign(x = "mx", value = new(rmaxima:::RMaxima), envir = e)
assign(x = "execute", value = get("mx", envir = e)$execute, envir = e)
assign(x = "stopMaxima", value = get("mx", envir = e)$stopMaxima, envir = e)
# quit maxima "on.exit"ing of knit()
# eval() doesn't work on "special primitive functions
# do.call() does ... this may break in the future
# see https://stat.ethz.ch/pipermail/r-devel/2013-November/067874.html
do.call("on.exit", list(quote(stopMaxima()),
add = TRUE), envir = e)
}
code <- options$code
out <- character(0);
for(i in 1:length(code))
out <- c(out, eval(call("execute", code[i]), envir = e))
engine_output(options, code, out)
}
I am trying to write an R-script that uses nested functions to save multiple data.frames (parallelly) to global environment. The below sample code works fine in Windows. But when I moved the same code to a Linux server, the objects the function - prepare_output() saves to global environment are not captured by the save() operation in function - get_output().
Am i missing something that is fundamentally different on how mcmapply affects scoping in Linux vs Windows?
library(data.table)
library(parallel)
#Function definitions
default_case <- function(flag){
if(flag == 1){
create_input()
get_output()
}else{
Print("select a proper flag!")
}
}
create_input <- function(){
dt_initial <<- data.table('col1' = c(1:20), 'col2' = c(21:40)) #Assignment to global envir
}
get_output<- function(){
list1 <- c(5,6,7,8)
dt1 <- data.table(dt_initial[1:15,])
prepare_output<- function(cnt){
dt_new <- data.table(dt1)
dt_new <- dt_new[col1 <= cnt, ]
assign(paste0('dt_final_',cnt), dt_new, envir = .GlobalEnv )
#eval(call("<<-",paste0('dt_final_',cnt), dt_new))
print('contents in global envir inside:')
print(ls(name = .GlobalEnv)) # This print all object names dt_final_5 through dt_final_8 correctly
}
mcmapply(FUN = prepare_output,list1,mc.cores = globalenv()$numCores)
print('contents in global envir outside:')
print(ls(name = .GlobalEnv)) #this does NOT print dataframes generated and assigned to global in function prepare_output
save( list = ls(name = .GlobalEnv)[ls(name = .GlobalEnv) %like% 'dt_final_' ], file = 'dt_final.Rdata')
}
if(Sys.info()['sysname'] == "Windows"){numCores <- 1}else{numCores <- parallel::detectCores()}
print('numCores:')
print(numCores)
#Function call
default_case(1)
The reason I an using nested structure is because the preparation of dt1 is time taking and I do not want to increase the execution time by its execution every loop in the apply call.
(Sorry, I'll write this as an 'Answer' because the comment box is too brief)
The best solution to your problem would be to make sure you return the objects you produce rather than trying to assign them from inside a function to an external environment [edit 2020-01-26] which never works in parallel processing because parallel workers do not have access to the environments of the main R process.
A very good rule of thumb in R that will help you achieve this: Never use assign() or <<- in code - neither for sequential nor for parallel processing. At best, you can get such code to work in sequential mode but, in general, you will end up with hard to maintain and error-prone code.
By focusing on returning values (y <- mclapply(...) in your example), you'll get it right. It also fits in much better with the overall functional design of R and parallelizes more naturally.
I've got a blog post 'Parallelize a For-Loop by Rewriting it as an Lapply Call' from 2019-01-11 that might help you transition to this functional style.
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
How do I create a set of R functions that all access the same private variable?
Let's say I want to create readSetting(key) and writeSetting(key,value) functions that both operate on the same hidden list settings. If I try it like so...
local( {
settings <- list()
readSetting <<- function ( key ) settings[[key]]
writeSetting <<- function ( key, value ) settings[[key]] = value
} )
...then readSetting and writeSetting are not visible outside of the local call. If I want them to be visible there, I have to first assign
readSetting <- writeSetting <- NULL
outside the local call. There must be a better way, because my code isn't DRY if I have to say in two different ways which variables are public.
(The context of this work is that I'm developing an R package, and this code will be in an auxiliary file loaded into the main file via source.)
This question is related to How to limit the scope of the variables used in a script? but the answers there do not solve my problem.
You can simulate somthing like that using R6Class package and the following very rough code:
Privates <- R6Class("Privates",
public=list(
readSetting = function(key) {
private$settings[[key]]
},
writeSetting = function(key,value) {
private$settings[[key]] <<- value
}
),
private=list(
settings = list()
)
)
a <- Privates$new()
a$writeSetting("a",4)
a$readSetting("a")
Directly reading o setting the a$setting would not work.
I created a function which produces a matrix as a result, but I can't figure out how to make the output of this function usable outside of the function environment, so that I could for instance save it in csv file.
My code for function is the following:
created function which takes url's from specific site and returns page title:
getTitle <- function(url) {
webpage <- readLines(url)
first.row <- webpage[1]
start <- regexpr("<title>", first.row)
end <- regexpr("</title>", first.row)
title <- substr(first.row,start+7,end-1)
return(title)
}
created function which takes vector of urls and returns n*2 matrix with urls and page titles:
getTitles <- function(pages) {
my.matrix <- matrix(NA, ncol=2, nrow=nrow(pages))
for (i in seq_along(1:nrow(pages))) {
my.matrix[i,1] <- as.character(pages[i,])
my.matrix[i,2] <- getTitle(as.character(pages[i,])) }
return(my.matrix)
print(my.matrix)}
After running this functions on a sample file from here http://goo.gl/D9lLZ which I import with read.csv function and name "mypages" I get the following output:
getTitles(mypages)
[,1] [,2]
[1,] "http://support.google.com/adwords/answer/1704395" "Create your first ad campaign - AdWords Help"
[2,] "http://support.google.com/adwords/answer/1704424" "How costs are calculated in AdWords - AdWords Help"
[3,] "http://support.google.com/adwords/answer/2375470" "Organizing your account for success - AdWords Help"
This is exactly what I need, but I'd love to be able to export this output to csv file or reuse for further manipulations. However, when I try to print(my.matrix), I am getting an error saying "Error: object 'my.matrix' not found"
I feel like it's quite basic gap in my knowledge, but have not been working with R for a while and could not solve that.
Thanks!
Sergey
That's easy: use <<- for assignment to a global.
But then again, global assignment is evil and not functional. Maybe you'd rather return
a list with several results from your function? Looking at your code, it seems that your second function may confuse the return and print. Make sure you return the correct data structure.
A little about functional programming. First of all, when you define your function:
getTitles <- function(pages) {
[...]
return(my.matrix)
print(my.matrix)
}
know that when the function is called it will never reach the print statement. Instead, it will exit right before, with return. So you can remove that print statement, it is useless.
Now the more important stuff. Inside your function, you define and return my.matrix. The object only exists within the scope of the function: as the function exits, what is returned is an unnamed object (and my.matrix is lost.)
In your session, when you call
getTitles(mypages)
the result is printed because you did not assign it. Instead, you should do:
out.matrix <- getTitles(mypages)
Now the result won't be printed but you can definitely do so by typing print(out.matrix) or just out.matrix on a single line. And because you have stored the result in an object, you can now reuse it for further manipulations.
If it help you grasp the concept, this is all the same as calling the c() function from the command line:
c(1, 5, 2) # will return and print a vector
x <- c(1, 5, 2) # will return and assign a vector (not printed.)
Bonus: Really, I don't think you need to define getTitles, but you can use one of the *apply functions. I would try this:
url <- as.character(mypages)
title <- sapply(url, getTitle)
report <- data.frame(url, title)
write.csv(report, file = "report.csv", row.names = FALSE)
Can't you just use <<- to assign it the object to the workspace? The following code works for me and saves the amort_value object.
amortization <- function(cost, downpayment, interest, term) {
amort_value <<- (cost)*(1-downpayment/100)*(interest/1200)*((1+interest/1200)^(term*12))/((1+interest/1200)^(term*12)-1)
sprintf("$%.2f", amort_value)
}
amortization(445000,20,3,15)
amort_value
At the end of the function, you can return the result.
First define the function:
getRangeOf <- function (v) {
numRange <- max(v) - min(v)
return(numRange)
}
Then call it and assign the output to a variable:
scores <- c(60, 65, 70, 92, 99)
scoreRange <- getRangeOf(scores)
From here on use scoreRange in the environment. Any variables or nested functions within your defined function is not accessible to the outside, unless of course, you use <<- to assign a global variable. So in this example, you can't see what numRange is from the outside unless you make it global.
Usually, try to avoid global variables at an early stage. Variables are "encapsulated" so we know which one is used within the current context ("environment"). Global variables are harder to tame.