Related
I have a shiny app below with 3 different tabs. I want each tab to have its own sidebar and I did this using conditionalPanel(). The first tab though (InsiderTraining) has 2 more tabs inside it (Tab1,Tab2) which I also want to have separated sidebars.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = tags$body(class="skin-blue sidebar-mini control-sidebar-open",dashboardPage(
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(title = "Investment Advisor Monitoring - Insider Trading",titleWidth = 450),
sidebar = dashboardSidebar(minified = F, collapsed = F,
h4("Investment Selected"),
uiOutput("mytab11"), uiOutput("mytab12"),uiOutput("mytab13"),uiOutput("mytab14")
#textInput("StockTicker3", "Enter Stock Symbol 3", value = "AMZN")
),
body = dashboardBody(
h3('Results'),
tabsetPanel(id = "tabs",
tabPanel("InsiderTraining",
tabsetPanel(id="tabs2",
tabPanel("tab1"),
tabPanel("tab2"))),
tabPanel("Switching"),
tabPanel("Tax Loss Harvesting")
)
),
controlbar = dashboardControlbar(width = 300,
h4("Insider Trading Parameters"),
uiOutput("mytab21"), uiOutput("mytab22")
#selectInput("InsiderTradingModel3", "Insider Trading Model 3",
# c("Dynamic" = "Dynamic",
# "AI based" = "AIbased"))
),
title = "DashboardPage"
)),
server = function(input, output) {
output$mytab11 <- renderUI({
tagList(
conditionalPanel(condition = 'input.tabs=="InsiderTraining"',
textInput("StockTicker", "Enter Stock Symbol", value = "NFLX"),
sliderInput('periods','Periods',min=1,max=120,value=60),
selectInput("mtvar", "Choose a variable", choices = colnames(mtcars))
))
})
output$mytab12 <- renderUI({
tagList(
conditionalPanel(condition = 'input.tabs=="Switching"',
textInput("StockTicker2", "Enter Stock Symbol", value = "APPL"),
selectInput("cvar", "Choose a variable", choices = colnames(cars))
))
})
output$mytab13 <- renderUI({
tagList(
conditionalPanel(condition = 'input.tabs2=="Tab1"',
textInput("StockTicker3", "Enter Stock Symbol", value = "APPL"),
selectInput("cvar2", "Choose a variable", choices = colnames(cars))
))
})
output$mytab14 <- renderUI({
tagList(
conditionalPanel(condition = 'input.tabs2=="Tab2"',
textInput("StockTicker4", "Enter Stock Symbol", value = "APPL"),
selectInput("cvar3", "Choose a variable", choices = colnames(cars))
))
})
}
)
Try this
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
shinyApp(
ui = tags$body(class="skin-blue sidebar-mini control-sidebar-open",dashboardPage(
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(title = "Investment Advisor Monitoring - Insider Trading",titleWidth = 450),
sidebar = dashboardSidebar(minified = F, collapsed = F,
h4("Investment Selected"),
#uiOutput("mytab11"),
uiOutput("mytab12"),uiOutput("mytab13"),uiOutput("mytab14")
#textInput("StockTicker3", "Enter Stock Symbol 3", value = "AMZN")
),
body = dashboardBody(
h3('Results'),
tabsetPanel(id = "tabs",
tabPanel("InsiderTraining",
tabsetPanel(id="tabs2",
tabPanel("tab1"),
tabPanel("tab2"))),
tabPanel("Switching"),
tabPanel("Tax Loss Harvesting")
)
),
controlbar = dashboardControlbar(width = 300,
h4("Insider Trading Parameters"),
uiOutput("mytab21"), uiOutput("mytab22")
#selectInput("InsiderTradingModel3", "Insider Trading Model 3",
# c("Dynamic" = "Dynamic",
# "AI based" = "AIbased"))
),
title = "DashboardPage"
)),
server = function(input, output) {
output$mytab11 <- renderUI({
tagList(
conditionalPanel(condition = 'input.tabs=="InsiderTraining"',
textInput("StockTicker", "Enter Stock Symbol", value = "AAPL"),
sliderInput('periods','Periods',min=1,max=120,value=60),
selectInput("mtvar", "Choose a variable", choices = colnames(mtcars))
))
})
output$mytab12 <- renderUI({
tagList(
conditionalPanel(condition = 'input.tabs=="Switching"',
textInput("StockTicker2", "Enter Stock Symbol", value = "NFLX"),
selectInput("cvar", "Choose a variable", choices = colnames(cars))
))
})
output$mytab13 <- renderUI({
tagList(
conditionalPanel(condition = 'input.tabs=="InsiderTraining" && input.tabs2=="tab1"',
textInput("StockTicker3", "Enter Stock Symbol", value = "APPL"),
sliderInput('periods3','Periods',min=1,max=120,value=30),
selectInput("cvar2", "Choose a variable", choices = colnames(cars))
))
})
output$mytab14 <- renderUI({
tagList(
conditionalPanel(condition = 'input.tabs=="InsiderTraining" && input.tabs2=="tab2"',
textInput("StockTicker4", "Enter Stock Symbol", value = "FB"),
selectInput("cvar3", "Choose a variable", choices = colnames(mtcars))
))
})
output$mytab21 <- renderUI({
tagList(
conditionalPanel(condition = 'input.tabs=="Switching"',
textInput("StockTicker", "Enter Stock Symbol", value = "ZM"),
sliderInput('periods','Periods',min=1,max=120,value=80),
selectInput("mtvar", "Choose a variable", choices = colnames(pressure))
))
})
output$mytab22 <- renderUI({
tagList(
conditionalPanel(condition = 'input.tabs=="Tax Loss Harvesting"',
textInput("StockTicker", "Enter Stock Symbol", value = "TSLA"),
sliderInput('periods','Periods',min=1,max=120,value=100),
selectInput("mtvar", "Choose a variable", choices = colnames(iris))
))
})
}
)
I would like to insert a bspopover next to the text: "Shapefile Import". For the Filter options I was able to insert as you can see in the code below, however for fileImput no. The executable code is below.
can anybody help me?
Thank you!
library(shinyBS)
library(shiny)
popoverTempate <-
'<div class="popover popover-lg" role="tooltip"><div class="arrow"></div><h3 class="popover-title"></h3><div class="popover-content"></div></div>'
DES_filter1<-paste("Text text text text text text.", sep = "<br>")
ui <- fluidPage(
tags$head(
tags$style(HTML(".popover.popover-lg {width: 500px; max-width: 500px;}"))
),
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
fileInput("shp", h3("Shapefile import"), multiple = TRUE, accept = c('.shp', '.dbf','.sbn', '.sbx', '.shx', '.prj')),
radioButtons(
"filter1",
h3("Select properties"),
choiceValues = c(1, 2),
choiceNames = list(
tagList(
tags$span("All properties"),
tags$span(icon("info-circle"), id = "icon1", style = "color: blue;")
),
tagList(
tags$span("Exclude properties"),
tags$span(icon("info-circle"), id = "icon2", style = "color: blue;")
)
),
selected = 1
),
bsPopover("icon1", "TITLE1", DES_filter1, placement = "right",
options = list(template = popoverTempate)),
bsPopover("icon2", "TITLE2", "CONTENT2", placement = "right"),
radioButtons("filter2", h3("Select"),
choices = list("All" = 1,
"Exclude" = 2),
selected = 1),
),
mainPanel(
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
You can add the icon in the fileInput title:
sidebarPanel(
fileInput("shp",
h3(
span("Shapefile import"),
span(icon("info-circle"), id = "icon3", style = "color: blue")
),
multiple = TRUE,
accept = c('.shp', '.dbf','.sbn', '.sbx', '.shx', '.prj')
),
bsPopover("icon3", "TITLE3", "CONTENT3", placement = "right"),
...
Friends, could you help me to insert a warning message if an option is selected in selecInput. In my case, I would like it to be the case if the option "Exclude farms" is selected, a message like: Change filter options selected above. The executable code is below:
library(shinyBS)
library(shiny)
popoverTempate <-
'<div class="popover popover-lg" role="tooltip"><div class="arrow"></div><h3 class="popover-title"></h3><div class="popover-content"></div></div>'
DES_filter1<-paste(".........", sep = "<br>")
ui <- fluidPage(
tags$head(
tags$style(HTML(".popover.popover-lg {width: 500px; max-width: 500px;}"))
),
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
radioButtons(
"filter1",
h3("Select properties"),
choiceValues = c(1, 2),
choiceNames = list(
tagList(
tags$span("All properties"),
tags$span(icon("info-circle"), id = "icon1", style = "color: blue;")
),
tagList(
tags$span("Exclude properties"),
tags$span(icon("info-circle"), id = "icon2", style = "color: blue;")
)
),
selected = 1
),
bsPopover("icon1", "TITLE1", DES_filter1, placement = "right",
options = list(template = popoverTempate)),
bsPopover("icon2", "TITLE2", "CONTENT2", placement = "right"),
selectInput("filter2", h3("Select farms"),
choices = list("All farms" = 1,
"Exclude farms" = 2),
selected = 1),
),
mainPanel(
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
If you are open to using another package here is a shinyWidgets solution with a 'sendSweetAlert':
library(shinyWidgets)
library(shiny)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
radioButtons(
"filter1",
h3("Select properties"),
choiceValues = c(1, 2),
choiceNames = list(
tagList(
tags$span("All properties"),
tags$span(icon("info-circle"), id = "icon1", style = "color: blue;")
),
tagList(
tags$span("Exclude properties"),
tags$span(icon("info-circle"), id = "icon2", style = "color: blue;")
)
),
selected = 1
),
selectInput("filter2", h3("Select farms"),
choices = list("All farms" = 1,
"Exclude farms" = 2),
selected = 1),
),
mainPanel(
)
)
)
server <- function(input, output, session) {
observe({
if(input$filter2 == 2){
sendSweetAlert(
session = session,
title = "Warning!",
text = "Change filter options selected above",
type = "warning"
)
}
})
}
shinyApp(ui = ui, server = server)
All is needed is to observe the selectInput value and when the input is on "Exclude farms" which has a value of 2 a warning message is sent.
My Shiny app has a universal sidebarPanel. I want to hide it for one particular tab, i.e. whenever the used would navigate to that tab the sidebarPanel would collapse. The code I am trying is as follows-
The UI-
library(shiny)
shinyUI(fluidPage (
theme = shinytheme("superhero"),
headerPanel("COVID-19 Data Visualizer"),
sidebarPanel(
width = 2,
selectInput(
"countries",
label = "Select Countries",
choices =
c("B", "C", "A"),
selected = c("A"),
multiple = T
),
submitButton(text = "View")
),
mainPanel (h1(""),
tabsetPanel(
tabPanel(
"Global Status",
div(id="Main"),
plotlyOutput("figG"),
br(),
plotlyOutput("global_time"),
br(),
plotlyOutput("global_cfr"),
br(),
plotlyOutput("global_p"),
br(),
plotlyOutput("global_recov_dead")
),
tabPanel(
"Comparative Charts",
plotlyOutput("fig_confirm"),
br(),
plotlyOutput("fig_dead"),
br(),
plotlyOutput("fig_recov")
),
tabPanel(
"Ratio Analysis",
plotlyOutput("fig_confirm_S"),
br(),
plotlyOutput("fig_confirm_D"),
br(),
plotlyOutput("fig_Ratio"),
br(),
plotlyOutput("fig_cfr_print")
)
))
))
The server part-
server <- function(input, output) {
observeEvent(input$tabs == "Global Status", {
shinyjs::hide(id = "Main")
})
}
I don't really want to use the navbarPage and want single sidebarPanel for all the inputs.
A screenshot of the output I am getting-
Thanks in advance.
Here is an example:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
sidebarLayout(
sidebarPanel(
id="sidebar",
selectInput(
"countries", label = "Select Countries",
choices = c("B", "C", "A"), selected = "A",
multiple = TRUE
)
),
mainPanel(
tabsetPanel(
tabPanel(
"Global status",
sliderInput("s1", "slider 1", 0, 100, 20)
),
tabPanel(
"Comparative charts",
sliderInput("s2", "slider 2", 0, 100, 50)
),
tabPanel(
"Ratio analysis",
sliderInput("s3", "slider 3", 0, 100, 80)
),
id = "tabset"
),
id="main"
)
)
)
server <- function(input, output){
observeEvent(input[["tabset"]], {
if(input[["tabset"]] == "Comparative charts"){
hideElement(selector = "#sidebar")
removeCssClass("main", "col-sm-8")
addCssClass("main", "col-sm-12")
}else{
showElement(selector = "#sidebar")
removeCssClass("main", "col-sm-12")
addCssClass("main", "col-sm-8")
}
})
}
shinyApp(ui = ui, server = server)
I have created the following UI using R shiny. The script is as follows.
The first part deals with the sidebar layout.
ui <- fluidPage(
titlePanel("Graphingtool"),
h3("DB"),
hr(),
fluidRow(
column(12,
fluidRow(
column(3,
fileInput("file1", 'DB',
multiple = TRUE,
accept = c("xlsx/xls",".xls",".xlsx"))),# We have added the formats here- will load excel alone- in case csv/txt needed amend here
column(5,
column(4,downloadButton(outputId = "Downloaddata", label = "Downloader"))
)
),
fluidRow(
column(3,
textInput(inputId = 'T',label = 'T'),
textInput(inputId = 'C',label = 'C'),
textInput(inputId = "P", label = "P"),
column(2, offset = 2,
actionButton(inputId = "CLS", label = "CLS"))
),
column(5,
textInput(inputId = "P", label = "P"),
textInput(inputId = "Y", label = "Y"),
numericInput(inputId = "Numberinput", label = "Ninput", min = -1000000000, max = 1000000000, value = 0,step = 1)
)),
fluidRow(
column(3,
radioButtons("dist", "Vertical Axis Scale",
c("Linear" = "Linear Reg",
"Log" = "Log reg"))),
column(5,
radioButtons("dist", "Horizontal Axis Scale",
c("Linear" = "Linear reg",
"Log" = "Log reg")))
),
fluidRow(
column(5,
sliderInput(inputId = "Scale", label = "Scale", min = 0, max = 100,
step = 2.5, value = 1))) ) )
Here we create the main panel
,mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("plot")),
tabPanel("Table", tableOutput("table"))
)))
server<-function(input, output){reactive({})}
shinyApp(ui, server)
I Have created the main panel. However, the Panel with two tabs is opening under the sidebar panel and not on the right hand side of the panel.
The script works but is it possible to open the main panel on the right of the sidebar panel. I request someone to guide me here.
Take a look on this if this okay or not for you..
library(shiny)
ui <- fluidPage(
titlePanel("Graphingtool"),
h3("DB"),
hr(),
sidebarLayout(
sidebarPanel(
fluidRow(
column(5,
ailgn="center",
fileInput("file1", 'DB',
multiple = TRUE,
accept = c("xlsx/xls",".xls",".xlsx"))),# We have added the formats here- will load excel alone- in case csv/txt needed amend here
column(5,
ailgn="center",
HTML('<br/>'),
column(4,downloadButton(outputId = "Downloaddata", label = "Downloader"))
)
),
fluidRow(
column(5,
ailgn="center",
textInput(inputId = 'T',label = 'T'),
textInput(inputId = 'C',label = 'C'),
textInput(inputId = "P", label = "P"),
column(2, offset = 2,
ailgn="center",
actionButton(inputId = "CLS", label = "CLS"))
),
column(5,
ailgn="center",
textInput(inputId = "P", label = "P"),
textInput(inputId = "Y", label = "Y"),
numericInput(inputId = "Numberinput", label = "Ninput", min = -1000000000, max = 1000000000, value = 0,step = 1)
)),
HTML('<br/>'),
fluidRow(
column(5,
ailgn="center",
radioButtons("dist", "Vertical Axis Scale",
c("Linear" = "Linear Reg",
"Log" = "Log reg"))),
column(5,
ailgn="center",
radioButtons("dist", "Horizontal Axis Scale",
c("Linear" = "Linear reg",
"Log" = "Log reg")))
),
fluidRow(
column(5,
ailgn="center",
sliderInput(inputId = "Scale", label = "Scale", min = 0, max = 100,
step = 2.5, value = 1)))
)
,mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("plot")),
tabPanel("Table", tableOutput("table"))
)))
)
server<-function(input, output){reactive({})}
shinyApp(ui, server)
You can tweak the size by adjusting column