bsCollapsePanel within renderUI - shiny

I am using bsCollapse panels (from the shinyBS library) heavily in an app that I am working on. I'd like to be able to define a panel on the server-side as shown in the code. The code does not run and returns an error ERROR: argument is of length zero. The problem seems to be that bsCollapse won't accept a renderUI argument and requires bsCollapsePanel call to be in ui.R.
I've tried having bsCollapse() on the server-side, which works but is clunky as the individual panels then don't expand/collapse in the same way. I've also tried including outputOptions(output, "hipanel", suspendWhenHidden = FALSE), the idea being that my "hipanel" would be evaluated earlier, but this didn't work.
I think the key is that renderUI/uiOutput isn't returning the an object that's accepted by bsCollapsePanel (at least not at the right time), but I'm not sure what to do about it.
server.R
shinyServer(function(input, output){
output$hipanel<-renderUI({
bsCollapsePanel("hello",helpText("It's working!"))
})
})
ui.R
shinyUI(fluidPage(
mainPanel(
bsCollapse(
bsCollapsePanel("This panel works",helpText("OK")),
uiOutput("hipanel")
))))

It seems that bsCollapse needs a bsCollapsePanel so just add this in and then you can rnder whatever you want into the content:
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
mainPanel(
bsCollapse(
bsCollapsePanel("This panel works",helpText("OK")),
bsCollapsePanel("hello",uiOutput("hipanel"))
)
)))
server <- shinyServer(function(input, output,session){
output$hipanel<- renderUI({
helpText("It's working!")
})
})
shinyApp(ui,server)
You can always dynamically create the whole thing
library(shiny)
library(shinyBS)
ui <- shinyUI(fluidPage(
mainPanel(
uiOutput("hipanel")
)))
server <- shinyServer(function(input, output,session){
output$hipanel<- renderUI({
bsCollapse(
bsCollapsePanel("This panel works",helpText("OK")),
bsCollapsePanel("hello",helpText("It's working!"))
)
})
})
shinyApp(ui,server)

Related

shinyCAPTCHA does not trigger the validation properly

I would like to integrate captcha verification into my shiny app (like this). But it has an unexpected behavior.
If this line:
recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI")
is inside the UI, my app works fine (I mean, the validation is triggered when the checkbox and the button are clicked)
However, if it is inside renderUI, the validation is triggered only by clicking the checkbox (there is no need to click the button)
Here is my minimal working example:
library(shiny)
library(shinyCAPTCHA)
ui <- fluidPage(
# With this line, the captcha works perfectly
recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"),
uiOutput("body")
)
server <- function(input, output, session) {
result <- callModule(recaptcha, "test", secret = "6LeIxAcTAAAAAGG-vFI1TnRWxMZNFuojJ4WifJWe")
output$body <- renderUI({
fluidPage(
# Inside renderUI, it does not work properly.
#recaptchaUI("test", sitekey = "6LeIxAcTAAAAAJcZVRqyHh71UMIEGNQ_MXjiZKhI"),
uiOutput("humansOnly")
)
})
output$humansOnly <- renderUI({
req(result()$success)
tags$h1("For human eyes only!")
})
}
shinyApp(ui, server)
I have an app with several modules, that's why I need to use renderUI. What is the error in my code?
I appreciate any help!

Reactive function to read rtf in rshiny

