R-Shiny Define function with inputs from ui.R - r

I use the following function to perform a weighted t-test on a data set.
pvfct <- function(var, weights) {
req(input$groupb)
req(input$sex)
req(input$age)
req(input$education)
if(is.null(input$groupa) == FALSE & is.null(input$groupb) == FALSE & is.null(input$sex) == FALSE & is.null(input$age) == FALSE & is.null(input$education) == FALSE) {
data <- df()
data1 <- data %>%
select(var, group1, weightrake) %>%
filter(group1 == 1)
data2 <- data %>%
select(var, group1, weightrake) %>%
filter(group1 == 2)
result <- wtd.t.test(data1[[var]], data2[[var]], data1[[weights]], data2[[weights]], samedata = FALSE)
result <- as.numeric(result$coefficients[3])
result <- round(result, 2)
result
}
else {}
}
result <- pvfct("Image_Vertrauen_ALLBRANDS_top2", "weightrake")
The function works perfectly fine as long as I define it inside Server.R. But what I want is to define all my functions in the global scope. I guess it has to do something to do with the inputs, since these are reactive?! Can anyone help me?
Why is this technically not working?

It is necessary to define all reactive expressions as part of server part of the code. Global scope can only contain static elements like library calls, data manipulation which once performed remain as is even if input changes. Global scope does not reexecute every time the widget input changes, it is only the server code which changes.
Since, your data filtering is dependent on an input condition, it will have to go inside server to work.
To understand how reactivity in shiny works, I find following articles pretty helpful
https://shiny.rstudio.com/articles/reactivity-overview.html
https://shiny.rstudio.com/articles/understanding-reactivity.html
As part of your code, everytime the function is run, value of input$groupa is looked up [if its false or not], this value lookup is something which global is unable to do and can only be performed by server.

Related

Updating a nested list object in the global environment from within a function in R

Here are the set of circumstances that have gotten me stuck:
The Problem
I have written a function in R that will need to execute within a for loop with the goal of manually adjusting some values and then updating a large nested list in the global environment. I have 2 functions more.points() and get.num.pts() that ask for user input. These are part of a larger function add.points() which runs everything and will be wrapped in a for loop. Unfortunately, I cannot figure out how to update the nested list to the correct place in the list's hierarchy from within the function. I must do it from within the function in order to make sure I dont run lines of code in the for loop after the function because this will cause readlines() to fail and take the next line of code as user input. How do I update the hierarchical list object in the correct place from within the add.points() function? assign() does not appear to be up to the task, at least to my limited knowledge. Any help is greatly appreciated. I am making a pipeline for aligning an atlas to brain images so I can localize cells that fluoresce to their respective brain regions.
more.points <- function(){
more.pts <- readline(prompt = "Do you need to add correspondence points to adjust the atlas registration? (y/n): ")
}
get.num.pts <- function(){
num.pts <- readline(prompt = "How many additional points are required? (You will be able to add additional points later if you need to): ")
}
add.points <- function(){
mo.pts <- as.character(more.points());
if(mo.pts == "y" || mo.pts == "Y" || mo.pts == "Yes" || mo.pts == "yes"){
while(mo.pts == "y" || mo.pts == "Y" || mo.pts == "Yes" || mo.pts == "yes") {
#ask for user input about number of new points to be created
n.pts <- as.integer(get.num.pts());
reg.fun.obj <- paste0(n.pts," updated!");
print(reg.fun.obj)
#do other stuff
#assign totally works here just fine because it isnt a hierarchical list being updated
assign("reg.obj", reg.fun.obj, envir = .GlobalEnv);
#Need to update the correct position in the list object hierarchy with new info.
assign(i.data[[reference.df$i[[i]]]][[reference.df$j[[i]]]][[reference.df$k[[i]]]], reg.obj, envir = .GlobalEnv);
#But this cannot take `i.data[[reference.df$i[[i]]]][[reference.df$j[[i]]]][[reference.df$k[[i]]]]` for the name argument. it must be a string.
mo.pts = as.character(more.points())
}
}
}
Reproducible example:
Here is an example of the global environment hierarchical list I need to update from an object within the add.points() function:
#Hierarchical List Object Example
#The image objects have more complexity in my real implementation i.e. image_1 is itself a list object with multiple attributes.
list.i <- c("channel1", "channel2", "channel3")
list.j <- c("m1", "m2", "m3")
list.k <- c("image_1", "image_2", "image_3")
k.tmp <- list()
j.tmp <- list()
i.data <- list()
for(i in seq_along(list.i)){
for(j in seq_along(list.j)){
for(k in seq_along(list.k)){
k.tmp[[k]] <- list.k[[k]]
names(k.tmp)[[k]] <- paste0("img", k)
}
j.tmp[[j]] <- k.tmp
names(j.tmp)[[j]] <- paste0("m", j)
k.tmp <- list()
}
i.data[[i]] <- j.tmp
names(i.data)[[i]] <- paste0("channel", i)
j.tmp <- list
}
remove(k.tmp,j.tmp)
#Additional example list I am using to know which elements of the hierarchy need to be updated/adjusted as the for loop cycles.
reference.df <- data.frame(i = c(rep(1, 9), rep(2, 9), rep(3, 9)), j = c(rep(c(1, 1, 1, 2, 2, 2, 3, 3, 3),3)), k = c(rep(c(1, 2, 3),9)))
Code to run function:
reg.obj <- i.data[[reference.df$i[[i]]]][[reference.df$j[[i]]]][[reference.df$k[[i]]]]
for(i in seq_along(reference.df$k)){
add.points()
}
Remember: I am unable to run anything after the function within the for loop because R will interpret the next line as the user input being fed to readlines(). Thus, the whole point of this loop and function - getting user input, saving, and cycling to the next image for the user to provide input on - will not occur.
For anyone else who runs into an issue like this. Don't be stupid like me. Use the return() function within your function to convert your variable into an output that you can feed into your nested list thusly:
in the function:
myfun(){
#do stuff to make object containing update
return(update.obj)
}
#run the function:
list[[x]][[y]][[z]] <- myfun()
#is equivalent to below occurring outside a function:
list[[x]][[y]][[z]] <- update.obj
Yes this was stupid but hopefully I helped someone avoid my fundamental mistake here. If you can avoid it, don't use assign() in a function.

