I'm trying to make the font size of the words on each button to be smaller (which would hopefully also shrink the overall button size for each option) but am struggling to find the right place to write the style = 'font-size: 5px' code. Where would I add that?
library(shiny)
library(shinyjqui)
server <- function(input, output) {
output$order <- renderPrint({ print(input$dest) })
}
ui <- fluidPage(
orderInput('source', 'Source', items = month.abb,
as_source = TRUE, connect = 'dest'),
orderInput('dest', 'Dest', items = NULL, placeholder = 'Drag items here...'),
verbatimTextOutput('order')
)
shinyApp(ui, server)
library(shiny)
library(shinyjqui)
server <- function(input, output) {
output$order <- renderPrint({ print(input$dest) })
}
ui <- fluidPage(
orderInput('source', 'Source', items = month.abb,
as_source = TRUE, connect = 'dest'),
orderInput('dest', 'Dest', items = NULL, placeholder = 'Drag items here...'),
verbatimTextOutput('order'),
tags$style(HTML(
'
.btn.shinyjqui {font-size: 5px}
'
))
)
shinyApp(ui, server)
to also shrink the button
tags$style(HTML(
'
.btn.shinyjqui {
font-size: 5px;
padding: 0;
}
'
))
Related
I have two tables and I'm trying to show one at a time based on user input in radio buttons. If the input from the radio buttons is "table", i'd like to show table1. If the input is else i'd like to show table2.
observeEvent(input$visuBtn,{
req(input$visuBtn)
print(input$visubtn)
if(input$visuBtn == "table"){
hide("table2")
#DT::dataTableOutput("table1")
renderUI(
DT::dataTableOutput("table1")
)
}else{
print("Should show table2")
# removeUI(
# selector = "table"
# )
renderUI(
DT::dataTableOutput("table2")
)
#DT::dataTableOutput("table2")
#show("table2")
}
})
I've tried doing this by showing and hiding the two tables and can't figure out how to get that to work. I"ve also tried using renderUI as well. What would be the best methodology to go about this?
mainPanel(
tabsetPanel(id = "sim.tabset",
tabPanel(title = "Results",
# tableOutput("table")
DT::dataTableOutput("table"),
DT::dataTableOutput("table2")
),
)
Depending on your app, you can toggle the visibility of the table in the frontend with a little bit of javascript. In the UI, create a button and wrap the dataTableOutput in a generic container.
# some where in your UI
actionButton("toggleTable", "Toggle Table"),
tags$div(
id = "tableContainer",
DT::dataTableOutput("table")
)
...
There are many ways to toggle the visibility of an element (changing the display properties, toggling css classes, modifying other attributes, etc.). The following function toggles the html attribute hidden when the button is clicked. This can be defined in the UI using the tags$script function or loaded from an external javascript file.
const btn = document.getElementById('toggle');
const elem = document.getElementById('tableContainer');
btn.addEventListener('click', function(event) {
if (elem.hasAttribute('hidden')) {
elem.removeAttribute('hidden');
} else {
elem.setAttribute('hidden', '');
}
});
In the server, render the datatable as normal and you can remove the toggling (unless you need additional things to happen when the button is clicked).
Here is the full example.
library(shiny)
shinyApp(
ui = tagList(
tags$main(
id = "main",
tags$h1("Collapsible Table Example"),
actionButton("toggleTable", "Toggle Table"),
tags$div(
id = "tableContainer",
DT::dataTableOutput("table")
)
),
tags$script(
type = "text/javascript",
"
const btn = document.getElementById('toggleTable');
const elem = document.getElementById('tableContainer');
btn.addEventListener('click', function(event) {
if (elem.hasAttribute('hidden')) {
elem.removeAttribute('hidden');
} else {
elem.setAttribute('hidden', '');
}
});
"
)
),
server = function(input, output, session) {
output$table <- DT::renderDataTable({
data.frame(
group = sample(c("A", "B"), 20, replace = TRUE),
x = rnorm(n = 20, mean = 50, sd = 2),
y = rnorm(n = 20, mean = 50, sd = 2)
)
})
}
)
I opted to go with a simple solution, just having one table that renders based on the choice of the radiobuttons. Meaning the if/else is just within the renderDataTable function
library(shiny)
library(DT)
ui <- fluidPage(
radioButtons("Buttons", "CHOOSE!", choices = c("MTCARS", "IRIS")),
DT::dataTableOutput("THETABLE")
)
server <- function(input, output, session) {
output$THETABLE<-DT::renderDataTable({
req(input$Buttons)
if(input$Buttons == "MTCARS") {
DT::datatable(mtcars)
} else {
DT::datatable(iris)
}
})
}
shinyApp(ui, server)
Alternatively, you could use conditional panel, so it shows the table based on the radiobutton selection:
library(shiny)
library(DT)
ui <- fluidPage(
radioButtons("Buttons", "CHOOSE!", choices = c("MTCARS", "IRIS")),
conditionalPanel("input.Buttons == 'MTCARS'",
DT::dataTableOutput("TABLEMTCARS")
),
conditionalPanel("input.Buttons == 'IRIS'",
DT::dataTableOutput("TABLEIRIS"))
)
server <- function(input, output, session) {
output$TABLEMTCARS<-DT::renderDataTable({
DT::datatable(mtcars)
})
output$TABLEIRIS<-DT::renderDataTable({
DT::datatable(iris)
})
}
shinyApp(ui, server)
library(shiny)
ui <- fluidPage(
title = "App Title",
textInput("text","enter here"),
uiOutput("text1")
)
max = 10
server <- function(session,input, output)
{
output$text1 <- reactive({ paste0('only ', max-nchar(input$text), ' characters left' ) })
observeEvent(input$text,{
if(nchar(input$text) > max ) {
updateTextInput(session , "text",value = substr(input$text,1,max))
}
})
}
shinyApp(ui=ui,server=server)
what should I do to stop the cursor when it reaches to the max length provided.I don't need any notification or alert box just the cursor stops and move backward to erase the text.
observeEvent(input$text,{
if(nchar(input$text) > max ) {
updateTextInput(session , "text",value = substr(input$text,1,max))
}
})
what things should I change to work like it..
took a reference from Add character limit to a text box in an R shiny app
Thank You in advance
You can run a javascript code in the server to do that.
library(shiny)
library(shinyjs)
ui <- fluidPage(
title = "App Title",
useShinyjs(),
textInput("text","enter here"),
uiOutput("text1")
)
max = 10
server <- function(session,input, output)
{
output$text1 <- reactive({ paste0('only ', max-nchar(input$text), ' characters left' ) })
runjs(sprintf("$('#text').attr('maxlength', %d)", max))
}
shinyApp(ui=ui,server=server)
I have an app which works with tabpanels that use many of the same inputs, and must be rendered using renderUI to respond to user data. I've noticed my modulated inputs give priority to the first menu they're rendered in and disregard changes made in different panels
The following is a simplified working example of the basic issue
library(shiny)
addexButtons <- function(id, label = "ROCParam") {
ns <- NS(id)
uiOutput(ns("roccondicionals"), label = label)
}
numbmod <- function(input, output, session, ndata) {
output$roccondicionals <- renderUI({
tagList(numericInput('numb', 'Choose Num', value = 0,))
})
}
ui <- fluidPage(navbarPage(
'App',
tabPanel(title = 'Menu 1',
sidebarLayout(
sidebarPanel(addexButtons("counter1", "Adder")),
mainPanel(textOutput('sumtotal'))
)),
tabPanel(title = 'Menu 2',
sidebarLayout(
sidebarPanel(addexButtons("counter2", "Multiplier"),),
mainPanel(textOutput('multiplytotal'))
))
))
server <- function(input, output) {
callModule(numbmod, "counter1")
callModule(numbmod, "counter2")
output$sumtotal <-
renderText(paste0('5 + ', input$numb, ' = ', input$numb + 5))
output$multiplytotal <-
renderText(paste0('5 x ', input$numb, ' = ', input$numb * 5))
}
shinyApp(ui = ui, server = server)
If you run this example you will see that, by changing to menu 2 the value retains the information modified in Menu 1 (which is intended) however if I choose to modify this same value in the same tab I can't and must return to Menu 1 to do so.
Is there a way to be able to modify the same rendered input on two different tabs where the last modification is the one retained?
As #YBS has already mentioned you cannot define two inputs with the same id. I would use updateNumericInput to automatically update the inputs when of the inputs is changed (triggered).
library(shiny)
addexButtons <- function(id, label = "ROCParam") {
ns <- NS(id)
uiOutput(ns("roccondicionals"), label = label)
}
numbmod <- function(input, output, session, ndata, n) {
output$roccondicionals <- renderUI({
numericInput(paste0("numb",n), 'Choose Num', value = 0)
})
}
ui <- fluidPage(navbarPage(
'App', id = "App",
tabPanel(title = 'Menu1',
tab_id = "tab1",
sidebarLayout(
sidebarPanel(addexButtons("counter1", "Adder")),
mainPanel(textOutput('sumtotal'))
)),
tabPanel(title = 'Menu2',
tab_id = "tab2",
sidebarLayout(
sidebarPanel(addexButtons("counter2", "Multiplier"),),
mainPanel(textOutput('multiplytotal'))
))
))
server <- function(input, output, session) {
observeEvent(input$numb1, {
updateNumericInput(session, "numb2", value = input$numb1)
updateNavbarPage(session,"App", "Menu2")
})
observeEvent(input$numb2, {
updateNumericInput(session, "numb1", value = input$numb2)
updateNavbarPage(session,"App", "Menu1")
})
callModule(numbmod, "counter1",n = 1)
callModule(numbmod, "counter2",n = 2)
output$sumtotal <-
renderText(paste0('5 + ', input$numb1, ' = ', input$numb1 + 5))
output$multiplytotal <-
renderText(paste0('5 x ', input$numb2, ' = ', input$numb2 * 5))
}
shinyApp(ui = ui, server = server)
I am trying to update divs while in a loop, some of which contain images. Using removeUI(..., immediate = TRUE) I can remove them and then replace them by new divs, with insertUI(..., immediate = TRUE). Although the texts appear in real time, the images do not load until we are out of the loop (see example below, you don't even have to load an image, a question mark will appear after the loop ends).
In my browser I can see the img tags are created in HTML, but still no images appear live.
Here is a reproducible example:
ui <- fluidPage(
actionButton("add","")
)
server <- function(input, output, session) {
for(i in 1:3){
Sys.sleep(1.5)
insertUI(
selector = "#add",
where = "afterEnd",
ui = div(style = paste0("width: 75px; height: 75px; background-color: white;"), h5("Text appears live", align = "center"),
div(h6("Text inside a div appears live")),
div(id = "img", img(src = "image.jpg", alt = "Images do not appear live")
)
),
immediate = TRUE
)
}
}
shinyApp(ui, server)
Is this normal behavior for shiny? If so is their a way to bypass it and to see the images appear directly? Another way to do it?
Here's a slightly more self-contained set of code that works for me if I run the app by hitting the "Run App" button in Rstudio.
dir.create("www")
dir.create("www/images")
library(shiny)
library(magick)
green.square <- image_blank(width=50, height =75, color= "green")
grid.total.squares <- 12*8
wordList <- 1:(grid.total.squares*2)
for (i in seq_along(wordList)){
thisImage = image_annotate(green.square, gravity="center", i,
size=30)
image_write(thisImage, format = "png", path = paste0("www/images/",i, ".png"))
}
ui <- fluidPage(
actionButton("add","Add something"),
)
server <- function(input, output, session) {
for(i in 1:3){
Sys.sleep(.5)
insertUI(
selector = "#add",
where = "afterEnd",
ui = div(style = paste0("min-width:75px; min-height: 75px; background-color: white; clear:both;"), h5("Text appears live", align = "center"),
div(h6("Text inside a div appears live")),
div(id = "img",
img(src = paste0("images/",i,".png"),
alt = "Images do not appear live"
),
hr()
)
),
immediate = TRUE
)
}
}
shinyApp(ui, server)
I have tried to nest some "observe events" in Shiny to create a conditional rule.
It should go like this :
if one box is clicked display the corresponding single output when the button is clicked.
if both boxes are clicked display both outputs when the button is clicked.
but it always displays both outputs.
Any suggestion?
shinyApp(
ui = basicPage(
checkboxInput("box1", label = "Checkbox1", value = FALSE),
checkboxInput("box2", label = "Checkbox2", value = FALSE),
actionButton('buttn', 'Validate'),
verbatimTextOutput("out1"),
verbatimTextOutput("out2")
),
server = function(input, output) {
observeEvent(input$buttn, {
observeEvent(input$box1, {
output$out1 <- renderText({"Foo"})});
observeEvent(input$box2, {
output$out2 <- renderText({"bar"})})
})
}
)
Please note that it is bad practice to put observeEvents or reactives inside other observeEvents. See this slide and the two after it from a presentation by Joe Cheng.
One possible solution is to simply show or hide elements with the shinyjs package. A working example is given below.
Another solution is to use reactiveVal to hold the text to be displayed, and update that from your observer.
Hope this helps!
Solution 1
library(shiny)
library(shinyjs)
ui <- basicPage(
checkboxInput("box1", label = "Checkbox1", value = FALSE),
checkboxInput("box2", label = "Checkbox2", value = FALSE),
actionButton('buttn', 'Validate'),
shinyjs::hidden(div(id='div1', verbatimTextOutput("out1"))),
shinyjs::hidden(div(id='div2', verbatimTextOutput("out2"))),
useShinyjs()
)
server <- function(input, output) {
observeEvent(input$buttn, {
if(input$box1)
shinyjs::show('div1')
else
shinyjs::hide('div1')
if(input$box2)
shinyjs::show('div2')
else
shinyjs::hide('div2')
})
output$out1 <- renderText({"Foo"})
output$out2 <- renderText({"bar"})
}
shinyApp(ui,server)
Solution 2
library(shiny)
library(shinyjs)
ui <- basicPage(
checkboxInput("box1", label = "Checkbox1", value = FALSE),
checkboxInput("box2", label = "Checkbox2", value = FALSE),
actionButton('buttn', 'Validate'),
verbatimTextOutput("out1"),
verbatimTextOutput("out2")
)
server <- function(input, output) {
text1 <- reactiveVal(NULL)
text2 <- reactiveVal(NULL)
observeEvent(input$buttn, {
ifelse(input$box1,text1('Foo'),text1(NULL))
ifelse(input$box2,text2('Bar'),text2(NULL))
})
output$out1 <- renderText({text1()})
output$out2 <- renderText({text2()})
}
shinyApp(ui,server)
You don't need the extra event observers. Just observe the button click and use standard R conditional logic to adjust the output based on the checkboxes.
shinyApp(
ui = basicPage(
checkboxInput("box1", label = "Checkbox1", value = FALSE),
checkboxInput("box2", label = "Checkbox2", value = FALSE),
actionButton('buttn', 'Validate'),
verbatimTextOutput("out1"),
verbatimTextOutput("out2")
),
server = function(input, output) {
observeEvent(input$buttn, {
if (input$box1) {
output$out1 <- renderText({"Foo"})
}
if (!input$box1) {
output$out1 <- renderText({NULL})
}
if (input$box2) {
output$out2 <- renderText({"Bar"})
}
if (!input$box2) {
output$out2 <- renderText({NULL})
}
})
}
)