Im trying to set names for a vector using the function names, but R gives me an error. I want to create a vector with function and then set name for each number in that vector. I want to do all this step by writing just one order (for example v(x)). This is example of my code script
v <- c(2,6,5)
d <- function(x) x*9
names(d(x))<-paste("q=", 1:3, sep="")
and R says
Error in names(d(x)) <- paste("q=", 1:3, sep = "") :
could not find function "d<-"
I don't really know what you are doing, but assuming this approximates it I can reproduce the error:
qn <- 1:11
div_1 <- function(x) { x <- x + 1 }
div_2 <- function(x) { x <- x + 2 }
div<- function(x) c(div_1(x)[1],div_2(x),div_1(x)[2:10])
x <- 1
names(div(x))<- paste("q=", qn, sep="" )
# Error in names(div(x)) <- paste("q=", qn, sep = "") :
# could not find function "div<-"
and I can fix it with this (breaking it into two steps):
qn <- 1:11
div_1 <- function(x) { x <- x + 1 }
div_2 <- function(x) { x <- x + 2 }
div<- function(x) c(div_1(x)[1],div_2(x),div_1(x)[2:10])
x <- 1
v <- div(x)
names(v)<- paste("q=", qn, sep="" )
# q=1 q=2 q=3 q=4 q=5 q=6 q=7 q=8 q=9 q=10 q=11
# 2 3 NA NA NA NA NA NA NA NA NA
It may be a bug, or a limitation in assigning names to a temporary variable (note that the result gets thrown out in your version). Out of curiousity, what are you doing with div?
Related
I would like to write a function which takes a list of variables out of a dataframe, say:
df <- data.frame(a = c(1,2,3,4,5), b = c(6,7,8,9,10))
And to compute always the same calculation, say calculate the standard deviation like:
test.function <- function(var){
for (i in var) {
paste0(i, "_per_sd") <- i / sd(i)
}
}
In order to create a new variable a_per_sd which is divided by it's standard deviation. Unfortunately, I am stuck and get a Error in paste0(i, "_per_sd") <- i/sd(i) : could not find function "paste0<-" error.
The expected usage should be:
test.function(df$a, df$b)
The expected result should be:
> df$a_per_sd
[1] 0.6324555 1.2649111 1.8973666 2.5298221 3.1622777
And for every other variable which was given.
Somehow I think I should use as.formula and/or eval, but I might be doing a thinking error.
Thank you very much for your attention and help.
Is this what you are after?
df <- data.frame(a = c(1,2,3,4,5), b = c(6,7,8,9,10))
test.function <- function(...){
x <- list(...)
xn <- paste0(unlist(eval(substitute(alist(...)))),
"_per_sd")
setNames(lapply(x, function(y) y/sd(y)), xn)
}
cbind(df, test.function(df$a, df$b))
#> a b df$a_per_sd df$b_per_sd
#> 1 1 6 0.6324555 3.794733
#> 2 2 7 1.2649111 4.427189
#> 3 3 8 1.8973666 5.059644
#> 4 4 9 2.5298221 5.692100
#> 5 5 10 3.1622777 6.324555
Created on 2020-07-23 by the reprex package (v0.3.0)
The question is not completely clear to me, but you might get sd of rows/columns or vectors by these approaches:
apply(as.matrix(df), MARGIN = 1, FUN = sd) #across rows
#[1] 3.535534 3.535534 3.535534 3.535534 3.535534
apply(as.matrix(df), MARGIN = 2, FUN = sd) #across columns
# a b
#1.581139 1.581139
lapply(df, sd) #if you provide list of vectors (columns of `df` in this case)
#$a
#[1] 1.581139
#
#$b
#[1] 1.581139
I got this far. Is this what you are looking for?
test.function <- function(var)
{
newvar = paste(var, "_per_sd")
assign(newvar, var/sd(var))
get(newvar)
}
Input:
test.function(df$a)
Result:
[1] 0.6324555 1.2649111 1.8973666 2.5298221 3.1622777
I got the idea from here: Assignment using get() and paste()
At the end this is what my code looks like:
test.function <- function(...){
x <- list(...)
xn <- paste0(unlist(eval(substitute(alist(...)))),
"_per_sd")
setNames(lapply(x, function(y) y/sd(y, na.rm = TRUE)), xn)
}
test.function.wrap <- function(..., dataframe) {
assign(deparse(substitute(dataframe)), cbind(dataframe, test.function(...)) , envir=.GlobalEnv)
}
test.function.wrap(df$a, df$b , dataframe = df)
To be able to assign the new variables to the existing dataframe, I put the (absolutely genius) tips together and wrapped the function in another function to do the trick. I am aware it might not be as elegant, but it does the work!
R Code
library(data.table)
x <- 4
f1 <- function(){
x <- 1
dt <- data.table(x=1:4,y=1:12)
dt[x==get("x", envir=parent.env(environment()))]
}
f1()
I got this:
x y
1: 1 1
2: 1 5
3: 1 9
f2 is a new function that remove x <- 1 in the function.
f2 <- function(){
#x <- 1
dt <- data.table(x=1:4,y=1:12)
dt[x==get("x", envir=parent.env(environment()))]
}
f2()
I got this:
x y
1: 4 4
2: 4 8
3: 4 12
that's right, my question is how to write a function to replace the get("x", envir=parent.env(environment()))?
Thanks!
I only just realized that the OP is grabbing x from the function's enclosing environment instead of passing it as an argument. I consider this bad practice and don't really have a recommendation for that case. I might delete this answer (which only covers passing x to the function) if it's too much of a distraction.
library(data.table)
dt <- data.table(x=1:4,y=1:12)
ff = function(x, ...){
mDT = data.table(x)
dt[mDT, on=.(x), ...]
}
ff(4L, verbose = TRUE)
# Calculated ad hoc index in 0 secs
# Starting bmerge ...done in 0 secs
# x y
# 1: 4 4
# 2: 4 8
# 3: 4 12
This only addresses the OP's specific example, of DT[x == get("x", ...)], and not broader expressions. For those, constructing and evaluating an expression should work:
fs = function(x, ...){
e = substitute(x == ..x, list(..x = x))
dt[eval(e), ...]
}
fs(4L, verbose = TRUE)
# Creating new index 'x'
# Starting bmerge ...done in 0 secs
# x y
# 1: 4 4
# 2: 4 8
# 3: 4 12
fs(3L, verbose = TRUE)
# Using existing index 'x'
# Starting bmerge ...done in 0 secs
# x y
# 1: 3 3
# 2: 3 7
# 3: 3 11
The verbose output indicates that fs creates indices, which can be helpful for speed. See vignette("datatable-secondary-indices-and-auto-indexing").
Eventually, there might be syntax so we can simply write ...
dt[..x == x]
perhaps using the proposed inherits = TRUE argument from the link for safety (so that x must be a column and either (i) x must exist in the parent environment or ..x must be a column name).
#Frank, Thanks! Based on this post variable usage in data.table, I wrote a function:
`..` <- function(x){
stopifnot(inherits(x, "character"))
stopifnot(length(x)==1)
get(x, parent.frame(4))
}
x <- 4
f1 <- function(){
x <- 1
dt <- data.table(x=1:4,y=1:12)
dt[x==..("x")]
}
f1()
f2 <- function(){
#x <- 1
dt <- data.table(x=1:4,y=1:12)
dt[x==..("x")]
}
f2()
Both f1 and f2 got the correct results!
Why parent.frame(4)?
We see the code first:
current_frame <- sys.nframe()
dt <- data.table()
dt[, sys.nframe() - current_frame]
We got 4, this should be the reason.
I found the old solution does not work for data.table 1.11.4, and I wrote a new one:
.. <- function (x, env = parent.frame())
{
stopifnot(inherits(x, "character"))
stopifnot(length(x) == 1)
get(x, envir = parent.env(env))
}
x <- 4
f1 <- function(){
x <- 1
dt <- data.table(x=1:4,y=1:12)
dt[x==..("x")]
}
f1j <- function(){
x <- 1
dt <- data.table(x=1:4,y=1:12)
dt[, ..("x")]
}
f2 <- function(){
#x <- 1
dt <- data.table(x=1:4,y=1:12)
dt[x==..("x")]
}
f2j <- function(){
#x <- 1
dt <- data.table(x=1:4,y=1:12)
dt[,..("x")]
}
stopifnot(all(f1()$y==c(1,5,9)))
stopifnot(all(f1j()==c(1)))
stopifnot(all(f2()$y==c(4,8,12)))
stopifnot(all(f2j()==c(4)))
I have tested that this worked for data.table_1.10.4-3 and data.table_1.11.4.
Actually, I am confused about R's parent.frame and how to find the right variables in R, I just tested some possible ways until I got the expected results.
x <- c(1,2,3,2,1)
table(x)
# x
# 1 2 3
# 2 2 1
Outputs how many times each element occur in the vector.
I am trying to imitate the above function using function()
Below is my code:
TotalTimes = function(x){
times = 0
y = unique(x)
for (i in 1:length(y)) {
for (i in 1:length(x)) {
if(y[i] == x[i])
times = times + 1
}
return(times)
}
}
What would be the right approach?
Here's a one-liner, using rle():
f <- function(x) {
with(rle(sort(x)), setNames(lengths, values))
}
f(c(1,2,3,2,1))
# 1 2 3
# 2 2 1
Alternatively, here's an option that's less "tricky", and is probably a better model for learning to code in an R-ish way:
f2 <- function(x) {
ss <- sort(x)
uu <- unique(ss)
names(uu) <- uu
sapply(uu, function(u) sum(ss == u))
}
f2(c(1,2,3,2,1))
# 1 2 3
# 2 2 1
function(x) {
q = sapply(unique(x), function(i) sum(x == i))
names(q) = unique(x)
return(q)
}
Here is one method using base R:
# data
x <- c(1,2,3,2,1)
# set up
y <- sort(unique(x))
counts <- rep_len(0, length.out=length(y))
names(counts) <- y
for(i in seq_along(x)) {
counts[x[i] == y] <- counts[x[i] == y] + 1
}
Wrapping it in a function:
table2 <- function(x) {
# transform x into character vector to reduce search cost in loop
x <- as.character(x)
y <- sort(unique(x))
counts <- rep_len(0, length.out=length(y))
names(counts) <- y
for(i in seq_along(x)) {
counts[x[i]] <- counts[x[i]] + 1L
}
return(counts)
}
This version only accepts a single vector, of course. At #Frank's suggestion, the function version is slightly different, and possibly faster, in that it transforms the input x into a character. The potential speed up is in the search in counts[x[i]] where the name in counts is referred to (as x[i]), rather than performing a search using "==."
I would like to replace the LHS of "=" in a expression in R. In my personal case, I need it to make sure the following creates a variable that does not already exist in the data frame
df %>% mutate(v = mean(w))
I tried eval(substitute()) but the LHS is not substituted
eval(substitute(df %>% mutate(v = mean(w)), list(v = as.name("id"))))
#similarly in a list
eval(substitute(l <- list(v=1:10),list(v=as.name("id"))))
l
$v
[1] 1 2 3 4 5 6 7 8 9 10
Why can't v substituted throught eval/substitute? What's the best way to work around it?
1) eval/parse Create a cmd string, parse it and evaluate it:
f2 <- function(DF, x, env = parent.frame()){
cmd <- sprintf("mutate(%s, %s = mean(v1))", deparse(substitute(DF)), x)
eval(parse(text = cmd), env)
}
f2(DF, "v1_name")
giving
v1 v1_mean
1 1 2
2 2 2
3 3 2
... etc ...
2) eval/as.call Another way is to construct a list, convert it to a call and evaluate it. (This is also the approach that mutate_each_q in dplyr takes.)
f3 <- function(DF, x, env = parent.frame()) {
L <- list(quote(mutate), .data = substitute(DF), quote(mean(v1)))
names(L)[3] <- x
eval(as.call(L), env)
}
f3(DF, "v1_name")
3) do.call We form a list equal to the last two components of the list in the prior solution and then use do.call :
f3 <- function(DF, x, env = parent.frame()) {
L <- list(.data = substitute(DF), quote(mean(v1)))
names(L)[2] <- x
do.call(mutate, L)
}
f3(DF, "v1_name")
Upodate Added additional solutions.
Okay, I'm close. Everything works but the last loop for compound where I get hung up on a data type issue. Copy and run to your heart's content.
x <- c(1:12)
dim(x) <- c(3,4)
x[2,2] <- NA
x[3,3] <- NA
colnames(x) <- c("A","B","C","D")
x
newframe <- data.frame(matrix(0, ncol = 4, nrow = 3))
for (i in 1:3)
for (j in 1:4)
{ newframe[i,j] <- (1 -1*(is.na(x[i,j]))) }
newframe <- as.matrix((newframe))
newframe
compound <- data.frame(matrix(0, ncol = 4, nrow = 3))
for (i in 1:3)
for (j in 1:4 )
{ compound[i,j] <- (as.numeric(x[i,j])*(as.numeric(newframe[i,j])))
}
compound
I'm trying to create an indicator variable for null instances and use it to create a compound variable that will zero out the original variable when null and flash the indicator.
Create indicator var's for missing instances and zero out or impute values for NA instances in original data:
# create data
x <- c(1:12)
dim(x) <- c(3,4)
x[2,2] <- NA
x[3,3] <- NA
x
# create data frame for indicator var's
newframe <- 1*(is.na(x))
newframe
class(newframe)
# zero out NAs in data, or alternatively replaced with imputed values
x[is.na(x)] <- 0
# create data frame for original data and indicator var's
newdata <- cbind(x, newframe)
newdata
Copy and run.
Is this what you're looking for ?
compound <- x
compound[is.na(x)] <- 0
compound
A B C D
[1,] 1 4 7 10
[2,] 2 0 8 11
[3,] 3 6 0 12