I want to adjust my function so that my if and else if statements recognize the name of the dataframe used and execute the correct plotting function. These are some mock data structured the same as mine:
df1<-data.frame(A=c(1,2,2,3,4,5,1,1,2,3),
B=c(4,4,2,3,4,2,1,5,2,2),
C=c(3,3,3,3,4,2,5,1,2,3),
D=c(1,2,5,5,5,4,5,5,2,3),
E=c(1,4,2,3,4,2,5,1,2,3),
dummy1=c("yes","yes","no","no","no","no","yes","no","yes","yes"),
dummy2=c("high","low","low","low","high","high","high","low","low","high"))
df1[colnames(df1)] <- lapply(df1[colnames(df1)], factor)
vals <- colnames(df1)[1:5]
dummies <- colnames(df1)[-(1:5)]
step1 <- lapply(dummies, function(x) df1[, c(vals, x)])
step2 <- lapply(step1, function(x) split(x, x[, 6]))
names(step2) <- dummies
tbls <- unlist(step2, recursive=FALSE)
tbls<-lapply(tbls, function(x) x[(names(x) %in% names(df1[c(1:5)]))])
A<-lapply(tbls,"[", c(1,2))
B<-lapply(tbls,"[", c(3,4))
C<-lapply(tbls,"[", c(3,4))
list<-list(A,B,C)
names(list)<-c("A","B","C")
And this is my function:
plot_1<-function (section, subsample) {
data<-list[grep(section, names(list))]
data<-data[[1]]
name=as.character(names(data))
if(section=="A" && subsample=="None"){plot_likert_general_section(df1[c(1:2)],"A")}
else if (section==name && subsample=="dummy1"){plot_likert(data$dummy1.yes, title=paste("How do the",name,"topics rank?"));plot_likert(data$Ldummy1.no, title = paste("How do the",name,"topics rank?"))}
}
Basically what I want it to do is plot a certain graph by specifying section and subsample I'm interested in if, for example, I want to plot section C and subsample dummy.1, I just write:
plot_1(section="C", subsample="dummy1)
I want to avoid writing this:
else if (section=="A" && subsample=="dummy1"){plot_likert(data$dummy1.yes, title=paste("How do the A topics rank?"));plot_likert(data$Ldummy1.no, title = paste("How do the A topics rank?"))}
else if (section=="B" && subsample=="dummy1"){plot_likert(data$dummy1.yes, title=paste("How do the B topics rank?"));plot_likert(data$Ldummy1.no, title = paste("How do the B topics rank?"))}
else if (section=="C" && subsample=="dummy1"){plot_likert(data$dummy1.yes, title=paste("How do the c topics rank?"));plot_likert(data$Ldummy1.no, title = paste("How do the C topics rank?"))}
else if (section=="C" && subsample=="dummy2")...
.
.
}
So I tried to extract the dataframe used from the list so that it matches the string of the section typed in the function (data<-list[grep(section, names(list))]) and store its name as a character (name=as.character(names(data))), because I thought that in this way the function would have recognized the string "A", "B" or "C" by itself, without the need for me to specify each condition.
However, if I run it, I get this error: Warning message: In section == name && subsample == "dummy1" : 'length(x) = 4 > 1' in coercion to 'logical(1)', that, from what I understand, is due to the presence of a vector in the statement. But I have no idea how to correct for this (I'm still quite new to R).
How can I fix the function so that it does what I want? Thanks in advance!
Well, I can't really test your code without the plot_likert_general_section function or the plot_likert function, but I've done a bit of simplifying and best practices--passing list in as an argument, consistent spaces and assignment operators, etc.--and this is my best guess as to what you want:
plot_1 = function(list, section, subsample) { ## added `list` as an argument
data = list[[grep(section, names(list))]] # use [[ to extract a single item
name = as.character(names(data))
if(subsample == "None"){
plot_likert_general_section(df1[c(1:2)], section)
} else {
yesno = paste(subsample, c("yes", "no"), sep = ".")
plot_likert(data[[yesno[1]]], title = paste("How do the", name, "topics rank?"))
plot_likert(data[[yesno[2]]], title = paste("How do the", name, "topics rank?"))
}
}
plot_1(list, section = "C", subsample = "dummy1)
I'm not sure if your plot_likert functions use base or grid graphics--but either way you'll need to handle the multiple plots. With base, probably use mfrow() to display both of them, if grid I'd suggest putting them in a list to return them both, and then maybe using gridExtra::grid.arrange() (or similar) to plot both of them.
You're right that the error is due to passing a vector where a single value is expected. Try inserting print statements before the equality test to diagnose why this is.
Also, be careful with choosing variable names like name which are baseR functions (e.g. ?name). I'd also recommend following the tidyverse style guide here: https://style.tidyverse.org/.
I'm sure this question may have been asked already, but I couldnt find an answer to my satisfaction.
So my Problem I defined a function (See below) which should take a Variable (x) and check if its part of a dataframe (y). The function should than ask for a promt until it is part of said dataframe.
However when I let it run it wont overwrite the variable inside the function so that the global enviroment variable gets also changed.
Thus var1 should store the value I gave through the prompt inside the function.
Thx :)
#Function
fn_Valid_prompt <- function(x, y, boolOP= FALSE){
while(is.element(x, colnames(y)) == boolOP){
cat("A")
x <<- readline(prompt="Please enter variable: ")
}
if (is.element(x, colnames(y)) != boolOP){
cat(green(bold("Success!")))}
}
#
var1 <- "V1"
data <- c(1:9)
metadata <- as.data.frame(matrix(data,3,3))
fn_Valid_prompt(var1, metadata, boolOP= FALSE)
The following version works, although i'm not sure of your intent with this code :
#Function
fn_Valid_prompt <- function(x, y, boolOP= FALSE){
while(is.element(x, colnames(y)) == boolOP){
x <- readline(prompt="Please enter variable: ")
}
if (is.element(x, colnames(y)) != boolOP){
cat("Success!")}
return(x)
}
#
var1 <- "V1"
data <- c(1:9)
metadata <- as.data.frame(matrix(data,3,3))
result = fn_Valid_prompt("V10", metadata, boolOP= FALSE)
cat(result)
Your mistake was to use <<- instead of <-. Furthermore, i assume you wanted to return the result ?
My problem is as follows: I'm trying to write a function that sets a collection of attributes on an object in a given environment. I'm trying to mimic a metadata layer, like SAS does, so you can set various attributes on a variable, like label, decimal places, date format, and many others.
Example:
SetAttributes(object = "list$dataframe$column", label="A label", width=20, decDigits=2,
dateTimeFormat="....", env=environment())
But I have to set attributes on different levels of objects, say:
comment(list$dataframe$column) <- "comment on a column of a dataframe in a list"
comment(dataframe$column) <- "comment on a column of a dataframe"
comment(list) <- "comment on a list/dataframe/vector"
Alternatively it can be done like this:
comment("env[[list]][[dataframe]][[column]]) <- "text"
# (my function recognizes both formats, as a variable and as a string with chain of
# [[]] components).
So I have implemented it this way:
SetAttributes <- function(varDescription, label="", .........., env=.GlobalEnv) {
parts <- strsplit( varDescription, "$", fixed=TRUE)[[1]]
if(length(parts) == 3) {
lst <- parts[1]
df <- parts[2]
col <- parts[3]
if(!is.na(label)) comment(env[[lst]][[df]][[col]]) <- label
if(!is.na(textWidth)) attr(env[[lst]][[df]][[col]], "width") <- textWidth
....
} else if(length(parts) == 2) {
df <- varTxtComponents[1]
col <- varTxtComponents[2]
if(!is.na(label)) comment(env[[df]][[col]]) <- label
if(!is.na(textWidth)) attr(env[[df]][[col]], "width") <- textWidth
....
} else if(length(parts) == 1) {
....
You see the problem now: I have three blocks of similar code for length(parts) == 3, 2 and 1
When I tried to automatize it this way:
path <- c()
sapply(parts, FUN=function(comp){ path <<- paste0(path, "[[", comp, "]]") )}
comment(eval(parse(text=paste0(".GlobalEnv", path)))) <- "a comment"
I've got an error:
Error in comment(eval(parse(text = paste0(".GlobalEnv", path)))) <- "a comment" :
target of assignment expands to non-language object
Is there any way to get an object on any level and set attributes for it not having a lot of repeated code?
PS: yes, I heard thousand times that changing external variables from inside a function is an evil, so please don't mention it. I know what I want to achieve.
Just to make sure you hear it 1001 times, it's a very bad idea for a function to have side effects like this. This is a very un R-like way to program something like this. If you're going to write R code, it's better to do things the R way. This means returning modified objects that can optionally be reassigned. This would make life much easier.
Here's a simplified version which only focuses on the comment.
SetComment <- function(varDescription, label=NULL, env=.GlobalEnv) {
obj <- parse(text= varDescription)[[1]]
eval(substitute(comment(X)<-Y, list(X=obj, Y=label)), env)
}
a<-list(b=4)
comment(a$b)
# NULL
SetComment("a$b", "check")
comment(a$b)
# [1] "check"
Here, rather than parsing and splitting the string, we build an expression that we evaluate in the proper context. We use substitute() to pop in the values you want to the actual call.
I want to write a function f that given:
x <- 1
f(.(y==x))
It returns the string:
"y == 1"
The function should be general enough, that the expression can be arbitrary. For instance, f(.(y==x & z==x)) should return "y == 1 & z == 1".
Any ideas?
The function:
g <- function(e) as.character(unlist(e))
does not work for me, as it returns "y == x". I want the replacement to take place.
UPDATE:
Also, this question is not a duplicate of How do I substitute symbols in a language object? I want to create a function f, that means that somehow I need to get the value of x from the caller's environment. My current attempt is this:
require(plyr)
x <- 1
f <- function(e) do.call(substitute, list(e[[1]], parent.frame(1)))
f(.(y==x & z==x))
But it still does not work. Maybe I should use something else instead of parent.frame?
Many thanks.
library(plyr)
g <- function(e) {
e[[1]][[3]] <- eval.parent(e[[1]][[3]])
deparse(e[[1]])
}
x <- 1
g(.(y==x))
This works, but is perhaps not as general as you wanted. (I would rather have a solution that substituted values if possible and left the values alone otherwise.)
UPDATE: not working yet, but maybe helpful.
g <- function(e) {
e1 <- e[[1]]
pe <- parent.env(environment())
vars <- all.vars(e1)
ss <- setNames(lapply(vars,
function(v) if (exists(v,pe)) get(v,pe) else v),
vars)
## at this point I'm stumped -- have tried various
## versions of eval, lapply, rapply, substitute ...
## afraid I would actually have to make up my own recursive
## function since rapply() only works on lists ...
}
I am currently writing a function which only accepts certain inputs (in the example only "a" and "b"). For all other inputs the function will return an error.
test <- function(x) {
allowedX <- c("a","b")
if(x %in% allowedX) print("Good choice!")
else stop("wrong input!")
}
To help users of the function I would like to supply the allowed values for x (stored in allowedX) using the tab completion feature in R and replace the default file name completion which is typically applied after a quote. So pressing TAB should give something like:
test(x="<TAB>
a b
However, I couldn't find a solution so far how to map the vector allowedX to the tab completion in R. Can somebody tell me how to do that?
Thanks in advance!
You could try something like the following:
test <- function() {
allowedX <- c("a","b")
x = readline('Please enter your choice of parameters (either "a" or "b"): ')
if(x %in% allowedX) print("Good choice!")
else stop("wrong input!")
}