I am trying to capture two different 'dateInput()' and calculate number of days in shinyApp.
Can someone help me on this, please?
My code:
library(shiny)
library(shinydashboard)
ui <- shinyUI(dashboardPage(
dashboardHeader(title = "Leave"),
dashboardSidebar(),
dashboardBody(
column(4, dateInput('st', "Start Date", format = "yyyy-mm-dd", width = '200px')),
column(4, dateInput('ed',"End Date", format = "yyyy-mm-dd", width = '200px')),
column(4, valueBoxOutput('caldif'))
)
))
server <- shinyServer(function(input,output,session){
output$caldif <- renderValueBox("Days",input$st - input$ed)
})
shinyApp(ui,server)
The main issue is with the call of renderValueBox. It requires a valueBox() inside it. difftime is probably the best function to calculate time differences.
library(shiny)
library(shinydashboard)
ui <- shinyUI(dashboardPage(
dashboardHeader(title = "Leave"),
dashboardSidebar(),
dashboardBody(
column(4, dateInput('st', "Start Date", format = "yyyy-mm-dd", width = '200px')),
column(4, dateInput('ed',"End Date", format = "yyyy-mm-dd", width = '200px')),
column(4, valueBoxOutput('caldif', width = 8))
)
))
server <- shinyServer(function(input,output,session){
output$caldif <- renderValueBox({
#valueBox needed here
#difftime will calculate the time difference
valueBox('Days', as.character(difftime(input$ed, input$st)))
})
})
shinyApp(ui,server)
Output:
Related
ConditionalPanel seems not working with shinydashboard
the input variables are working as shown, but I just can't turn off the slideInput under the conditionalPanel chunk.
quite odd to me, please advise.
Here is my top example
library(shiny)
library(shinydashboard)
ui <-
dashboardPage(
dashboardHeader(title = ""),
dashboardSidebar(
checkboxInput("chk", label = "checkBox",value = FALSE ),
conditionalPanel(condition = "input.chk ==TRUE",
sliderInput("slide", label = "test", min = 0, max = 10, value = 5))
),
dashboardBody(
textOutput("result"),
textOutput("checked")
)
)
server <-
function(input, output, session) {
result <- reactive(ifelse(input$slide >5, " greater than 5", "smaller than 5"))
output$result <- renderText(result())
output$checked <- renderText(input$chk)
}
shinyApp(ui, server)
After few hours of searching, the answer turned out to be really straightforeward.
condition = "input.chk ==1"
and solved my question.
New to R Shiny. When I am trying to implement a valueBox using a reactive function, where the reactive function changes through choices of column names, based off of user select, to then where I would like to produce the maximum from the selected column.
Had an array of errors from cannot find object "Ordered_Product_Sales" even though it was clearly there to cannot apply non function.
Here is my code
library(shinythemes)
library(shiny)
library(plotly)
library(lubridate)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(skin = "black", #theme = shinytheme("cyborg"),
dashboardHeader("Metric Tracker"),
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "Dashboard", icon = icon("city"))))
dashboardBody(fluidRow(
tabItems(
tabItem(tabName = "Dashboard",
box(width = 4,title = "Inputs", solidHeader = TRUE, status = "warning", selectInput("value", "1st Value to Track:" , choices = c("Units_Ordered", "Buy_Box_Percentage", "Ordered_Product_Sales", "Session_Percentage","aov"), selected = "Ordered_Product_Sales", multiple = FALSE, selectize = TRUE)
valueBoxOutput("max"), valueBoxOutput("min", width = 3)
),
server <- function(input, output){
g <- reactive({
(input$value)
})
output$max <- renderValueBox({
#maxi <- max(metricx2[,get(g())])
valueBox(maxi, subtitle = "Max")
I just simply want to display the maximum value from the column that has been selected in selectInput. The reactive switches between the names of the columns/selectInput choices.
Metricx2 is the data I want to pull the maximum value from.
If you need additional code let me know as this is only a snippet and i could have left something informative out.
Thanks for the help, I'm trying.
You don't show enough code for me to see what the problem is. Here is a minimal working example:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic boxes"),
dashboardSidebar(
selectInput('column', 'Column:', names(mtcars))
),
dashboardBody(
valueBoxOutput("vbox")
)
)
server <- function(input, output) {
output$vbox <- renderValueBox({
valueBox(
paste('Maximum of', input$column),
max(mtcars[[input$column]])
)
})
}
shinyApp(ui, server)
I am using sliderTextInput from the shinyWidgets package. I am having trouble making the labels readable.
To begin with, they are too small, which I have fixed using css. However, now the labels overlap so it is hard to read them.
I would like to be able to do one or both of the following:
Angle the text at 45 or 90 degrees so labels don't overlap.
Reduce the number of labels so there is more space between them. I tried doing this in the choices = argument but that then stops those options from being selected. I think this might be to do with this relating to text rather than numbers, so that might make this impossible.
I have tried using sliderInput instead, but that presents different issues. I almost got it working using this answer, but the additional problem is that I have the input server side, fed in as a uiOutput, which is something I can't change because it's important for a different element. This approach doesn't work with the linked solution - I end up with nice enough labels but the breaks are daily rather than monthly.
Here is a pared down example:
Using sliderTextInput (labels overlapping)
library(shinydashboard)
library(shinyWidgets)
library(shiny)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(type = "text/css", ".irs-grid-text {font-size: 12pt !important;")),
fluidRow(
box(uiOutput("month_selection"))
)
)
)
server <- function(input, output) {
output$month_selection <- renderUI({
sliderTextInput(
inputId = "month_select",
label = "",
grid = TRUE,
force_edges = TRUE,
choices = seq(from = as.Date("2017-01-01"), to = as.Date("2019-12-31"),by = 30)
)
})
}
shinyApp(ui, server)
Using sliderInput (doesn't run)
library(shinydashboard)
library(shinyWidgets)
library(shiny)
monthStart <- function(x) {
x <- as.POSIXlt(x)
x$mday <- 1
as.Date(x)
}
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(type = "text/css", ".irs-grid-text {font-size: 12pt !important;")),
fluidRow(
box(uiOutput("month_selection"))
)
)
)
server <- function(input, output) {
output$month_selection <- renderUI({
sliderInput(
inputId = "month_select",
label = "",
min = as.Date("2017-01-01"),
max = as.Date("2019-12-31"),
value = as.Date("2019-12-31"),
timeFormat = "%b %Y",
animate = TRUE
)
})
sliderMonth <- reactiveValues()
observe({
sliderMonth$Month <- as.character(monthStart(input$month_select))
})
}
shinyApp(ui, server)
> Warning: Error in as.POSIXlt.default: do not know how to convert 'x' to class “POSIXlt”
Solution (credits go to Victor Perrier) taken from the shinyWidgets issue created by the asker.
Text can be roteted with nothing more than CSS. The class .irs-grid-text identifies the labels of the sliderTextInput widget. With transform the text can be rotated so that it does not overlap.
library(shinydashboard)
library(shinyWidgets)
library(shiny)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
tags$head(tags$style(
type = "text/css",
".irs-grid-text {font-size: 12pt !important; transform: rotate(-90deg) translate(-30px);"
)),
fluidRow(
box(uiOutput("month_selection"), height = "200px")
)
)
)
server <- function(input, output) {
output$month_selection <- renderUI({
sliderTextInput(
inputId = "month_select",
label = "",
grid = TRUE,
force_edges = TRUE,
choices = seq(from = as.Date("2017-01-01"), to = as.Date("2019-12-31"), by = 30)
)
})
}
shinyApp(ui, server)
I'm trying to take input from a slider in shiny and use it in the server section by calling a function on it to obtain information for graphing. However, the input from the slider is not recognized serverside, and throws an error.
Evaluation error: argument "hour" is missing, with no default.
The inputID matches the argument so I don't understand why it wouldn't be able to access it.
library(shiny)
library(shinydashboard)
get_data <- function(foo){return(foo)}
#build shiny app
header <- dashboardHeader(
title="Data"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Charts and Analysis", tabName = "charts", icon = icon("bar-chart-o"),
menuSubItem("Temperature by Time of Day", tabName = "temperatures", icon = NULL) )
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "temperatures",
fluidRow(
box(
title = "Time of Day",
sliderInput(inputId = "hour", label="Hour (military)", min=0, max=23, value=12, step=1)
),
box(plotOutput("series"))
)
)
)
)
ui <- dashboardPage(skin="green", header, sidebar, body)
server <- function(input, output) {
MR <- get_data(strtoi(input$hour))
output$series <- renderPlot({
plot(x=MR, y=MR)
})
}
shinyApp(ui, server)
In a shiny application calls to input parameters must be in a reactive context.
Then we must move the functional assignment into the renderPlot function.
library(shiny)
library(shinydashboard)
get_data <- function(foo){return(foo)}
#build shiny app
header <- dashboardHeader(
title="Data"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Charts and Analysis", tabName = "charts", icon = icon("bar-chart-o"),
menuSubItem("Temperature by Time of Day", tabName = "temperatures", icon = NULL) )
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "temperatures",
fluidRow(
box(
title = "Time of Day",
sliderInput(inputId = "hour", label="Hour (military)", min=0, max=23, value=12, step=1)
),
box(plotOutput("series"))
)
)
)
)
ui <- dashboardPage(skin="green", header, sidebar, body)
server <- function(input, output) {
output$series <- renderPlot({
MR <- get_data(strtoi(input$hour))
plot(x=MR, y=MR)
})
}
shinyApp(ui, server)
The given R shiny script has a selectInput and infobox below, I just want to display the selected value in the selectInput within the infobox in the ui. Please help me with a solution and if possible, kindly avoid any scripting in the sever as I have furthur dependency. If this can be done within the UI, would be great, thanks.
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(title = "Data", status = "primary", solidHeader = T, width = 12,
fluidPage(
fluidRow(
column(2,offset = 0, style='padding:1px;',
selectInput("select the
input","select1",unique(iris$Species)))
))),
infoBox("Median Throughput Time", iris$Species)))
server <- function(input, output) { }
shinyApp(ui, server)
Trick is to make sure you know where the value of the selectInput is being assigned, which is selected_data in my example, this can be referenced within the server code by using input$selected_data.
renderUI lets you build a dynamic element which can be rendered with uiOutput and the output id, in this case, info_box
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
box(title = "Data", status = "primary", solidHeader = T, width = 12,
fluidPage(
fluidRow(
column(2, offset = 0, style = 'padding:1px;',
selectInput(inputId = "selected_data",
label = "Select input",
choices = unique(iris$Species)))
)
)
),
uiOutput("info_box")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$info_box <- renderUI({
infoBox("Median Throughput Time", input$selected_data)
})
}
# Run the application
shinyApp(ui = ui, server = server)