I am new to R and RShiny. Am building an application to compare two rtf files where a user can choose the two files dynamically. Is there a reactive function that I can use to read an rtf file before I pass it on to renderDiffr? Here is one version of the code I generated but the issue I am having is for these two rtf files I pick under folder1 and folder2 should be passed to renderDiffr below. I am sure there is a simple solution that I am yet to figure out. Would appreciate your help.
library(diffr)
library(shiny)
ui <- fluidPage(
# Main title of the page
titlePanel(HTML("<center>Comparison of two files</center>")),
# Browse buttons to select files
sidebarLayout(position="left",
sidebarPanel(
#fileInput("selectfolder1","Select file from folder 1"),
#fileInput("selectfolder2","Select file from folder 2"),
# Submit button to perform the compare
actionButton("goButton", "Compare", class = "btn-success")
),
mainPanel(
verbatimTextOutput("folder1"),
verbatimTextOutput("folder2"),
diffrOutput("value")
)))
shinyServer(
server <- function(input, output, session){
re1<-reactive({
file1<-file.choose()
})
output$folder1<-renderText({
re1()
})
re2<-reactive({
file2<-file.choose()
})
output$folder2<-renderText({
re2()
})
re3<-reactive({
input$goButton
x<-diffr(folder1,folder2, before="Folder 1",after="Folder 2")
})
output$value<-renderDiffr({
re3()
})
}
)
shinyApp(ui, server)
According to this documentation you pass the result of diffr() to diffrOutput().
What I changed:
When you use a reactive function make sure that you return the result at the end of it. I use return() for clarity (though it's not necessary).
In diffr(folder1,folder2, ...) I used diffr(re1(), re2(), ...) for obvious reasons.
I also skipped the re3 reactive In this sample and used diffr() directly in renderDiffr. But that is merely to reduce complexity.
library(diffr)
library(shiny)
ui <- fluidPage(
# Main title of the page
titlePanel(HTML("<center>Comparison of two files</center>")),
# Browse buttons to select files
sidebarLayout(position="left",
sidebarPanel(
#fileInput("selectfolder1","Select file from folder 1"),
#fileInput("selectfolder2","Select file from folder 2"),
# Submit button to perform the compare
actionButton("goButton", "Compare", class = "btn-success")
),
mainPanel(
verbatimTextOutput("folder1"),
verbatimTextOutput("folder2"),
diffrOutput("FileDiff", width="600px", height="auto")
)))
shinyServer(
server <- function(input, output, session){
re1<-reactive({
file1<-file.choose()
file1
})
output$folder1<-renderText({
re1()
})
re2<-reactive({
file2<-file.choose()
file2
})
output$folder2<-renderText({
re2()
})
# re3<-reactive({
# input$goButton
# x<-diffr(folder1,folder2, before="Folder 1",after="Folder 2")
# return(x)
# })
output$FileDiff <- renderDiffr({
input$goButton
diffr(re1(), re2(), before="Folder 1", after="Folder 2")
})
}
)
shinyApp(ui, server)

I keep getting an error in my shiny app for linear regression?

I'm trying to create a shiny app and I can't seem to find the error in my code.
I keep getting this error here:
Error in match.arg(position) : 'arg' must be NULL or a character vector
I'm am also unsure as to what the inputs should be.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
titlePanel("Linear Regression Shiny App"),
sidebarLayout(
sidebarPanel(
h1("Linear Regression"),
p("Select inputs for the Response
Variable"),
selectInput("ResVar",
"Response Variables:",
c("","","")
),
p("Select inputs for the Predictor
Variable"),
selectInput("PreVar",
"Predictor Variables:",
c("","","")
),
actionButton("goButton","Go!"),
plotOutput("distPlot")),
mainPanel =
verbatimTextOutput("ResVarPrint"),
verbatimTextOutput("PreVarPrint")
))
# Define server logic required to draw a histogram
server <- function(ResVar,PreVar) {
lm1 <- reactive({reformulate((input$ResVar),(input$PreVar))})
output$ResPrint <- renderPrint({input$ResVar})
output$PrePrint <- renderPrint({input$PreVar})
output$RegSum <- renderPrint({summary(lm1())})
}
# Run the application
shinyApp(ui = ui, server = server)
You had misplaced some parenthesis near the end of you UI code, and tried to use mainPanel= instead of the proper mainPanel(. The UI code below addresses the error and gets your app to load.
ui <- fluidPage(
titlePanel("Linear Regression Shiny App"),
sidebarLayout(
sidebarPanel(
h1("Linear Regression"),
p("Select inputs for the Response
Variable"),
selectInput("ResVar",
"Response Variables:",
c("","","")
),
p("Select inputs for the Predictor
Variable"),
selectInput("PreVar",
"Predictor Variables:",
c("","","")
),
actionButton("goButton","Go!"),
plotOutput("distPlot")
),
mainPanel(
verbatimTextOutput("ResVarPrint"),
verbatimTextOutput("PreVarPrint")
)
)
)
However, you may want to consider whether you actually want your plotOutput in the sidebar or whether you want it in the main panel, in which case you'll need to move it down.

Let parent server of module know that something happened inside the module

I am building an app that presents a data table and which allows you to add data. The adding of data is build by means of a form. This form is written by a module. What I want to happen is that one may fill out the form, press an 'add' button and that the data inside the table is updated.
As an example, could you help me figure out how to complete the following piece of code:
library(shiny)
library(shinydashboard)
moduleInput <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session){
observeEvent(input$action1, {
# Do stuff here,
# -> let the parent module or server know that something has happened
})
}
ui <- fluidPage(
verbatimTextOutput("module.pressed"),
moduleInput("first")
)
server <- function(input, output, session){
# print the currently open tab
output$module.pressed <- renderPrint({
#-> Write that we have pressed the button of the module
})
callModule(module,"first")
}
shinyApp(ui = ui, server = server)
All I thus want to do is find an easy way to present TRUE in the output field module.pressed when something happend inside the module.
Thanks!
Modules can pass reactive expression(s) to calling apps/modules by returning them in their server function. The documentation provides a few examples on how to set up interactions between modules and calling apps - https://shiny.rstudio.com/articles/modules.html
If a module needs to use a reactive expression, take the reactive expression as a function parameter. If a module wants to return reactive expressions to the calling app, then return a list of reactive expressions from the function.
library(shiny)
moduleInput <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session){
action1 <- reactive(input$action1)
return(reactive(input$action1))
}
ui <- fluidPage(
verbatimTextOutput("module.pressed"),
moduleInput("first")
)
server <- function(input, output, session){
action1 <- callModule(module,"first")
output$module.pressed <- renderPrint({
print(action1())
})
}
shinyApp(ui = ui, server = server)

shiny - how to disable the dashboardHeader

I am new to shiny. When I made my project, I need to hide the dashboardHeader in server side.
In the shinydashboard website, I found the code dashboardHeader(disable = TRUE). I tried this, but it was not work.
However, I tried use shinyjs to solve the problem.
<code>
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(
extendShinyjs(text = 'shinyjs.hidehead = function(params) {
$("header").addClass("sidebar-collapse") }'),
),
dashboardSidebar(),
dashboardBody(
actionButton("button","hide_header",width = 4 )
)
)
server <- function(input, output) {
observeEvent(input$button, {
js$hidehead()
})}
shinyApp(ui, server)</code>
I guess you already known, it still not worked.
Any ideas for my case?
Shinyjs is a great library. The problem with your code is that you need first to initialize shinyjs with shinyjs::useShinyjs() and put it inside the dashboarBody function. Also, to hide/show the header you don't need to add the class "sidebar-collapse" that is actually for the sidebar. You only need to add style="display:none" to hide the header, and remove it to show the header. Below is your code modified to hide/show the header. The JS code used is very simple and it receive the parameter to add directly from the js$hidehead() function.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
# initialize shinyjs
shinyjs::useShinyjs(),
# add custom JS code
extendShinyjs(text = "shinyjs.hidehead = function(parm){
$('header').css('display', parm);
}"),
actionButton("button","hide header"),
actionButton("button2","show header")
)
)
server <- function(input, output) {
observeEvent(input$button, {
js$hidehead('none')
})
observeEvent(input$button2, {
js$hidehead('')
})
}
shinyApp(ui, server)