I would like to run a very simple script concurrently or asynchronously, displaying an estimated progress bar.
This works well enough when using system2() like this:
path <- '../Desktop/.../My_Skript_Dir/'
system2(command = "cmd.exe",
input = paste('"./R-4.2.1/bin/Rscript.exe"',
paste0(path, '/Progress_Bar.R')), wait = FALSE)
If possible I would like to avoid using system2 though and I recently found out that callr might do the trick. It almost works, using the function from the "Progress_Bar" script:
estimated_progress <- function(df = NULL, add_time = FALSE){
require(tcltk)
require(callr)
pred <- round(nrow(df)*0.6) # prediction
callr::r_bg(func = function(pred){ # open background r session
pb1 <- tcltk::tkProgressBar(title='PB', label='PB', min=0, max=pred, initial=0)
for (index in seq(pred)){
tcltk::setTkProgressBar(pb=pb1, value=index)
Sys.sleep(1)
}
}, args = list(pred))
}
df <- data.frame(matrix(nrow = 200, ncol = 3)) # dummy data
estimated_progress(df = df, add_time = FALSE)
When I do this, the progress bar opens in a new window as expected.
It keeps going for the next 1-3 function(s) (for example invisible(pbapply::pblapply(1:200000, function(x) x**3)) ) but any more than that and estimated_progress() abborts.
What am I missing here? I am sure it's quite obvious and I have read that callr can work asynchronously (look here) but I can't make it work.
Related
If i run my code interactive i.e line by line in Rstudio everything works and is realy fast.
As soon as i try to run my code as a script, parLapply takes a significantly long time.
As if its waiting for something or is blocked by something.
Top shows also that R processes spawn and are inactive for a while.
In both situations the code will produce the same result.
It is difficult for me to provide a code example that would demonstrate the problem
since as long as i don't use big structures this problem does not accrues.
I wrote a small example to demonstrate the problem but since i dont use the big nested lists or xml the problem does not happen.
I know its far from ideal question but maybe some one has a hint or hat the same problem before.
library(parallel)
library(osmar)
src <- osmsource_api(url = "https://api.openstreetmap.org/api/0.6/")
muc_bbox <- center_bbox(11.575278, 48.137222, 10000, 10000)
test_osm <- get_osm(muc_bbox, src)
n.cores <- detectCores()
wegpunkte<-list(c(id = 7018492265, lon = 11.8303853, lat = 48.1102703),
c(id = 94064123, lon = 12.1768446, lat = 48.1265051),
c(id = 1532819835,lon = 12.0014881, lat = 47.8225144),
c(id = 130221481, lon = 12.2078502, lat = 47.8395169))
find_a_node <- function(osm_object,search_lon,search_lat){
nodes_ids_found <- osmar::find(osm_object, node(attrs(lon>search_lon & lat > search_lat )))
if(anyNA((nodes_ids_found)))
{
nodes_ids_found <- osmar::find(osm_object, node(attrs(lon < search_lon & lat < search_lat )))
}
nodes_found <- base::subset(osm_object,nodes_ids_found)
node_coords <- data.frame(nodes_found$nodes$attrs[, c("id","lon", "lat")])
node_coords$dist <- geodist_vec(x1 = node_coords$lon,y1 = node_coords$lat,x2 = search_lon,y2 = search_lat,measure = "haversine")
point_result <- node_coords[which.min(node_coords$dist),]
nodes_found <- base::subset(nodes_found,point_result$id)
print(point_result)
return(base::subset(nodes_found,nodes_found$nodes$attrs$id))
}
tictoc::tic()
clust <- makeCluster(n.cores,type="FORK",outfile="test")
wegpunkte_nodes <- parLapply(clust,wegpunkte, function(x) find_a_node(test_osm,x[[1]],x[[2]]))
stopCluster(clust)
tictoc::toc()
I solved the problem by using mcmapply.
I'm using chromote R package and I'm testing it with shiny application. I'm trying to click on the icon that should duplicate few select elements. But all I have is tooltip when I take a screenshot and if I open the browser it freezes the R process.
Here is my code:
#' Run shiny in background - based on shinytest source code
#' #export
shiny.bg <- function(path, loadTimeout = 10000, shinyOptions = list()) {
tempfile_format <- tempfile("%s-", fileext = ".log")
p <- callr::r_bg(function(path, shinyOptions) {
do.call(shiny::runApp, c(path, shinyOptions))
},
args = list(
path = normalizePath(path),
shinyOptions = shinyOptions
),
stdout = sprintf(tempfile_format, "shiny-stdout"),
stderr = sprintf(tempfile_format, "shiny-stderr"),
supervise = TRUE
)
if (! p$is_alive()) {
abort(paste0(
"Failed to start shiny. Error: ",
strwrap(readLines(p$get_error_file()))
))
}
## Try to read out the port. Try 5 times/sec, until timeout.
max_i <- loadTimeout / 1000 * 5
for (i in seq_len(max_i)) {
err_lines <- readLines(p$get_error_file())
if (!p$is_alive()) {
abort(paste0(
"Error starting application:\n", paste(err_lines, collapse = "\n")
))
}
if (any(grepl("Listening on http", err_lines))) break
Sys.sleep(0.2)
}
if (i == max_i) {
abort(paste0(
"Cannot find shiny port number. Error:\n", paste(err_lines, collapse = "\n")
))
}
line <- err_lines[grepl("Listening on http", err_lines)]
m <- rematch::re_match(text = line, "https?://(?<host>[^:]+):(?<port>[0-9]+)")
url <- sub(".*(https?://.*)", "\\1", line)
list(
process = p,
url = url
)
}
#' Run shiny application and Chromeote instance
chromote.shiny <- function() {
chr <- chromote::ChromoteSession$new()
app <- shiny.bg('.')
chr$Page$navigate(app$url)
chr$Page$loadEventFired()
chr$screenshot()
list(
chr = chr,
app = app
)
}
#' kill browser and R shiny process
cleanUp <- function(obj) {
obj$chr$Browser$close()
obj$app$process$kill()
}
#' click on the element
chromote.click <- function(chromote, selector) {
doc = chromote$DOM$getDocument()
node = chromote$DOM$querySelector(doc$root$nodeId, selector)
box <- chromote$DOM$getBoxModel(node$nodeId)
left <- box$model$content[[1]]
top <- box$model$content[[2]]
x <- left + (box$model$width / 2)
y <- top + (box$model$height / 2)
chromote$Input$dispatchMouseEvent(type = "mousePressed", x = x, y = y, button="left")
chromote$Input$dispatchMouseEvent(type = "mouseReleased", x = x, y = y, button="left")
}
tmp <- chromote.shiny()
chromote.click(tmp$chr, ".clone-pair")
tmp$chr$screenshot()
I have no idea how I can debug this and there are not much information how to make a click, I've found dispatchMouseEvent in issue in GitHub repo for chromote.
Links to repo https://github.com/rstudio/chromote
The reason why I want to use chromote is I want to create unit/integration test for my application and shinytest is way outdated it use phantomJS that was abandoned years ago (so you need to use very old JavaScript because otherwise pantomJS will throw error and test will fail) and RSelenium is also not maintained anymore.
Had the same issue..
I found this library that uses chromote but has a number of functions (GetElement, Click) from RSelenium.
install.packages("remotes")
remotes::install_github("rundel/hayalbaz")
I'm using a function from an R package called RAC (R Package for Aqua Culture). It generates a Y/N prompt in the console window prior to execution. Is there a way to deactivate the prompt or automatically answer N every time?
The function Bass_pop_main will generate:
Do you want to change the inputs? [y/n]
Here's an example:
library(RAC)
setwd("../RAC_seabass") #working directory
userpath <- "../RAC_seabass" #userpath
Bass_pop_skeleton(userpath) #create input and output folders
forcings <- Bass_pop_dataloader(userpath) #load environmental variables
output <- Bass_pop_main("../RAC", forcings) #run growth model
Not sure if there is any setting that you can supply externally which will allow you to answer "No" automatically every time. However, we can change the source code of Bass_pop_main according to our requirement and use it. The source code is available if you enter Bass_pop_main in the console.
library(RAC)
Bass_pop_main_revised <- function (userpath, forcings) {
rm(list = ls())
cat("Sea Bass population bioenergetic model\n")
cat(" \n")
currentpath = getwd()
out_pre <- Bass_pop_pre(userpath, forcings)
Param = out_pre[[1]]
Tint = out_pre[[2]]
Gint = out_pre[[3]]
Food = out_pre[[4]]
IC = out_pre[[5]]
times = out_pre[[6]]
Dates = out_pre[[7]]
N = out_pre[[8]]
CS = out_pre[[9]]
out_RKsolver <- Bass_pop_loop(Param, Tint, Gint, Food, IC, times, N, userpath)
out_post <- Bass_pop_post(userpath, out_RKsolver, times, Dates, N, CS)
cat(" ")
cat("End")
return(out_post)
}
Now use Bass_pop_main_revised function instead of Bass_pop_main and it will never ask for input.
setwd("../RAC_seabass")
userpath <- "../RAC_seabass"
Bass_pop_skeleton(userpath)
forcings <- Bass_pop_dataloader(userpath)
output <- Bass_pop_main_revised("../RAC", forcings)
The point in the code is to gather posts from a Facebook page and store them in my_page however i am unfamiliar with the code as it is for a Uni project. The problem i have is that it has to be used in a .rpres format created using Rstudio and as such i don't want the output but still need to run the code.
This is the output i don't want to be displayed:
```{r, echo = FALSE}
#install.packages("Rfacebook")
include(Rfacebook)
token <- "Facebook dev auth token goes here"
page_name <- "BuzzFeed"
my_page <- getPage(page_name, token, n = 2,reactions = TRUE,api = "v2.10")
number_required <- 50
dates <- seq(as.Date("2017/07/14"), Sys.Date(), by = "day")
#
n <- length(dates) - 1
df_daily <- list()
for (i in 1:n){
cat(as.character(dates[i]), " ")
try(df_daily[[i]] <- getPage(page_name, token,
n = number_required,reactions = TRUE,api = "v2.10",
since = dates[i],
until = dates[i+1]))
cat("\n")
}
```
Your problem is simply that Rfacebook::getPage prints to the console when it runs. That's because it calls cat(), which is the same thing as print(). Fortunately the package provides a switch to turn that off - all you need to do is add the verbose = FALSE argument to your call and it will stop printing:
getPage(...)
getPage(..., verbose = FALSE)
It's pretty bad practice for a package to call cat or print - they should use message and warning instead - so I have raised an issue with the package maintainer to ask for this to be changed, which you can watch here if you like:
https://github.com/pablobarbera/Rfacebook/issues/145
I'm trying to make very simple GUI for my script. In nutshell problem looks like that :
dataset is dataframe, I would like to plot one column as the time and use simple GUI for choosing next/previus column.
dataset <-data.frame(rnorm(10), rnorm(10), rnorm(10))
columnPlot <- function(dataset, i){
plot(dataset[, i])
}
how to use tcltk for calling fplot with different i's ?
Not what you asked for (not tcltkrelated), but I would advise you to have a look at the new shiny package from RStudio.
Are you particularly attached to the idea of using tcltk? I've been working on something similar using the gWidgets package and have had some success. According to it's CRAN site, "gWidgets provides a toolkit-independent API for building interactive GUIs". This package uses tcltk or GTK2 and I've been using the GTK2 portion. Here's a quick example of a GUI with a spinbutton for changing i. I also added a little fanciness to your function because you mentioned you would be plotting time series, so I made the x axis Time.
data<-data.frame(rnorm(11),rnorm(11),rnorm(11))
i = 1
fplot <- function(i, data = data){
library(ggplot2)
TimeStart <- as.Date('1/1/2012', format = '%m/%d/%Y')
plotdat <- data.frame(Value = data[ ,i], Time = seq(TimeStart,TimeStart + nrow(data) - 1, by = 1))
myplot <- ggplot(plotdat, aes(x = Time, y = Value))+
geom_line()
print(myplot)
}
library(gWidgets)
options(guiToolkit = 'RGtk2')
window <- gwindow ("Time Series Plots", visible = T)
notebook <- gnotebook (cont = window)
group1 <- ggroup(cont = notebook, label = "Choose i", horizontal=F)
ichooser <- gspinbutton(cont = group1, from = 1, to = ncol(data), by = 1, value = i, handler = function(h,...){
i <<- svalue(h$obj)})
plotbutton <- gbutton('Plot', cont = group1, handler=function(h,...){
fplot(i, data)})
graphicspane1 <- ggraphics(cont = group1)