In my App I would like to have 3 fileInput object per row. How should I modify the code ? currently even if I define the column width It just put one fileInput in each row :
library(shiny)
library(shinythemes)
library(shinydashboard)
library(shinyWidgets)
ui <- fluidPage(
theme = shinytheme("lumen"),
shinyWidgets::useShinydashboard(),
navbarPage("test theme",
tabPanel("tab1",
mainPanel(width = 12,
fluidRow(
box(width = 12,
title = "title", status = "primary", solidHeader = TRUE,
numericInput("num","Number of file input",value = 2),
column(width = 3,
uiOutput("fIn"))
)
)
)
)
)
)
server <- function(input, output, session) {
output$fIn <- renderUI({
ind = as.numeric(input$num)
lapply(1:ind, function(k) {
fileInput(paste0("fIn", k), paste('File:', k), accept=c("xlsx","text"))
})
})
}
shinyApp(ui, server)
Instead of wrapping the uiOutput in column wrap each single fileInput in a column:
library(shinyWidgets)
library(shiny)
library(shinydashboard)
ui <- fluidPage(
shinyWidgets::useShinydashboard(),
navbarPage(
"test theme",
tabPanel(
"tab1",
mainPanel(
width = 12,
fluidRow(
box(
width = 12,
title = "title", status = "primary", solidHeader = TRUE,
numericInput("num", "Number of file input", value = 2),
uiOutput("fIn")
)
)
)
)
)
)
server <- function(input, output, session) {
output$fIn <- renderUI({
ind <- as.numeric(input$num)
lapply(1:ind, function(k) {
column(
4,
fileInput(paste0("fIn", k), paste("File:", k), accept = c("xlsx", "text"))
)
})
})
}
shinyApp(ui, server)
Related
I'm trying to create a introduction with pop-up text boxes using "rintrojs" package.
The thing is that I am using modules with golem in my app, so there is one module per each tab.
The problem i'm getting is that when running the app and clicking the button to display the introduction, the 2 dialog boxes appear at the top left corner of the screen.
I'm having the same issue as reported here: Using the ‘rintrojs’ in Shiny to create e step-by-step introductions on app usage; dialog box appears top left corner for some tabs but not others
The difference is that I'm working with modules and the solution proposed here (https://stackoverflow.com/a/70162738/14615249) doesn't work for me.
Here is the problem:
enter image description here
And here is some reproducible code so it gets easier to understand:
library(shiny)
library(rintrojs)
library(shinyWidgets)
# UI Module 1
mod_module1_ui <- function(id){
ns <- NS(id)
tagList(
rintrojs::introjsUI(),
column(
width = 12,
actionButton(
inputId = ns("bt"),
label = "Display Button"
)
),
div(
sidebarPanel(
style = "height: 100px;",
width = 12,
shiny::column(
width = 3,
rintrojs::introBox(
shiny::numericInput(
inputId = ns("numeric"),
label = "Numeric Input",
value = 45
),
data.step = 1,
data.intro = div(
h5("Description goes here")
)
),
),
shiny::column(
width = 3,
rintrojs::introBox(
shinyWidgets::pickerInput(
inputId = ns("picker"),
label = "Picker Input",
choices = c(1, 2, 3, 4, 5)
),
data.step = 2,
data.intro = div(
h5("Description goes here")
)
),
),
),
),
)
}
# SERVER Module 1
mod_module1_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
observeEvent(input$bt, rintrojs::introjs(session))
})
}
# UI Module 2
mod_module2_ui <- function(id){
ns <- NS(id)
tagList(
rintrojs::introjsUI(),
column(
width = 12,
actionButton(
inputId = ns("bt"),
label = "Display Button"
)
),
div(
sidebarPanel(
style = "height: 100px;",
width = 12,
shiny::column(
width = 3,
rintrojs::introBox(
shiny::numericInput(
inputId = ns("numeric"),
label = "Numeric Input",
value = 45
),
data.step = 1,
data.intro = div(
h5("Description goes here")
)
),
),
shiny::column(
width = 3,
rintrojs::introBox(
shinyWidgets::pickerInput(
inputId = ns("picker"),
label = "Picker Input",
choices = c(1, 2, 3, 4, 5)
),
data.step = 2,
data.intro = div(
h5("Description goes here")
)
),
),
),
),
)
}
# SERVER Module 2
mod_module2_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
observeEvent(input$bt, rintrojs::introjs(session))
})
}
# APP UI
app_ui <- function(request) {
tagList(
shiny::navbarPage(
title = ("Example"),
fluid = TRUE,
# 1 - Tab 1 ----
tabPanel(
title = "tab1",
shinydashboard::dashboardHeader(
title = span(
h1("Title tab 1")
)
),
shinydashboard::dashboardBody(
mod_module1_ui("module1_1")
),
),
# 2 - Tab 2 ----
shiny::tabPanel(
title = "tab2",
shinydashboard::dashboardHeader(
title = h1("Title tab 2")
),
shinydashboard::dashboardBody(
mod_module2_ui("module2_1")
),
),
)
)
}
# APP SERVER
app_server <- function(input, output, session) {
mod_module1_server("module1_1")
mod_module2_server("module2_1")
}
shinyApp(app_ui, app_server)
Is there a way to solve this?
Ps: This is my first ever question here in StackOverFlow, so I'd like to apologize in advance if I'm missing important parts of how to ask the question.
Thank you!
This problem was addressed in this Github issue but I write a summary and a similar solution here.
rintrojs works by adding attributes to the HTML elements you want to highlight. For example, it adds data-step=1 as an attribute of the numeric input. The problem is that if you create multiple tours, there will be several elements with the attribute data-step=1, which means that rintrojs will not be able to know which one is the "true first step". This is why only the page top left corner is highlighted.
One solution (detailed in the issue I referred to) is to create the list of steps in the server of each module. Therefore, each time the server part of the module will be called, it will reset the steps of rintrojs, so that there is only one data-step=1 for example.
Here's your example adapted:
library(shiny)
library(rintrojs)
library(shinyWidgets)
# UI Module 1
mod_module1_ui <- function(id){
ns <- NS(id)
tagList(
rintrojs::introjsUI(),
column(
width = 12,
actionButton(
inputId = ns("bt"),
label = "Display Button"
)
),
div(
sidebarPanel(
style = "height: 100px;",
width = 12,
shiny::column(
width = 3,
shiny::numericInput(
inputId = ns("numeric"),
label = "Numeric Input",
value = 45
)
),
shiny::column(
width = 3,
div(
id = ns("mypicker"),
shinyWidgets::pickerInput(
inputId = ns("picker"),
label = "Picker Input",
choices = c(1, 2, 3, 4, 5)
)
)
),
),
)
)
}
# SERVER Module 1
mod_module1_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
intro <- reactive({
data.frame(
element = paste0("#", session$ns(c("numeric", "mypicker"))),
intro = paste(c("Slider", "Button"), id)
)
})
observeEvent(input$bt, rintrojs::introjs(session, options = list(steps = intro())))
})
}
# UI Module 2
mod_module2_ui <- function(id){
ns <- NS(id)
tagList(
column(
width = 12,
actionButton(
inputId = ns("bt"),
label = "Display Button"
)
),
div(
sidebarPanel(
style = "height: 100px;",
width = 12,
shiny::column(
width = 3,
shiny::numericInput(
inputId = ns("numeric"),
label = "Numeric Input",
value = 45
)
),
shiny::column(
width = 3,
div(
id = ns("mypicker"),
shinyWidgets::pickerInput(
inputId = ns("picker"),
label = "Picker Input",
choices = c(1, 2, 3, 4, 5)
)
)
),
),
),
)
}
# SERVER Module 2
mod_module2_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
intro <- reactive({
data.frame(
element = paste0("#", session$ns(c("numeric", "mypicker"))),
intro = paste(c("Slider", "Button"), id)
)
})
observeEvent(input$bt, rintrojs::introjs(session, options = list(steps = intro())))
})
}
# APP UI
app_ui <- function(request) {
tagList(
shiny::navbarPage(
title = ("Example"),
fluid = TRUE,
# 1 - Tab 1 ----
tabPanel(
title = "tab1",
shinydashboard::dashboardHeader(
title = span(
h1("Title tab 1")
)
),
shinydashboard::dashboardBody(
mod_module1_ui("module1_1")
),
),
# 2 - Tab 2 ----
shiny::tabPanel(
title = "tab2",
shinydashboard::dashboardHeader(
title = h1("Title tab 2")
),
shinydashboard::dashboardBody(
mod_module2_ui("module2_1")
),
),
)
)
}
# APP SERVER
app_server <- function(input, output, session) {
mod_module1_server("module1_1")
mod_module2_server("module2_1")
}
shinyApp(app_ui, app_server)
Note that using "picker" in the dataframe containing the steps doesn't really work (only a very small part of the pickerInput is highlighted). This is why I wrap the pickers in div() and use the id of this div() instead.
Is there a way of aligning a widget inside a shinydashboard box? For example, in the following app:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(box(
title = "Test", width = 4, solidHeader = TRUE, status = "primary",
dropdownButton(
inputId = "mydropdown",
label = "Controls",
icon = icon("sliders"),
status = "primary",
circle = FALSE,
numericInput("obs", "Observations:", 10, min = 1, max = 100)
),
plotOutput('plot')
))
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(runif(input$obs))
})
}
shinyApp(ui, server)
I would like to align the dropdownButton widget to the bottom right corner of the Test box. How can I do that?
Just put the dropdownButton after the plot and inside a div with a class "pull-right"
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(box(
title = "Test", width = 4, solidHeader = TRUE, status = "primary",
plotOutput('plot'),
div(class = "pull-right",
dropdownButton(
inputId = "mydropdown",
label = "Controls",
icon = icon("sliders"),
status = "primary",
circle = FALSE,
numericInput("obs", "Observations:", 10, min = 1, max = 100)
)
)
))
)
server <- function(input, output) {
output$plot <- renderPlot({
hist(runif(input$obs))
})
}
shinyApp(ui, server)
I'm trying to modularize a shiny app that has a button to reactively switch between tabPanels using updateTabsetPanel(). This works in the non-modular app, but doesn't when making the reactive is contained in a module. I think it has to do with the panels being outside the scope of the module. Below are minimal examples (the non-modular version that works and the modular version that does not). Is there a way to have the module talk to the tabPanels?
# Non-modular version
library(shiny)
library(shinydashboard)
ui <- fluidPage(
fluidRow(
column(
width = 12,
tabBox(
id = "tabset2",
type = "tabs",
selected = "1",
tabPanel("T1", value = "1",
fluidRow(
box(width = 9, "Some content here"),
box(width = 3,
actionButton("switchbutton", "Click to swtich")
)
)
),
tabPanel("T2", value = "2",
fluidRow(
box(width = 9, "Some different content here")
)
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$switchbutton, {
updateTabsetPanel(session = session,
inputId = "tabset2",
selected = "2")
})
}
shinyApp(ui, server)
# Modular version
library(shiny)
library(shinydashboard)
switcherButton <- function(id) {
ns <- NS(id)
fluidRow(
column(
width = 12,
tabBox(
id = "tabset2",
type = "tabs",
selected = "1",
tabPanel("T1", value = "1",
fluidRow(
box(width = 9, "Some content here"),
box(width = 3,
actionButton(ns("switchbutton"), "Click to switch")
)
)
),
tabPanel("T2", value = "2",
fluidRow(
box(width = 9, "Some different content here")
)
)
)
)
)
}
switcher <- function(input, output, session, parent) {
observeEvent(input$switchbutton, {
updateTabsetPanel(session = session,
inputId = "tabset2",
selected = "2")
})
}
ui <- fluidPage(
switcherButton("switcher1")
)
server <- function(input, output, session) {
callModule(switcher, "switcher1")
}
shinyApp(ui, server)
I
You have forgotten to wrap the tabBox id in ns(). Just replace "tabset2" by ns("tabset2")
I am trying to build a shiny app where the user can decide how many tabs he wants to be shown. Here's what I have so far:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(glue)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput(inputId = "slider", label = NULL, min = 1, max = 5, value = 3, step = 1)
),
dashboardBody(
fluidRow(
box(width = 12,
p(
mainPanel(width = 12,
column(6,
uiOutput("reference")
),
column(6,
uiOutput("comparison")
)
)
)
)
)
)
)
server <- function(input, output) {
output$reference <- renderUI({
tabsetPanel(
tabPanel(
"Reference",
h3("Reference Content"))
)
})
output$comparison <- renderUI({
req(input$slider)
tabsetPanel(
lapply(1:input$slider, function(i) {
tabPanel(title = glue("Tab {i}"),
value = h3(glue("Content {i}"))
)
})
)
})
}
shinyApp(ui = ui, server = server)
This does not produce the desired results, as the comparison tabs are not shown properly.
I have already checked out these 2 threads:
R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI)
R Shiny dynamic tab number and input generation
but they don't seem to solve my problem. Yes, they create tabs dynamically with a slider, but they don't allow to fill these with content as far as I can tell.
What works for me is a combination for lapply and do.call
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(glue)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sliderInput(inputId = "slider", label = NULL, min = 1, max = 5, value = 3, step = 1)
),
dashboardBody(
fluidRow(
box(width = 12,
p(
mainPanel(width = 12,
column(6,
uiOutput("reference")
),
column(6,
uiOutput("comparison")
)
)
)
)
)
)
)
server <- function(input, output) {
output$reference <- renderUI({
tabsetPanel(
tabPanel(
"Reference",
h3("Reference Content"))
)
})
output$comparison <- renderUI({
req(input$slider)
myTabs = lapply(1:input$slider, function(i) {
tabPanel(title = glue("Tab {i}"),
h3(glue("Content {i}"))
)
})
do.call(tabsetPanel, myTabs)
})
}
shinyApp(ui = ui, server = server)
When working with datatables everything is clear - I can choose 5, 10, 25, 50 or 100 entries.
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
dataTableOutput('table')
)
)
),
server = function(input, output) {
output$table <- DT::renderDataTable(iris)
}
)
Unfortunately, in rhandsontable I can not find proper solution. My only result looks that:
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
rHandsontableOutput('table')
)
)
),
server = function(input, output) {
output$table <- renderRHandsontable(
rhandsontable(iris, width = 550, height = 300)
)
}
)
How can I enforce rhandsontable to give me selectinput with number of entries?
You can pass min/max rows/columns to the function: https://github.com/handsontable/handsontable/issues/225
library(shiny)
library(rhandsontable)
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
sliderInput('input', label = "Rows",
min = 1, max = nrow(iris), value = 10)
),
column(12,
rHandsontableOutput('table')
)
)
),
server = function(input, output) {
output$table <- renderRHandsontable(
rhandsontable(iris, width = 550, height = 300, maxRows = input$input)
)
}
)