Passing a filepath to a R function? - function

I tried to pass a filepath to a function in R, but I failed =/ I hope someone here can help me.
>heat <- function(filepath)
{ chicks <- read.table(file=filepath, dec=",", header=TRUE, sep="\t")
...
}
When I call the function, nothing happens...
>heat("/home/.../file.txt")
... and "chicks" is not found
>chicks
Error: Object 'chicks' not found
What is the correct way to pass a path to a function?

You should be able to pass file paths as you have (if the file exists). You can also query file paths in R using list.files() [use the argument full.names=TRUE]. However, in this case I believe you cannot see chicks because it is local to the function so you will not be able to see this variable outside of the function. Furthermore, if your last expression is an assignment, I believe the output is not printed. Try
> heat <- function(filepath) {
+ read.table(file=filepath, dec=",", header=TRUE, sep="\t")
+ }
> heat("/home/.../file.txt")
or
> chicks <- heat("/home/.../file.txt")
> chicks
and you should see chicks. Or if you want to see it printed while assigning, add parentheses around the statement:
> (chicks <- heat("/home/.../file.txt"))
If you want to assign to chicks within the function but still see it after the function has completed,
> heat <- function(filepath) {
+ chicks <- read.table(file=filepath, dec=",", header=TRUE, sep="\t")
+ assign("chicks",chicks,globalenv())
+ }

The function can't know what you're trying to make the output. If you don't specify it, the output will be the last viable line, which may not always be what you want. Use return() to specify what should come out as an object.
heat <- function(filepath) {
chicks <- read.table(file=filepath, dec=",", header=TRUE, sep="\t")
...
return(chicks)
}
inpt <- heat("/.../file.txt")
Does this help with your problem?

Also when working with paths, it is often helpful to test whether the file/folder exists:
heat <- function(filepath){
if(!file.exists(filepath)){
stop(sprintf("Filepath %s does not exist",filepath))
}
...
}
In the example above, however, read.table will give an error message if the file does not exist.

Related

R dbplyr mysql column conversion

I have a table in mySQL that looks something like this:
tbl<-tibble(
Result=c("0.1","<0.0001","1.1"),
Unit=c("mg/L","ug/L","mg/L"),
Pref_Unit=c("mg/L","mg/L","mg/L"),
Conversion=c(1,1000,1)
)
What I would like to do using dbplyr, pool, and RMariaDB is to convert the Result column to the preferred unit using the conversion factor in the table, while preserving the "<", and also splitting the Result column into a numeric fraction containing only the number and censored indicating whether the Result contained a "<".
With regular dplyr, I would do something like this:
tbl<-tbl %>%
mutate(numb_Result=as.numeric(gsub("<","",Result)),
cen_Result=grepl("<",Result)) %>%
mutate(new_Result=ifelse(cen_Result,paste0("<",numb_Result*Conversion),paste0(numb_Result*Conversion)))
But that doesn't work with the database table. Any help would be appreciated.
The challenge is most likely because dbplyr does not have translations defined for gsub and grepl. A couple of possibilities for you to test below:
library(dplyr)
library(dbplyr)
tbl<-tibble(
Result=c("0.1","<0.0001","1.1"),
Unit=c("mg/L","ug/L","mg/L"),
Pref_Unit=c("mg/L","mg/L","mg/L"),
Conversion=c(1,1000,1)
)
remote_table = tbl_lazy(tbl, con = simulate_mssql())
remote_table %>%
mutate(has_sign = ifelse(substr(Result, 1, 1) == "<", 1, 0)) %>%
mutate(removed_sign = ifelse(has_sign == 1, substr(Result, 2, nchar(Result)), Result)) %>%
mutate(num_value = as.numeric(removed_sign)) %>%
mutate(converted = as.character(1.0 * num_value * Conversion)) %>%
mutate(new_Result = ifelse(has_sign, paste0("<",converted), converted))
There are dbplyr translations for ifelse, substr, nchar, as.numeric, as.character, and paste0. So I expected this to work. However, I keep getting an error because the translator requires the start and stop arguments to substr to be constants and hence it does not like me passing nchar(Results) as an argument. But this might be fixed in a more recent version of the package.
My second attempt:
remote_table %>%
mutate(has_sign = ifelse(substr(Result, 1, 1) == "<", 1, 0),
character_length = nchar(Result),
remove_first = sql(REPLACE(Result, "<", ""))) %>%
mutate(removed_sign = ifelse(has_sign == 1, remove_first, Result)) %>%
mutate(num_value = as.numeric(removed_sign)) %>%
mutate(converted = as.character(1.0 * num_value * Conversion)) %>%
mutate(new_Result = ifelse(has_sign, paste0("<",converted), converted))
This produces the expected SQL translation. But as I am using a simulated database connection, I have not been able to test whether it returns the expected output. The downside of this approach is that it used the SQL function REPLACE directly (it passes untranslated into the SQL code), which is less elegant than a fully translated solution.
There are probably more elegant ways to do this. But hopefully between these two you can find a suitable solution.
Thank you Simon!
I had found a similar solution which does work on the actual SQL database environment (note that I also had to pass the column name as a variable result_col, hence the use of !!sym()):
tbl %>%
mutate(numb_res = REGEXP_REPLACE(!!sym(result_col),"<",""),
cen_res = !!sym(result_col) %like% "<%") %>%
mutate(numb_res=numb_res*Conversion) %>%
mutate(!!result_col:=case_when(
cen_res==1 ~ paste0("<",numb_res),
T ~ paste0(numb_res)
))
It seems you are correct that there is no SQL translation for as.character() and as.numeric(), but just doing the multiplication on the character vector is enough to make it numeric, and similarly, pasting the values with "<" make its back into a character.
I think this is working for me, but I will investigate your answer as well.

