Scoping between output functions - shiny

I have been through (hopefully thoroughly enough) the shiny help article on scoping, and have also seen the answer regarding setting a global object here. Neither addresses, however, what I think (emphasis on "think") I need to do. If a variable is only created in an output function, can it be seen in another? Using action buttons, I'm trying to control lengthy calculations and some will only happen on condition of other things happening. As a minimal example,
library(shiny)
library(stringr)
fruitref <- c("apple","peach","pear","plum","banana","kiwi")
textareaInput <- function(inputID, label, value="", rows=10, columns=30) {
HTML(paste0('<div class="form-group shiny-input-container">
<label for="', inputID, '">', label,'</label>
<textarea id="', inputID, '" rows="', rows,'" cols="',
columns,'">', value, '</textarea></div>'))
}
ui <- fluidPage(titlePanel("minimal example"),
sidebarLayout(
sidebarPanel(
textareaInput("inputfruit", "Enter some fruits:"),
actionButton("checkfruit", "Check fruits"),
verbatimTextOutput("fruitstat")
),
mainPanel(
textOutput("fruits")
)
)
)
server <- function(input,output){
flag <- F
inputs <- eventReactive(input$checkfruit,{input$inputfruit})
continue <- reactive(flag)
output$fruitstat <- renderText({
inputs <- inputs()
inputs <- str_trim(unlist(strsplit(inputs,split="\n")),side="both")
if(length(setdiff(inputs,fruitref)) != 0 | length(inputs) == 0){
flag <- F
paste(paste(setdiff(inputs,fruitref), collapse=", "),"not in table.")
} else {
flag <- T
"All fruits ok."
}
})
output$fruits <- renderText({
paste("Continue? ",continue())
})
}
shinyApp(ui = ui, server = server)
There's a reference table and user input is checked against that table. User enters list in pieces until hitting the check button, then gets feedback whether all are OK, or if there's a mismatch. Only if all are okay do I want to continue. I tried setting a "continue" flag in the output function, but that didn't work, and setting it in the server outside of the output function would not update the value. I also tried creating an environment in the server function and using assign, but that too did not update the value when I tried to retrieve it for renderText later. Since it's not an input, accessible through input$, I figured I cannot use any of the update* functions.
This may not be the best way to set this kind of conditional. I saw in the tutorial the conditional pane, but that depends on an input, rather than something created in the function. More generally, there are more complicated objects to be created in the output functions (there will be four large tables and a plot at most; all or some subset will actually be output) that then other output functions should see, I did not think I could define them as reactive global objects, because until some later things happen, they can't be calculated.

Define continue as an eventReactive:
continue <- eventReactive(input$checkfruit, flag)
And also use the global assignment operator inside function
flag <<- F
flag <<- T
Then it will work. Tested.

Related

lapply with a list of lists

I believe that there must be some related questions in the community, but I failed to find the one very informative to my case:
Basically, I am trying to produce three plots with the lapply function. Below are my codes.
p_grid <- seq(0,1,length.out=20)
prior_uni <- rep(1,20)
prior_bi <- ifelse( p_grid < 0.5 , 0 , 1)
prior_exp <- exp(-5*abs(p_grid-0.5))
prior_list <- list(prior_uni, prior_bi, prior_exp)
ggs <- lapply(prior_list, function(x){
likelihood <- dbinom(6,9, prob = p_grid)
unstd.post <- likelihood*x
std.post <- unstd.post/sum(unstd.post)
plot_post <- plot(p_grid,std.post,type="b", ylim = c(0,max(x)))
mtext(paste0(x))
}
)
By doing so, I get the plots but the mtext function does not work well. Instead of showing the title prior_uni, prior_bi, prior_exp respectively, it gives every single value of the list (e.g., prior_uni) with overlapping each other.
It is a bit confusing to me. According to the plot results, the function within lapply seems to take the three lists of prior_list, not every single value. In other words, x is the three elements of prior_list, not the sixty (3*20) elements, but the function mtext does oppositely.
I hope I have expressed clearly. Look for your responses.
Best regards,
Jilong

Use map inside map?

