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.
It appears the input value of a selectInput object is not updating. I have inserted one in the sidebar menu. I am using shinyDashboard. here is my code.
header & Sidebar
header <-
dashboardHeader(
title = "REPORT",
tags$li(class = "dropdown",
tags$style(
HTML(
"#import url('//fonts.googleapis.com/css?family=Libre+Baskerville:400,700|Open+Sans:400,700|Montserrat:400,700');"
)
)),
disable = FALSE,
titleWidth = '200'
)
header$children[[3]]$children[[3]] <-
tags$h1("DATABASE",
# align = 'left',
style = "color:#FFFFFF; font-weight: bold; font-family: 'Open Sans','Libre Baskerville',Montserrat, serif;font-size: 23px;")
data_type_list<-c('in vivo','in vitro','pbpk')
siderbar <- dashboardSidebar(
width = 200,
sidebarMenu(
id = 'sidebar',
style = "position: relative; overflow: visible;",
menuItem(
"TK Knowlegebase",
tabName = 'tk',
icon = icon('database'),
badgeColor = "teal",
#radioButtons("tk_data_type", "Select Data Type:",data_type_list)
selectInput('tk_data_type',"Select Data Type",data_type_list, selected=1)
)
)
)
body
body <- dashboardBody(width = 870,
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
),
#theme = shinythemes::shinytheme("darkly"),
tabItems(
tabItem (
tabName = "tk",
mainPanel(
#in vivo ----
conditionalPanel(
condition ="input.tk_data_type== 'in vivo'",
tags$h2('vivo')
),
# in vitro ----
conditionalPanel(
condition="input.tk_data_type== 'in vitro'",
tags$h2('vitro')
)
,
# pbpk ----
conditionalPanel(
condition="input.tk_data_type== 'pbpk'",
tags$h2('pbpk')
)
)))
server = function(input, output, session) {
observe({input$tk_data_type})
}
ui <- dashboardPage(title = 'ARC Toxkin App', skin = 'purple',
header, siderbar, body)
shiny::shinyApp(ui = ui, server = server)
I even attempted to use observe({input$tk_data_type}) in the server section to no success.
What I obtain is a blank page. what I wish to see is content from dashboardBody() appear.
Thank you for your time
UPDATE
This is a short-term fix solution, thanks to user YBS.
vitro_tabset<-tabsetPanel(
tabPanel("Detailed",
"This is a test"),
tabPanel("Phys-chem",
"This is a test"),
tabPanel("Exploratory",
"This is a test"),
tabPanel("Downloads",
"This is a test")
)
vivo_tabset<-tabsetPanel(
tabPanel("Detailed",
"This is a test"),
tabPanel("Phys-chem",
"This is a test"),
tabPanel("Exploratory",
"This is a test"),
tabPanel("Downloads",
"This is a test")
)
siderbar <- dashboardSidebar(
sidebarMenu(
id = 'sidebar',
menuItem(
"TK Knowlegebase",
tabName = 'tk',
icon = icon('database'),
badgeColor = "teal",
selected = TRUE,
startExpanded = TRUE,
#radioButtons("tk_data_type2", "Select Data Type:",data_type_list),
menuSubItem('vivo', tabName = 'vivo', icon = shiny::icon("angle-double-right"), selected = NULL),
menuSubItem('vitro', tabName = 'vitro', icon = shiny::icon("angle-double-right"), selected = TRUE),
menuSubItem('pbpk', tabName = 'pbpk', icon = shiny::icon("angle-double-right"), selected = NULL)
)
)
)
body <- dashboardBody(width = 870,
tabItems(
tabItem (tabName = "vivo",
vivo_tabset),
tabItem(tabName='vitro',
# in vitro ----
vitro_tabset),
# pbpk ----
tabItem(tabName='pbpk')
It appears that tabItems() and tabItem() don't work well in your program as the sidebarmenu requires minor tweaking. Also, you don't need mainPanel. Try this
data_type_list <- c("in vivo","in vitro","pbpk")
ui <- shinydashboard::dashboardPage(title = "ARC Toxkin App", skin = "purple",
shinydashboard::dashboardHeader(
title = "REPORT" ,
tags$li(class = "dropdown",
tags$style(
HTML(
"#import url('//fonts.googleapis.com/css?family=Libre+Baskerville:400,700|Open+Sans:400,700|Montserrat:400,700');"
)
)),
disable = FALSE,
titleWidth = '200'
),
shinydashboard::dashboardSidebar(width = 220,
useShinyjs(),
sidebarMenu(
id = "tabs",
style = "position: relative; overflow: visible;",
menuItem("TK Knowlegebase", tabName="tk", icon = icon("bar-chart-o"),
menuSubItem("TK Knowlegebase1", tabName = "tk1", icon = icon('database')),
selectInput("tk_data_type", label="Select Data Type", choices = data_type_list, selected=1),
menuSubItem("TK Knowlegebase2", tabName = "tk2", icon = icon('database'))
#radioButtons("tk_data_type2", "Select Data Type:",data_type_list)
)
)
),
shinydashboard::dashboardBody( #width = 870,
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "custom.css"),
),
#theme = shinythemes::shinytheme("darkly"),
tabItems(
#tabItem(tabName = "tk", headerPanel('First')),
tabItem(tabName = "tk1",
fluidRow(
shinydashboard::box(title = "Graphics Package", width = 12, solidHeader = TRUE, status="info",
## vivo
conditionalPanel(
condition = "input.tk_data_type == 'in vivo'",
tags$h2(' vivo')
),
## in vitro
conditionalPanel(
condition = "input.tk_data_type == 'in vitro'",
tags$h2(' vitro')
),
## pbpk
conditionalPanel(
condition = "input.tk_data_type == 'pbpk'",
tags$h2(' pbpk')
),
verbatimTextOutput("tb1"),
DTOutput("tb2")
))
),
tabItem(tabName = "tk2", headerPanel('Last'), DTOutput("tb3")
#verbatimTextOutput("tb4")
)
)
)
)
server <- function(input, output, session) {
output$tb3 <- renderDT(mtcars)
output$tb2 <- renderDT(iris)
output$tb1 <- renderPrint({input$tk_data_type})
output$tb4 <- renderPrint({input$tk_data_type2})
}
shinyApp(ui, server)
I refer to codes from shiny widget gallery to create a fileInput widget on my shinydashboard.
ui.R
fluidPage(
# Copy the line below to make a file upload manager
fileInput("file", label = h3("File input")),
hr(),
fluidRow(column(4, verbatimTextOutput("value")))
)
server.R
function(input, output) {
# You can access the value of the widget with input$file, e.g.
output$value <- renderPrint({
str(input$file)
})
}
I expect my app to show "file upload progress", "upload complete" status and "summary" of the file just like image below.
Below are my codes for shinydashboard:
** for your convenience, refer to "tab Item" = "file".
library(shinydashboard)
library(shiny)
# define user interface
ui <- dashboardPage(
dashboardHeader(title = "B. Times Square"),
dashboardSidebar(
sidebarMenu(
menuItem(text = "Overview", tabName = "overview", icon = icon("balance-scale-right")),
menuItem(text = "Future", tabName = "future", icon = icon("map-signs")),
menuItem(text = "History", tabName = "history", icon = icon("history")),
menuItem(text = "File Upload", tabName = "data", icon = icon("file-upload"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "overview",
fluidRow(
infoBox(title = "Revenue", 1000, icon = icon("hand-holding-usd")),
infoBox(title = "Transaction", 50, icon = icon("bed")),
infoBox(title = "Occupancy %", 40, icon = icon("percentage"))
)
),
tabItem(tabName = "future",
fluidRow(
box(
title = "Revenue [Book]", width = 4,
plotOutput(outputId = "p1-revenue-book")
),
box(
title = "Revenue [Check-In]", width = 4,
plotOutput(outputId = "p2-revenue-checkin")
),
box(
title = "RevPAR", width = 4,
plotOutput(outputId = "p3-revpar")
)
),
fluidRow(
box(
title = "Revenue [Channel]", width = 4,
plotOutput(outputId = "p4-revenue-channel")
),
box(
title = "Occupancy [unit]", width = 4,
plotOutput(outputId = "p5-occupancy")
),
box(
title = "Book vs Cancel [Unit]", width = 4,
plotOutput(outputId = "p6-book-vs-cancel")
)
)
),
tabItem(tabName = "history",
fluidRow(
box(
title = "Revenue [Check-In]", width = 4,
plotOutput(outputId = "p2-revenue-checkin")
),
box(
title = "Revenue [Book]", width = 4,
plotOutput(outputId = "p1-revenue-book")
),
box(
title = "RevPAR", width = 4,
plotOutput(outputId = "p3-revpar")
)
),
fluidRow(
box(
title = "Revenue [Channel]", width = 4,
plotOutput(outputId = "p4-revenue-channel")
),
box(
title = "Occupancy [unit]", width = 4,
plotOutput(outputId = "p5-occupancy")
),
box(
title = "Book vs Cancel [Unit]", width = 4,
plotOutput(outputId = "p6-book-vs-cancel")
)
)
),
tabItem(tabName = ***"data"***,
column(width = 4,
fluidRow(
wellPanel(
fileInput(inputId = "***csv-upload***", label = "File Upload:",
accept = c("csv", ".csv"))
)
)
)
)
)
)
)
# define server
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
I click on "Run App", tried to upload csv file but I don't see any progress bar or file upload complete status after I select a file. The widget basically doesn't work at all.
I have a simple shiny dashboard that has four tabs in the side menu, and for some reason, when I build the shiny app, clicking on the side menu does not show me a new page, and the content of tab2 just appends itself to tab1.
While searching stackoverflow showed me this question: Shinydashboars tabItems not working properly, the answer doesn't apply to me since I'm not using rmd, and i don't plan to host it to a AWS server.
Here is the code for reference:
ui <- dashboardPage(
dashboardHeader(title = "Study Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("Overall Objectives", tabName = "objectives"),
menuItem("Wellpad Operator", tabName = "wellpad_operator"),
menuItem("Wastewater Expert", tabName = "wastewater_expert"),
menuItem("Freshwater Expert", tabName = "freshwater_expert"),
menuItem("Environmental Impact", tabName = "environ_impact")
)
),
dashboardBody(
#Tab 1 Objective View
tabItems(
tabItem(tabName = "objectives",
h2("Overall Objectives"),
fluidRow(
box(
title = "Overall Objective Comparison", width = 6, solidHeader = TRUE,
plotOutput("objective_plot")
),
box(
title = "Cost Category Breakdown", width = 6, solidHeader = TRUE,
plotOutput("costbreakdown_plot")
),
box(
title = "Decision Variables", width = 12, solidHeader = TRUE,
tableOutput("decision_table"))
))
),
#Tab 2 Wellpad Decision
tabItem(tabName = "wellpad_operator",
h2("Wellpad Operator")
),
#Tab 3 Wastewater Expert
tabItem(tabName = "wastewater_expert",
h2("Wastewater Expert")
),
#Tab 4 Freshwater Expert
tabItem(tabName = "freshwater_expert",
h2("Freshwater Expert")
),
#Tab 5 Environmental Damages
tabItem(tabName = "environ_impact",
h2("Environmental Impact"))
)
)
server <- function(input, output) {
#server side code that generates the plots
}
shinyApp(ui = ui, server = server)
Thanks for all your help!
You need to put all your tabItem inside tabItems. Try this:
dashboardBody(
#Tab 1 Objective View
tabItems(
tabItem(tabName = "objectives",
h2("Overall Objectives"),
fluidRow(
box(
title = "Overall Objective Comparison", width = 6, solidHeader = TRUE,
plotOutput("objective_plot")
),
box(
title = "Cost Category Breakdown", width = 6, solidHeader = TRUE,
plotOutput("costbreakdown_plot")
),
box(
title = "Decision Variables", width = 12, solidHeader = TRUE,
tableOutput("decision_table"))
)),
#Tab 2 Wellpad Decision
tabItem(tabName = "wellpad_operator",
h2("Wellpad Operator")
),
#Tab 3 Wastewater Expert
tabItem(tabName = "wastewater_expert",
h2("Wastewater Expert")
),
#Tab 4 Freshwater Expert
tabItem(tabName = "freshwater_expert",
h2("Freshwater Expert")
),
#Tab 5 Environmental Damages
tabItem(tabName = "environ_impact",
h2("Environmental Impact"))
)
)