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.
Related
I have the below code for Modal Popup and I'm able to edit the contents of the popup. But I would like to save the edited contents into a file,
**server.r**
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")
)
)
}
observeEvent(input$gennet, {
showModal(modelnetlist())
})
ui.R
#library(qdap)
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 save the edited contents of the file into run.scs and update it.
Please navigate to IPL upload tab and click on Generate netlist button for the modal popup to open.
You can use such an observer:
observeEvent(input[["save"]], {
writeLines(input[["theScript"]], "path/to/file.txt")
})
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 3 boxes in the dashboard body. When radioButton in selected to "P3G", box1 and box3 should appear i.e hide box2. When radiobutton is selected to "Chose File", box2 and box3 should appear. I have the below code using shinyjs but it is not working as required i.e. not hiding complete box contents as coded in observeEvent. Any help?
sidebar <- dashboardSidebar(width=200,
sidebarMenu(id="tabs",
menuItem("Input File", tabName =
"tab1",icon = icon("fas fa-file"))))
body <- tabItem(tabName = "tab1",value="file_nput",h2("Select file"),
fluidRow(useShinyjs(),
radioButtons("file_rd",label= "Chose Dataset:",
choices = list("P3G","Chose File"),selected = "P3G"),
box( id ="box1",title = "Default Sample", width = 7, status = "info",
tabPanel("Sample Info",value="p3_samples",
DT::dataTableOutput("p3_table"))),
box(id= "box2", title = "Uploaded Sample", width = 7, status = "info",
tabsetPanel(id = "sam_tab",
tabPanel("Upload", value="upload_file",
fileInput(inputId ="FILE",label = "Upload file",multiple=FALSE,
accept = c(".txt")),
checkboxInput('header', label = 'Header', TRUE),
actionButton("createdb","Create DB")),
tabPanel("File Info",value="samples",tableOutput("summary"),icon = icon("info"),
DT::dataTableOutput("full_table"),actionButton("upload","Proceed")))),
box(id = "box3" ,status = "info", width = 5,
tabBox(id = "infobox", height = "100%", width = "100%",
tabPanel("Instructions",h4("Instructions for uploading valid input file"))))))
ui<- shinyUI(dashboardPage(dashboardHeader(title = "TestApp", titleWidth = 150),sidebar,dashboardBody(tabItems(body))))
server <- function(input, output, session) {
observeEvent(input$file_rd, {
if (input$file_rd == "P3G") {
shinyjs::hide(id = "box2", anim=TRUE)
}else {
shinyjs::hide(id = "box1",anim=TRUE)
}
})
}
shinyApp(ui=ui, server=server)
You can simply use
conditionalPanel()
so conditionalPanel for box1 will be like this:
conditionalPanel('input.file_rd === "P3G"', box(id = 'box1', ...)
and for box2 and box3:
conditionalPanel('input.file_rd != "P3G"', box(id = 'box2', ...), box(id = 'box3', ...)
I have a couple of questions regarding R shiny Dashboard.
ui.R
library(shinydashboard)
library(shiny)
dashboardPage(
dashboardHeader(title = 'Test Interface'),
dashboardSidebar(width = 600,
h3('-------Input Data-------'),
fluidRow(
column(6, div(style = "height:10px"), fileInput(inputId = 'FileInput', label = 'Upload Input:', accept = c('csv','tsv','txt'))),
column(2, div(style = "height:3px"), checkboxInput(inputId = 'header', label = 'Header', value = FALSE)),
column(2, div(style = "height:12px"), radioButtons(inputId = 'sep', label = 'Separator', choices = c(comma=',',tab="\t",space=' '), selected = ","),offset = 1)
),
fluidRow(column(6, div(style = "height:1px"), fileInput(inputId = 'FileInput1', label = 'Upload Second Input:'))),
br(),
h3('-------Select Foreground-------'),
fluidRow(
column(5, div(style = "height:17px"), radioButtons(inputId = 'cutoff', label = 'Selection', choices = c('Up'='pos','Down'='neg','Both'='both'))),
br(),
column(3, div(style = "height:1px"), textInput(inputId = 'fc', label = "Fold Change", value = '0')),
column(3, div(style = "height:1px; margin-left:10cm"), height = 6,textInput(inputId = 'pvalue', label = "Adj. Pvalue",value = '0.05'))
),
fluidRow(column(2, h1(" "), actionButton(inputId = 'select', label = "Select Data"))),
fluidRow(column(5, div(style = "height:25px;font-color:blue"), downloadButton('download', 'Download Plot')))),
dashboardBody(
tabsetPanel(type="tabs", id = "tabvalue",
tabPanel(title = "Input Table", value = 'tab1', DT::dataTableOutput('table')),
tabPanel(title = "Plot", value = 'tab7', plotOutput('plot',width = 800,height = 800)))))
server.R
library(shiny)
shinyServer(function(input, output, session){
})
I couldn't figure out how to add a vertical scroll bar to the dashboardSidebar. In my actual app, the last elements are not visible when I run the app.
Thanks!
I ran into this and came up with the following hack (and I do mean hack).
shinyDashboard(
tags$head(
tags$style(HTML(".sidebar {
height: 90vh; overflow-y: auto;
}"
) # close HTML
) # close tags$style
), # close tags#Head
# ...
The 90vh sets the sidebar height at 90% of the viewport height. You may want to adjust this to taste. Too large a percentage and some of the sidebar still drops below the horizon; too small a percentage and the sidebar ends noticeably before the main body (with the scrollbar appearing prematurely).