Is there any way to retrieve all tab names in a tabsetpanel in Shiny?
for example a code that separately gives the name of the tabs in the tabsets tabs1 and tabs2:
library(shiny)
ui <- fluidPage(
tabsetPanel(id = "tabs1",
tabPanel("Tab1"),
tabPanel("Tab2"),
tabPanel("Tab3"),
tabPanel("Tab4"),
),
tabsetPanel(id = "tabs2",
tabPanel("T1"),
tabPanel("T2"),
tabPanel("T3"),
tabPanel("T4"),
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
We can use htmltools::tagQuery to achive this:
library(shiny)
library(htmltools)
ui <- fluidPage(
tabsetPanel(id = "tabs1",
tabPanel("Tab1"),
tabPanel("Tab2"),
tabPanel("Tab3"),
tabPanel("Tab4"),
),
tabsetPanel(id = "tabs2",
tabPanel("T1"),
tabPanel("T2"),
tabPanel("T3"),
tabPanel("T4"),
)
)
tabs1_panel_names <- sapply(tagQuery(ui)$find("#tabs1")$find("a")$selectedTags(), function(x){tagGetAttribute(x, "data-value")})
print(tabs1_panel_names)
tabs2_panel_names <- sapply(tagQuery(ui)$find("#tabs2")$find("a")$selectedTags(), function(x){tagGetAttribute(x, "data-value")})
print(tabs2_panel_names)
server <- function(input, output, session) {}
shinyApp(ui, server)
Related
In the shiny app below Im trying to use shinyJS() to hide and display text but I get:
Error: shinyjs: could not find the Shiny session object. This usually happens when a shinyjs function is called from a context that wasn't set up by a Shiny session.
Do not bother that dataset does not exist its just an example
## app.R ##
library(shiny)
library(shinydashboard)
library(dplyr)
library(shinyjs)
ui <- dashboardPage(
dashboardHeader(title = "Biodiversity"),
dashboardSidebar(
actionButton("action","Submit")
),
dashboardBody(
useShinyjs(),
show(
div(id='text_div',
verbatimTextOutput("text")
)
),
uiOutput("help_text"),
plotlyOutput("plot")
)
)
server <- function(input, output) {
output$help_text <- renderUI({
HTML("<b>Click 'Show plot' to show the plot.</b>")
})
react<-eventReactive(input$action,{
hide("help_text")
omited <-subset(omited, omited$scientificName %in% isolate(input$sci)&omited$verbatimScientificName %in% isolate(input$ver))
})
}
shinyApp(ui = ui, server = server)
You can't use show() in the ui, these functions are used in the server. Remove that and it works. Sample:
## app.R ##
library(shiny)
library(shinydashboard)
library(dplyr)
library(shinyjs)
library(plotly)
ui <- dashboardPage(
dashboardHeader(title = "Biodiversity"),
dashboardSidebar(
actionButton("action","Submit")
),
dashboardBody(
useShinyjs(),
div(id='text_div',
verbatimTextOutput("text")
)
,
uiOutput("help_text"),
plotOutput("plot")
)
)
server <- function(input, output) {
output$help_text <- renderUI({
HTML("<b>Click 'Show plot' to show the plot.</b>")
})
observeEvent(input$action,{
hide("help_text")
output$plot <- renderPlot({
plot(1)
})
})}
shinyApp(ui = ui, server = server)
Output:
There is a function in psych package called 'alpha' which gives out various statistics. I want a specific column from the output so I use a code. This code works perfectly in console but it doesn't work when I try to use it in shiny.
library(shiny)
library(mirt)#This contains a dataset called deAyala
library(psych)#This has the alpha() function
server<- shinyServer(
function(input, output) {
output$data <- renderUI({
alpha(deAyala,warnings=FALSE)$item.stats$raw.r #Warning disables the warnings
})
}
)
ui<- shinyUI(fluidPage(
titlePanel(title = h4("Output", align="center")),
sidebarLayout(
sidebarPanel(
),
mainPanel(
uiOutput("data"),
)
)
))
shinyApp(ui = ui, server = server)
You can use renderTable or renderText to display the output instead of renderUI.
library(shiny)
server<- shinyServer(
function(input, output) {
output$data <- renderTable({
alpha(deAyala,warnings=FALSE)$item.stats$raw.r
})
}
)
ui<- shinyUI(fluidPage(
titlePanel(title = h4("Output", align="center")),
sidebarLayout(
sidebarPanel(
),
mainPanel(
tableOutput("data"),
)
)
))
shinyApp(ui = ui, server = server)
I have created the following application template in R shiny :
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage("",actionButton("toggleSidebar", "toggle", icon =
icon("database")),
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),mainPanel() ))))
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}) }
shinyApp(ui, server)
The App will create a toggle button in the sidebar. The button should appear in the navbar and not above the sidebar. The actual toggle button appears above next to the word tab. It is however, not visible.
The part that is not visible that you mention is in fact the empty title parameter that you have "". Leaving this out as below places the toggle button in the title position:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(actionButton("toggleSidebar", "toggle", icon =
icon("database")),
tabPanel("tab",
div( id ="Sidebar",sidebarPanel(
)),mainPanel() )))
server <-function(input, output, session) {
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar")
}) }
shinyApp(ui, server)
I made an example with multiple tabPanels.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
id = "navbarID",
tabPanel("tab1",
div(class="sidebar"
,sidebarPanel("sidebar1")
),
mainPanel(
"MainPanel1"
)
),
tabPanel("tab2",
div(class="sidebar"
,sidebarPanel("sidebar2")
),
mainPanel(
"MainPanel2"
)
)
)
)
server <-function(input, output, session) {
observeEvent(input$sidebar_button,{
shinyjs::toggle(selector = ".sidebar")
})
}
shinyApp(ui, server)
=======================================
I have created a simpler example that does not use the sidepanel class, but I am not sure if it will work in all environments.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
navbarPage(title = tagList("title",actionLink("sidebar_button","",icon = icon("bars"))),
tabPanel("tab1",
sidebarPanel("sidebar1"),
mainPanel("MainPanel1")
),
tabPanel("tab2",
sidebarPanel("sidebar2"),
mainPanel("MainPanel2")
)
)
)
server <-function(input, output, session) {
observeEvent(input$sidebar_button,{
shinyjs::toggle(selector = ".tab-pane.active div:has(> [role='complementary'])")
})
}
shinyApp(ui, server)
I am building a shiny dashboard and I want to implement a valueBox within the Dashboard.
body <- dashboardBody(
fluidRow(
valueBox(totalSales,"Total Sales",color="blue")
),
fluidRow(
DT::dataTableOutput("salesTable")
),
fluidRow(
DT::dataTableOutput("top10Sales")
)
)
And this is the result:
The number on the upper left is the variable totalSales but it isn't formatted in a valueBox.
Does anyone know what the problem is?
I appreciate your answers!!
My try with valueBoxOutput, but with the same result:
ui.R
body <- dashboardBody(
fluidRow(
valueBoxOutput("totalSales")
),
fluidRow(
DT::dataTableOutput("salesTable")
),
fluidRow(
DT::dataTableOutput("top10Sales")
)
)
server.R
function(input, output, session) {
output$salesTable = DT::renderDataTable(top10Sales)
output$top10Sales = DT::renderDataTable(top10Sales)
#output$totalSales = DT::renderDataTable(totalSales)
output$totalSales <- renderValueBox({
valueBox(totalSales, "Approval",color = "yellow")
})
}
And still the same result:
By the way: Infobox is working:
infoBox("test", value=1, width=3)
valueBox has to be used on the server side. To display a shiny dynamic UI element, there's generally a function (in this case valueBoxOutput) available to display it:
library(shinydashboard)
library(dplyr)
library(DT)
body <- dashboardBody(
fluidRow(
valueBoxOutput("totalCars")
),
fluidRow(
DT::dataTableOutput("table")
)
)
ui <- dashboardPage(header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = body
)
server <- function(input, output) {
output$table = DT::renderDataTable(mtcars)
output$totalCars <- renderValueBox({
valueBox("Total", nrow(mtcars), color = "blue")
})
}
shinyApp(ui, server)
I need to embed a webpage reached through a URL inputted by the user.
I found this script but I can't make the iframe depend on a textInput() containing a URL. This example fails and I am not sure why.
library(shiny)
ui <- fluidPage(
textInput('url','url',value = "www.google.com"),
uiOutput('o')
)
server <- function(input, output, session) {
output$o = renderUI({
tags$iframe(src=input$url)
})
}
shinyApp(ui, server)
You can do like this:
library(shiny)
ui <- fluidPage(titlePanel("Getting Iframe"),
sidebarLayout(
sidebarPanel(
textInput("url", label = "Enter url"),
actionButton("go", "Go")
),
mainPanel(
htmlOutput("frame")
)
))
server <- function(input, output) {
output$frame <- renderUI({
validate(need(input$go, message=FALSE))
tags$iframe(src=isolate(input$url), height=600, width=535)
})
}
shinyApp(ui, server)