I am trying to alternate the presence of a TinyMCE editor in R Shiny.
I can load the editor, then remove it with the respective actionButtons. However, upon attempting to load it more than once, only a textAreaInput-type interface is rendered:
library(shiny)
library(ShinyEditor)
ui <- fluidPage(
use_editor("API-KEY"),
uiOutput("tiny"),
actionButton("load", "Load TinyMCE"),
actionButton( "remove", "Remove TinyMCE" ))
server <- function(input, output, session) {
observeEvent(input$load, {
output$tiny = renderUI( editor('textcontent'))})
observeEvent(input$remove, {
output$tiny = renderUI( NULL)})
}
shinyApp(ui = ui, server = server)
How would it be possible to reload it? Thank you.
I would try that:
library(shiny)
library(ShinyEditor)
ui <- fluidPage(
use_editor("API-KEY"),
uiOutput("tiny"),
actionButton("btn", "Load/Remove TinyMCE"),
)
server <- function(input, output, session) {
output$tiny <- renderUI({
if(input$btn %% 2 == 0) {
editor('textcontent')
} else {
NULL
}
})
}
shinyApp(ui = ui, server = server)
And if that doesn't work I would hide it instead of removing it:
library(shiny)
library(ShinyEditor)
ui <- fluidPage(
use_editor("API-KEY"),
conditionalPanel(
condition = "input.btn %% 2 == 0",
uiOutput("tiny")
),
actionButton("btn", "Load/Remove TinyMCE"),
)
server <- function(input, output, session) {
output$tiny <- renderUI({
editor('textcontent')
})
}
shinyApp(ui = ui, server = server)
The following is based on #Stéphane Laurent's advice.
library(shiny)
library(ShinyEditor)
library(shinyjs)
ui <- fluidPage(
use_editor("API-KEY"),
useShinyjs(),
uiOutput("tiny"),
actionButton( "toggle", "Toggle TinyMCE" ))
server <- function(input, output, session) {
output$tiny = renderUI( editor('textcontent'))
observe({if(input$toggle %% 2 == 0) {
hide('tiny')
} else {
show('tiny')
}
})
}
shinyApp(ui = ui, server = server)
Related
I have a simple shiny app which I would like to show a warning if user input is bigger than a threshold.
library(shiny)
library(shinyalert)
ui <- fluidPage(
numericInput("obs", "Observations:", 1),
verbatimTextOutput("value")
)
server <- function(input, output) {
observeEvent(input$obs,{
if(!is.na(input$obs) && input$obs >10){
shinyalert("warning!", "input too big", type = "warning")
}
})
output$value <- renderText({ input$obs })
}
shinyApp(ui, server)
if user is not quick enough to provide input, let say for the input$obs = 110 we have 1 second delay between putting the second and third value the popups warning will appear !
How should I fix this ?
Use shinyCatch from spsComps to make your life easier
library(shiny)
library(spsComps)
ui <- fluidPage(
numericInput("obs", "Observations:", 1),
verbatimTextOutput("value")
)
server <- function(input, output) {
output$value <- renderText({
shinyCatch({
if(!is.na(input$obs) && input$obs >10) warning("input too big")
}, blocking_level = "warning", prefix = "")
input$obs
})
}
shinyApp(ui, server)
when blocking_level = "warning" is specified shinyCatch blocks following code in the renderText expression. So when your number is larger than 10, the new input$obs will not be rendered.
Here's what users see
Here's what developers see in the console
You can use showNotification() from shiny itself:
library(shiny)
ui <- fluidPage(
numericInput("obs", "Observations:", 1),
verbatimTextOutput("value")
)
server <- function(input, output) {
observeEvent(input$obs,{
if(!is.na(input$obs) && input$obs >10){
showNotification(
ui = tags$h4("Input Too Big!"),
type = "warning"
)
}
})
output$value <- renderText({ input$obs })
}
shinyApp(ui, server)
Or {shinytoastr}:
library(shiny)
library(shinytoastr)
ui <- fluidPage(
shinytoastr::useToastr(),
numericInput("obs", "Observations:", 1),
verbatimTextOutput("value")
)
server <- function(input, output) {
observeEvent(input$obs,{
if(!is.na(input$obs) && input$obs >10){
shinytoastr::toastr_warning(
message = "Decrease it.",
title = "Input too big!"
)
}
})
output$value <- renderText({ input$obs })
}
shinyApp(ui, server)
Or {spsComps} as #lz100 mentioned. The choice is yours.
I want to get the loop variable from a loop. However, renderText function utilizes the last loop's value.
library(shiny)
ui <- fluidPage(
mainPanel("main panel", textOutput("ts_txt1"), textOutput("ts_txt2"), textOutput("ts_txt3"), textOutput("ts_txt4"), textOutput("ts_txt5"), textOutput("ts_txt6"), textOutput("ts_txt7"), textOutput("ts_txt8"), textOutput("ts_txt9"), textOutput("ts_txt10"),)
)
server <- function(input, output) {
observe({
for (i in 1:10) {
output[[paste0("ts_txt",i)]]<- renderText(
{ paste0(i,"_" )})
}
})
}
shinyApp(ui = ui, server = server)
My desired output is as follow:
1_
2_
3_
4_
5_
6_
7_
8_
9_
10_
Try this
library(shiny)
ui <- fluidPage(
mainPanel("main panel", textOutput("ts_txt1"), textOutput("ts_txt2"), textOutput("ts_txt3"), textOutput("ts_txt4"), textOutput("ts_txt5"), textOutput("ts_txt6"), textOutput("ts_txt7"), textOutput("ts_txt8"), textOutput("ts_txt9"), textOutput("ts_txt10"),)
)
server <- function(input, output) {
observe({
for (i in 1:10) {
local({
i <- i
output[[paste0("ts_txt",i)]]<- renderText({ paste0(i,"_" )})
})
}
})
}
shinyApp(ui = ui, server = server)
I have the shiny app below and I would like to toggle between a plot (default) and its table using the same actionButton().
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("exc",
"Exchange")
),
mainPanel(
uiOutput(outputId = "car_plot")
)
)
)
server <- function(input, output) {
showPlot <- reactiveVal(TRUE)
observeEvent(input$exc, {
showPlot(!showPlot())
})
output$car_plot <- renderUI({
if (showPlot()){
renderPlot({
plot(mtcars)
})
}
else{
renderDataTable(
datatable(
mtcars)
)
}
})
}
shinyApp(ui = ui, server = server)
I think what you have is close. I would create separate outputs for the plot and table as below (output$plot and output$table) and call them depending on state of your reactiveVal. Let me know if this is the behavior you had in mind.
server <- function(input, output) {
showPlot <- reactiveVal(TRUE)
observeEvent(input$exc, {
showPlot(!showPlot())
})
output$car_plot <- renderUI({
if (showPlot()){
plotOutput("plot")
}
else{
dataTableOutput("table")
}
})
output$plot <- renderPlot({
plot(mtcars)
})
output$table <- renderDataTable(datatable(mtcars))
}
It should be easy to prevent "London" showing up at the top of the page, but I couldn't find how.
library(shiny)
ui <- fluidPage(
mainPanel(
mylist <- c("London","Paris"),
selectInput("s", "Select", mylist)
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
Take mylist out of fluidPage:
library(shiny)
mylist <- c("London","Paris")
ui <- fluidPage(
mainPanel(
selectInput("s", "Select", mylist)
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
Otherwise mylist is included in the mainPanel function as another output to include such as a header.
Of course, as an alternative you could just include your option list directly in selectInput and omit the mylist vector completely:
selectInput("s", "Select", choices = c("London","Paris"))
You can use the vector into direct inside selectInput like:
library(shiny)
ui <- fluidPage(
mainPanel(
selectInput("s", "Select", choices = c("London","Paris"))
)
)
server <- function(input, output) {}
shinyApp(ui = ui, server = server)
if you have to use some static validation in your option based on selection you can use something like:
library(shiny)
library(shinyalert)
ui <- fluidPage(
mainPanel(
useShinyalert(),
selectInput("option_select", "Select", choices = c("London"="lon","Paris"="par")),
actionButton("check_city","City Selected")
)
)
server <- function(input, output) {
observeEvent(input$check_city,{
if(input$option_select=="lon")
{
shinyalert("City Selected: London")
}
else
{
shinyalert("City Selected: Paris")
}
})
}
shinyApp(ui = ui, server = server)
Is there a way to close the context menu of a dropdownButton in a shiny app after clicking on a button? I was looking for an attribute like closed/opened in the dropdownButton-documentation and couldn't find anything but I believe there must be a way to do this.
This is an example app:
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
dropdownButton(
actionButton("button", "Press this Button to close the dropdownButton!"),
circle = TRUE, status = "primary", icon = icon("user-circle")
)
)
server <- function(input, output) {
observeEvent(
input$button, {
# Set dropdownButton closed
print("Test")
}
)
}
shinyApp(ui = ui, server = server)
Do you mean something like this?
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
uiOutput('help')
)
server <- function(input, output) {
observeEvent(
input$button, {
shinyjs::hide("button")
#output$help <- renderUI({} )
}
)
output$help <- renderUI(dropdownButton(
actionButton("button", "Press this Button to close the dropdownButton!"),
circle = TRUE, status = "primary", icon = icon("user-circle")
) )
}
shinyApp(ui = ui, server = server)
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
uiOutput('help')
)
server <- function(input, output) {
observeEvent(
input$button, {
shinyjs::hideElement("dropdown-menu")
}
)
output$help <- renderUI(dropdownButton(
actionButton("button", "Press this Button to close the dropdownButton!"),
circle = TRUE, status = "primary", icon = icon("user-circle")
) )
}
shinyApp(ui = ui, server = server)
By dropping "sw-show" class from your dropdown menu, its context will be disappeared.
Use shinyjs::removeClass to do it.
Don't forget to add sw-content- prefix to the menu's ID.
`
library(shiny)
library(shinyjs)
library(shinyWidgets)
ui <- fluidPage(
useShinyjs(),
uiOutput('drop_down_output')
)
server <- function(input, output) {
output$drop_down_output <- renderUI({
dropdown(
inputId = 'drop_down_1',
actionButton("button", "Run!")
)
})
observeEvent(input$button,{
shinyjs::removeClass(id = 'sw-content-drop_down_1', class = 'sw-show')
})
}
shinyApp(ui = ui, server = server)
`