What is correct method for observing multiple events in Shiny?

I need a data table to update each time a different date range, # of decimals to display, or a common vs all set of variables is chosen by the user. The code below works, but I don't think it's "correct". The three variables I need the code to respond to (input$descr_daterange, input$descr_radio, and input$descr_decimals) are located within the renderDataTable function. That doesn't seem like the right way to do this.
observeEvent(input$descr_daterange, {
descr_date_inds <- reactiveValues()
descr_date_inds$begin_ind <- min(which(substr(inputData$qcdata$LDT,1,10) == input$descr_daterange[1]))
descr_date_inds$end_ind <- max(which(substr(inputData$qcdata$LDT,1,10) == input$descr_daterange[2]))
output$data_descr <- renderDataTable({
description <- descr(inputData$qcdata[descr_date_inds$begin_ind:descr_date_inds$end_ind,],transpose = TRUE, stats = input$descr_radio)
description <- description[-which(row.names(description) == 'RecNum'),]
if ('N.Valid' %in% colnames(description) & 'Pct.Valid' %in% colnames(description)){
description <- description[,-which(colnames(description) == 'N.Valid' | colnames(description) == 'Pct.Valid')]}
description <- round2(description[,2:ncol(description)],input$descr_decimals)
return(description)
autoWidth = TRUE
options=list(pageLength = 50)
})
})
I've seen code examples that list the variables like this:
observeEvent(c(input$descr_daterange, input$descr_decimals, input$descr_radio),
{...})
However, I get warnings that only the first of the list is being used. How do I code this to get it to to work correctly?
You were close: put all reactive inputs to cause a trigger within braces.
Try this:
observeEvent({
input$descr_daterange
input$descr_decimals
input$descr_radio
}, {
descr_date_inds <- reactiveValues()
descr_date_inds$begin_ind <- min(which(substr(inputData$qcdata$LDT,1,10) == input$descr_daterange[1]))
descr_date_inds$end_ind <- max(which(substr(inputData$qcdata$LDT,1,10) == input$descr_daterange[2]))
output$data_descr <- renderDataTable({
description <- descr(inputData$qcdata[descr_date_inds$begin_ind:descr_date_inds$end_ind,],transpose = TRUE, stats = input$descr_radio)
description <- description[-which(row.names(description) == 'RecNum'),]
if ('N.Valid' %in% colnames(description) & 'Pct.Valid' %in% colnames(description)){
description <- description[,-which(colnames(description) == 'N.Valid' | colnames(description) == 'Pct.Valid')]}
description <- round2(description[,2:ncol(description)],input$descr_decimals)
return(description)
autoWidth = TRUE
options=list(pageLength = 50)
})
})
By-the-ways:
reactiveValues() tend to belong outside of reactive blocks, and used/referenced within them. I don't know the rest of your app nor how you intend to use them, so it might be that you don't need it at all (and are just using its list/env functionality), in which case you are carrying unneeded overhead by doing it this way.
You should never use & or | within an if conditional unless it is wrapped in any or all or some aggregating function. if requires its conditional to be exactly length 1, whereas &/| are vectorized logical ands/ors, meaning they can be length 0 or more.
Even if both sides of the & are length-1, there is still a reason: && short-circuits, & does not.
### short-circuiting
TRUE || stop("hello")
# [1] TRUE
### not
TRUE | stop("hello")
# Error: hello
Lastly, it's a bit declarative, in that by forcing yourself to use &&, you have to think about the length of the conditional. By using &, you're implying (to whomever is reading/using your code) that you will accept a result of length other than 1 ... which doesn't always work cleanly for if.

