Is there a way to add a icon next to "Country" and when the user hover on it, it should show some text
library(shiny)
ui <- fluidPage(
selectInput("Sel","Sel",choices = 1:100),
htmlOutput("Sd")
)
server <- function(input, output, session) {
output$Sd <- renderUI({
"Country"
})
}
shinyApp(ui, server)
library(shiny)
library(shinyBS)
ui <- fluidPage(
selectInput("Sel","Sel",choices = 1:100),
htmlOutput("Sd")
)
server <- function(input, output, session) {
output$Sd <- renderUI({
tags$span(
"Country ",
tipify(
icon("bar-chart"),
"Hello, I am the tooltip!"
)
)
})
}
shinyApp(ui, server)
With a bit of HTML and CSS
Then you can use CSS to customize the hovering text
library(shiny)
ui <- fluidPage(
# Add CSS
tags$head(
tags$style(HTML("
#an_icon .text {
position:relative;
bottom:30px;
left:0px;
visibility:hidden;
}
#an_icon:hover .text {
visibility:visible;
}
"))
),
selectInput("Sel","Sel",choices = 1:100),
htmlOutput("Sd"),
# HTML for the icon
tags$div(id = 'an_icon',
icon("bar-chart"),
tags$span(class = "text", tags$p("text")))
)
server <- function(input, output, session) {
output$Sd <- renderUI({
"Country"
})
}
shinyApp(ui, server)
Related
I'm trying to output a table via tableHTML that depends on some input in a Shiny app. In the example below, I want the table to depend on the radio button. I'm getting an error saying "Error: no function to return from, jumping to top level", so it seems it doesn't like my two return-statements. Any ideas how to go about this?
library(shiny)
library(tableHTML)
ui = fluidPage(
fluidRow(
radioButtons("radio", label = h3("Data on/off"),
choices = list("On", "Off"),
selected = "Off"),
tableHTML_output("mytable")
)
)
server = function(input, output) {
output$mytable <- render_tableHTML({
if ((input$radio == "On")) {
return(tableHTML(mtcars))
}
else {
return(NULL)
}
})
}
shinyApp(ui, server)
The above works when replacing tableHTML_output by tableOutput and render_tableHTML by renderTable and removing the tableHMTL() function.
It seems a package related issue.
Since we are dealing with plain html, we can use shiny::htmlOutput.
library(shiny)
library(tableHTML)
ui <- fluidPage(
fluidRow(
radioButtons("radio",
label = h3("Data on/off"),
choices = list("On", "Off"),
selected = "On"
),
htmlOutput("mytable")
)
)
server <- function(input, output) {
html_table <- eventReactive(input$radio, {
table <- if (input$radio == "On") {
tableHTML(mtcars)
}
return(table)
})
output$mytable <- renderText(
html_table()
)
}
shinyApp(ui, server)
Another workaround is to have two render_tableHTML inside an observeEvent like this:
library(shiny)
library(tableHTML)
ui <- fluidPage(
fluidRow(
radioButtons("radio",
label = h3("Data on/off"),
choices = list("On", "Off"),
selected = "Off"
),
tableHTML_output("mytable")
)
)
server <- function(input, output) {
observeEvent(input$radio, {
if (input$radio == "On") {
output$mytable <- render_tableHTML({
tableHTML(mtcars)
})
} else {
output$mytable <- render_tableHTML({
NULL
})
}
})
}
shinyApp(ui, server)
Is there a way to make sure either of the action buttons are pressed, the event should trigger. In the below example, the output is to be printed when either of the buttons pressed
library(shiny)
ui <- fluidPage(
actionButton("act1", "Action1"),
actionButton("act2", "Action2"),
htmlOutput("gh")
)
server <- function(input, output, session) {
observeEvent((input$act1 | input$act2),{
output$gh <- renderUI({
"Clicked"
})
})
}
shinyApp(ui, server)
Yes, observeEvent has other arguments such as ignoreInit, just set it to TRUE
library(shiny)
ui <- fluidPage(
actionButton("act1", "Action1"),
actionButton("act2", "Action2"),
htmlOutput("gh")
)
server <- function(input, output, session) {
observeEvent((input$act1 | input$act2),{
output$gh <- renderUI({
"Clicked"
})
},ignoreInit = TRUE)
}
shinyApp(ui, server)
Can we display toggle button next to Iris title as shown below
Below is the code for this
if (interactive()) {
library(shiny)
library(shinyWidgets)
library(DT)
ui <- fluidPage(
tags$h3("Material switch examples"),
materialSwitch(inputId = "switch1", label = "Night mode"),
dataTableOutput("df")
)
server <- function(input, output) {
output$df <- DT::renderDataTable({
datatable(head(iris),caption = "Iris",options = list(dom = 'ft'))
})
}
shinyApp(ui, server)
}
You could use a fluidRow instead of the caption option:
if (interactive()) {
library(shiny)
library(shinyWidgets)
library(DT)
ui <- fluidPage(
tags$h3("Material switch examples"),
fluidRow(column(2,tags$h4("Iris")),column(10,materialSwitch(inputId = "switch1", label = "Night mode"))),
dataTableOutput("df")
)
server <- function(input, output) {
output$df <- DT::renderDataTable({
datatable(head(iris),options = list(dom = 'ft'))
})
}
shinyApp(ui, server)
}
The app is intended to display summarized_mod when the action button is clicked. But I keep getting a summarized_mod missing error.
summarized <- data.frame(id = 1:20, group = letters[1:4], TY_COMP = runif(20), LY_COMP = runif(20))
library(shiny)
ui <- fluidPage(
verbatimTextOutput("text"),
actionButton("btn", "Show the summarized")
)
server <- function(input, output){
summarized <- reactive({summarized})
observeEvent(input$btn,{
summarized_mod <-summarized()$TY_COMP / summarized()$LY_COMP-1 }
})
output$text <- renderPrint(summarized_mod())
}
shinyApp(ui, server)
dat <- data.frame(id = 1:20,
group = letters[1:4],
TY_COMP = runif(20),
LY_COMP = runif(20))
library(shiny)
ui <- fluidPage(
verbatimTextOutput("text"),
actionButton("btn", "Show the summarized")
)
server <- function(input, output){
# summarized <- reactive({summarized}) useless !
summarized_mod <- eventReactive(input$btn, {
dat$TY_COMP / dat$LY_COMP-1
})
output$text <- renderPrint(summarized_mod())
}
shinyApp(ui, server)
im trying to invoke js across different tabs in shiny like the code below
library(shiny)
library(shinyjs)
ui <- tagList(
useShinyjs(),
navbarPage(
"shinyjs with navbarPage",
tabPanel("tab1",
actionLink(inputId = 'link',label = 'Fast Forward')
),
tabPanel("tab2",
actionButton("button", "Click me"),
textInput(inputId = "hello", label='',value = "Hello!")
)
)
)
server <- function(input, output, session) {
observeEvent(input$link, {
runjs('$("#link").click();')
})
observeEvent(input$button,{
toggle("hello")
})
}
shinyApp(ui, server)
the command is not going through, what could be the problem?
Try with this modified server part:
server <- function(input, output, session) {
observeEvent(input$link, {
runjs("$('a[data-value=\"tab2\"]').tab('show');")
})
observeEvent(input$button,{
toggle("hello")
})
}
i found the mistake.
i wrote
runjs('$("#link").click();')
instead of
runjs('$("#button").click();')