Errors in Deploying Rapache and Rook - r

I am trying to create a web application using R and Rook.
I saw this example http://www.road2stat.com/cn/r/rook.html and I have been able to replicate it in my command line (Calling it from inside R). But I want multiple users to be able to connect to the app at the same-time so I want to deploy it like Jeff said here - http://jeffreyhorner.tumblr.com
I have been able to replicate most of the examples that came with Rook package like Jeff stated on his blog. These include:
summary.r
rnorm
RookTestApp
The problem I am having now is that I cant make the former example work (That is -www.road2stat) It gives me an error message every time I try to upload a file to it. This does not happen when I use the command line.
My error message is like so:
Internal Server Error The server encountered an internal error or
misconfiguration and was unable to complete your request.
This is my path to deploy my app
<Location /test/Visbin>
SetHandler r-handler
RFileEval /usr/lib/R/library/Rook/exampleApps/visbin.R:Rook::Server$call(newapp)
</Location>
This is the app I am trying to replicate
newapp = function(env) {
req = Rook::Request$new(env)
res = Rook::Response$new()
res$write('Choose a Binary file to Train:\n')
res$write('<form method="POST" enctype="multipart/form-data">\n')
res$write('<input type="file" name="data">\n')
res$write('xdim:\n')
res$write('<form method="POST">\n')
res$write('<input type="text" name="xdim" value="12">\n')
res$write('ydim:\n')
res$write('<form method="POST">\n')
res$write('<input type="text" name="ydim" value="25">\n')
res$write('ncolors:\n')
res$write('<form method="POST">\n')
res$write('<input type="text" name="ncolors" value="8">\n')
res$write('<input type="submit" name="Go!">\n</form>\n<br>')
myNormalize = function (target) {
return((target - min(target))/(max(target) - min(target)))
}
if (!is.null(req$POST())) {
data = req$POST()[["data"]]
hash = digest(data$tempfile, algo = "md5", file = TRUE)
destFile = file(data$tempfile, "rb")
k = floor((file.info(data$tempfile)$size/16)) - 2
doneFile = readBin(con = destFile, what = "raw", n = 2 * 8 * k)
close(destFile)
tmpFile0 = rbind(doneFile[seq(1, (2 * 8 * k) - 1, 2)], doneFile[seq(2, (2 * 8 * k), 2)])
tmpFile1 = paste(tmpFile0[1, ], tmpFile0[2, ], sep = "")
initMat = matrix(strtoi(tmpFile1, 16L), ncol = 8, byrow = TRUE)
normMat = myNormalize(initMat)
trainedSOM = kohonen::som(normMat, grid = somgrid(xdim = req$POST()[["xdim"]], ydim = req$POST()[["ydim"]], "hexagonal"))
png(paste("/tmp/", hash, ".png", sep = ""))
plot(trainedSOM, type = "dist.neighbours", palette.name = rainbow, ncolors = as.numeric(req$POST()[["ncolors"]]), main = "")
dev.off()
res$write(paste("<img src='", s$full_url("pic"), "/", hash, ".png'", " />", sep = ""))
}
res$finish()
}
And this is my command line instruction:
s = Rhttpd$new()
s$add(app = newapp, name = "visbin")
s$add(app = File$new("/tmp"), name = "pic")
s$start()
s$browse("visbin")
Can anyone please point me in the right direction or direct me to resources that will assist me in doing it.
P.S. I am using a fedora 15 and I have Rapache-1.2.0 installed.

Related

Cant fetch all records in Qualtrics API using httr package

I am trying to fetch all my mailinglists contacts using the following custom function, but contact lists didn't download all the records inside them. Idk what I am doing wrong?
get_all_contacts<-function(mailingListID){
directoryId<-"POOL_XXXXXXXXXX"
apiToken<-"XXXXXXXXXX"
fetch_url<- VERB(verb = "GET", url = paste("https://iad1.qualtrics.com/API/v3/directories/", directoryId,
"/mailinglists/",mailingListID ,"/contacts",sep = ""),
add_headers(`X-API-TOKEN` = apiToken), encode = "json")
fetch_url<-content(fetch_url, "parse",encoding = "UTF-8")
fetch_url<-fetch_url$result$nextPage
elements <- list()
while(!is.null(fetch_url)){
res<- VERB(verb = "GET", url = fetch_url,
add_headers(`X-API-TOKEN` = apiToken),
encode = "json")
res<-content(res, "parse",encoding = "UTF-8")
elements <- append(elements,res$result$elements)
fetch_url <- res$result$nextPage
}
return(elements)
}