Anonymous function in R using sparklyr spark_apply

I am trying to use the spark_apply() function from library(sparklyr) I am using the spark_apply() function because the sparklyr package does not support using subsets. I am a bit lost about where I need to include the function(e) within the following dplyr syntax.
Here is the original syntax I am trying to adapt with an anonymous function (I'm not 100% this is the term)
match_cat3 <- match_cat2 %>%
group_by(VarE, VarF) %>%
mutate(Var_G = if(any(Var_C ==1)) ((VarG - VarG[Var_C ==
1])/(Var_G + Var_G[Var_C == 1])/2) else NA)
Here is my attempt at using the spark_apply() function with the mutate equation from above. I would love some help with how to use the function(e) and where the e goes within the syntax. I don't have any experience using a function within another function like this.
match_cat3 <- spark_apply(
function(e)
match_cat2 %>%
group_by(e$VarE, e$VarF) %>%
mutate(e$Var_G = if(any(e$Var_C ==1)) ((e$VarG -
e$VarG[e$Var_C == 1])/(e$Var_G + e$Var_G[e$Var_C == 1])/2) else NA, e)
)
```
This gives me an out of bounds error.
I was basing the syntax off of the following block from the spark_apply() documentation.
trees_tbl %>%
spark_apply(
function(e) data.frame(2.54 * e$Girth, e),
names = c("Girth(cm)", colnames(trees)))
Thanks!
You seem to be having trouble writing a sparklyr::spark_apply() function. The template that might be more useful for you starts with your Spark DataFrame.
##### data_sf is a Spark DataFrame that will be sent to all workers for R
data_sf <- sparklyr::copy_to(sc, iris, overwrite = TRUE)
data2_sf <- sparklyr::spark_apply(
x = data_sf,
f = function(x) { ##### data_sf will be the argument passed to this x parameter
x$Petal_Length <- x$Petal_Length + 10 ##### data_sf will now be converted to an R object used here (Spark doesn't like `Petal.Length` so automatically changes column names)
return(x)
})
In your case:
you're missing the x argument, the first in sparklyr::spark_apply()
you're bringing in external stuff (match_cat2) through the e argument of your anonymous function but improperly putting it inside the definition of the function as well
you're missing brackets around your multiline expression and so you aren't defining a function
you're trying to use dplyr (and magrittr) with wrong syntax--you can refer to variables like group_by(VarE) not group_by(e$VarE)
Functions are defined as function(data, context) {} where you can provide arbitrary code within the {}. Chapter 11.7 Functions
you're trying to do some conditional stuff in your if else (you could also use the ifelse() function here) but I'm not sure what your intent is
##### Rewritten, maybe helpful?
match_cat3 <- spark_apply(
x = match_cat2, ##### the Spark DataFrame you give to spark_apply()
function(e) { ##### the opening bracket
e %>% ##### the function's argument, NOT `match_cat2 %>%`
group_by(VarE, VarF) %>% ##### remove `e$`
mutate(Var_G = something_good) ##### not sure of your intent here
})

Subset data from original data frame using filters defined in lists

I have original data set of size (1100000*62) and i need to divide data based on manual filters.
I have created a function which can separate data by manually entering the parameters: It takes below parameters.
segment_dat <- function(data, Region, gtv_class_bracket, hotelclass){...}
Requirement :Subset of data should be on below parameters :
data[[1]] should be based on NORTH-GTV1-0.5
data[[2]] should be based on NORTH-GTV1-5
...
data[[120]] should be based on SOUTH-GTV5-5
I am bit new to iterative loops.
I have found multiple threads and i am able to write below code , but it is not helpful as of now.final aim is to supply every data set to the another function written to do cluster analysis. Please help , if you have any leads. Basically i need to iterate over three lists reg,gtv,hc .Final count of data sets
should be 120 .
#####################################################################
############ adding segment_dat code#########################
segment_dat<-function(data,Region,gtv_class_bracket,hotelclass) {
##############################if no parameters are missing #############################
if ( !missing(Region) & !missing(gtv_class_bracket) &!missing(hotelclass)){
data1<-data[data$region==Region & data$gtv_class_bracket==gtv_class_bracket &
data$hotelclass==hotelclass,]
}
#################################################################################################
################### if two of the parameters are missing #######################################
else if(missing(gtv_class_bracket) & missing(hotelclass) & !missing(Region)) {
data1<-data[data$region==Region,]
}
else if (missing(Region) & missing(hotelclass) & !missing(gtv_class_bracket)){
data1<-data[data$gtv_class_bracket==gtv_class_bracket,]
}
else if (missing(Region) & missing(gtv_class_bracket) & !missing(hotelclass))
{
data1<-data[data$hotelclass==hotelclass,]
}
###########################################################################################
######################## If any one of the parameter is missing ###########################
else if (missing(gtv_class_bracket)){
data1<-data[data$hotelclass==hotelclass & data$region==Region,]
}
else if (missing(hotelclass)){
data1<-data[data$gtv_class_bracket==gtv_class_bracket & data$region==Region,]
}
else if (missing(Region)){
data1<-data[data$gtv_class_bracket==gtv_class_bracket & data$hotelclass==hotelclass,]
}
}
#
# example data
data=list()
reg<-as.list(c("NORTH","EAST","WEST","SOUTH"))
gtv<-as.list(c("GTV1","GTV2","GTV3","GTV4","GTV5"))
hc<-as.list(c(0.5,1,2,3,4,5))
#xx<-data.frame()
for (i in 1:length(reg)){
for(j in 1:length(gtv)){
j=i
for(k in 1:length(hc)){
k=j
data[[i]]<-segment_dat(hotel_clus3,Region=reg[[i]],
gtv_class_bracket=gtv[[j]],hotelclass=hc[[k]])
}} }
Here's a replacement for your segment_dat() function. No triple for-loop is required to invoke it. Below the function, it is invoked on your data.
segment_dat <- function(data, region, gtv_class_bracket, hotelclass){
## Build inputs list while checking for missing inputs
inputs <- list()
if(!missing(region)) inputs <- list(region=region)
if(!missing(gtv_class_bracket) inputs <- c(inputs, list(gtv_class_bracket=gtv_class_bracket))
if(!missing(hotelclass)) inputs <- c(inputs, hotelclass=hotelclass)
if(inputs == 0) stop("Some subsetable column is required as input.")
## Build permutation data.frame
inputs['stringsAsFactors'] <- FALSE
values <- do.call(expand.grid, inputs)
## Generate list of data.frames
apply(vals, 1, function(x) merge(data, x))
}
data <- segment_dat(hotel_clus3, reg, gtv, hc)
Edit
Replaced a variable that was not present in your code; should all work now.

scoping in R, and dealing with 'with'

In R, there are lots of situations where with seems to be used to help you write shorter code; however, this masks existing symbols like local variables and function parameters. Is there any way to refer to them without renaming them so they don't clash with your data?
For instance, in this frame, I've got a state column;
df <- data.frame(
label=c("a", "b", "c"),
state=c("off","on","off"))
I can write a filtering function with a .state parameter, and the filter works;
instateWorks <- function(.state) {
subset(df, df$state == .state)
}
# correct - 1 observation for "b"
onWorks <- instateWorks("on")
but if I give my function a sensible parameter name, there's a problem and the symbol state seems to refer to the data frame's column;
instateFails <- function(state) {
subset(df, df$state == state)
}
# fails - all 3 observations
onFails <- instateFails("on")
Is there any way to qualify that state is supposed to mean the parameter, to make the script work as expected?
Edit - to clarify why 'with' and 'eval' are the issue I'm struggling with, consider this code;
df <- data.frame(
label=c("a", "b", "c"),
state=c("off","on","off"))
with(df, state == "on")
# FALSE TRUE FALSE
state <- on
with(df, state == state)
# TRUE TRUE TRUE
In the last with statement, I'm looking for a way to express 'tell me which rows have the 'state' variable in DF has the same value as the 'state' variable defined on the line above.
Without this ability, I can't write a function with a parameter called the same thing as the name of a column.
Thanks to #HaddE.Nuff, I came up with this;
instateFails <- function(state) {
args <- environment()
subset(df, state == args$state)
}
capture the current environment before you make the call, which gives you a way to refer to all the locals in the calling function. Then refer to the environment variable inside the filter expression.

Resources