RCurl: Display progress meter in Rgui - r

Using R.exe or Rterm.exe, this gives an excellent progress meter.
page=getURL(url="ftp.wcc.nrcs.usda.gov", noprogress=FALSE)
In Rgui I am limited to:
page=getURL(url="ftp.wcc.nrcs.usda.gov",
noprogress=FALSE, progressfunction=function(down,up) print(down))
which gives a very limited set of download information.
Is there a way to improve this?

I start doubting that with standard R commands it is possible to reprint overwriting the current line, which is what RCurl does in non-GUI mode.
I am glad to tell that I was wrong. At least for a single line, \r can do the trick. In fact:
conc=function(){
cat(" abcd")
cat(" ABCD", '\n')
}
conc()
# abcd ABCD
But:
over=function(){
cat(" abcd")
cat("\r ABCD", "\n")
}
over()
# ABCD
That given, I wrote this progressDown function, which can monitor download status rewriting always on the same same line:
library(RCurl) # Don't forget
### Callback function for curlPerform
progressDown=function(down, up, pcur, width){
total=as.numeric(down[1]) # Total size as passed from curlPerform
cur=as.numeric(down[2]) # Current size as passed from curlPerform
x=cur/total
px= round(100 * x)
## if(!is.nan(x) && px>60) return(pcur) # Just to debug at 60%
if(!is.nan(x) && px!=pcur){
x= round(width * x)
sc=rev(which(total> c(1024^0, 1024^1, 1024^2, 1024^3)))[1]-1
lb=c('B', 'KB', 'MB', 'GB')[sc+1]
cat(paste(c(
"\r |", rep.int(".", x), rep.int(" ", width - x),
sprintf("| %g%s of %g%s %3d%%",round(cur/1024^sc, 2), lb, round(total/1024^sc, 2), lb, px)),
collapse = ""))
flush.console() # if the outptut is buffered, it will go immediately to console
return(px)
}
return(pcur)
}
Now we can use the callback with curlPerform
curlProgress=function(url, fname){
f = CFILE(fname, mode="wb")
width= getOption("width") - 25 # you can make here your line shorter/longer
pcur=0
ret=curlPerform(url=url, writedata=f#ref, noprogress=FALSE,
progressfunction=function(down,up) pcur<<-progressDown(down, up, pcur, width),
followlocation=T)
close(f)
cat('\n Download', names(ret), '- Ret', ret, '\n') # is success?
}
Running it with a small sample binary:
curlProgress("http://www.nirsoft.net/utils/websitesniffer-x64.zip", "test.zip")
the intermediate output at 60% is (no # protection):
|................................. | 133.74KB of 222.75KB 60%
where KB, will be adjusted to B, KB, MB, GB, based on total size.
Final output with success status, is:
|.......................................................| 222.61KB of 222.75KB 100%
Download OK - Ret 0
Note, the output line width is relative to R width option (which controls the maximum number of columns on a line) and can be customised changing the curlProgress line:
width= getOption("width") - 25
This is enough for my needs and solves my own question.

Here's a simple example using txtProgressBar. Basically, just do a HEAD request first to get the file size of the file you want to retrieve, then setup a txtProgressBar with that as its max size. Then you use the progressfunction argument to curlPerform to call setTxtProgressBar. It all works very nicely (unless there is no "content-length" header, in which case this code works by just not printing a progress bar).
url <- 'http://stackoverflow.com/questions/21731548/rcurl-display-progress-meter-in-rgui'
h <- basicTextGatherer()
curlPerform(url=url, customrequest='HEAD',
header=1L, nobody=1L, headerfunction=h$update)
if(grepl('Transfer-Encoding: chunked', h$value())) {
size <- 1
} else {
size <- as.numeric(strsplit(strsplit(h$value(),'\r\nContent-Type')[[1]][1],
'Content-Length: ')[[1]][2])
}
bar <- txtProgressBar(0, size)
h2 <- basicTextGatherer()
get <- curlPerform(url=url, noprogress=0L,
writefunction=h2$update,
progressfunction=function(down,up)
setTxtProgressBar(bar, down[2]))
h2$value() # return contents of page
The output is just a bunch of ====== across the console.

What about:
curlProgress=function(url, fname){
f = CFILE(fname, mode="wb")
prev=0
ret=curlPerform(url=url, writedata=f#ref, noprogress=FALSE,
progressfunction=function(a,b){
x=round(100*as.numeric(a[2])/as.numeric(a[1]))
if(!is.nan(x) && x!=prev &&round(x/10)==x/10) prev<<-x else x='.'
cat(x)
}, followlocation=T)
close(f)
cat(' Download', names(ret), '- Ret', ret, '\n')
}
?
It prints dots or percent download divisible by 10 and breaks line on 50%.
And with a small 223 KB file:
curlProgress("http://www.nirsoft.net/utils/websitesniffer-x64.zip", "test.zip")
it sounds like this:
................10...............20................30...............40...............50
..............................70...............80...............90...............100... Download OK - Ret 0
I start doubting that with standard R commands it is possible to reprint overwriting the current line, which is what RCurl does in non-GUI mode.

Related

Recursion error in R (Fibonacci sequence)

So I am trying to learn R on my own and am just working through the online tutorial. I am trying to code a recursive function that prints the first n terms of the Fibonacci sequence and can't get the code to run without the error:
Error in if (nterms <= 0) { : missing value where TRUE/FALSE needed
My code does ask me for input before entering the if else statement either which I think is odd as well. Below is my code any help is appreciated.
#Define the fibonacci sequence
recurse_fibonacci <- function(n) {
# Define the initial two values of the sequence
if (n <= 1){
return(n)
} else {
# define the rest of the terms of the sequence using recursion
return(recurse_fibonacci(n-1) + recurse_fibonacci(n-2))
}
}
#Take input from the user
nterms = as.integer(readline(prompt="How many terms? "))
# check to see if the number of terms entered is valid
if(nterms <= 0) {
print("please enter a positive integer")
} else {
# This part actually calculates and displays the first n terms of the sequence
print("Fibonacci Sequence: ")
for(i in 0:(nterms - 1)){
print(recurse_fibonacci(i))
}
}
This is a problem of readline in non-interactive mode. readline does not wait for a keypress and immediately executes the next instruction. The solution below is the solution posted in this other SO post.
I post below a complete answer, with the Fibonnaci numbers function a bit modified.
recurse_fibonacci <- function(n) {
# Define the initial two values of the sequence
if (n <= 1){
n
} else{
# define the rest of the terms of the sequence using recursion
Recall(n - 1) + Recall(n - 2)
}
}
#Take input from the user
cat("How many terms?\n")
repeat{
nterms <- scan("stdin", what = character(), n = 1)
if(nchar(nterms) > 0) break
}
nterms <- as.integer(nterms)
# check to see if the number of terms entered is valid
if(nterms <= 0) {
print("please enter a positive integer")
} else {
# This part actually calculates and displays the first n terms of the sequence
print("Fibonacci Sequence: ")
for(i in 0:(nterms - 1)){
print(recurse_fibonacci(i))
}
}
This code is the contents of file fib.R. Running in a Ubuntu 20.04 terminal gives
rui#rui:~$ Rscript fib.R
How many terms?
8
Read 1 item
[1] "Fibonacci Sequence: "
[1] 0
[1] 1
[1] 1
[1] 2
[1] 3
[1] 5
[1] 8
[1] 13
rui#rui:~$
To make it work with Rscript replace
nterms = as.integer(readline(prompt="How many terms? "))
with
cat ("How many terms?")
nterms = as.integer (readLines ("stdin", n = 1))
Then you can run it as Rscript fib.R, assuming that the code is in the file fib.R in the current working directory.
Otherwise, execute it with source ("fib.R") within an R shell.
Rscript does not operate in interactive mode and does not expect any input from the terminal. Check what interactive () returns in both the cases. Rscript will return FALSE as it is non-interactive, but the same function when run within an R shell (with source ()) it will be true.
?readline mentions that it cannot be used in non-interactive mode. Whereas readLines explicitely connect to stdin.
The code works fine but you shouldn't enter it into the terminal as is. My suggestion: put the code into a script file (ending .R) and source it (get help about it with ?source but it's actually pretty straightforward).
In R-Studio you can simply hit the source button.

How to improve formatting of slack messages using slackr?

I'm using slackr to send alert messages to a Slack channel. It works great except the message format is not great and I want to improve it.
install_github("hrbrmstr/slackr")
library(slackr)
slackr_setup(channel="#alerts", username="Mark Davis",
incoming_webhook_url = "https://hooks.slack.com/services/T31P8UDAB/BCH4HKQSC/*********",
api_token = "*********", echo = F)
alert="On Monday, 2018-09-03 # 2pm Pacific..."
slackr(alert)
Here is an example of how a message from slackr looks in Slack:
Here is an example of how I'd like it to look:
slackr doesn't seem to have many options in the way of formatting. I was thinking of building an image and inserting that, but I'm having trouble building an image out of a text file using R.
Perhaps there is another api I could call that could take my text and format it for slack?
I'm open to any suggestions.
Addendum:
Slackr has an option to upload files, so my latest attempt is to create an image from the text message and upload that object.
I am able to create a png file from the text message using the magick library. I created an image with a colored background, and I simply add the message text to the image:
library(magick)
alert_picture <- image_read('alert_480x150_dark_red.png')
alert_picture=image_annotate(alert_picture, DreamCloud_Alert, size = 20, gravity = "southwest",
color = "white", location = "+10+10")
image_write(alert_picture, path = "alert_picture.png", format = "png")
The image looks pretty good (although there doesn't seem to be an easy way to bold or underline specific words in the message), but the obstacle now is that I can't get the upload command to work.
slackr_upload(filename = "alert_picture.png")
I don't get any error messages but nothing is uploaded to slack.
I got around this issue by using the httr package to execute the post image function to slack.
Thanks to Adil B. for providing the solution:
Post Image to Slack Using HTTR package in R
I am not sure this is what you meant, but I solved allowing formatting like in a regular slack message by altering the slackr_bot() function and just removing the 2 sets of 3 back-ticks at the end of the code where it says text. Then just call it slackr_bot1() or something, and then you can post formatted messages. This is the function after the back-ticks removal:
slackr_bot1 <- function(...,
channel=Sys.getenv("SLACK_CHANNEL"),
username=Sys.getenv("SLACK_USERNAME"),
icon_emoji=Sys.getenv("SLACK_ICON_EMOJI"),
incoming_webhook_url=Sys.getenv("SLACK_INCOMING_URL_PREFIX")) {
if (incoming_webhook_url == "") {
stop("No incoming webhook URL specified. Did you forget to call slackr_setup()?", call. = FALSE)
}
if (icon_emoji != "") { icon_emoji <- sprintf(', "icon_emoji": "%s"', icon_emoji) }
resp_ret <- ""
if (!missing(...)) {
# mimics capture.output
# get the arglist
args <- substitute(list(...))[-1L]
# setup in-memory sink
rval <- NULL
fil <- textConnection("rval", "w", local = TRUE)
sink(fil)
on.exit({
sink()
close(fil)
})
# where we'll need to eval expressions
pf <- parent.frame()
# how we'll eval expressions
evalVis <- function(expr) withVisible(eval(expr, pf))
# for each expression
for (i in seq_along(args)) {
expr <- args[[i]]
# do something, note all the newlines...Slack ``` needs them
tmp <- switch(mode(expr),
# if it's actually an expresison, iterate over it
expression = {
cat(sprintf("> %s\n", deparse(expr)))
lapply(expr, evalVis)
},
# if it's a call or a name, eval, printing run output as if in console
call = ,
name = {
cat(sprintf("> %s\n", deparse(expr)))
list(evalVis(expr))
},
# if pretty much anything else (i.e. a bare value) just output it
integer = ,
double = ,
complex = ,
raw = ,
logical = ,
numeric = cat(sprintf("%s\n\n", as.character(expr))),
character = cat(sprintf("%s\n\n", expr)),
stop("mode of argument not handled at present by slackr"))
for (item in tmp) if (item$visible) { print(item$value, quote = FALSE); cat("\n") }
}
on.exit()
sink()
close(fil)
# combined all of them (rval is a character vector)
output <- paste0(rval, collapse="\n")
loc <- Sys.getlocale('LC_CTYPE')
Sys.setlocale('LC_CTYPE','C')
on.exit(Sys.setlocale("LC_CTYPE", loc))
resp <- POST(url = incoming_webhook_url, encode = "form",
add_headers(`Content-Type` = "application/x-www-form-urlencoded",
Accept = "*/*"), body = URLencode(sprintf("payload={\"channel\": \"%s\", \"username\": \"%s\", \"text\": \"%s\"%s}",
channel, username, output, icon_emoji)))
warn_for_status(resp)
}
return(invisible())
}
slackr_bot1("*test* on time")

R with tcltk/tcltk2: Improve slow performance when displaying big data.frame with TkTable?

Please see two edits below (added later)...
I have loaded a big data.frame into memory (2.7 mio rows and 7 columns - 74 MB of RAM).
If I want to view the data using Tcl/Tk's Tktable widget via the tcltk2 package function tk2edit
it takes over 15 minutes till the window is displayed with the data
and about 7 GB of RAM (!) is consumed by R (incl. Tcl/Tk) en plus!
Example:
library(tcltk2)
my.data.frame <- data.frame(ID=1:2600000,
col1=rep(LETTERS,100000),
col2=rep(letters,1E5),
col3=26E5:1) # about 40 MB of data
tk2edit(my.data.frame)
The basic problem seems to be that each cell of the data.frame must loaded into an tcl array via two nested loops (see the code in this tktable question).
The tcltk2 package's function tk2edit works the same way, over-simplified:
# my.data.frame contains a lot of rows...
for (i in 0:(dim(my.data.frame)[1])) {
for (j in 0:(dim(my.data.frame)[2]-1)) {
tclarray1[[i,j]] <- my.data.frame[i, j]
}
}
Question: Is there any way to optimize displaying big data.frames with tktable, e. g. by avoiding the nested loops? I just want to view data (no editing required)...
tktable has the -variable option where you can set the tcl array variable that contains ALL the data of the table. So we "only" have to find way to create a tcl array from an R data.frame with "one call to tcl from R"...
PS: This is not a problem of the tcltk2 package but seems to be a general problem how to "bulk load" data of a data.frame into Tcl variables...
PS2: The good thing is that Tktable seems to be able to display such a lot of data efficiently (I can scroll and even edit cells without noticing any severe delays).
Edit 1 (09/01/2015): Adding pure Tcl/Tk benchmark results with Tktable and data in an array
I have prepared a simple benchmark in Tcl/Tk to measure the execution time and memory consumption of filling a similar Tktable:
#!/usr/bin/env wish
package require Tktable
set rows 2700000
set columns 4
for {set row 0} {$row <= $rows} {incr row} {
for {set column 0} {$column < $columns} {incr column} {
if {$row == 0} {
set data($row,$column) Titel$column
} else {
set data($row,$column) R${row}C${column}
}
}
}
ttk::frame .fr
table .fr.table -rows $rows -cols $columns -titlerows 1 -titlecols 0 -height 5 -width 25 -rowheight 1 -colwidth 9 -maxheight 100 -maxwidth 400 -selectmode extended -variable data -xscrollcommand {.fr.xscroll set} -yscrollcommand {.fr.yscroll set}
scrollbar .fr.xscroll -command {.fr.table xview} -orient horizontal
scrollbar .fr.yscroll -command {.fr.table yview}
pack .fr -fill both -expand 1
pack .fr.xscroll -side bottom -fill x
pack .fr.yscroll -side right -fill y
pack .fr.table -side right -fill both -expand 1
Results:
Memory consumption: 3.2 GB
Time until the table is displayed: 15 sec.
Conclusion: Tcl/Tk arrays are wasting memory, but the performance is very good (the runtime of 15 minutes when using R with tcltk seem to be caused by R to Tcl/Tk communication overhead.
Test setup: Ubuntu 14.04 64 Bit with 16 GB RAM...
Edit 2 (10/01/2015): Adding pure Tcl/Tk benchmark results of ttk::treeview with data in a list
To compare the memory consumption of Tktable to ttk::treeview I wrote this code:
#!/usr/bin/env wish
set rows 2700000
set columns 4
set data {}
set colnames {}
for {set i 0} {$i < $columns} {incr i} {
lappend colnames Title$i
}
for {set row 0} {$row <= $rows} {incr row} {
set newrow {}
for {set column 0} {$column < $columns} {incr column} {
lappend newrow R${row}C${column}
}
lappend data $newrow
}
ttk::treeview .tv -columns $colnames -show headings -yscrollcommand {.sbY set} -xscrollcommand {.sbX set}
foreach Element $data {
.tv insert {} end -values $Element
}
foreach column $colnames {
.tv heading $column -text $column
}
ttk::scrollbar .sbY -command {.tv yview}
ttk::scrollbar .sbX -command {.tv xview} -orient horizontal
pack .sbY -side right -fill y
pack .sbX -side bottom -fill x
pack .tv -side left -fill both
Results:
Memory consumption: 2 GB (thereof data stored as list: 1.2 GB)
Time until the table is displayed: 15 sec.
Compare: 10 mio rows consume 7.2 GB of RAM but selecting a row takes serveral seconds (2 - 5) then (possible reason: Internal list traversal?)
Conclusion:
The treeview is more memory efficient than Tktable since it can use a list instead of an array.
For bigger data sizes (> a few million rows) the row selection is slow (the more at the end the slower!)
I have found one possible solution/workaround using Tktable in an "unbound" (command) mode.
With the command option of Tktable you can specify a function that is called each time a cell shall be displayed on the screen. This avoids "loading" all the data from R to Tcl at once improving the "start-up" time and significantly reduces the memory consumption caused by TCL's way of storing arrays and lists.
This way every time you scroll a series of function calls are done to ask for the content of the visible cells.
It works for me even with over 10 mio. rows!
Drawback: Calling an R function that returns a Tcl variable for each cell is still far from being efficient. If you scroll for the first time you can watch the cells being updated. Therefore I am still looking for a bulk data transfer solution between R and Tcl/Tk.
Any suggestions to improve the performance are welcome!
I have implemented a small demo (with 1 mio. rows and 21 columns consuming 1.2 GB of RAM) and added some buttons to test different features (like caching).
Note: The long start-up time is caused by creating the underlying test data, NOT by Tktable!
library(tcltk)
library(data.table)
# Tktable example with -command ("unbound" mode) ---------------------------
# Doc: http://tktable.sourceforge.net/tktable/doc/tkTable.html
NUM.ROWS <- 1E6
NUM.COLS <- 20
# generate a big data.frame - this will take a while but is required for the demo
dt.data <- data.table(ID = 1:NUM.ROWS)
for (i in 1:NUM.COLS) {
dt.data[, (paste("Col",i)) := paste0("R", 1:NUM.ROWS, " C", i)]
}
# Fill one cell with a long text containing special control characters to test the Tktable behaviour
dt.data[3,3 := "This is a long text with backslash \\ and \"quotes\"!"]
tclRequire("Tktable")
t <- tktoplevel()
tkwm.protocol(t, "WM_DELETE_WINDOW", function() tkdestroy(t))
# Function to return the current row and column as "calculated" value (without an underlying data "model")
calculated.data <- function(C) {
# Function arguments for Tcl "substitutions":
# See: http://tktable.sourceforge.net/tktable/doc/tkTable.html
# %c the column of the triggered cell.
# %C A convenience substitution for %r,%c.
# %i 0 for a read (get) and 1 for a write (set). Otherwise it is the current cursor position in the cell.
# %r the row of the triggered cell.
return(tclVar(C)) # this does work!
}
# Function to return the content of a data.table for the current row and colum
data.frame.data <- function(r, c) {
if( r == "0")
return(tclVar(names(dt.data)[as.integer(c)+1])) # First row contains the column names
else
return(tclVar(as.character(dt.data[as.integer(r)+1, as.integer(c)+1, with = FALSE]))) # Other rows are data rows
}
frame <- ttklabelframe(t, text = "Data:")
# Add the table to the window environment to ensure killing it when the window is closed (= no more phantom calls to the data command handler)
# Cache = TRUE: This greatly enhances speed performance when used with -command but uses extra memory.
t$env$table <- tkwidget(frame, "table", rows = NUM.ROWS, cols = NUM.COLS, titlerows = 1, selecttype = "cell", selectmode = "extended", command = calculated.data, cache = TRUE, yscrollcommand = function(...) tkset(scroll.y, ...), xscrollcommand = function(...) tkset(scroll.x, ...))
scroll.x <- ttkscrollbar(frame, orient = "horizontal", command=function(...) tkxview(t$env$table,...)) # command that performs the scrolling
scroll.y <- ttkscrollbar(frame, orient = "vertical", command=function(...) tkyview(t$env$table,...)) # command that performs the scrolling
buttons <- ttkframe(t)
btn.read.only <- ttkbutton(buttons, text = "make read only", command = function() tkconfigure(t$env$table, state = "disabled"))
btn.read.write <- ttkbutton(buttons, text = "make writable", command = function() tkconfigure(t$env$table, state = "normal"))
btn.clear.cache <- ttkbutton(buttons, text = "clear cache", command = function() tcl(t$env$table, "clear", "cache"))
btn.bind.data.frame <- ttkbutton(buttons, text = "Fill cells from R data.table",
command = function() {
tkconfigure(t$env$table, command = data.frame.data, rows = nrow(dt.data), cols = ncol(dt.data), titlerows = 1)
tcl(t$env$table, "clear", "cache")
tkwm.title(t,"Cells are filled from an R data.table")
})
btn.bind.calc.value <- ttkbutton(buttons, text = "Fill cells with calculated values",
command = function() {
tkconfigure(t$env$table, command = calculated.data, rows = 1E5, cols = 40)
tcl(t$env$table, "clear", "cache")
tkwm.title(t,"Cells are calculated values (to test the highest performance possible)")
})
tkgrid(btn.read.only, row = 0, column = 1)
tkgrid(btn.read.write, row = 0, column = 2)
tkgrid(btn.clear.cache, row = 0, column = 3)
tkgrid(btn.bind.data.frame, row = 0, column = 5)
tkgrid(btn.bind.calc.value, row = 0, column = 6)
tkpack(frame, fill = "both", expand = TRUE)
tkpack(scroll.x, fill = "x", expand = FALSE, side = "bottom")
tkpack(scroll.y, fill = "y", expand = FALSE, side = "right")
tkpack(t$env$table, fill = "both", expand = TRUE, side = "left")
tkpack(buttons, side = "bottom")

R - How to print progress in a loop over list?

I need to process a long list of images using a loop. It takes a considerable time to run everything, and therefore I would like to keep track of the progress.
This is my loop:
files.list <- c("LC82210802013322LGN00_B1.TIF", "LC82210802013322LGN00_B10.TIF",
"LC82210802013322LGN00_B11.TIF", "LC82210802013322LGN00_B2.TIF",
"LC82210802013322LGN00_B3.TIF", "LC82210802013322LGN00_B4.TIF",
"LC82210802013322LGN00_B5.TIF", "LC82210802013322LGN00_B6.TIF",
"LC82210802013322LGN00_B7.TIF", "LC82210802013322LGN00_B8.TIF",
"LC82210802013322LGN00_B9.TIF", "LC82210802013322LGN00_BQA.TIF",
"LC82210802013354LGN00_B1.TIF", "LC82210802013354LGN00_B10.TIF",
"LC82210802013354LGN00_B11.TIF", "LC82210802013354LGN00_B2.TIF",
"LC82210802013354LGN00_B3.TIF", "LC82210802013354LGN00_B4.TIF",
"LC82210802013354LGN00_B5.TIF", "LC82210802013354LGN00_B6.TIF",
"LC82210802013354LGN00_B7.TIF", "LC82210802013354LGN00_B8.TIF",
"LC82210802013354LGN00_B9.TIF", "LC82210802013354LGN00_BQA.TIF",
"LC82210802014021LGN00_B1.TIF", "LC82210802014021LGN00_B10.TIF",
"LC82210802014021LGN00_B11.TIF", "LC82210802014021LGN00_B2.TIF",
"LC82210802014021LGN00_B3.TIF", "LC82210802014021LGN00_B4.TIF",
"LC82210802014021LGN00_B5.TIF", "LC82210802014021LGN00_B6.TIF",
"LC82210802014021LGN00_B7.TIF", "LC82210802014021LGN00_B8.TIF",
"LC82210802014021LGN00_B9.TIF", "LC82210802014021LGN00_BQA.TIF",
"LC82210802014037LGN00_B1.TIF", "LC82210802014037LGN00_B10.TIF",
"LC82210802014037LGN00_B11.TIF", "LC82210802014037LGN00_B2.TIF",
"LC82210802014037LGN00_B3.TIF", "LC82210802014037LGN00_B4.TIF",
"LC82210802014037LGN00_B5.TIF", "LC82210802014037LGN00_B6.TIF",
"LC82210802014037LGN00_B7.TIF", "LC82210802014037LGN00_B8.TIF",
"LC82210802014037LGN00_B9.TIF", "LC82210802014037LGN00_BQA.TIF",
"LC82210802014085LGN00_B1.TIF", "LC82210802014085LGN00_B10.TIF",
"LC82210802014085LGN00_B11.TIF", "LC82210802014085LGN00_B2.TIF",
"LC82210802014085LGN00_B3.TIF", "LC82210802014085LGN00_B4.TIF",
"LC82210802014085LGN00_B5.TIF", "LC82210802014085LGN00_B6.TIF",
"LC82210802014085LGN00_B7.TIF", "LC82210802014085LGN00_B8.TIF",
"LC82210802014085LGN00_B9.TIF", "LC82210802014085LGN00_BQA.TIF"
)
for (x in files.list) { #loop over files
# Tell about progress
cat('Processing image', x, 'of', length(files.list),'\n')
}
Of course, instead of showing the name of the file, I would like to show the index of the current file in the context of the length of the entire list.
I really need the names of the files within the loop, because I need to load and save a new version of each one of them.
Any ideas? Thanks in advance.
for (x in 1:length(files.list)) { #loop over files
# doing something on x-th file => files.list[x]
# Tell about progress
cat('Processing image', x, 'of', length(reproj),'\n')
}
for (i in 1:length(files.list)) {
x <- files.list[i]
# do stuff with x
message('Processing image ', i, ' of ', length(files.list))
}
You can use system window progress bar as under:
# put this before start of loop
total = length of your loop
# put this before closing braces of loop
pb <- winProgressBar(title = "progress bar", min = 0, max =total , width = 300)
Sys.sleep(0.1)
# Here i is loop itrator
setWinProgressBar(pb, i, title=paste( round(i/total*100, 0),"% done"))
# put this after closing braces of loop
close(pb)

Capture and process output from external commands from R

Take this simple python script for example:
#!/usr/bin/env python3
# /tmp/xxx.py
import time
for i in range(1000):
print(i)
time.sleep(1)
It continuously outputs numbers. I can call it from R like this:
system2("/tmp/xxx.py", stdin=?)
where stdin can be set to NULL, "", TRUE or a filename. But what I am looking for is a way to process these numbers in realtime. For example, whenever a number is printed from this python script, I want to multiply the number by Pi and then print it to the console. Is there a way to do this in R?
Not an expert, but I got something working.
First of all, I used the following /tmp/xxx.R executable Rscript instead of your python script as I found out python was buffering its output (not printing one line at a time) which makes it hard to test:
#!/usr/bin/env Rscript
for (i in 1:5) {
cat(i, "\n")
Sys.sleep(1)
}
Then the R code:
system('mkfifo /tmp/xxx.fifo')
f <- fifo("/tmp/xxx.fifo", 'r')
p <- pipe('/tmp/xxx.R > /tmp/xxx.fifo; echo OVER > /tmp/xxx.fifo', 'w')
while(TRUE) {
line <- readLines(f, n = 1)
if (length(line) > 0) {
if (line == "OVER") break
cat(pi * as.numeric(line), "\n")
}
Sys.sleep(0.1)
}
close(f)
close(p)
some of which was inspired from this: https://stackoverflow.com/a/5561188/1201032.
Hope it answers your question.

Resources