Getting the output of a script in Matlab called from R

I am trying to call a very simple script in Matlab from RStudio. However, whenever I run the following code, without getting any error, it will return 0 to me. Would you please let me know how I can call Matlab scripts in R and get their outputs?
run_matlab_script("C:/Users/XXX/Desktop/Sum.m", verbose = TRUE, desktop = FALSE, splash = FALSE,
display = TRUE, wait = TRUE, single_thread = FALSE)
Note that to use the above function, I am using "matlabr" package in r. Moreover, my simple script in Matlab includes the below code:
b=1+2
Thanks in advance!
matlab::run_matlab_script uses system to call matlab. As of today, that function (current commit is c01d310) looks like:
run_matlab_script = function(
fname,
verbose = TRUE,
desktop = FALSE,
splash = FALSE,
display = FALSE,
wait = TRUE,
single_thread = FALSE,
...){
stopifnot(file.exists(fname))
matcmd = get_matlab(
desktop = desktop,
splash = splash,
display = display,
wait = wait,
single_thread = single_thread)
cmd = paste0(' "', "try, run('", fname, "'); ",
"catch err, disp(err.message); ",
"exit(1); end; exit(0);", '"')
cmd = paste0(matcmd, cmd)
if (verbose) {
message("Command run is:")
message(cmd)
}
x <- system(cmd, wait = wait, ...)
return(x)
}
Noteworthy (to me) is that run_matlab_script includes ... in its formals, and passes that unchanged to system. In fact, its help documentation specifically says that is what it does:
#' #param ... Options passed to \code{\link{system}}
Because of this, we can try to capture its output by looking at system. From ?system,
intern: a logical (not 'NA') which indicates whether to capture the
output of the command as an R character vector.
which suggests that if you change your call to
ret <- run_matlab_script("C:/Users/XXX/Desktop/Sum.m", verbose = TRUE, desktop = FALSE,
splash = FALSE, display = TRUE, wait = TRUE, single_thread = FALSE,
intern = TRUE)
you will get its output in out.

Logging each request to a separate json file with RestRserve

