I am trying to create a shiny app with a module including a username/password input fields and save them to the environment variable through Sys.setenv()
A full example of what I have done is available here
In summary, I have created a module in setCredentials.R (set/get username and password are one line function using Sys.getenv() and Sys.setenv(), not displayed here for space sake)
credentialsInput <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("username"), "Username", value = get_username()),
passwordInput(ns("password"), "Password", value = get_password()),
actionButton(ns("credentialSubmitButton"), "Submit" ))
}
setCredentials <- function(input, output, session){
eventReactive(input$credentialSubmitButton,{
set_username(input$username)
set_password(input$password)
})
observeEvent(input$credentialSubmitButton,{
print(paste(get_username(),get_password()))
})
}
Then in my app.R file I have called the module
ui <- fluidPage(
titlePanel("Set credentials"),
credentialsInput("credentials")
)
server <- function(input, output) {
callModule(setCredentials,"credentials")
}
shinyApp(ui = ui, server = server)
If variable are already set in the .Rprofile or equivalent, they are properly displayed in the field as default values. However if I modify (or enter in case of no .Rprofil) the print command return unchanged values (also if I click several times in case the print is executed before the set functions)
I guess somehow I cannot access the proper environment with Sys.setenv() from my module, but I don't understand exactly why.
Any help would be greatly appreciated.
I found a way to have this working. In my setCredentials function, I need to set the username and password in a observeEvent function call rather than a eventReactive...
setCredentials <- function(input, output, session){
observeEvent(input$credentialSubmitButton,{
set_username(input$username)
set_password(input$password)
print(paste(get_username(),get_password()))
})
}
Related
I build a shiny app that need to add pieces of UI dynamically based on some parameter I'll know only in real time. I created a simplistic reconstruction of my needs, and encountered a problem I describe below
so in my example I have a module called mblock. for the sake of this example it only displays a text. the actual text to display is decided at run time, and so is the number of texts (and hence blocks) will be decided at runtime
for the specific example I set texts to be a fixed vector containing all the texts to be shown, but in reality it will be computed as a reactive object. the code is below:
library(shiny)
#block module
mblockUI = function(id) {
ns = NS(id)
fluidRow(
textOutput(ns("text"))
)
}
mblock = function(input,output,session,actual_text) {
output$text = renderText({actual_text})
}
# Define the main ui
ui <- fluidPage(
uiOutput("all_blocks"),
actionButton("submit","submit")
)
# Define server logic
server <- function(input, output) {
texts = c("aaaa","bbbb","cccc") #this is a sample vector of texts to be shown in blocks
output$all_blocks = renderUI({
for(i in 1:length(texts)) {
mname = paste0("block",i) #block name to be created (the name of the module)
#print(mname)
insertUI("#submit","beforeBegin",mblockUI(mname)) #adding the ui
#now adding the server side of each block
#also passing the text to be shown
callModule(mblock,mname,texts[i])
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
The problem is that all the blocks show the same text (the last one). and I don't understand why
any ideas how to fix the code? what do I miss
(shiny version 1.4.0)
First of all, insertUI is able to work "on its own" and doesn't need renderUI. You can put it in an observe environment instead. However, be careful of the output of insertUI since it is persistent, as explained in the documentation of this function:
Unlike renderUI(), the UI generated with insertUI() is persistent: once it's created, it stays there until removed by removeUI(). Each new call to insertUI() creates more UI objects, in addition to the ones already there (all independent from one another). To update a part of the UI (ex: an input object), you must use the appropriate render function or a customized reactive function.
I don't know why but the for loop doesn't work (as your example shows) whereas lapply does (see this answer for example).
Here's your example with these corrections:
library(shiny)
#block module
mblockUI = function(id) {
ns = NS(id)
fluidRow(
textOutput(ns("text"))
)
}
mblock = function(input,output,session,actual_text) {
output$text = renderText({actual_text})
}
# Define the main ui
ui <- fluidPage(
actionButton("submit","submit")
)
# Define server logic
server <- function(input, output) {
texts = c("aaaa","bbbb","cccc") #this is a sample vector of texts to be shown in blocks
observe({
lapply(1:length(texts), function(i) {
mname = paste0("block",i) #block name to be created (the name of the module)
#print(mname)
insertUI("#submit","beforeBegin",mblockUI(mname)) #adding the ui
#now adding the server side of each block
#also passing the text to be shown
callModule(mblock,mname,texts[i])
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm building an RShiny App and I'd like to have users be able to navigate to a directory and then I want to be able to use this directory name in a function. There are several similar questions out there, but nothing I've been able to work out for my problem. I created a simple reproducible example.
In this example, I'd like to be able to take the path_prefix and pass it to a system command so that I can change to this directory. I'm having the function print the path_prefix in the Shiny window and what is printed is appropriate. However, the functions I'm using turn the path into a list where each folder is in quotes. Does anyone have suggestions for how this could work?
library(shiny)
library(shinyFiles)
# UI
ui <- fluidPage(
shinyDirButton('path_prefix', 'Select a directory', title='Select a directory'),
textOutput('path_prefix'),
actionButton("run", "run test")
)
# Server
server <- function(input, output, session) {
volumes <- getVolumes()
shinyDirChoose(input, 'path_prefix', roots=volumes, session=session)
dirname <- reactive({parseDirPath(volumes, input$path_prefix)})
# Observe input dir
observe({
#fileinfo <- parseSavePath(volumes, input$path_prefix)
if(!is.null(dirname)){
print(dirname())
output$path_prefix <- renderText(dirname())
}
})
observeEvent(input$run, {
system(paste0("cd ", input$path_prefix))
})
}
shinyApp(ui = ui, server = server)
I am trying to make Shiny App which allows users to save inputs and later load them.
Easiest way to approach this, is to make Save button, which saves inputs. Here is basic app to demonstrate:
server.R
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("integer", "Integer:",
min = 0, max = 1000,
value = 500)
),
mainPanel(tableOutput("values"),
actionButton('save_inputs', 'Save inputs')
)
))
server <- function(input, output, session) {
sliderValues <- reactive({
value = input$integer
})
output$values <- renderTable({
sliderValues()
})
observeEvent(input$save_inputs,{
saveRDS( input$integer , file = 'integer.RDS')
})
}
shinyApp(ui = ui, server = server)
However, I would like to make saving automatic, e.g. I want inputs to be saved at end of session. onSessionEnded() should be answer to this, but it can't reach input values and save them.
session$onSessionEnded( function() {
saveRDS( input$integer, file = 'integer.RDS')
})
Which returns error: Warning:
Error in .getReactiveEnvironment()$currentContext: Operation not
allowed without an active reactive context. (You tried to do something
that can only be done from inside a reactive expression or observer.)
Is there any way to solve it?
Using isolate seems to solve the problem.
session$onSessionEnded(function() {
isolate(saveRDS( input$integer, file = 'integer.RDS'))
})
Using another observe event function and watching the value of isClosed() we can
make this work
observeEvent(session$isClosed()==T,{
saveRDS( input$integer, file = 'integer.RDS')
})
observeEvent() as well as reactive() are both considered "reactive" environments which means they are watching for changing values throughout the session and not just on startup. If you put a function that needs to be reactive outside of a reactive environment shiny will do you the favor of sending you that error, to inform you the function would never be called unless we wrap it in a reactive function.
Also +1 for the well composed question.
I am trying to write a Shiny module which shows a conditionalPanel based on input from the global UI. In the minimal example below the conditionalPanel should show a radioButtons widget when a checkbox in the global UI is clicked, but I can't get it to work.
What am I doing wrong?
library(shiny)
conditional <- function(input, output, session, check){
output$check <- reactive({check()})
outputOptions(output, "check", suspendWhenHidden = FALSE)
output$conditional <- renderUI({
ns <- session$ns
conditionalPanel(
condition = 'output.check',
radioButtons(ns('radioItem'),
'Select option',
choices = c('option 1','option 2'))
)
})
}
conditionalUI <- function(id){
ns <- NS(id)
uiOutput(ns('conditional'))
}
ui <- fluidPage(
fluidRow(checkboxInput('check','Show')),
fluidRow(conditionalUI('mymod'))
)
server <- function(input, output, session) {
check <- reactive({input$check})
callModule(conditional, 'mymod', check = check)
}
shinyApp(ui = ui, server = server)
Simple fix - The condition should be condition = input.check instead of condition = output.check.
You are having a problem with the naming conventions that shiny modules enforce.
Although you have a similar output object in your module, it is not the same as in server. If you specify an output
func <- function(input, output, session) {
output$something <- (...)
}
inside a module, that you called with
callModule(func, 'someIdentifier')
then your output id, which shiny uses to reference all the elements, becomes
someIdentifier-something
You can test this by writing uiOutput("mymod-conditional") instead of uiOutput(ns('conditional')).
Normally, this shouldn't bother you, since modules work the way that all references are resolved within a module. But the conditionalPanel condition, being in JavaScript ("on the other side" so to say), must use global references.
So the fix for your problem would be to change the condition to
condition = 'output["mymod-check"]'
Note that dashes cant be used with JavaScript dot notation, so bracket notation has to be used.
A trick that helped me identify the problem, was to inject JavaScript into the condition in order to show the current value of output on the client side. I placed condition = 'console.log(output)' inside the conditionalPanel so you can inspect the available object in the browser console.
I am having a lot of trouble getting a search filtering module working.
I am to run stats on a large database of cat owner information.
I want my search module to bring up a list of possible owners(that the user can select from) based on a selection from a list of cat breeds.
I thought wrapping the updateSelectInput with observe and using a reactive cat owner expression would facilitate this, in the module, but it is not working( and I can't guess why this is happening or how to debug this). It worked in these other posts([1]:R shiny passing reactive to selectInput choices , [2]:using values from a reactive input to directly input into a custom function)
Why won't my selectInput update with cat owners?
library(shiny)
df=data.frame(
cat=c("tabby","DSH","MSH","LSH","DSH","MSH","LSH","sphinx"),
owner=c("Foo","Bar","Bash","Foo","Foo","Foo","Bar","Bash"),stringsAsFactors = F)
refinedSearch<-function(input, output, session){
ownsCat<-reactive({df[df$cat%in%input$cat,"owner"]})
observe({updateSelectInput(session, "ownerSelected",
label ="Owned By",choices = ownsCat())})
return()
}
refinedSearchUI<-function(id){
ns <- NS(id)
fluidRow(
column(4,selectInput(ns("cat"),"Cat",selectize = T,
choices =c("tabby","DSH","MSH","LSH","sphinx") )),
column(4,selectInput(ns("ownerSelected"),"Owned By","",selectize = T))
)
}
ui <- fluidPage(
h1("Find cats owners"),
fluidRow(column(10,offset=1, refinedSearchUI("tmp"))),
fluidRow(column(10,offset=1, actionButton("addFilter","Add a Filter",
icon = icon("plus"))))
)
server <- function(input, output,session) {
refinedSearch(input,output,session)
observeEvent(input$add, {insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearch(input,output,session))})
}
shinyApp(ui = ui, server = server)
Thank y'all for you time.
There seems to be quite a bit of confusion on how to call modules. You need to use the callModule() function in the server. Also, when inserting UI (using the insertUI()function), you need to call the refinedSearchUI() function, not the refinedSearch() function (which, again, should always be called through callModule(), so it should never actually get called directly like that).
I'd recommend a re-reading of the modules article.
You also have a typo. The event in your observeEvent() function should be input$addFilter, not input$add (which doesn't exist, so that observer is never fired..)
If you change your server function to this, your app will work as expected:
server <- function(input, output,session) {
callModule(refinedSearch, "tmp")
observeEvent(input$addFilter, {
id <- paste0("filter_", input$add)
insertUI(selector = "#addFilter",where = "beforeBegin",
ui = refinedSearchUI(id))
callModule(refinedSearch, id)
})
}