Save decoded JSON values in Lua Variables

Following script describes the decoding of a JSON Object, that is received via MQTT. In this case, we shall take following JSON Object as an example:
{"00-06-77-2f-37-94":{"publish_topic":"/stations/test","sample_rate":5000}}
After being received and decoded in the handleOnReceive function, the local function saveTable is called up with the decoded object which looks like:
["00-06-77-2f-37-94"] = {
publish_topic = "/stations/test",
sample_rate = 5000
}
The goal of the saveTable function is to go through the table above and assign the values "/stations/test" and 5000 respectively to the variables pubtop and rate. When I however print each of both variables, nil is returned in both cases.
How can I extract the values of this table and save them in mentioned variables?
If i can only save the values "publish_topic = "/stations/test"" and "sample_rate = 5000" at first, would I need to parse these to get the values above and save them, or is there another way?
local pubtop
local rate
local function saveTable(t)
local conversionTable = {}
for k,v in pairs(t) do
if type(v) == "table" then
conversionTable [k] = string.format("%q: {", k)
printTable(v)
print("}")
else
print(string.format("%q:", k) .. v .. ",")
end
end
pubtop = conversionTable[0]
rate = conversionTable[1]
end
local lua_value
local function handleOnReceive(topic, data, _, _)
print("handleOnReceive: topic '" .. topic .. "' message '" .. data .. "'")
print(data)
lua_value = JSON:decode(data)
saveTable(lua_value)
print(pubtop)
print(rate)
end
client:register('OnReceive', handleOnReceive)
previous question to thread: Decode and Parse JSON to Lua
The function I gave you was to recursively print table contents. It was not ment to be modified to get some specific values.
Your modifications do not make any sense. Why would you store that string in conversionTable[k]? You obviously have no idea what you're doing here. No offense but you should learn some basics befor you continue.
I gave you that function so you can print whatever is the result of your json decode.
If you know you get what you expect there is no point in recursively iterating through that table.
Just do it like that
for k,v in pairs(lua_value) do
print(k)
print(v.publish_topic)
print(v.sample_rate)
end
Now read the Lua reference manual and do some beginners tutorials please.
You're wasting a lot of time and resources if you're trying to implement things like that if you do not know how to access the elements of a table. This is like the most basic and important operation in Lua.

How to figure out which column names are illegal in ranger?

Here is a ranger call:
rf_fit <-
rf_mod %>%
fit(my_outcome_factor ~ ., data = data_train)
and the output:
Error in parse.formula(formula, data, env = parent.frame()) :
Error: Illegal column names in formula interface. Fix column names or use alternative interface in ranger.
How can I tell which columns are illegal?
I tried setting up a function foo() to debug:
foo <- function() {
browser()
ranger:::parse.formula(my_outcome_factor ~ ., data = data_train)
}
This function didn't help me much, because I don't know how to get a breakpoint in the right spot.
It's ranger version 0.12.1.

