I want to develop a feature that when opening the switch the image can show outside of the page and when closing the switch, the image is hidden. Here is my sample code for showing/hiding the image in the page but if we can make the image be a floating window and can be moved around the exiting app page?
library("shinydashboard")
library("shinyWidgets")
ui <- fluidPage(
h4("Embedded image"),
uiOutput("img"),
fluidRow(
tags$h4("Show and Hide Image"),
materialSwitch(
inputId = "get_image",
label = "Show Image",
value = FALSE,
status = "success"
),
),
)
server <- function(input, output, session) {
observeEvent(input$get_image, {
if(input$get_image == TRUE){
output$img <- renderUI({
tags$img(src = "https://www.r-project.org/logo/Rlogo.png")
})
}else{
output$img <- NULL
}
})
}
shinyApp(ui, server)
Something like this?
library(shiny)
library("shinydashboard")
library("shinyWidgets")
ui <- fluidPage(
h4("Embedded image"),
uiOutput("img"),
fluidRow(
tags$h4("Show and Hide Image"),
materialSwitch(
inputId = "get_image",
label = "Show Image",
value = FALSE,
status = "success"
),
),
)
server <- function(input, output, session) {
output$img <- renderUI({
if(input$get_image)
absolutePanel(
tags$img(src = "https://www.r-project.org/logo/Rlogo.png", width = "512"),
draggable = TRUE
)
})
}
shinyApp(ui, server)
Related
I'd like to use shinyWidgets::materialSwitch instead of a checkbox in my app for an improved UI.
However, I can't seem to get materialSwitch to work when used with renderUI/uiOutput. The input displays properly but doesn't seem to register a click to "switch".
For the purposes of my app - I need this to be inside a renderUI.
Pkg Versions:
shinyWidgets_0.7.2
shiny_1.7.2
library(shiny)
library(shinyWidgets)
# library(shinyjs)
ui <- fluidPage(
div(class="row",
column(width = 3,
uiOutput("switch")
)
)
)
server <- function(input, output, session) {
output$switch = renderUI({
materialSwitch(
inputId = "switch",
label = "Show Count",
right = TRUE,
status = "primary",
value = FALSE
)
})
}
shinyApp(ui = ui, server = server)
Why is this happening, and how can the problem be fixed?
The issue is that you give same name "switch" to both uiOutput.outputId and materiaSwitch.inputId.
It works OK when they get different ids:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
div(class="row",
column(width = 3,
uiOutput("switch"),
textOutput("result")
)
)
)
server <- function(input, output, session) {
output$switch = renderUI({
materialSwitch(
inputId = "switchButton",
label = "Show Count",
right = TRUE,
status = "primary",
value = FALSE
)
})
output$result = renderText(input$switchButton)
}
shinyApp(ui = ui, server = server)
Here is how it should work:
library(shiny)
library(shinyWidgets)
# library(shinyjs)
ui <- fluidPage(
div(style = 'position: absolute;left: 50px; top:100px; width:950px;margin:auto',
materialSwitch(inputId = "switch",
label = "Show Count",
right = TRUE,
status = "primary",
value = FALSE)
)
)
server <- function(input, output, session) {
output$value1 <- renderText({ input$switch })
}
shinyApp(ui = ui, server = server)
When running the code below, you will notice that I have two options below. If you press the Excel option, a fileInput will appear right below the radioButtons. However, I would like to know if it is possible to separate fileInput from radioButtons. I will insert an image to clarify what I want. See that they are separated.
Executable code below:
library(shiny)
library(dplyr)
library(shinyjs)
library(shinythemes)
library(readxl)
ui <- fluidPage(
shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel("PAGE1",
sidebarLayout(
sidebarPanel(
radioButtons("button",
label = h3("Data source"),
choices = list("Excel" = "Excel",
"Database" = "database"),
selected = "File"),
uiOutput('fileInput'),
),
mainPanel(
)))))
server <- function(input, output) {
observe({
if(is.null(input$button)) {
}else if (input$button =="Excel"){
output$fileInput <- renderUI({
fileInput("file",h4("Import file"), multiple = T, accept = ".xlsx")
})
} else if(input$button=="database"){
output$fileInput <- NULL
} else {
output$fileInput <- NULL
}
})
}
shinyApp(ui = ui, server = server)
Example:
I left it in red to specify the space
A possible workaround could be to use fluidRow with two columns to simulating a sidebarPanel with a mainPanel.
Notice that I wrapped the inputs in a div(class = "well well-lg") for the background.
App
library(shiny)
library(dplyr)
library(shinyjs)
library(shinythemes)
library(readxl)
ui <- navbarPage(
theme = shinytheme("flatly"), collapsible = TRUE,
br(),
tabPanel(
"PAGE1",
fluidRow(
column(
width = 6,
fluidRow(div(
class = "well well-lg",
radioButtons("button",
label = h3("Data source"),
choices = list(
"Excel" = "Excel",
"Database" = "database"
),
selected = "File"
)
)),
fluidRow(
uiOutput("fileInput")
)
),
column(
width = 6,
tableOutput("iris")
)
)
)
)
server <- function(input, output) {
output$iris <- renderTable({
iris
})
observe({
if (is.null(input$button)) {
} else if (input$button == "Excel") {
output$fileInput <- renderUI({
div(class = "well well-lg", fileInput("file", h4("Import file"), multiple = T, accept = ".xlsx"))
})
} else if (input$button == "database") {
output$fileInput <- NULL
} else {
output$fileInput <- NULL
}
})
}
shinyApp(ui = ui, server = server)
I wish to have a popout modal within a shiny app that depending on the user's action within the modal,
it would show or hide certain fields.
For example, the Modal includes a button that when pressed, another button would apear\disappear.
sadly, although the observeEvent detects a change in the hide\show button, shinyjs::toggle(), shinyjs::hide()
and shinyjs::show() fail to work
example script:
library(shiny)
ui <- fluidPage(
actionButton("show_modal", "show modal"),
)
server <- function(input, output) {
observeEvent(input$show_modal, {
showModal(
modalDialog(footer = NULL,easyClose = T,
tagList(
fluidRow(
box(status = "primary", width = 6, style = "direction: ltr",
actionButton("toggle_btn", "show or hide second button")
)),
fluidRow(
box(status = "success", width = 6, style = "direction: ltr",
actionButton("box_btn", "Box!")
))
)
))
})
observeEvent(input$toggle_btn, {
shinyjs::toggle("box_btn")
cat("\npresentation button pressed\n")
})
}
shinyApp(ui, server)
You can do it without shinyjs by using conditionalPanel():
library(shiny)
ui <- fluidPage(
actionButton("show_modal", "show modal"),
)
server <- function(input, output) {
rv <- reactiveValues(show_btn = FALSE)
observeEvent(input$toggle_btn, {
rv$show_btn <- !rv$show_btn
})
output$show_btn <- reactive({rv$show_btn})
outputOptions(output, "show_btn", suspendWhenHidden = FALSE)
observeEvent(input$show_modal, {
# add_path_to_existing_offers_DB(user = user)
showModal(
modalDialog(
footer = NULL,
easyClose = T,
tagList(
fluidRow(
actionButton("toggle_btn", "show or hide second button")
),
conditionalPanel(
condition = "output.show_btn == true",
fluidRow(
actionButton("box_btn", "Box!")
)
)
)
)
)
})
}
shinyApp(ui, server)
Turns out as Dean Attali the author of shinyjs pointed out kindly,
that I failed to call useShinyjs() function.
library(shiny)
library(shinyjs)
ui <- fluidPage(
**useShinyjs(),**
actionButton("show_modal", "show modal"),
)
server <- function(input, output) {
observeEvent(input$show_modal, {
showModal(
modalDialog(footer = NULL,easyClose = T,
tagList(
fluidRow(
box(status = "primary", width = 6, style = "direction: ltr",
actionButton("toggle_btn", "show or hide second button")
)),
fluidRow(
box(status = "success", width = 6, style = "direction: ltr",
actionButton("box_btn", "Box!")
))
)
))
})
observeEvent(input$toggle_btn, {
shinyjs::toggle("box_btn")
cat("\npresentation button pressed\n")
})
}
shinyApp(ui, server)
I would like to have one of the tabPanels in my Shiny app launch a shinyFiles style input. In this case I would like to launch a shinySaveButton, without the shinySaveButton being in my dataset (By clicking the save icon [which is actually a tabPanel])
Reproducible example below
library(shiny)
library(shinyFiles)
ui <- navbarPage('Test App',id = "inTabset", selected="panel1",
tabPanel(title = "", value = "Save", icon = icon("save")),
tabPanel(title = "Panel 1", value = "panel1",
h1("Panel1")),
tabPanel(title = "Panel 2",value = "panel2",
h1("Panel2"))
)
server <- function(input, output, session) {
values = reactiveValues(tabSelected="panel1")
observe({
if (input$inTabset=="Save") {
updateNavbarPage(session,"inTabset",selected=values$tabSelected)
#CODE FOR LOADING SHINYFILES DIALOG IN HERE
} else {
values$tabSelected<-input$inTabset
}
})
}
shinyApp(ui, server)
Any help would be greatly appreciated.
Work around using hidden element trick
library(shiny)
library(shinyFiles)
library(shinyjs)
jsCode<-"shinyjs.saveButton=function(){ $('#buttonFileSaveHidden').click(); }"
ui <- fluidPage(
useShinyjs(),
extendShinyjs(text = jsCode),
navbarPage('Test App',id = "inTabset", selected="panel1",
tabPanel(title = "", value = "Save", icon = icon("save")),
tabPanel(title = "Panel 1", value = "panel1",
h1("Panel1")
),
tabPanel(title = "Panel 2",value = "panel2",
h1("Panel2"))
),
# HIDDEN BUTTON TO INITIATE THE SAVE
hidden(shinySaveButton( "buttonFileSaveHidden",
label="",
title="Save as ...",
list('hidden_mime_type'=c("R")),
class='hiddenButton')),
wellPanel( #ONLY INCLUDED TO DISPLAY OF PATH INFO OF THE CHOICE
h3('Current save path info'),
tableOutput('table')
)
)
server <- function(input, output, session) {
values = reactiveValues(tabSelected="panel1")
observe({
if (input$inTabset=="Save") {
updateNavbarPage(session,"inTabset",selected=values$tabSelected)
#CODE FOR LOADING SHINYFILES DIALOG IN HERE
js$saveButton()
} else {
values$tabSelected<-input$inTabset
}
})
shinyFileSave(input, "buttonFileSaveHidden", session=session, roots=c(wd="~"), filetypes=c('R') ) #hidden
# GET THE SAVE PATH CHOICE AND RECORD IT IN fp.dt.rv
fp.dt.rv<-reactiveVal("")
observeEvent(input$buttonFileSaveHidden,{
fp.dt<-parseSavePath(c(wd='~'), input$buttonFileSaveHidden)
fp.dt.rv(fp.dt) #or just use to immediately write.
})
# ONLY TO DISPLAY THE SAVE CHOICE
output$table <- renderTable(fp.dt.rv())
}
shinyApp(ui, server)
I have modalDialog embedded into other modalDialog. When I run modalButton both of them closed.
How to close only embedded modalDialog?
Now :
Code :
library(shiny)
shinyApp(
ui <- fluidPage(
actionButton("one","Press")
),
server <- function(input, output,session) {
observeEvent(input$one,{
showModal(modalDialog(
actionButton("two","Press 2"),
footer = tagList(
modalButton("Cancel")
)))
})
observeEvent(input$two,{
showModal(modalDialog(
"OKAY",
footer = tagList(
modalButton("Cancel")
)))
})
})
Need :
Im not sure what you want to display in modal but maybe you can have a look at the sweetalertR package :
library(shiny)
library(sweetalertR)
shinyApp(
ui <- fluidPage(
sweetalert('#one',
title = "Are you sure?",
text = "Press here for some magic",
type = "warning",
showCancelButton = TRUE,
confirmButtonColor = '#DD6B55',
confirmButtonText = 'Yes, Confirm!',
closeOnConfirm = FALSE,
evalFunction = 'function(){swal("OKAY!", "Thank you PorkChop!", "success")}'
),
actionButton("one","Press")
),
server <- function(input, output,session) { })