How would one set up logging each request to a different json file with RestRserve?
I tried using the lgr package (referred to in RestRserve's doc on logging) like so:
library(RestRserve)
library(lgr)
app = Application$new(content_type = "text/plain")
# RestRserve logger
app$logger = RestRserve::Logger$new(level = "trace", name = "mylogger",
printer=function(timestamp, level, logger_name, pid, message, ...)
{
lgr$log(level=tolower(level), msg=message, ...)
}
)
# JSON appender in lgr
tf <- tempfile(tmpdir="D:/temp", fileext=".log")
lgr$add_appender(AppenderJson$new(tf), name = "json")
# Endpoint
app$add_get("/sqrt", function(request, response) {
on.exit({
# Next log file
tf <- tempfile(tmpdir="D:/temp", fileext=".log")
lgr$appenders$json$set_file(tf)
})
app$logger$info(msg="", context=list(request_id = request$id, message="Process start"))
response$body = sqrt(x)
app$logger$info(msg="", context=list(request_id = request$id, message="Process end"))
})
# Submit request
request = Request$new(path = "/sqrt", method = "GET", parameters_query = list(x = "10"))
response = app$process_request(request)
But this splits up a request's log info across two files. I'm also quite sure it wouldn't work for simultaneous requests.
I believe you even don't need any special logger - just use writeLines. Also you can rely on req$id to name files since it is unique.
library(RestRserve)
req = Request$new()
res = Response$new()
fl = file.path(tempdir(), paste0(req$id, ".log"))
con = file(fl, open = "at")
writeLines("Process start", con)
res$set_body(sqrt(10))
writeLines("Process end", con)
close(con)
readLines(fl)
unlink(fl)

How to scrape additional data points from Zillow using R

I inherited a file from a previous coworker to use R to pull Zillow "Zestimate" and "Rent Zestimate" data for properties, and then output these data points to a CSV file. However, I am very new to coding and have not been successful with pulling additional information that I know is available. I have searched the site for answers, but since I am still trying to learn how to code I haven't been successful with making my own edits to the current code. Any help I can get adding code to pull any of these additional data points would be much appreciated.
Property details (sqft, year built, beds, baths, property type)
Zestimate range (high and low)
Rent Zestimate range (high and low)
Last sold date and price
Price history (latest event, date, and price)(not sure this can be scraped )
Tax history (latest year and property taxes) (not sure this can be scraped )
Current code:
houseAddsSplit = read.csv(houseAddsFileLocation) zillowAdds = paste(houseAddsSplit$STREET, houseAddsSplit$CITY, houseAddsSplit$STATE, houseAddsSplit$ZIP, sep = " ")
library(ZillowR)
library(XML)
set_zillow_web_service_id(zwsId)
zpidList = NULL
zestimate = NULL
rentZestimate = NULL
for(i in 1:length(zillowAdds)){
print(paste("Processing house: ", i, ", address: ", zillowAdds[i]))
print(zillowAdds[i])
houseZpidClean = "ERR"
houseZestClean = "ERR"
houseRentZestClean = "ERR"
houseInfo = try(GetSearchResults(address = zillowAdds[i], citystatezip = as.character(houseAddsSplit$ZIP[i]), rentzestimate = TRUE))
'#'while(houseInfo$message$code != "0"){
'#' houseInfo = try(GetSearchResults(address = cipAdds[i], citystatezip = as.character(cipLoans$ZIP[i]), rentzestimate = TRUE))
'#' Sys.sleep(runif(1, 3, 5))
'#'}
if(houseInfo$message$code == "0"){
houseZpid = try(xmlElementsByTagName(houseInfo$response, "zpid", recursive = TRUE))
houseZest = try(xmlElementsByTagName(houseInfo$response, "amount", recursive = TRUE))
houseZpidAlmostClean = try(toString.XMLNode(houseZpid$results.result.zpid))
houseZestAC = try(toString.XMLNode(houseZest$results.result.zestimate.amount))
houseRentZestAC = try(toString.XMLNode(houseZest$results.result.rentzestimate.amount))
houseZpidClean = try(substr(houseZpidAlmostClean, 7, nchar(houseZpidAlmostClean) - 7))
houseZestClean = try(substr(houseZestAC, 24, nchar(houseZestAC) - 9))
houseRentZestClean = try(substr(houseRentZestAC, 24, nchar(houseRentZestAC) - 9))
}
closeAllConnections()
zpidList[i] = houseZpidClean
print(paste("zpid: ", houseZpidClean))
zestimate[i] = houseZestClean
print(paste("zestimate: ", houseZestClean))
rentZestimate[i] = houseRentZestClean
print(paste("rent zestimate: ", houseRentZestClean))
Sys.sleep(runif(1, 7, 10))
}
outputData = cbind(houseAddsSplit, zestimate, rentZestimate)
write.csv(outputData, paste(writeToFolder, "/zillowPullOutput.csv", sep = ""))
print(paste("All done. File written to", paste(writeToFolder, "/zillowPullOutput.csv", sep = "")))
Hope you solved this, but GetSearchResult API wouldn't return all the results you are looking for. You may have to call GetUpdatedPropertyDetails API to get all the results.

Query Oracle DNS in RStudio

I am using RStudio with package RODBC using the following code
require(RODBC)
channel<-odbcConnect(dsn = "USA", uid = "AA", pwd = "***" )
odbcGetInfo(channel)
This returns all the details but when I try and do a sql query
test<-sqlQuery(channel,"select * from cnty", rows_at_time = 1)
It returns an error with
Error in odbcFetchRows(channel, max = max, buffsize = buffsize, nullstring = nullstring, :
negative length vectors are not allowed
This works if I open Microsoft AccessDB - External Data -ODBC DataBase - link to data source click machine Data Source and select the source which then allows me to do a select query.
I have also tried using
debug(odbcFetchRows) test<-sqlQuery(channel,"select * from cnty", rows_at_time = 1)
This returns
function (channel, max = 0, buffsize = 1000, nullstring = NA_character_,
believeNRows = TRUE)
{
if (!odbcValidChannel(channel))
stop("first argument is not an open RODBC channel")
.Call(C_RODBCFetchRows, attr(channel, "handle_ptr"), max,
buffsize, as.character(nullstring), believeNRows)
}
I got this working by using test<-sqlQuery(channel,"select * from cnty", rows_at_time = 1,believeNRows = FALSE)

Resources