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)
Related
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.
I have following JSON data I would like to decode to Lua to access each the publish_topic and sample_rate value.
{"00-06-77-2f-37-94":{"publish_topic":"/stations/test","sample_rate":5000}}
If I understand correctly the Lua table will look like this:
{00-06-77-2f-37-94 = "publish_topic":"/stations/test","sample_rate":5000}
Next I would go through the table to save each value into a local variable.
However, if I try printing out the values of the table (using following code), I get 'nil' as return. Is the code for reading table values wrong?
Does the table have two values or is it just the one: ["publish_topic":"/stations/test","sample_rate":5000] ?
lua_value = JSON:decode(data)
for _,d in pairs(lua_value) do
print(lua_value[d])
end
local topic = lua_value[0]
local timer = lua_value[1]
end
Edit: I am using following JSON library for Lua: http://regex.info/blog/lua/json
Edit2: #Piglet: I implemented your script and modified it by adding a table (conversionTable) in which both elements "publish_topic":"/stations/test" and "sample_rate:5000" would be respectively saved in the variables pubtop and rate. When I however print each of both variables, nil ist returned in both cases.
How can I extract the information out of this table to save in variables?
Ultimately I actually only would like to save the values "/stations/test" and "5000" into these variables. Would I need to parse each of the elements above to get these or is there another way?
local pubtop
local rate
local function printTable(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 .. "'")
-- This sample publishes the received messages to test/topic2
print(data)
lua_value = JSON:decode(data)
printTable(lua_value)
print(pubtop)
print(rate)
end
client:register('OnReceive', handleOnReceive)
I don't know which json library you're using so I can't tell you wether JSON:decode(data) is the correct way.
Assuming lua_value would like like so:
local lua_value = {
["00-06-77-2f-37-94"] = {
publish_topic = "/stations/test",
sample_rate = 5000
}
}
Then your loop
for _,d in pairs(lua_value) do
print(lua_value[d])
end
will indeed print nil.
lua_value has a single element at key "00-06-77-2f-37-94" which is a table.
Each loop iteration will give you a key value pair. So d is actually the value and hence the inner table of lua_value
So you're actually doing this:
local innerTable = lua_value["00-06-77-2f-37-94"]
print(lua_value[innerTable])
Of course lua_value[innerTable] is nil.
Edit:
Try something like
function printTable(t)
for k,v in pairs(t) do
if type(v) == "table" then
print(string.format("%q: {", k))
printTable(v)
print("}")
else
print(string.format("%q:", k) .. v .. ",")
end
end
end
printTable(lua_value)
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
}
})
I was able to store functions into a table. But now I have no idea of how to invoke them. The final table will have about 100 calls, so if possible, I'd like to invoke them as if in a foreach loop. Thanks!
Here is how the table was defined:
game_level_hints = game_level_hints or {}
game_level_hints.levels = {}
game_level_hints.levels["level0"] = function()
return
{
[on_scene("scene0")] =
{
talk("hint0"),
talk("hint1"),
talk("hint2")
},
[on_scene("scene1")] =
{
talk("hint0"),
talk("hint1"),
talk("hint2")
}
}
end
Aaand the function definitions:
function on_scene(sceneId)
-- some code
return sceneId
end
function talk(areaId)
-- some code
return areaId
end
EDIT:
I modified the functions so they'll have a little more context. Basically, they return strings now. And what I was hoping to happen is that at then end of invoking the functions, I'll have a table (ideally the levels table) containing all these strings.
Short answer: to call a function (reference) stored in an array, you just add (parameters), as you'd normally do:
local function func(a,b,c) return a,b,c end
local a = {myfunc = func}
print(a.myfunc(3,4,5)) -- prints 3,4,5
In fact, you can simplify this to
local a = {myfunc = function(a,b,c) return a,b,c end}
print(a.myfunc(3,4,5)) -- prints 3,4,5
Long answer: You don't describe what your expected results are, but what you wrote is likely not to do what you expect it to do. Take this fragment:
game_level_hints.levels["level0"] = function()
return
{
[on_scene("scene0")] =
{
talk("hint0"),
}
}
end
[This paragraph no longer applies after the question has been updated] You reference on_scene and talk functions, but you don't "store" those functions in the table (since you explicitly referenced them in your question, I presume the question is about these functions). You actually call these functions and store the values they return (they both return nil), so when this fragment is executed, you get "table index is nil" error as you are trying to store nil using nil as the index.
If you want to call the function you stored in game_level_hints.levels["level0"], you just do game_level_hints.levels["level0"]()
Using what you guys answered and commented, I was able to come up with the following code as a solution:
asd = game_level_hints.levels["level0"]()
Now, asd contains the area strings I need. Although ideally, I intended to be able to access the data like:
asd[1][1]
accessing it like:
asd["scene0"][1]
to retrieve the area data would suffice. I'll just have to work around the keys.
Thanks, guys.
It's not really clear what you're trying to do. Inside your anonymous function, you're returning a table that uses on_scene's return value as keys. But your on_scene doesn't return anything. Same thing for talk.
I'm going to assume that you wanted on_scene and talk to get called when invoking each levels in your game_level_hints table.
If so, this is how you can do it:
local maxlevel = 99
for i = 0, maxlevel do
game_level_hints.levels["level" .. i] = function()
on_scene("scene" .. i)
talk("hint" .. i)
end
end
-- ...
for levelname, levelfunc in pairs(game_level_hints.levels) do
levelfunc()
end
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.