installr:install.pandoc() appears broken - r

I recently noticed that the install.pandoc function in the installr package appears to be broken.
I get the following error message:
trying URL 'https://github.com/'
Content type 'text/html; charset=utf-8' length unknown
downloaded 78 KB
github.com is not compatible with the version of Windows you're running. Check your computer's system information and then contact the software publisher.
It looks like the function is not finding the appropriate file from GitHub. I have submitted a pull request to the installr package on GitHub which corrects this error.

Here is the function that should install Pandoc correctly and that was submitted as a pull request. In case you run into this error before it is fixed.
library(installr)
FixedInstall.Pandoc <- function (URL = "https://github.com/jgm/pandoc/releases", use_regex = TRUE,
to_restart, ...)
{
URL <- "https://github.com/jgm/pandoc/releases"
page_with_download_url <- URL
if (!use_regex)
warning("use_regex is no longer supported, you can stop using it from now on...")
page <- readLines(page_with_download_url, warn = FALSE)
sysArch <- Sys.getenv("R_ARCH")
sysArch <- gsub("/ |/x", "", sysArch)
pat <- paste0("jgm/pandoc/releases/download/[0-9.]+/pandoc-[0-9.-]+-windows",".*", sysArch, ".*", ".msi")
target_line <- grep("windows", page, value = TRUE)
m <- regexpr(pat, target_line)
URL <- regmatches(target_line, m)
URL <- head(URL, 1)
URL <- paste("https://github.com/", URL, sep = "")
installed <- install.URL(URL, ...)
if (!installed)
return(invisible(FALSE))
if (missing(to_restart)) {
if (is.windows()) {
you_should_restart <- "You should restart your computer\n in order for pandoc to work properly"
winDialog(type = "ok", message = you_should_restart)
choices <- c("Yes", "No")
question <- "Do you want to restart your computer now?"
the_answer <- menu(choices, graphics = "TRUE", title = question)
to_restart <- the_answer == 1L
}
else {
to_restart <- FALSE
}
}
if (to_restart)
os.restart()
}

Related

Error when trying to download species models in R with ebirdst::ebirdst_download()

I've requested an access key and set it. Sys.getenv("EBIRDST_KEY") returns the correct key. ebirdst_download(species = "Sharp-tailed Grouse") returns an error
Error in ebirdst_download(species = "Sharp-tailed Grouse") : Cannot
access Status and Trends data URL. Ensure that you have a working
internet connection and a valid API key for the Status and Trends
data.
My internet is working. Looking at the source code, I believe the error is generated because the function reads a url, essentially read_json(stringr::str_glue("{api_url}list-obj/{species}?key={key}")) which for some reason is null.
https://rdrr.io/github/CornellLabofOrnithology/ebirdst/src/R/ebirdst-loading.R?fbclid=IwAR1JYbCoD_VGwtZ0e1tz7yEPIR1buwN3GUyraZqokeS8rFTox4g3ceWRnns
But I can get it to work if I use the following lines of the source code. I'm not sure why the ebirdst function is failing.
species<-"Sharp-tailed Grouse"
path = rappdirs::user_data_dir("ebirdst")
species <- get_species(species)
which_run <- which(ebirdst::ebirdst_runs$species_code == species)
run <- ebirdst::ebirdst_runs$run_name[which_run]
key<-Sys.getenv("EBIRDST_KEY")
api_url <- "https://st-download.ebird.org/v1/"
list_obj_url <- stringr::str_glue("{api_url}list-obj/{species}?key={key}")
files <-jsonlite::read_json(list_obj_url, simplifyVector = TRUE)
files <- data.frame(file = files)
files <- files[!stringr::str_detect(files$file, "\\.db$"), , drop = FALSE]
files$src_path <- stringr::str_glue("{api_url}fetch?objKey={files$file}",
"&key={key}")
files$dest_path <- file.path(path, files$file)
files$exists <- file.exists(files$dest_path)
dirs <- unique(dirname(files$dest_path))
for (d in dirs) {
dir.create(d, showWarnings = FALSE, recursive = TRUE)
}
old_timeout <- getOption("timeout")
options(timeout = max(3000, old_timeout))
for (i in seq_len(nrow(files))) {
dl_response <- utils::download.file(files$src_path[i],
files$dest_path[i],
mode = "wb")
if (dl_response != 0) {
stop("Error downloading file: ", files$file[i])
}
}

