I have a shiny application in which a dataTable is displayed when the user selects Sector A from the radioButtons menu in the sidebar. The problem is that it is displayed twice. I checked it in browser mode too. Why does this happen I display the whole app here since it may be caused by the if logic of the app. renderTable() works fine so I guess there is an issue with DT
#ui.r
library(shiny)
library(shinythemes)
library(DT)
ui <- fluidPage(
theme=shinytheme("slate") ,
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
uiOutput("rad")
),
# Main panel for displaying outputs ----
mainPanel(
uiOutput("tabers"),
DT::dataTableOutput("table")
)
)
)
#server.r
library(shiny)
library(DT)
server = function(input, output) {
output$rad<-renderUI({
radioButtons("radio", label = "",
choices = list("Home"=1,"About" = 2, "Sector A" = 3, "Sector B" = 4,"Sector C" = 5),
selected = 1)
#selected = character(0))
})
output$tabers<-renderUI({
if(is.null(input$radio)) {
tabsetPanel(
id="tabF",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance")
)
}
else if(input$radio==3){
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Constituents",
output$table <- renderDataTable({
mtcars
})
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==4){
tabsetPanel(
id="tabD",
type = "tabs",
tabPanel("Constituents"
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==5){
tabsetPanel(
id="tabE",
type = "tabs",
tabPanel("Constituents"
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==2){
}
# Left last else in here but should not get called as is
else if(input$radio==1){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" )
)
}
})
}
It looks like renderTable does the same thing. For some reason, the output of renderDataTable({mtcars}) gets displayed twice, first through uiOutput, second through dataTableOutput() (both are in mainPanel). Commenting the line dataTableOutput("table") fixes the behavior in that it shows the table only once. Interestingly, removing the assignment like so:
else if(input$radio==3){
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Constituents",
renderDataTable({
mtcars
})
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
also renders the table once. So it looks like when inside renderUI, renderDataTable just creates the output without requiring a dataTableOutput in the UI.
This seems to allow (for better or worse) to easily render different tables in different tabs without corresponding output entries in the UI.
else if(input$radio==3){
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Constituents",
renderDataTable({
mtcars
})
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==4){
tabsetPanel(
id="tabD",
type = "tabs",
tabPanel("Constituents",
renderDataTable({
iris
})
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
Related
I am trying to build an app in shiny that hide / shows "pages" when a specific key is pressed to simulate an implicit association test. Participants at the beginning get instructed and then (from IAT1 on) have to press either "e" or "i" when a specific word appears and then the next word should be presented. This means that the first word should disappear and the new word appear when "e" or "i" is pressed. As I did not get very far right now after IAT 1 (word 1) not the second word is presented but the welcome page again to test the key input.
Instead of e.keyCode I also tried e.which but the key input seems not to change anything or to let elements appear / disappear and I don't know what I am doing wrong or where the problem might be.
ui <- fluidPage(
useShinyjs(),
div(
id = "welcome",
mainPanel(
fluidRow(
h3("Welcome"),
p("Welcome to the test."),
br(),
actionButton("continue1", label = "weiter")
)
)
),
hidden(
div(
id = "instruction",
mainPanel(
fluidRow(
h3("Instruction"),
p("Please ...")),
br(),
actionButton("continue2", label = "weiter"))
)
),
hidden(
div(
id = "IAT1",
mainPanel(
fluidRow(
h3("IAT"),
p("IAT word 1")),
br(),
tags$script('$(document).on("keypress", function(e) {
shiny.onInputChange("keyid1", e.keyCode);
});'))
))
)
#####server#
useShinyjs()
server <- function(input, output) {
observeEvent(input$continue1, {
show("instruction")
hide("welcome")
})
observeEvent(input$continue2, {
show("IAT1")
hide("instruction")
})
observeEvent(input$keyid1,{
if(e.keyCode == 69) {
hide("IAT1")
show("welcome")
}
else {}
})
}
shinyApp(ui = ui, server = server)
Try this, I added the keys (e,i, SHIFT+e, SHIFT+i)
library(shiny)
library(ggplot2)
ui <- fluidPage(
useShinyjs(),
div(
id = "welcome",
mainPanel(
fluidRow(
h3("Welcome"),
p("Welcome to the test."),
br(),
actionButton("continue1", label = "weiter")
)
)
),
hidden(
div(
id = "instruction",
mainPanel(
fluidRow(
h3("Instruction"),
p("Please ...")),
br(),
actionButton("continue2", label = "weiter"))
)
),
hidden(
div(
id = "IAT1",
mainPanel(
fluidRow(
h3("IAT"),
p("IAT word 1")),
br(),
tags$script('$(document).on("keypress", function(e) {
Shiny.onInputChange("keyid1", e.keyCode);
});'))
))
)
server <- function(input, output,session) {
observeEvent(input$continue1, {
show("instruction")
hide("welcome")
})
observeEvent(input$continue2, {
show("IAT1")
hide("instruction")
})
observeEvent(input$keyid1,{
print(input$keyid1)
if(input$keyid1 %in% c(101,105,69,73)) {
hide("IAT1")
show("welcome")
}
else {}
})
}
shinyApp(ui = ui, server = server)
I have a shiny app in which I have a radioButtons widget with four buttons. When none of them is clicked I want the tabsetPanel "tabC" to be displayed. If "About" is selected I do not want tabsetPanel at all and if "Section A,B or C" is selected I want the tabsetPanel "tabA" to be displayed.
#ui.r
ui <- fluidPage(
theme=shinytheme("slate") ,
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
uiOutput("rad")
),
# Main panel for displaying outputs ----
mainPanel(
uiOutput("tabers")
)
)
)
#server.r
library(shiny)
server = function(input, output) {
output$rad<-renderUI({
radioButtons("radio", label = "",
choices = list("About" = 1, "Sector A" = 2, "Sector B" = 3,"Sector C" = 4),
selected = character(0))
})
output$tabers<-renderUI({
if(input$radio=="Sector A"){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio=="Sector B"){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio=="Sector C"){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio=="About"){
}
else{
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" )
)
}
})
}
I believe since your choices have numeric values, you need to compare input$radio with a numeric value, for example: if (input$radio == 2) for Sector A.
In addition, when no radio buttons are selected, input$radio should be NULL. You could check for that at the beginning, and if NULL, show your tabC.
Please let me know if this has the desired behavior.
library(shiny)
library(shinythemes)
#ui.r
ui <- fluidPage(
theme=shinytheme("slate") ,
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
uiOutput("rad")
),
# Main panel for displaying outputs ----
mainPanel(
uiOutput("tabers")
)
)
)
#server.r
server = function(input, output) {
output$rad<-renderUI({
radioButtons("radio", label = "",
choices = list("About" = 1, "Sector A" = 2, "Sector B" = 3,"Sector C" = 4),
selected = character(0))
})
output$tabers<-renderUI({
if(is.null(input$radio)) {
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance")
)
}
else if(input$radio==2){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==3){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==4){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==1){
}
# Left last else in here but should not get called as is
else{
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" )
)
}
})
}
shinyApp(ui, server)
Thinking a little about your app, look at this option using some fuctions from shinydashboar package.
library(shiny)
library(shinydashboard)
library(shinythemes)
#ui.r
ui <- fluidPage(
theme=shinytheme("slate") ,
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
sidebarMenu( id = "tab",
menuItem("Home", tabName = "home"),
menuItem("Sector A", tabName = "sect_a"),
menuItem("Sector b", tabName = "sect_b"),
menuItem("Sector c", tabName = "sect_c"),
menuItem("About", tabName = "about")
)
),
# Main panel for displaying outputs ----
mainPanel(
tabItems(
# Home tab
tabItem(
tabName = "home",
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" ))
),
tabItem(
tabName = "sect_a",
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index"))
),
tabItem(
tabName = "sect_b",
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index"))
),
tabItem(
tabName = "sect_c",
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index"))),
tabItem(tabName = "about")
)
)
)
)
#server.r
server = function(input, output) {
}
shinyApp(ui, server)
I want to call the function fziim (defined previously) whose arguments depend on the values of two widgets defined in the ui. The function returns a list with several plots that I want to display.
I try the following code but can't make it run properly, as the elements of the list appear not be accessible
first the ui
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
fluidRow(
column(9,
selectInput("sector", h4("Sector"),
choices = list("S1","S1")
, selected = 1))# need to insrt instead list with sector names
),
fluidRow(
column(9,
numericInput("num1",
h4("Investment value (million $)"),
value = "100"))
)
),
mainPanel(
tabsetPanel(
tabPanel("Trade Balance",
fluidRow(
plotOutput("graph_trade")
)
),
tabPanel("Imports",
fluidRow(
plotOutput("graph_imports")
)
),
tabPanel("Exports",
fluidRow(
plotOutput("graph_exports")
)
),
tabPanel("Supply chain",
fluidRow(
plotOutput("graph_supply_chain")
)
),
tabPanel("Taxes",
fluidRow(
plotOutput("graph_all_taxes")
)
),
tabPanel("Employment",
fluidRow(
plotOutput("graph_employment"),
)
)
)
)
)
)
And the server is as follows:
server <- function(input, output) {
impacts_update<-fziim(sector =input$sector,investment =input$num1 )
output$graph_all_taxes<-renderPlot({
impacts_update$graph_all_taxes
})
output$graph_employment<-renderPlot({
impacts_update$graph_employment
})
output$graph_trade<-renderPlot({
impacts_update$graph_trade_balance
})
output$graph_imports<-renderPlot({
impacts_update$graph_imports_blockade
})
output$graph_exports<-renderPlot({
impacts_update$graph_exports_blockade
})
output$graph_supply_chain<-renderPlot({
impacts_update$graph_domestic
})
}
Where fziim looks like:
fziim<-function(sector, investment){
g1<-plot1
g2<-plot2
g3<-plot3
g4<-plot4
g5<-plot5
g6<-plot6
output<-list(g1,g2,g3,g4,g5,g6)
return(output)
}
Here is a reproducible app that hits the main points of what you are after. We make the
impacts_update a reactive function and call it in every renderPlot function. Doing so allows us to assign it to a regular variable and pull from the list of data.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("A","Test",choices=c(1,2,3)),
selectInput("B","TEest",choices=c(1,2,3))
),
mainPanel(
plotOutput("graph_all_taxes"),
plotOutput("graph_employment")
)
))
server <- function(input, output) {
fziim<-function(A,B){
C<-(1:3)
A<-as.numeric(A)
dfA<-data.frame(A,C)
g1<-dfA
B<-as.numeric(B)
dfB<-data.frame(B,C)
g2<-dfB
return(list(g1,g2))
}
impacts_update<-reactive({
fziim(input$A, input$B)
})
output$graph_all_taxes<-renderPlot({
graph_tax<-impacts_update()
graph_tax<-unlist(graph_tax)
plot(graph_tax[1])
})
output$graph_employment<-renderPlot({
graph_tax2<-impacts_update()
graph_tax2<-unlist(graph_tax2)
plot(graph_tax2[2])
})
#And so on...
}
shinyApp(ui = ui, server = server)
Note: My fiizm function is only for testing purposes.
Main change
How we create the list
impacts_update<-reactive({
fziim(sector =input$sector,investment =input$num1)
)}
How we call the list
output$graph_all_taxes<-renderPlot({
graph_tax<-impacts_update()
graph_tax<-unlist(graph_tax)
plot(graph_tax[1])
})
I have a Shiny App that takes a text input and shows it on the main panel (I used this answer to build it):
ui.r:
library(shiny)
shinyUI(fluidPage(
titlePanel("This is a test"),
sidebarLayout(
sidebarPanel(
textInput("text1", "Enter the text", ""),
actionButton("goButton", "Go")
),
mainPanel(
h3(textOutput("text1", container = span))
)
)
)
)
server.r:
shinyServer(function(input, output) {
cap <- eventReactive(input$goButton, {
input$text1
})
output$text1 <- renderText({
cap()
})
})
It worked great until I decided to add a Tabset panel, and show the input on one of the tabs. I modified mainPanel() in ui.r as:
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("t1"),
tabPanel("t2",
tabPanel("t3"), h3(textOutput("text1", container = span)),
)
)
After this change, I am getting an error when launching an app:
ERROR: cannot coerce type 'closure' to vector of type 'character'
Is there something I am missing?
You have to put the content within the tab within the call to tabPanel. Ex:
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel("t1"),
tabPanel("t2"),
tabPanel("t3", h3(textOutput("text1", container = span)))
)
)
Thus, server.R is unchanged from you question, and ui.R becomes:
library(shiny)
shinyUI(
fluidPage(
titlePanel("This is a test"),
sidebarLayout(
sidebarPanel(
textInput("text1", "Enter the text", ""),
actionButton("goButton", "Go")
),
mainPanel(
tabsetPanel(
type = "tabs",
tabPanel("t1"),
tabPanel("t2"),
tabPanel("t3", h3(textOutput("text1", container = span)))
)
)
)
)
)
I need to change the value of an input every time that the user changes the page of a dataset pagination.
I've tried to use the observeEvent, but it doesn't work.
UI
fluidRow(
column(10,
""
),
column(2,
textInput("inText", "Input text 2", value = "Default text")
),
column(12,
dataTableOutput('table')
)
)
Server
observeEvent(input$table, {
updateTextInput(session, "inText", value = paste("New text",0))
})
Hope you can help me.
Assuming your table id is table as given in your example, you can use:
input$table_state$start / input$table_state$length + 1.
In the following a complete example:
library(DT)
library(shiny)
app <- shinyApp(
ui = fluidPage(
tags$head(
# hides the default search functionality
tags$style(
HTML(".dataTables_filter, .dataTables_info { display: none; }")
)
),
fluidRow(
column(10,
""
),
column(2,
# adding new page filter
uiOutput("pageFilter")
),
column(12,
dataTableOutput('table')
)
)
),
server = function(input, output) {
output$pageFilter <- renderUI({
val <- input$table_state$start / input$table_state$length + 1
numericInput("page", "Page", val, min = 1)
})
output$table <- DT::renderDataTable({
iris
}, options = list(pageLength = 5, stateSave = TRUE))
# using new page filter
observeEvent(input$page, {
dataTableProxy("table") %>% selectPage(input$page)
})
}
)
runApp(app, launch.browser = TRUE)