ifelse try combination returns just object of length 1

if you run this you get info about financial statements
library(RJSONIO)
data<-fromJSON("http://www.registeruz.sk/cruz-public/api/uctovny-vykaz?id=4455316",encoding = "UTF-8")
when you run this you get vector of length 312 with items from balance sheet
data$obsah$tabulky[[1]]$data
I am doing this for more companie within loop and sometimes json path above is not present which would return error . So therefore I use try to return NA if there is an error, otherwise I want to just return object from above mentioned path
ifelse(class(try(data$obsah$tabulky[[1]]$data))=="try-error",NA,data$obsah$tabulky[[1]]$data)
However when I run it it returns just 1 item of vector not full 312
You can't get the result you want from ifelse because, per the documentation for that function, "ifelse returns a value with the same shape as test." Your test has length 1, so ifelse will only return an object with length 1.
To return objects of different dimensions, you can break up the if and else parts and wrap them in a call to lapply. Here's one way to do this, iterating your process over a vector of URLs and collecting the results in a list:
lapply(urls, function(x) {
# you might want try here, too, in case you get errors at this stage
X <- try(fromJSON(x, encoding = "UTF-8"))
Y <- try(X$obsah$tabulky[[1]]$data)
if (class(Y) == "try-error") {
NA
} else {
Y
}
})

Ignore NA's in sapply function

I am using R and have searched around for an answer but while I have seen similar questions, it has not worked for my specific problem.
In my data set I am trying to use the NA's as placeholders because I am going to return to them once I get part of my analysis done so therefore, I would like to be able to do all my calculations as if the NA's weren't really there.
Here's my issue with an example data table
ROCA = c(1,3,6,2,1,NA,2,NA,1,NA,4,NA)
ROCA <- data.frame (ROCA=ROCA) # converting it just because that is the format of my original data
#Now my function
exceedes <- function (L=NULL, R=NULL, na.rm = T)
{
if (is.null(L) | is.null(R)) {
print ("mycols: invalid L,R.")
return (NULL)
}
test <-(mean(L, na.rm=TRUE)-R*sd(L,na.rm=TRUE))
test1 <- sapply(L,function(x) if((x)> test){1} else {0})
return (test1)
}
L=ROCA[,1]
R=.5
ROCA$newcolumn <- exceedes(L,R)
names(ROCA)[names(ROCA)=="newcolumn"]="Exceedes1"
I am getting the error:
Error in if ((x) > test) { : missing value where TRUE/FALSE needed
As you guys know, it is something wrong with the sapply function. Any ideas on how to ignore those NA's? I would try na.omit if I could get it to insert all the NA's right where they were before, but I am not sure how to do that.
There's no need for sapply and your anonymous function because > is already vectorized.
It also seems really odd to specify default argument values that are invalid. My guess is that you're using that as a kludge instead of using the missing function. It's also good practice to throw an error rather than return NULL because you would still have to try to catch when the function returns NULL.
exceedes <- function (L, R, na.rm=TRUE)
{
if(missing(L) || missing(R)) {
stop("L and R must be provided")
}
test <- mean(L,na.rm=TRUE)-R*sd(L,na.rm=TRUE)
as.numeric(L > test)
}
ROCA <- data.frame(ROCA=c(1,3,6,2,1,NA,2,NA,1,NA,4,NA))
ROCA$Exceeds1 <- exceedes(ROCA[,1],0.5)
This statement is strange:
test1 <- sapply(L,function(x) if((x)> test){1} else {0})
Try:
test1 <- ifelse(is.na(L), NA, ifelse(L > test, 1, 0))
Do you want NA:s in the result? That is, do you want the rows to line up?
seems like just returning L > test would work then. And adding the column can be simplified too (I suspect "Exeedes1" is in a variable somewhere).
exceedes <- function (L=NULL, R=NULL, na.rm = T)
{
if (is.null(L) | is.null(R)) {
print ("mycols: invalid L,R.")
return (NULL)
}
test <-(mean(L, na.rm=TRUE)-R*sd(L,na.rm=TRUE))
L > test
}
L=ROCA[,1]
R=.5
ROCA[["Exceedes1"]] <- exceedes(L,R)