I'm trying to use the menuSubItem functions to organize my inputs since I'll have a lot. What I'm finding though is that the conditional Panel is minimizing the whole menuItem and not expanding them. And what I'm also seeing is that the body doesn't change when I click on different tabs. Am I using conditionalPanels right?
library(needs)
needs(
shiny,
ggplot2,
tidyverse,
shinydashboard,
DT,
shinycssloaders,
plotly
)
# Define UI for application that draws a histogram
header = dashboardHeader(
# tags$li(class = "dropdown",
# tags$style(".main-header {max-height: 80px}"),
# tags$style(".main-header .logo {height: 80px}")),
#title = tags$img(src='logo.png',height='100',width='200')
)
sidebar = dashboardSidebar(
sidebarMenu(
id = 'panelsbar',
style = '"overflow-y:auto; max-height: 600px; position:relative;"',
menuItem('Data Input', tabName = 'data'),
conditionalPanel(
condition = "input.panelsbar== 'data'",
fileInput(
"file",
"Upload CSV files",
multiple = TRUE,
accept = ("text/comma")
)
),
menuItem('Simulate',tabName = 'sim_tab',
helpText('Adjust Simulation Parameters'),
menuSubItem('Promotion Parameters', tabName = 'promo'),
useShinyjs(),
div(id = 'sidebar_promo',
conditionalPanel("input.panelsbar==='promo'",
radioButtons('promoType',label = 'Promotion Definitions:',
choices =c('Aggregated','Role Defined'),
selected = 'Aggregated',inline=F,width='200px'),
conditionalPanel('input.promoType==="Aggregated"',
sliderInput('promoAll','Set promotion rate:',value = 25,min = 0,max = 100,step = 5),
),
conditionalPanel('input.promoType==="Role Defined"',
helpText('Set Promotion Rates for each role'),
sliderInput(
'promoRole1','Role 1:',value = 25,min = 0,max = 100,step = 5),
sliderInput(
'promoRole2','Role 2:',value = 25,min = 0,max = 100,step = 5),
sliderInput(
'promoRole3','Role 3:', value = 25,min = 0, max = 100, step = 5),
sliderInput(
'promoRole4', 'Role 4:', value = 25, min = 0, max = 100,step = 5)
)
)),
menuSubItem('Candidate Slates', tabName = 'hire'),
div(id='sidebar_hire',
conditionalPanel("input.panelsbar==='hire'",
radioButtons('hireType',label = 'Candidate Slate Definitions:',
choices =c('Aggregated','Role Defined'),
selected = 'Aggregated',inline=F,width='200px'),
conditionalPanel('input.hireType==="Aggregated"',
sliderInput('hireAll','Set candidate slate rates:',value = 25,min = 0,max = 100,step = 5),
),
conditionalPanel('input.promoType==="Role Defined"',
helpText('Set the Candidate Slate Diversity'),
h5('0 = Females, 100 = Males'),
sliderInput(
'hireRole1',
'Role 1:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'hireRole2',
'Role 2:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'hireRole3',
'Role 3:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'hireRole4',
'Role 4:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'hireRole5',
'Role 5:',
value = 25,
min = 0,
max = 100,
step = 5
)
))),
menuSubItem('Turnover Rates', tabName = 'turnover'),
div(id='sidebar_turnover',
conditionalPanel("input.panelsbar==='turnover'",
radioButtons('turnoverType',label = 'Turnover Definitions:',
choices =c('Aggregated','Role Defined'),
selected = 'Aggregated',inline=F,width='200px'),
conditionalPanel('input.turnoverType==="Aggregated"',
sliderInput('turnoverAll','Set turnover rate:',value = 25,min = 0,max = 100,step = 5),
),
conditionalPanel(
"input.turnoverType==='Role Defined'",
helpText('Set the turnover rate for each role'),
sliderInput(
'turnoverRole1',
'Role 1:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'turnoverRole2',
'Role 2:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'turnoverRole3',
'Role 3:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'turnoverRole4',
'Role 4:',
value = 25,
min = 0,
max = 100,
step = 5
),
sliderInput(
'turnoverRole5',
'Role 5:',
value = 25,
min = 0,
max = 100,
step = 5
)
))
)),
actionButton('go','Run')
))
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'data',
wellPanel(DT::dataTableOutput('table'))),
tabItem(
tabName = 'sim_tab',
fluidRow(h2('Average of Distribution',align = 'center')),
fluidRow(h5('Below is a table of the average distribution from the simulation',align='center')),
fluidRow(
wellPanel(
DT:::dataTableOutput('simDataTable') %>%
withSpinner(color="#ee1100")
),
fluidRow(h2('Average of Distribution',align = 'center')),
fluidRow(
wellPanel(
plotlyOutput('simPlot')
)
))
)
))
ui = shinydashboard::dashboardPage(header, sidebar, body, skin = 'red',
tags$head(tags$style(
HTML(".sidebar {
height: 90vh; overflow-y: auto;
}")
)))
There is no need to use conditionalPanel for the initial menuItem. You can try this...
shinydashboard::dashboardSidebar(width=300,
useShinyjs(),
sidebarMenu(id = "panelsbar",
#style = '"overflow-y:auto; max-height: 600px; position:relative;"',
menuItem("Home", tabName = "home", icon = icon("home")),
menuItem('Data Input', # tabName = 'data1' ,
#conditionalPanel( condition = "input.panelsbar== 'data'",
menuSubItem(
fileInput(
"file",
"Upload CSV files",
multiple = TRUE,
accept = ("text/comma")
),tabName = 'data' )
),
menuItem("Simulate", tabName = 'sim_tab',
helpText('Adjust Simulation Parameters'),
menuItem("Promotion Parameters", tabName = 'promo' ,
# div(id = 'sidebar_promo',
# conditionalPanel("input.panelsbar==='promo'",
radioButtons('promoType', label = 'Promotion Definitions:',
choices =c('Aggregated','Role Defined'),
selected = 'Aggregated',inline=F,width='200px'),
conditionalPanel('input.promoType==="Aggregated"',
sliderInput('promoAll','Set promotion rate:',value = 25,min = 0,max = 100,step = 5),
),
conditionalPanel('input.promoType==="Role Defined"',
helpText('Set Promotion Rates for each role'),
sliderInput(
'promoRole1','Role 1:',value = 25,min = 0,max = 100,step = 5),
sliderInput(
'promoRole2','Role 2:',value = 25,min = 0,max = 100,step = 5),
sliderInput(
'promoRole3','Role 3:', value = 25,min = 0, max = 100, step = 5),
sliderInput(
'promoRole4', 'Role 4:', value = 25, min = 0, max = 100,step = 5)
)
#)
#),
), ## new line
menuItem('Candidate Slates', tabName = 'hire'),
...
Related
I'm currently building an application in R-Shiny and having troubles with the location of the graph since I've added tabs to the application. I want to move the graph from the first tab from below the inputs to the right of them. I'm currently getting the following message from R.
bootstrapPage(position =) is deprecated as of shiny 0.10.2.2. The 'position' argument is no longer used with the latest version of Bootstrap. Error in tabsetPanel(position = "right", tabPanel("Drawdown Plot", plotOutput("line"), : argument is missing, with no default
Any help would be greatly appreciated! Code is below
ui <- fluidPage(
titlePanel("Drawdown Calculator"),
theme = bs_theme(version = 4, bootswatch = "minty"),
sidebarPanel(
numericInput(inputId = "pot",
label = "Pension Pot",
value = 500000, min = 0, max = 2000000, step = 10000),
numericInput(inputId = "with",
label = "Withdrawal Amount",
value = 40000, min = 0, max = 200000, step = 1000),
numericInput(inputId = "age",
label = "Age", value = 65, max = 90, min = 40),
sliderInput(inputId = "int",
label = "Interest",
value = 4, max = 15, min = 0, step = 0.1)),
mainPanel(
tabsetPanel(position = "right",
tabPanel("Drawdown Plot", plotOutput("line"),
p("This drawdown calculator calculates a potential drawdown outcome")),
tabPanel ("Breakdown of Drawdown Withdrawals",
tableOutput("View")),
))
)
Try this code -
library(shiny)
library(bslib)
ui <- fluidPage(
titlePanel("Drawdown Calculator"),
theme = bs_theme(version = 4, bootswatch = "minty"),
sidebarPanel(
numericInput(inputId = "pot",
label = "Pension Pot",
value = 500000, min = 0, max = 2000000, step = 10000),
numericInput(inputId = "with",
label = "Withdrawal Amount",
value = 40000, min = 0, max = 200000, step = 1000),
numericInput(inputId = "age",
label = "Age", value = 65, max = 90, min = 40),
sliderInput(inputId = "int",
label = "Interest",
value = 4, max = 15, min = 0, step = 0.1)),
mainPanel(
tabsetPanel(
tabPanel("Drawdown Plot",
p("This drawdown calculator calculates a potential drawdown outcome"),
tableOutput("View")),
tabPanel("Breakdown of Drawdown Withdrawals",
plotOutput("line"))
))
)
server <- function(input, output) {}
shinyApp(ui, server)
I'm trying show the TableOuput first, according to the user inputs, there are: "media" and "desv_pad". When I click on the button "rodar", the table is showed. After that, I need to delete the output Table "saida" when a press the actionButton "reset", then my interface will be clean to receive new inputs and run again, but my code isn't working.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel("Inputs",
numericInput(inputId = "media",
label = "Mean:",
value = 0,
min = 0),
numericInput(inputId = "desv_pad",
label = "Standard Deviation:",
value = 1,
min = 0),
numericInput(inputId = "delta",
label = "Mean Shift:",
value = 0.5,
min = 0,
max = 2,
step = 0.25),
numericInput(inputId = "n",
label = "Size of Samples:",
value = 5,
min = 0,
max = 10,
step = 1),
numericInput(inputId = "alfa",
label = "% alpha",
value = 0.27,
min = 0,
step = 0.1),
numericInput(inputId = "beta",
label = "% beta:",
value = 97,
min = 0,
step = 0.1),
numericInput(inputId = "xb_teo",
label = "%X max:",
value = 10,
min = 0),
actionButton("rodar", "Run")
),
mainPanel(
tags$h4( tableOutput('saida')),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
actionButton("reset", "Reset")
)
)
)
server <- function(input, output)
{
v <- reactiveValues(data = NULL)
observeEvent(input$rodar,{
output$saida <- renderTable({ #resultado,
passo_n <- 0
#Recebendo os inputs:
n <-input$n
Xb_teo <- input$xb_teo# input Xbarra percentual teorico definido pelo usuario
med<- input$media #input da media
desv_pad <- input$desv_pad #input do desvio padrao
alfa <- input$alfa #% determinado pelo usuario
beta <- input$beta #% determinado pelo usuario
delta <- input$delta
v$data <- c(n, Xb_teo,med, desv_pad, alfa, beta, delta)
})
})
observeEvent(input$reset, {
v$data <- NULL
})
output$saida <- renderTable({
if(is.null(v$data)) return()
v$data
})
}
shinyApp(ui = ui, server = server)
There are lot of undefined variables in your code. I have replaced them with constants for now.
Put output$saida outside observeEvent. Try this app :
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel("Inputs",
numericInput(inputId = "media",
label = "Mean:",
value = 0,
min = 0),
numericInput(inputId = "desv_pad",
label = "Standard Deviation:",
value = 1,
min = 0),
numericInput(inputId = "delta",
label = "Mean Shift:",
value = 0.5,
min = 0,
max = 2,
step = 0.25),
numericInput(inputId = "n",
label = "Size of Samples:",
value = 5,
min = 0,
max = 10,
step = 1),
numericInput(inputId = "alfa",
label = "% alpha",
value = 0.27,
min = 0,
step = 0.1),
numericInput(inputId = "beta",
label = "% beta:",
value = 97,
min = 0,
step = 0.1),
numericInput(inputId = "xb_teo",
label = "%X max:",
value = 10,
min = 0),
actionButton("rodar", "Run")
),
mainPanel(
tags$h4( tableOutput('saida')),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
tags$br(),
actionButton("reset", "Reset")
)
)
)
server <- function(input, output)
{
v <- reactiveValues(data = NULL)
observeEvent(input$rodar,{
passo_n <- 0
#Recebendo os inputs:
n <-input$n
Xb_teo <- input$xb_teo# input Xbarra percentual teorico definido pelo usuario
med<- input$media #input da media
desv_pad <- input$desv_pad #input do desvio padrao
alfa <- input$alfa #% determinado pelo usuario
beta <- input$beta #% determinado pelo usuario
delta <- input$delta
v$data <- c(n, Xb_teo,med, desv_pad, alfa, beta, delta)
})
observeEvent(input$reset, {
v$data <- NULL
})
output$saida <- renderTable({
v$data
})
}
shinyApp(ui = ui, server = server)
I am building a shinydashboard app, and I want to get one box within two rows (see image below).
https://imgur.com/ilNn11M
I tried to mix column and rows, but i didn't manage du get this result.
Here is my ui test :
fluidRow(
box(
width = 3,
title = "Analyses",
dataTableOutput("ind_ana") %>% withSpinner(type = getOption("spinner.type", default = 6))
),
box(
width = 3,
title = "Limites de quantification",
dataTableOutput("ind_lq") %>% withSpinner(type = getOption("spinner.type", default = 6))
),
box(width = 3,
title = "Valeurs de références",
dataTableOutput("tabFnade")
),
box(width = 3,
title = "Seuils",
splitLayout(
numericInput("seuil1", NULL, value = 0, min = 0, max =0),
colourInput("col1", NULL, "blue")
),
splitLayout(
numericInput("seuil2", NULL, value = 0, min = 0, max =0),
colourInput("col2", NULL, "green")
),
splitLayout(
numericInput("seuil3", NULL, value = 0, min = 0, max =0),
colourInput("col3", NULL, "yellow")
),
splitLayout(
numericInput("seuil4", NULL, value = 0, min = 0, max =0),
colourInput("col4", NULL, "orange")
),
splitLayout(
numericInput("seuil5", NULL, value = 0, min = 0, max =0),
colourInput("col5", NULL, "red")
),
splitLayout(
numericInput("seuil6", NULL, value = 0, min = 0, max =0),
colourInput("col6", NULL, "brown")
)
)
Can I make this with shinydashboard, maybe with css ?
I manage to do it with shiny dashboard using two big box slided into 3 columns :
fluidRow(
column(width = 9,
box(
title = "Tab1", width = NULL, height = "200px",
column(width = 4, "Tab1"),
column(width = 4, "Tab2"),
column(width = 4, "Tab3")
),
box(
title = "Tab4", width = NULL, height = "200px"
)
),
column(width = 3,
box(
title = "Tab5", width = NULL, height = "400px"
)
)
)
I am using library(ygdashboard) from here for build a Right Side control bar in Shiny Apps. Which most like AdminLTE.io template.
In AdminLTE.io Right Side Control Bar there is an option,by enabling it the content part will adjust the width and display accordingly.
Can any body help me out here?? My Try:
Mycode:
UI.R
library(shinydashboard)
library(shinyjs)
library(plotly)
library(shinyWidgets)
library(ygdashboard)
library(c3)
library(flexdashboard)
source("helper.R")
dashboardPage( skin = 'green',
dashboardHeader(title=" Test Stand Report",
tags$li(a(img(src = 'logo.jfif',
height = "30px"),
style = "padding-top:10px; padding-bottom:10px;"),
class = "dropdown")),
dashboardSidebar(sidebarMenu(id="tabs",
menuItem("DashBoard", tabName = "dashboard", icon = icon("dashboard", lib = "glyphicon")),
menuItem("Drill Report",icon = icon("link",lib = "glyphicon"),
menuSubItem("Test Stand",tabName = "test_stand",icon = icon("database")),
menuSubItem("Test Code",tabName = "test_code",icon = icon("folder-open",lib = "glyphicon")),
menuSubItem("Product Based",tabName = "product_based",icon = icon("database")),
menuSubItem("Time Shift",tabName = "time_shift",icon = icon("folder-open",lib = "glyphicon"))
)
)
),
dashboardBody(
shinyjs::useShinyjs(),
tabItems(
tabItem(tabName = "dashboard",
fluidRow(
column(3,
gaugeOutput("gauge1",width = "100%", height = "auto"),
uiOutput("infobox_1")
#gaugeOutput("gauge2",width = "100%", height = "auto")
),
column(3,
gaugeOutput("gauge3",width = "100%", height = "auto"),
uiOutput("infobox_2")
#gaugeOutput("gauge4",width = "100%", height = "100px")
),
column(3,
gaugeOutput("gauge5",width = "100%", height = "auto"),
uiOutput("infobox_3")
#gaugeOutput("gauge6",width = "100%", height = "auto")
),
column(3,
gaugeOutput("gauge7",width = "100%", height = "auto"),
uiOutput("infobox_4")
#gaugeOutput("gauge8",width = "100%", height = "auto")
)
),
fluidRow(
)
),
tabItem(tabName = "test_stand",
fluidRow(
column(3,
wellPanel(
uiOutput("test_stand_select")
)
),
column(3,uiOutput("count_test_code")),
column(3,uiOutput("count_vehicle_tested")),
column(3,uiOutput("count_vehicle_failed"))
),
fluidRow(
box(title = "Success Faliure Ratio",solidHeader = TRUE,width = 4,collapsible = TRUE,height = 'auto',status="success",
plotlyOutput("sucess_faliure_pie",height = '250px')
#tableOutput("sucess_faliure_pie")
),
box(title = "Success Faliure rate with Test_Code",solidHeader = TRUE,width = 8,collapsible = TRUE,height = 'auto',status="success",
#tableOutput("test_stand_test_code_rel")
plotlyOutput("test_stand_test_code_rel",height = '250px')
)
)
),
tabItem(tabName = 'test_code',
fluidRow(
)
)
)
),
dashboardFooter(mainText = "My footer", subText = "2018"),
dashboardControlbar()
)
Server.R
library(shiny)
library(shinyjs)
library(RMySQL)
library(DT)
library(devtools)
library(woe)
library(sqldf)
library(plyr)
library(shinyalert)
source("helper.R")
shinyServer(function(input, output,session) {
######################### Date range Selection ################################
output$date_range<-renderUI({
if(input$tabs=="test_stand")
{
dateRangeInput("selected_date_range_test_stand", "Select Time Period:",
start = Sys.Date()-10,
end = Sys.Date(),
max=Sys.Date())
}
else if(input$tabs=="test_code")
{
dateRangeInput("selected_date_range_test_code", "Select Time Period:",
start = Sys.Date()-10,
end = Sys.Date(),
max=Sys.Date())
}
else if(input$tabs=="product_based")
{
dateRangeInput("selected_date_range_product_based", "Select Time Period:",
start = Sys.Date()-10,
end = Sys.Date(),
max=Sys.Date())
}
})
##########################report buttom ################################
output$action_btn<-renderUI({
if(input$tabs=="test_stand")
{
actionBttn("get_data_test_stand","Get Report")
}
else if(input$tabs=="test_code")
{
actionBttn("get_data_test_code","Get Report")
}
else if(input$tabs=="product_based")
{
actionBttn("get_data_product_based","Get Report")
}
})
#########################product group selection##################################
output$pg_list<-renderUI({
if(input$tabs=="test_stand")
{
selectInput("selected_pg_test_stand","Select your Product Group",choices = c("Back"="BHO","SKD"="SKD","ABC"="ABC"))
}
else if(input$tabs=="test_code")
{
selectInput("selected_pg_test_code","Select your Product Group",choices = c("Back"="BHO","SKD"="SKD","ABC"="ABC"))
}
else if(input$tabs=="product_based")
{
selectInput("selected_pg_product_based","Select your Product Group",choices = c("Back"="BHO","SKD"="SKD","ABC"="ABC"))
}
})
#############################top 8 gauge################################
output$gauge1<-renderGauge({
gauge(0.5,
min = 0,
max = 1,
sectors = gaugeSectors(success = c(0.5, 1),
warning = c(0.3, 0.5),
danger = c(0, 0.3)),label = 'Gauge 1')
})
output$infobox_1<-renderInfoBox({
infoBox("Total Test Stand Active",10 * 2,subtitle = "Subtitle", icon = icon("credit-card"),fill = TRUE,color = "yellow")
})
output$gauge3<-renderGauge({
gauge(0.7,
min = 0,
max = 1,
sectors = gaugeSectors(success = c(0.5, 1),
warning = c(0.3, 0.5),
danger = c(0, 0.3)),label = 'Gauge 3')
})
output$infobox_2<-renderInfoBox({
infoBox("Total Test Code Running ",10 * 2,subtitle = "Subtitle" ,icon = shiny::icon("bar-chart"),color = "fuchsia",width = 4,fill = TRUE)
})
output$gauge5<-renderGauge({
gauge(0.6,
min = 0,
max = 1,
sectors = gaugeSectors(success = c(0.5, 1),
warning = c(0.3, 0.5),
danger = c(0, 0.3)),label = 'Gauge 5')
})
output$infobox_3<-renderInfoBox({
infoBox(
"Total Vehicle Tested", "80%",subtitle = "Subtitle", icon = icon("list"),
color = "green", fill = TRUE
)
})
output$gauge7<-renderGauge({
gauge(0.3,
min = 0,
max = 1,
sectors = gaugeSectors(success = c(0.5, 1),
warning = c(0.3, 0.5),
danger = c(0, 0.3)),label = 'Gauge 7')
})
output$infobox_4<-renderInfoBox({
infoBox("Total Vehicle Passed ",10 * 2,subtitle = "Subtitle", icon = icon("check"),fill = TRUE, color = 'orange')
})
#############################test_stand value_box########################
})
Helper.R (from the link)
dashboardControlbar <- function() {
withTags(
div(
id = "right_sidebar",
# Control Sidebar Open
aside(class = "control-sidebar control-sidebar-dark",
# # # # # # # #
#
# Navigation tabs
#
# # # # # # # #
ul(class = "nav nav-tabs nav-justified control-sidebar-tabs",
# first tabs
li(class = "active",
a(href = "#control-sidebar-first-tab", `data-toggle` = "tab",
i(class = "fa fa-sliders")
)
),
# second tabs
li(
a(href = "#control-sidebar-second-tab", `data-toggle` = "tab",
i(class = "fa fa-search")
)
),
# third tab
li(
a(href = "#control-sidebar-third-tab", `data-toggle` = "tab",
i(class = "fa fa-paint-brush")
)
)
),
# # # # # # # #
#
# Tab Panels
#
# # # # # # # #
div(class = "tab-content",
#########################
# First tab content #
#########################
div(class = "tab-pane active", id = "control-sidebar-first-tab",
h3(class = "control-sidebar-heading", "Controller"),
# write elements here
uiOutput("date_range"),
#textOutput("date_validate"),
uiOutput("pg_list"),
uiOutput("action_btn")
#actionBttn("get_data","Get Report")
),
#########################
# Second tab content #
#########################
div(class = "tab-pane", id = "control-sidebar-second-tab",
h3(class = "control-sidebar-heading", "Search"),
# write other elements here
selectInput("selected_search_topic","Select Content Type to Seacrh",choices = c("Test Stand","Test Code","Product")),
searchInput("searchtext","Enter your Search Topic Here", placeholder = "A placeholder",btnSearch = icon("search"),btnReset = icon("remove"))
),
#########################
# Third tab content #
#########################
div(class = "tab-pane", id = "control-sidebar-third-tab",
# third tab elements here
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp")
)
)
)
),
# control-sidebar
# Add the sidebar background. This div must be placed
# immediately after the control sidebar
div(class = "control-sidebar-bg", "")
)
)
}
Within shiny how would I go about updating values within a DT table without it repainting the entire table and thus flickering on each update.
The following example compares both the standard tableOutput with DT::dataTableOutput.
Note the flickering on each update of dataTableOutput.
Is there away to avoid this and have a smoother user interaction? ui.R and server.R example below.
require(shiny);require(DT)
shinyUI(fluidPage(
titlePanel("Sliders"),
sidebarLayout(
sidebarPanel(
sliderInput(
"integer", "Integer:",
min = 0, max = 1000, value = 500
),
sliderInput(
"decimal", "Decimal:",
min = 0, max = 1, value = 0.5, step = 0.1
),
sliderInput(
"range", "Range:",
min = 1, max = 1000, value = c(200,500)
),
sliderInput(
"format", "Custom Format:",
min = 0, max = 10000, value = 0, step = 2500,
pre = "$", sep = ",", animate = TRUE
),
sliderInput(
"animation", "Looping Animation:", 1, 2000, 1,
step = 10, animate =
animationOptions(
interval = 300, loop = TRUE,
playButton = "PLAY", pauseButton = "PAUSE"
)
)
),
mainPanel(tableOutput("values"),
DT::dataTableOutput('DTtable'))
)
))
shinyServer(function(input, output) {
sliderValues <- reactive({
data.frame(
Name = c("Integer",
"Decimal",
"Range",
"Custom Format",
"Animation"),
Value = as.character(
c(
input$integer,
input$decimal,
paste(input$range, collapse = ' '),
input$format,
input$animation
)
),
stringsAsFactors = FALSE
)
})
output$values <- renderTable({
sliderValues()
})
output$DTtable = DT::renderDataTable(rownames = FALSE,
{
sliderValues()
},
options = list(processing = FALSE))
})
It looks like the ideal solution would be to implement the reload functionality:
https://datatables.net/reference/api/ajax.reload()
Any advice on how to do this?