I have two lists: One with some tidy data and another with models made with tidymodels package
data_list <- list(train,test)
model_fits <- list(tree,forest,xgb)
I want to make a new list with a confusion matrix for train and test for every model.
The function that calculates confusion matrix:
ConfMat <-
function(df,data){
df <-
predict(df,new_data = data, type = "class") %>%
mutate(truth = data$NetInc) %>%
conf_mat(truth,.pred_class)}
I have tried to do this (x,y is arbitrary).:
map(data_list,map(model_fits,ConfMat(x,y)))
My problem is that I have no idea how to actually set "x" and "y" right.
PS: double for loop works. I'm asking specifically for map solution or equivalent.
Appreciate all help i can get! cheers
Use an anonymous function -
library(purrr)
result <- map(data_list,function(x) map(model_fits,function(y) ConfMat(x,y)))
result

Shiny conditionalPanel always appears

I built a small application making use of a conditional Panel which worked out of the box.
A second attempt has been less satisfying. The issue is that the conditional panels both show up no matter whether the conditions are met or not.
Here's what I have in a stripped down version:
library(shiny)
source('distplot.r')
ui<-fluidPage(
fluidRow(
radioButtons("intype", 'Data or Statistics?',
c(Data="d", Statistics="s")),
#Only show this if sample data are to be entered
conditionalPanel(
condition = "input$intype == 'd'",
textInput('x', 'Sample Data (Comma Separated)', value='')),
#Only shows this panel for summary statitics (sd or sigma if known)
conditionalPanel(
condition = "input$intype == 'r'",
numericInput('m','Sample Mean',value=''),
numericInput('sd','SD (Population or Sample)',value=''),
numericInput('n','Sample size',value=''))
)
)
server<-function(input, output){
DTYPE<-eventReactive(input$go,{input$dtype})
output$plot<-renderPlot({hist(runif(1000))})
}
shinyApp(ui=ui, server=server)
The two conditional panels always appear no matter the value of input$intype.
You need to use input.intype and not input$intype in your condition. Moreover intype can only be 'd' or 's' in your example, and you use 'r' in your condition.
Details section from ?shiny::conditionalPanel :
In the JS expression, you can refer to input and output JavaScript objects that contain the current values of input and output. For example, if you have an input with an id of foo, then you can use input.foo to read its value. (Be sure not to modify the input/output objects, as this may cause unpredictable behavior.)

My checkboxinput value does not work

I have a small shiny application which plot a graph with a log scale when the variable 'logEch' is "x".
This works:
output$plot <- renderPlot({
logEch<-"x"
Plotfigure(XHydrau,DataQs, ParHydrau, Rescal,logEch)
})
But when I affect the value "x" from the inputcheckbox 'xlog':
output$plot <- renderPlot({
if(input$xlog){logEch<-"x"}
Plotfigure(XHydrau,DataQs, ParHydrau, Rescal,logEch)
})
I obtain the error message: argument is of length zero
What do I need to do to fix this?
As you have not posted full reproducible example i can only assume where the problem lays...
I guess you need to expand your if statement --> there must be if...else... arguments!
so i would add to renderPlot:
if(input$xlog){logEch<-"x"}else{NULL}

Linking sidebarPanels in shiny for SelectizeInput function

Assume I have a drop down in sidebarPanel - location from which I can select a maximum of 2 options. I want to create an if loop where in - chosing 'Saddle Joint' and 'Gliding Joint' from the drop down leads to selection of objects 'x' and 'y' in another sidebarPanel - datasets - basically creating a linkage.
I tried this piece of code, but it doesn't work:
if (input$location== "Saddle Joint" & input$location== "Gliding Joint") {
updateCheckboxGroupInput(session,
"datasets", "Datasets:", choices = c("x","y"),
selected= c("x","y"))
}
Do take a look at the screenshot for better picture!
Thanks!
Screenshot
Issue was with the boolean in your if statement. Use this:
"Saddle Joint" %in% input$location & "Gliding Joint" %in% input$location
Also could use:
all(c("Saddle Joint","Gliding Joint") %in% input$location)