I am having a weird issue with the r-script (npm module) and the passage of the output to NodeJS.
Using:
needs("arules")
data <- read.transactions(input[[1]], sep = ",")
library(arules)
# default settings result in zero rules learned
groceryrules <- apriori(data, parameter = list(support =
0.006, confidence = 0.25, minlen = 2))
summary(groceryrules)
inspect(groceryrules[1:5])
I get the result fine in nodeJS as:
[ { '2': '=>', lhs: '{potted plants}', rhs: '{whole milk}', support: 0.0069, confidence: 0.4, lift: 1.5655, count: 68, _row: '[1]' }, { '2': '=>', lhs: '{pasta}', rhs: '{whole milk}', support: 0.0061, confidence: 0.4054, lift: 1.5866, count: 60, _row: '[2]' } ...]
However, changing the last line to:
inspect(sort(groceryrules, by = "lift")[1:5])
I get no output. If I set the interval to 1:2, it prints correctly the two top observations (by Lift).
Why can't I view more than 2 items when using sort?
My code in NodeJS:
var R = require("r-script");
var out = R("tests.R");
out = out.data(__dirname+"\\groceries.csv");
out = out.callSync();
console.log(out)
Thanks!
I managed to find the solution.
Using:
out <- capture.output(inspect(sort(groceryrules,by="lift")[1:10]))
out
It correctly puts into a string the inspect output and then passes it to the NodeJS server as:
[' lhs rhs support confidence lift count',
'[1] {herbs} => {root vegetables} 0.007015760 0.4312500 3.956477 69',...]
A simple split in each string should address the problem now, to make the data manageable.
EDIT:
Managed to find a better solution that gets the JSON in the correct format straight away, by using:
data = (sort(rules,by="lift"))
as(data, "data.frame")
This way it correctly converts the frame to JSON.
Related
Trying to cut a bunch of audio (.WAV) files into smaller samples in R. For this example, I'm using a loop to cut out 1 minute samples at 140 minutes.
For some files, the recording ends before 140 minutes due to an error in the recording device. When this occurs, an error appears -- and the loop stops. I'm trying to make it so the loop continues by using the try or tryCatch function however keep getting errors.
The code is as follows:
for(i in 1:length(AR_CD288)){
CUT_AR288_5 <- try({readWave(AR_CD288[i], from = 140, to = 141, units = "minutes")})
FILE.OUT_AR288_5<- sub("\\.wav$", "_140.wav", AR_CD288)
OUT.PATH_AR288_5 <- file.path("New files", basename(FILE.OUT_AR288_5))
writeWave(CUT_AR288_5, extensible=FALSE, filename = OUT.PATH_AR288_5[i])
}
I get the following two errors from the code:
Error in readBin(con, int, n = N, size = bytes, signed = (bytes != 1), :
invalid 'n' argument
Error in writeWave(CUT_AR288_5, extensible = FALSE, filename = OUT.PATH_AR288_5[i]) :
'object' needs to be of class 'Wave' or 'WaveMC
The loop still saves some samples into the "New files" directory, however, once the loop reaches a file <140 minutes, the loop stops.
I am very stuck! Any help would be greatly appreciated.
Cheers.
When I use try, I always do one (or both) of:
check the return value to see if it inherits "try-error", indicating that the command failed; or
add try(., silent = TRUE), indicating that I don't care if it succeeded (but this implies that I will not use its return value, either).
Try this:
for (i in seq_along(AR_CD288)) {
CUT_AR288_5 <- try({
readWave(AR_CD288[i], from = 140, to = 141, units = "minutes")
}, silent = TRUE)
if (!inherits(CUT_AR288_5, "try_error")) {
FILE.OUT_AR288_5 <- sub("\\.wav$", "_140.wav", AR_CD288)
OUT.PATH_AR288_5 <- file.path("New files", basename(FILE.OUT_AR288_5))
writeWave(CUT_AR288_5, extensible = FALSE, filename = OUT.PATH_AR288_5[i])
}
}
Three notes:
I changed 1:length(.) to seq_along(.); the latter is more resilient in an automated use when it is feasible that the vector might be length 0. For example, if AR_CD288 can ever be length 2, intuitively we expect 1:length(AR_CD288) to return nothing so that the for loop will not run; unfortunately, it resolves to 1:0 which returns a vector of length 2, which will often fail (based on whatever code is operating in the loop). The use of seq_along(.) will always return a vector of length 0 with an empty input, which is what we need. (Alternatively and equivalent, seq_len(length(AR_CD288)), though that's really what seq_along is intended to do.)
If you do not add silent=TRUE (or explicitly add silent=FALSE), then you will get an error message indicating that the command failed. Unfortunately, the error message may not indicate which i failed, so you may be left in the dark as far as fixing or removing the errant file. You may prefer to add an else to the if (inherits(.,"try-error")) clause so that you can provide a clearer error, such as
if (inherits(CUT_AR288_5, "try_error")) {
warning("'readWave' failed on ", sQuote(AR_CD288[i]), call. = FALSE)
} else {
FILE.OUT_AR288_5 <- sub("\\.wav$", "_140.wav", AR_CD288)
# ...
}
(noting that I put the "things worked" code in the else clause here ... I find it odd to do if (!...) {} else {}, seems like a double-negation :-).
The choice to wrap one function or the whole block depends on your needs: I tend to prefer to know exactly where things fail, so the will-possibly-fail functions are often individually wrapped with try so that I can react (or log/message) accordingly. If you don't need that resolution of error-detection, then you can certainly wrap the whole code-block in a sense:
for (i in seq_along(AR_CD288)) {
ret <- try({
CUT_AR288_5 <- readWave(AR_CD288[i], from = 140, to = 141, units = "minutes")
FILE.OUT_AR288_5 <- sub("\\.wav$", "_140.wav", AR_CD288)
OUT.PATH_AR288_5 <- file.path("New files", basename(FILE.OUT_AR288_5))
writeWave(CUT_AR288_5, extensible = FALSE, filename = OUT.PATH_AR288_5[i])
}, silent = TRUE)
if (inherits(ret, "try-error")) {
# do or log something
}
}
I am trying to evaluate strings within a for loop within an R script using JuliaCall::julia_eval. While I was able to accomplish this in R using the deSolve package, I am running into issues when converting the code to one that is compatible with Julia. The base code for the correctly functioning R deSolve code is shown below.
library(deSolve)
library(dplyr)
Combine <- c(" - 1*0.4545*(H2O2^1) - 1*27000000*(`$OH`^1)*(H2O2^1)", " - 1*3100000000*(`1,4-dioxane`^1)*(`$OH`^1)",
" - 1*33000*(TOC^1)*(`$OH`^1)", "2*0.4545*(H2O2^1) - 1*3100000000*(`1,4-dioxane`^1)*(`$OH`^1) - 1*33000*(TOC^1)*(`$OH`^1) - 1*27000000*(`$OH`^1)*(H2O2^1) - 1*8500000*(`$OH`^1)*(`HCO3-`^1) - 1*390000000*(`$OH`^1)*(`CO3 2-`^1)",
" - 1*8500000*(`$OH`^1)*(`HCO3-`^1)", " - 1*390000000*(`$OH`^1)*(`CO3 2-`^1)"
)
time <- seq(from=0, to=0.01, by = 1E-4)
State <- c(H2O2 = 0.000294117647058824, `1,4-dioxane` = 0.00000113494,
TOC = 0, `$OH` = 0, `HCO3-` = 0.003766104, `CO3 2-` = 0.0000167638711956647)
ODEcreater2 <- function(t, state, parameters){
with(as.list(c(state)),{
for (i in 1:6) { #
dY[i] <- eval(parse(text=Combine[i]))}
return(list(dY))
} )}
out1<- ode(y = state, times = time, func = ODEcreater2, parms = NULL)
I am trying to use replicate the code and run it in Julia to improve the speed of the ODE solver by using diffeqr vs. deSolve. Unfortunately, I am running into evaluating the string/expression within a for loop in julia_call.
library(diffeqr)
diffeqr::diffeq_setup()
library(JuliaCall)
julia <- julia_setup()
ODEcreater <- JuliaCall::julia_eval("
function (dY,t,state)
for i in 1:6
dY[i] = eval(Meta.parse(:Combine[i]))
end
end")
tspan <- list(1E-6, 1E-3)
sol = diffeqr::ode.solve(ODEcreater,state,tspan, abstol=1e-8, reltol=1e-8)
Does anyone have any insight into the best way to evaluate the strings within the for loop? I have been investigating metaexpressions on the JuliaLang website but am still lost.
As mentioned in the duplicate question https://stackoverflow.com/a/58766919/1544203 , building the string and then doing
sprintf("function f(du,u,p,t)\n%s\nend", paste(Combine, collapse="\n"))
from the R side builds a single string which matches the format that works. This is also optimal since it excludes any extra function calls from the generated function.
from julia docs:
parse(str; raise=true, depwarn=true)
Parse the expression string greedily, returning a single expression. An error is thrown if there are additional
characters after the first expression. If raise is true (default), syntax errors will raise an error; otherwise, parse
will return an expression that will raise an error upon evaluation. If depwarn is false, deprecation warnings will be
suppressed.
julia> Meta.parse("x = 3")
:(x = 3)
so, Meta.parse accepts a string and returns an expression. this should evaluate correctly:
eval(Meta.parse(Combine[i]))
one problem i see is the use of non-valid julia variable names, like $OH
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")
An example of what I desire:
local X = {["Alpha"] = 5, ["Beta"] = this.Alpha+3}
print(X.Beta) --> error: [string "stdin"]:1: attempt to index global 'this' (a nil value)
is there a way to get this working, or a substitute I can use without too much code bloat(I want it to look presentable, so fenv hacks are out of the picture)
if anyone wants to take a crack at lua, repl.it is a good testing webpage for quick scripts
No there is no way to do this because the table does not yet exist and there is no notion of "self" in Lua (except via syntactic sugar for table methods). You have to do it in two steps:
local X = {["Alpha"] = 5}
X["Beta"] = X.Alpha+3
Note that you only need the square brackets if your key is not a string or if it is a string with characters other than any of [a-z][A-Z][0-9]_.
local X = {Alpha = 5}
X.Beta = X.Alpha+3
Update:
Based on what I saw on your pastebin, you probably should do this slightly differently:
local Alpha = 5
local X = {
Alpha = Alpha,
Beta = Alpha+3,
Gamma = someFunction(Alpha),
Eta = Alpha:method()
}
(obviously Alpha has no method because in the example it is a number but you get the idea, just wanted to show if Alpha were an object).
I have already discussed a similar type of a question in this following post
How to set a for -loop in R
each file contents as follows:
FILE_1.FASTA
>>TTBK2_Hsap ,(CK1/TTBK)
MSGGGEQLDILSVGILVKERWKVLRKIGGGGFGEIYDALDMLTRENVALKVESAQQPKQVLKMEVAVLKKLQGKDHVCRFIGCGRNDRFNYVVMQLQGRNLADLRRSQSRGTFT
FILE_2.FASTA
>>TTBK2_Hsap ,(CK1/TTBK)
MSGGGEQLDILSVGILVKERWKVLRKIGGGGFGEIYDALDMLTRENVALKVESAQQPKQVLKMEVAVLKKLQGKDHVCRFIGCGRNDRFNYVVMQLQGRNLADLRRSQSRGTFT
However, there is another package in R which works like this:
extractAPAAC(x, props = c("Hydrophobicity", "Hydrophilicity"), lambda = 30,
w = 0.05, customprops = NULL)
I tried creating a function to run it for number of file sequences and the program looks like this
read_and_extract <- function(fasta) {
seq <- readFASTA(fasta)[[1]]
return(extractAPAAC(seq, props = c("Hydrophobicity", "Hydrophilicity"), lambda = 30,
w = 0.05, customprops = NULL))
}
setwd("H:\\CC")
fasta_files <- dir(pattern = "[.]fasta$")
aa_comp <- vapply(fasta_files, read_and_extract, rep(pi, 80))
write.csv(aa_comp, file = "C:\\Users\\PAAC.csv")
This programs shows an error
Error: unexpected ',' in "w = 0.05,"
But I have given w=0.05 as of default value, could anyone tell me where is the actual problem?