How to click on element with Chrome DevTools Protocol?

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")

RPlumber API - returning data as CSV instead of JSON - works locally on mac, but not on ubuntu-16.04

We are using RPlumber to host an API, and our developers asked that the API endpoints provide data in a CSV format, rather than JSON. To handle this, we have the following:
r_endpoints.R
#* #get /test-endpoint-1
testEndpoint <- function(res) {
mydata <- data.frame(a = c(1,2,3), b = c(3,4,5))
print('mydata')
print(mydata)
con <- textConnection("val","w")
print(paste0('con: ', con))
write.csv(x = mydata, con, row.names = FALSE)
close(con)
print('res and res.body')
print(res);
res$body <- paste(val, collapse="\n")
print(res$body)
return(res)
}
#* #get /test-endpoint-2
testEndpoint2 <- function() {
mydata <- data.frame(a = c(1,2,3), b = c(3,4,5))
return(mydata)
}
run_api.r
library(plumber)
pr <- plumber::plumb("r_endpoints.R")
pr$run(host = "0.0.0.0", port = 8004)
test-endpoint-2 returns the data in a JSON format, whereas test-endpoint-1 returns the data in a CSV format. When these endpoints are run locally on my mac, and when I hit the endpoints, I receive the following correct output:
To host the API, we've installed R + the libraries + pm2 on a Linode Ubuntu 16.04 server, and installed all (I think all) of the dependencies. When we try to hit the endpoints as hosted on the server, we receive:
Here are the print statements that I've added to test-endpoint-1 to help with debugging:
[1] "mydata"
a b
1 1 3
2 2 4
3 3 5
[1] "con: 3"
[1] "res and res.body"
<PlumberResponse>
Public:
body: NULL
clone: function (deep = FALSE)
headers: list
initialize: function (serializer = serializer_json())
removeCookie: function (name, path, http = FALSE, secure = FALSE, same_site = FALSE,
serializer: function (val, req, res, errorHandler)
setCookie: function (name, value, path, expiration = FALSE, http = FALSE,
setHeader: function (name, value)
status: 200
toResponse: function ()
[1] "\"a\",\"b\"\n1,3\n2,4\n3,5"
These are the correct print statements - the same that we get locally. For some reason, the server will not allow us to return in a CSV format in the same way that my local machine allows, and I have no idea why this is the case, or how to fix it.
Edit
After updating the plumber library on my local machine, I now receive the error An exception occurred. on my local machine as well. It seems, in the newer version of plumber, that the snippet of code I use to convert the API endpoint output to a CSV file:
...
con <- textConnection("val","w")
write.csv(x = mydata, con, row.names = FALSE)
close(con)
res$body <- paste(val, collapse="\n")
return(res)
no longer works.
Edit 2
Here's my own stackoverflow post from nearly 3 years ago on how to return the data as a CSV... seems to no longer work.
Edit 3
Using #serialize csv does "work", but when I hit the endpoint, the data is downloaded as a CSV onto my local machine, whereas it would be better for the data to simply be returned in a CSV format from the API, but not automatically downloaded into a CSV file...
Maybe look into this for inspiration, here I'm modifying responses content-type headers to text/plain. text/plain should display in the browser I believe.
#* #get /json
#* #serializer unboxedJSON
function() {
dostuff()
}
#* #get /csv
#* #serializer csv list(type="text/plain; charset=UTF-8")
function() {
dostuff()
}
dostuff <- function() {
mtcars
}
This ugly code works
EDIT : added an enum spec for swagger UI
library(plumber)
#* #get /iris
function(type, res) {
if (type == "csv") {
res$serializer <- serializer_csv(type = "text/plain; charset=UTF-8")
}
iris
}
#* #plumber
function(pr) {
pr_set_api_spec(pr, function(spec) {
spec$paths$`/iris`$get$parameters[[1]]$schema$enum = c("json", "csv")
spec
})
}
The An exception occurred issue is actually from httpuv and is fixed in the latest GitHub version of the package (see https://github.com/rstudio/httpuv/pull/289). Installing httpuv from GitHub (remotes::install_github("rstudio/httpuv")) and running the API again should resolve the issue.

Error in ocrFile function in AbbyyR package

While I was using Abbyy cloud SDK for OCR, I keep on getting the error below when I try to use the ocrFile function which is inside the AbbyyR package.
" Error in curl_download(finishedlist$resultUrl[res$id == finishedlist$id], :
Argument 'url' must be string. "
When I send the files to the cloud and process them everything works fine but when the cloud returns the files there is a problem in downloading them. I thought that it might be a network or certificate problem but I can't solve the problem.
Thanks in advance
There is a problem in source code, it needs as.character() function for url.
I updated ocrFile function as follows:
install.packages("curl")
library(curl)
new_ocrFile<-function (file_path = "", output_dir = "./", exportFormat = c("txt",
"txtUnstructured", "rtf", "docx", "xlsx", "pptx", "pdfSearchable",
"pdfTextAndImages", "pdfa", "xml", "xmlForCorrectedImage",
"alto"), save_to_file = TRUE)
{
exportFormat <- match.arg(exportFormat)
res <- processImage(file_path = file_path, exportFormat = exportFormat)
while (!(any(as.character(res$id) == as.character(listFinishedTasks()$id)))) {
Sys.sleep(1)
}
finishedlist <- listFinishedTasks()
res$id <- as.character(res$id)
finishedlist$id <- as.character(finishedlist$id)
if (identical(save_to_file, FALSE)) {
res <- curl_fetch_memory(as.character(finishedlist$resultUrl[res$id ==
finishedlist$id]))
return(rawToChar(res$content))
}
curl_download(as.character(finishedlist$resultUrl[res$id == finishedlist$id]),
destfile = paste0(output_dir, unlist(strsplit(basename(file_path),
"[.]"))[1], ".", exportFormat))
}
I hope, it helps.

git commit throws error '[<-'

Does anybody have an idea, how I can fix this? git commit -a -m "message here works fine for other projects and previous commits this day were all ok.
Now, it throws the error:
Error in [<-(*tmp*, 1, "Date", value = "2016-07-29") :
Indizierung außerhalb der Grenzen
Ausführung angehalten
The error message is something like:
index out of bounds
Please let me know if you need any further information.
Here is a screenshot:
Edit: #Carsten guessed right! I have a hook running. But I cannot see why it should stop working from one to another minute... (It still does not work)
#!C:/R/R-3.2.2/bin/x64/Rscript
# License: CC0 (just be nice and point others to where you got this)
# Author: Robert M Flight <rflight79#gmail.com>, github.com/rmflight
inc <- TRUE # default
# get the environment variable and modify if necessary
tmpEnv <- as.logical(Sys.getenv("inc"))
if (!is.na(tmpEnv)) {
inc <- tmpEnv
}
# check that there are files that will be committed, don't want to increment version if there won't be a commit
fileDiff <- system("git diff HEAD --name-only", intern = TRUE)
if ((length(fileDiff) > 0) && inc) {
currDir <- getwd() # this should be the top level directory of the git repo
currDCF <- read.dcf("DESCRIPTION")
currVersion <- currDCF[1,"Version"]
splitVersion <- strsplit(currVersion, ".", fixed = TRUE)[[1]]
nVer <- length(splitVersion)
currEndVersion <- as.integer(splitVersion[nVer])
newEndVersion <- as.character(currEndVersion + 1)
splitVersion[nVer] <- newEndVersion
newVersion <- paste(splitVersion, collapse = ".")
currDCF[1,"Version"] <- newVersion
currDCF[1, "Date"] <- strftime(as.POSIXlt(Sys.Date()), "%Y-%m-%d")
write.dcf(currDCF, "DESCRIPTION")
system("git add DESCRIPTION")
cat("Incremented package version and added to commit!\n")
}
Thanks to #Carsten: Using print statements I could track the error in the hook file. In the end it was a stupid bug, where Date was accidentially deleted (=missing) in the description file.

Resources