I want to trigger some action on clicking the menuItem. I use observe here: when I click 'Drivers' item I want some text to be returned in the console. Unfortunately, when I run the app the error comes up: Error in if: argument is of length 0. My menuItem exists, id is also ok so don't know why this error shows up.
Here is reproducible code (observe is on the bottom of my code):
library(shiny)
library(bs4Dash)
library(leaflet)
bodyTag <- dashboardBody(
tags$head(
tags$style(
"#map {
height: calc(100vh - 57px) !important;
}"
)
),
tabItems(
tabItem(
tabName = "live",
box(
title = "LIVE",
id = "panel",
height = 450,
collapsible = TRUE
)
),
tabItem(
tabName = "drivers",
box(
title = "Drivers",
id = "panel",
height = 450,
collapsible = TRUE
)
),
tabItem(
tabName = "customers",
box(
title = "Customers",
id = "panel",
height = 450,
collapsible = TRUE
)
)
),
leafletOutput("map")
)
ui <- dashboardPage(
dark = TRUE,
header = dashboardHeader(
title = h5("DEMO app")
),
sidebar = dashboardSidebar(
fixed = TRUE,
collapsed = TRUE,
expandOnHover = FALSE,
status = "purple",
customArea = fluidRow(
actionButton(
inputId = "myAppButton",
label = NULL,
icon = icon("users"),
width = NULL,
status = "primary",
style = "margin: auto",
dashboardBadge(1, color = "danger")
)
),
sidebarMenu(
id = "sidebarID",
menuItem("Live", tabName = "live", icon = icon("circle")),
menuItem("Drivers", tabName = "drivers", icon = icon("user-friends")),
menuItem("Customers", tabName = "customers", icon = icon("building"))
)
),
body = bodyTag
)
server <- function(input, output) {
observeEvent(input$sidebarID, {
updateBox("panel", action = "toggle")
})
output$map <- renderLeaflet({
leaflet() %>%
setView(lng = -73.98928, lat = 40.75042, zoom = 6) %>%
addProviderTiles("CartoDB.Positron")
})
# the problem is here
observe({
if(input$tabs == "drivers") {
print("Drivers")
#print(input$tabs)
} else {
print("other tabs")
}
})
}
shinyApp(ui = ui, server = server)
I'm pretty sure that input$tabs is how I should get to the given menuItem but maybe I'm wrong.
You're wrong. Many other posted solutions to this problem use tabs as the id of the sidebar menu, but you don't:
sidebarMenu(
id = "sidebarID",
menuItem("Live", tabName = "live", icon = icon("circle")),
menuItem("Drivers", tabName = "drivers", icon = icon("user-friends")),
menuItem("Customers", tabName = "customers", icon = icon("building"))
)
So you need
observe({
if(input$sidebarID == "drivers") {
print("Drivers")
#print(input$tabs)
} else {
print("other tabs")
}
})
It's a simple typo.
I would like to edit the contents of a modal popup in R shiny. Below is my code with which I'm able to print the values in the modal popup but I'm not able to edit it.
Server.R
modelnetlist <- function(failed = FALSE){
netlistdata <- readLines('run.scs')
splitText1 <- stringi::stri_split(str = netlistdata, regex = '\\n')
# wrap a paragraph tag around each element in the list
replacedText1 <- lapply(splitText1, p)
modalDialog(
title = "Netlist File",
replacedText1,
easyClose = FALSE,
footer = tagList(
modalButton("Close"),
actionButton("save", "Save")
)
)
}
observeEvent(input$gennet, {
showModal(modelnetlist())
})
ui.R
options(shiny.maxRequestSize=100*1024^2)
ui <- dashboardPage(skin = "yellow",
dashboardHeader(title = "Modelling Automation"),
dashboardSidebar(
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Data Processing", tabName = "DP", icon = icon("database"), startExpanded = TRUE,
menuSubItem("Merge", tabName= "Merge"),
menuSubItem("Data", tabName = "Data"),
menuSubItem("Plot", tabName = "Plot", selected = TRUE),
menuSubItem("Parameters", tabName = "Parameters")),
menuItem("Parameter Extraction", icon = icon("book-open"), tabName = "PE"),
menuSubItem("Data Conversion", tabName = "DC"),
menuSubItem("IPL Upload", tabName = "IPL"),
menuSubItem("Netlist Spectre", tabName = "netlist"),
menuSubItem("Spectre logs", tabName = "mylog"),
menuSubItem("Parameter Fitting", tabName = "PF"),
menuItem("Model QA", tabName = "QA", icon = icon("angellist"))
),
textOutput("res")
),
dashboardBody(
tabItems(
tabItem("DP", "Dashboard tab content"),
#tabItem("PE", "Widgets tab content"),
tabItem("Merge", fileInput("mergefiles", "choose the files", accept = c(".txt"), multiple = TRUE), downloadButton("Download", label = "Merged File")),
tabItem("Data",
mainPanel(div(style='overflow-x:scroll',tableOutput("txt"),tableOutput("filetable"),tableOutput("filetable1")))
),
tabItem("Plot",sidebarLayout(sidebarPanel(width=3,
fileInput("datasets", "choose the files", accept = c(".txt",".esd"), multiple = TRUE),
uiOutput("plotdata"),uiOutput("devicetype"), uiOutput("chip"),
uiOutput("macro"),
uiOutput("device"),fluidRow(column(5,uiOutput("minIT2")),column(5,uiOutput("maxIT2"))),
fluidRow(column(5,uiOutput("temperature")), column(5,uiOutput("DCleakage"))),
fluidRow(column(5,uiOutput("varx")),column(5,uiOutput("vary")))
),
mainPanel(width=9,
plotlyOutput("PLOT")))),
tabItem("Parameters",tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"),
div(style="display:inline-block;width:32%;text-align: center;",actionButton("action", label = "Normalize")),
tabsetPanel(type="tabs",
tabPanel("CV Table",div(style='overflow-x:scroll',dataTableOutput('DiodeCVTable')),fluidRow(column(5, actionButton("perimeterCV", label="Change Perimeter")),column(5, actionButton("changeCV", label = "Change Goldenchip"))),fluidRow(column(5, uiOutput("dynamicCV")),column(5,uiOutput("goldenchipCV"))),plotlyOutput("cvplot")),
tabPanel("DC Table",div(style='overflow-x:scroll',dataTableOutput('DiodeDCTable')),fluidRow(column(5, actionButton("perimeterDC", label="Change Perimeter")),column(5, actionButton("changeDC", label = "Change Goldenchip"))),fluidRow(column(5, uiOutput("dynamicDC")),column(5,uiOutput("goldenchipDC"))),plotlyOutput("dcplot")),
tabPanel("TLP Table",div(style='overflow-x:scroll',dataTableOutput('TLPTable')), fluidRow(column(5, actionButton("perimeterTLP", label="Change Perimeter")),column(5, actionButton("changeTLP", label = "Change Goldenchip"))),fluidRow(column(5, uiOutput("dynamicTLP")),column(5,uiOutput("goldenchipTLP"))),plotlyOutput("tlpplot")),
tabPanel("VFTLP Table",div(style='overflow-x:scroll',dataTableOutput('VFTLPTable')), fluidRow(column(5, actionButton("perimeterVFTLP", label="Change Perimeter")),column(5, actionButton("changeVFTLP", label = "Change Goldenchip"))),fluidRow(column(5, uiOutput("dynamicVFTLP")),column(5,uiOutput("goldenchipVFTLP"))), plotlyOutput("vftlpplot")))),
tabItem("PE","Parameter Extraction Content"),
tabItem("DC",uiOutput("onedevice"),uiOutput('tabs'),
conditionalPanel(condition="input.layer=='CV'", plotlyOutput("plotcv1"),br(), tableOutput("device1cv")),
#conditionalPanel(condition="input.layer=='CV 2'", plotlyOutput("plotcv2"),br(), tableOutput("device2cv")),
# conditionalPanel(condition="input.layer=='CV 3'", plotlyOutput("plotcv3"),br(), tableOutput("device2cv")),
conditionalPanel(condition="input.layer=='DC # 25'", plotlyOutput("plotdc125"),br(), tableOutput("device1dc25")),
conditionalPanel(condition="input.layer=='DC # -40'", plotlyOutput("plotdc140"),br(), tableOutput("device1dc40")),
conditionalPanel(condition="input.layer=='DC # 125'", plotlyOutput("plotdc1125"),br(), tableOutput("device1dc125")),
conditionalPanel(condition="input.layer=='DC # 150'", plotlyOutput("plotdc1150"),br(), tableOutput("device1dc150")),
conditionalPanel(condition="input.layer=='TLP'",fluidRow(column(3,uiOutput("stepcountTLP")), column(3, uiOutput("maxvoltageTLP")), column(3, uiOutput("VholdTLP")), downloadButton("DownloadTLP",label = "Download converted data")), plotlyOutput("plottlp1"),br(), tableOutput("device1tlp")),
#conditionalPanel(condition="input.layer=='TLP 2'", plotlyOutput("plottlp2"),br(), tableOutput("device2tlp")),
conditionalPanel(condition="input.layer=='VFTLP'",fluidRow(column(3,uiOutput("stepcountVFTLP")), column(3, uiOutput("maxvoltageVFTLP")), column(3, uiOutput("VholdVFTLP"))), plotlyOutput("plotvftlp1"),br(), tableOutput("device1vftlp"))
),
tabItem("PF", uiOutput('modelingtabs'),
conditionalPanel(condition="input.modtab=='CV'",tableOutput("modelingdevice1CV")),
conditionalPanel(condition= "input.modtab=='DC # 25'", tableOutput("modelingdevice1DC25")),
conditionalPanel(condition= "input.modtab=='DC # 40'", tableOutput("modelingdevice1DC40")),
conditionalPanel(condition= "input.modtab=='DC # 125'", tableOutput("modelingdevice1DC125")),
conditionalPanel(condition= "input.modtab=='DC # 150'", tableOutput("modelingdevice1DC150")),# plotlyOutput("plotcv1"),br(), tableOutput("device1cv")),
conditionalPanel(condition="input.modtab=='TLP'",tableOutput("modelingdevice1TLP")),# plotlyOutput("plottlp1"),br(), tableOutput("device1tlp")),
conditionalPanel(condition="input.modtab=='VFTLP'",tableOutput("modelingdevice1VFTLP"))#, plotlyOutput("plotvftlp1"),br(), tableOutput("device1vftlp"))
),
tabItem("IPL",
fluidRow(box(title = "Model Inputs", width = 8,
fileInput("iplfile", "choose the IPL file", accept = c(".xlsx"), multiple = TRUE),
column(3, uiOutput("modeltype")),
column(3,uiOutput("modeldevtype")),
column(3,uiOutput("modelpath")),
column(3, uiOutput("wrapperfile")),
column(3,uiOutput("zapcon")),
column(3,uiOutput("polarity")),
column(3,uiOutput("sectiontype")),
column(3,uiOutput("designfile")),
column(3, uiOutput("esd_event")),
column(3, uiOutput("esd_exit")),
column(3, uiOutput("modelnodeorder")),
column(3, uiOutput("terminalbias")),
column(3,uiOutput("design")),
column(3,uiOutput("modtemp")),
column(3,uiOutput("ylogaxis")))),
box(title = "Model Parameters in IPL", width = 20, tableOutput("IPLTable"),
uiOutput("newvalue1"),
uiOutput("newvalue2"),
uiOutput("newvalue3"),
uiOutput("newvalue4"))
,fluidRow(box(width = 6, height = 60,actionButton("SpecPlot", label="Spectre Plot", width = 100),
# bsModal("netl", strong("Netlist File", style="color:#0000ff; font-size:120%"),
# "gennet", size = "large", uiOutput("modelnetlist")),
actionButton("HspiPlot", label="Hspice Plot", width = 100),
actionButton("gennet", label="Generate netlist"),
actionButton("ChangeValues", label="Change Values"),
actionButton("save", label = "Save"),
actionButton("Mergesim", label="Merge Simulation Plots"))),
uiOutput("newvalues"),
#conditionalPanel(condition = "input$specplot", withSpinner(plotlyOutput("plotspe"), type = 1, hide.ui = FALSE)),
tags$head(
tags$style(
HTML(".shiny-notification {
height: 100px;
width: 500px;
position:fixed;
top: calc(50% - 50px);;
left: calc(50% - 400px);;
}
"
)
)
),
#box(title = "Simulation", status = "primary", plotlyOutput("plotspe", height = 250)),
fluidRow(column(width=6,
fluidRow(plotlyOutput("plotspe",width = "100%", height = "400px", inline = FALSE))),
column(width=6,
fluidRow(plotlyOutput("plothspi",width = "100%", height = "400px", inline = FALSE)))),
fluidRow(column(width=6,fluidRow(plotlyOutput("plotspechspi",width = "100%", height = "400px", inline = FALSE)))),
# splitLayout(style = "height:400px;", cellWidths = c("800", "800"),
# plotlyOutput("plotspe"), plotlyOutput("plothspi"))
# ,
plotlyOutput("plottlpalongspectre")
),
tabItem("netlist", fluidPage(uiOutput("netlistfile"))),
tabItem("mylog", fluidPage(uiOutput("logfile"))),
tabItem("QA", " QA tab content")# actionButton("ChangeValues", label="Change Values"
)
)
)
**run.scs file:** (File that I'm calling in modelnetlist function to read and display it in the modal)
Simmulator lang=spectre
global 0
paropt options redefinedparams= ignore
parameters vnw=0 vnd=0
parameters area_1=5.5e-12
I would like to edit in the modal popup, but I'm only to print with my code. I tried textInput, textOutput inside modalDialog but it doesn't help. Any suggestions?
In modalDialog function you can use almost any UI elements (see ... parameter)
modelnetlist <- function(failed = FALSE){
netlistdata <- paste(readLines('run.scs'),collapse="\n")
modalDialog(
title = "Netlist File",
textAreaInput("theScript", value=netlistdata),
easyClose = FALSE,
footer = tagList(
modalButton("Close"),
actionButton("save", "Save")
)
)
}
and to get new script in the save button listener use input$theScript
observeEvent(input$save, {
# do whatever you want with input$theScript
if(isTruthy(input$theScript))
writeLines(input$theScript, "run.scs")
})
Note: the path where you save file must be writeable.
I am adding clickable icons in my shiny app to show a popup information box. Please see the following screenshot and code example. My strategy is to wrap my text and the code for actionLink in the HTML function. This works well. However, the size of the icon is determined by the size of the associated. I would like to know if it is possible to make all the icons the same size, such as the smallest one associated with the selectInput?
The documentation (https://shiny.rstudio.com/reference/shiny/1.0.1/icon.html) mentioned that it is to set "fa-3x" in the icon function to make the size to be 3 times as normal. But in my case the size would sill be determined by the associated text and each text has a different size. So I guess this strategy would not work. It would be great if anyone can share their ideas or suggestions.
# Load the packages
library(shiny)
library(shinydashboard)
library(shinyalert)
# User Interface
ui <- dashboardPage(
header = dashboardHeader(title = ""),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem(
text = "Example",
tabName = "tab1"
)
)
),
body = dashboardBody(
# A call to use the shinyalert package
useShinyalert(),
tabItems(
tabItem(
tabName = "tab1",
h2(HTML("This is a title",
as.character(actionLink(inputId = "info1",
label = "",
icon = icon("info"))))),
fluidRow(
box(
title = HTML("This is the title of the box",
as.character(actionLink(inputId = "info2",
label = "",
icon = icon("info")))),
status = "primary", solidHeader = TRUE,
selectInput(inputId = "Select",
label = HTML("This is the title of the selectInput",
as.character(actionLink(inputId = "info3",
label = "",
icon = icon("info")))),
choices = 1:3)
)
)
)
)
)
)
server <- function(input, output, session){
observeEvent(input$info1, {
shinyalert(text = "Info 1", type = "info")
})
observeEvent(input$info2, {
shinyalert(text = "Info 2", type = "info")
})
observeEvent(input$info3, {
shinyalert(text = "Info 3", type = "info")
})
}
# Run the app
shinyApp(ui, server)
I'm not sure if I understand your question correctly but if you want the them all to have the same size you can adapt the font size for the icons like this:
# Load the packages
library(shiny)
library(shinydashboard)
library(shinyalert)
# User Interface
ui <- dashboardPage(
header = dashboardHeader(title = ""),
sidebar = dashboardSidebar(
sidebarMenu(
menuItem(
text = "Example",
tabName = "tab1"
)
)
),
body = dashboardBody(
# A call to use the shinyalert package
useShinyalert(),
tabItems(
tabItem(
tabName = "tab1",
h2(HTML("This is a title", "<font size='3'>",
as.character(actionLink(inputId = "info1",
label = "",
icon = icon("info"))), "</font>")),
fluidRow(
box(
title = HTML("This is the title of the box", "<font size='3'>",
as.character(actionLink(inputId = "info2",
label = "",
icon = icon("info"))), "</font>"),
status = "primary", solidHeader = TRUE,
selectInput(inputId = "Select",
label = HTML("This is the title of the selectInput", "<font size='3'>", as.character(actionLink(inputId = "info3",
label = "",
icon = icon("info"))), "</font>"
),
choices = 1:3)
)
)
)
)
)
)
server <- function(input, output, session){
observeEvent(input$info1, {
shinyalert(text = "Info 1", type = "info")
})
observeEvent(input$info2, {
shinyalert(text = "Info 2", type = "info")
})
observeEvent(input$info3, {
shinyalert(text = "Info 3", type = "info")
})
}
# Run the app
shinyApp(ui, server)
I have an shinydashboard app, the app get an filter box and a tabset which show a datatatable depending on filter.
I have a reset button which reset the filters whith shinyjs::reset function, and I want to reset also the tableset and showing the complete table or nothing.
I want also to do it for a valuboxes.
My app is like this :
For server interface I have an basic : output$tableprint_A <- DT::renderDataRable ({})
ui :
body <- dashboardBody(
tabItems(
#### First tab item #####
tabItem(tabName = "fpc",
fluidRow(
infoBoxOutput("kpm_inf", width = 6),
infoBoxOutput(outputId = "fpc_inf", width = 6)
),
fluidRow(
box(title = "Variables filter",
shinyjs::useShinyjs(),
id = "side_panel",
br(),
background = "light-blue",
solidHeader = TRUE,
width = 2,
selectInput("aaa", "aaa", multiple = T, choices = c("All", as.character(unique(fpc$aaa))))
br(),
br(),
p(class = "text-center", div(style = "display:inline-block", actionButton("go_button", "Search",
icon = icon("arrow-circle-o-right"))),
div(style = "display:inline-block", actionButton("reset_button", "Reset",
icon = icon("repeat")))),
p(class = 'text-center', downloadButton('dl_fpc', 'Download Data'))),
tabBox(
title = tagList(),
id = "tabset1",
width = 10,
tabPanel(
"A \u2030 ",
DT::dataTableOutput("tableprint_A"),
bsModal(id = 'startupModal', title = 'Update message', trigger = '',
size = 'large',
tags$p(tags$h2("Last update of A : 01/09/2017",
br(), br(),
"Last update of B : 01/09/2017",
br(), br(),
"Last update of C : 01/09/2017",
style = "color:green", align = "center")))
),
tabPanel(
"B % Table",
DT::dataTableOutput("tableprint_B")),
type = "pills"
)
),
fluidRow(
# Dynamic valueBoxes
valueBoxOutput("info_gen", width = 6)
)
I tried this :
observeEvent(input$reset_button, {
output$tableprint_A <- NULL
})
Edit:
I want something like that, but when I action the search button I want it to appear again :
shinyjs::onclick("reset_button",
shinyjs::toggle(id = "tableprint_A", anim = TRUE))
You should try this out:
output$tableprint_A <- renderDataTable({
if(input$reset_button == 1) {
NULL
}else{
datatable(...)
}
})
if the button is clicked then nothing will be displayed, else the datatable is shown.
[EDIT]
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(selectInput("select", "select", choices = unique(iris$Species), multiple = T),
actionButton("go_button", "Search",
icon = icon("arrow-circle-o-right")),
actionButton("reset_button", "Reset",
icon = icon("repeat")),
DT::dataTableOutput('tbl')),
server = function(input, output) {
values <- reactiveValues(matrix = NULL)
observe({
if (input$go_button == 0)
return()
values$matrix <- iris[iris$Species %in% input$select, ]
})
observe({
if (input$reset_button == 0)
return()
values$matrix <- NULL
})
output$tbl = DT::renderDataTable({
datatable(values$matrix, options = list(lengthChange = FALSE))}
)
}
)
I'm using the dropdownButton from this link that is in Shiny Widgets, with a slight mod to make the text black. drop-down checkbox input in shiny
My goal is to make the dropdownButton in my sidebar look as much like a selectInput feature as possible. I got the button to be the same size as the the selectInput, and the caret to be placed correctly, thanks to help on another post, but when I change the window size, I run into UI overlap issues.
Any suggestions? See my issue below:
Both are screenshots of the same app from the same code, just different window sizes. I'd like the dropdownButton to stay consistent in matching its size to the selectInput above. I also don't understand why my h5("Filter 2:) text splits with the larger window size, and I don't want it to do that.
library(shiny)
library(shinydashboard)
dropdownButton2 <- function(label = "", status = c("default", "primary", "success", "info", "warning", "danger"), ..., width = NULL) {
status <- match.arg(status)
# dropdown button content
html_ul <- list(
class = "dropdown-menu",
style = if (!is.null(width))
paste0("width: ", validateCssUnit(width), ";"),
lapply(X = list(...), FUN = tags$li, style = "margin-left: 10px; margin-right: 10px;color:black")
)
# dropdown button apparence
html_button <- list(
class = paste0("btn btn-", status," dropdown-toggle"),
type = "button",
`data-toggle` = "dropdown"
)
html_button <- c(html_button, list(label))
html_button <- c(html_button, list(tags$span(class = "caret")))
# final result
tags$div(
class = "dropdown",
do.call(tags$button, html_button),
do.call(tags$ul, html_ul),
tags$script(
"$('.dropdown-menu').click(function(e) {
e.stopPropagation();
});")
)
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(width = 325,
selectInput('month',label='Filter 1:',choices= month.name,multiple = FALSE,selected = "March"),
br(),
column(1,
h5(strong(("Filter 2:"))),
tags$style(type = 'text/css', ".btn-default{width: 100%;}"),
tags$style(type = 'text/css', ".btn .caret{position: relative;}"),
tags$style(type = 'text/css', ".caret{top: 45%; right:-35%}"),
dropdownButton2(
label = "Filter 2:", status = "default", width = 200,#circle = FALSE,
checkboxGroupInput(inputId = "check1", label = "Choose", choices = c("A","B","C"))
),
h5(strong(("Filter 3:"))),
dropdownButton2(
label = "Filter 3:", status = "default", width = 200,#circle = FALSE,
checkboxGroupInput(inputId = "check3", label = "Choose", choices = c("A","B","C"))
)
)),
dashboardBody()
)
server <- function(input, output){
}
shinyApp(ui = ui, server = server)
#SarahGC - The column you have defined in your code has width = 1 which is being used to display dropdownbuttons. By just changing that value, both your problems will get solved (text wont split on the label, and width of buttons will not be restricted). Please note width must be between 1 and 12.
column(11,
h5(strong("Filter 2:")),
tags$style(type = 'text/css', ".btn-default{width: 100%;}"),
tags$style(type = 'text/css', ".btn .caret{position: relative;}"),
tags$style(type = 'text/css', ".caret{top: 45%; right:-35%}"),
dropdownButton2(
label = "Filter 2:", status = "default",width = 100,#circle = FALSE,
checkboxGroupInput(inputId = "check1", label = "Choose", choices = c("A","B","C"))
),
h5(strong("Filter 3:")),
dropdownButton2(
label = "Filter 3:", status = "default",width = 100,#circle = FALSE,
checkboxGroupInput(inputId = "check3", label = "Choose", choices = c("A","B","C"))
)
)