My problem is that I told shiny to take all the line (12 columns) to print c7 box but it only uses half of it. Can anyone figure out what is the problem? Following is my code:
library(shinydashboard)
library(shiny)
library(readr)
library(rsconnect)
header=dashboardHeader(title="App")
sidebar=dashboardSidebar(sidebarMenu(
menuItem("Stack", tabName = "a", icon = icon("dashboard"))))
c7=column(12,box(title="Prediction Box",status="warning",solidHeader=FALSE,
textInput("text", label = h3("Write something :"), value = ""),actionButton("do","Go")))
body=dashboardBody(tabItems(tabItem(tabName="a",fluidRow(c7))))
ui <- dashboardPage(header,sidebar,body)
server <- function(input, output){
}
shinyApp(ui,server)
By default, if you're not specifying the width of the box it will be set to 6. Have a look at ?box
E.g.:
library(shinydashboard)
library(shiny)
header=dashboardHeader(title="App")
sidebar=dashboardSidebar(sidebarMenu(menuItem("Stack", tabName = "a", icon = icon("dashboard"))))
?box
c7=column(12,box(width=12,title="Prediction Box",status="warning",solidHeader=FALSE,
textInput("text", label = h3("Write something :"), value = ""),actionButton("do","Go")))
body=dashboardBody(tabItems(tabItem(tabName="a",fluidRow(c7))))
ui <- dashboardPage(header,sidebar,body)
server <- function(input, output){
}
shinyApp(ui,server)
Related
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'm trying to increase the height of a select input inside the sidebar of a shinydashboard. When started, the height is correct, but immediatly, the size decrease to the default one.
I try use tags$style :
tags$style(type='text/css', "#input_id {height: 100px}")
Here is a reproductible example :
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
ui <- dashboardPage(
title = "Plan de gestion",
dashboardHeader(
title = "test"
),
dashboardSidebar(
sidebarMenu(
selectInput(inputId = "test_size", label = "Test", choices = c("A", "B", "C")),
tags$style(type='text/css', "#choix_param {height: 100px}")
)
),
dashboardBody(
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
}
# Run the application
shinyApp(ui = ui, server = server)
Thank you for your help.
I find the solution :
tags$head(tags$style(HTML("#test_size+ div>.selectize-input {min-height: 500px}")))
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)
In my current application I am using a navlistPanel similar to the one below and I was wondering whether it would be possible to add a selectInput UI element to the navlist?
I have tried this in my ui.R but it doesn't work:
fluidPage(
titlePanel("Application Title"),
navlistPanel(
"Header",
tabPanel("First"),
tabPanel("Second"),
tabPanel("Third")
# selectInput(inputId, label, choices, selected = NULL) <- I've tried this but it doesn't work
)
)
Any solutions/workarounds are welcome.
I was wondering whether using sidebarLayout + sidebarPanel would work where the sidebarPanel imitates the behaviour of a navlistPanel but wasn't able to implement it.
A clean solution will be difficult, but how about something like this:
library(shiny)
shinyApp(
ui <- fluidPage(
titlePanel("Application Title"),
navlistPanel("Header", id = "navOut",
tabPanel("First", "First"),
tabPanel(selectInput("navSel", "Selection:", c("b", "c")), textOutput("txt"))
)
),
server <- shinyServer(function(input, output){
output$txt <- renderText(input$navSel)
})
)
If you are okay with using shinydashboard, it is fairly simple.
library(shiny)
library(shinydashboard)
rm(list=ls)
######/ UI Side/######
header <- dashboardHeader(title = "Test")
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("First Tab",tabName = "FTab", icon = icon("globe")),
menuItem("Second Tab",tabName = "STab", icon = icon("star"))
),
selectInput("navSel", "Selection:", c("b","c"))
)
body <- dashboardBody()
ui <- dashboardPage(header, sidebar, body)
######/ SERVER Side/######
server <- function(input, output, session) {
}
shinyApp(ui, server)
I have an existing Shiny script with standard widgets from the Shiny library. Now I wish to add something to show temperature on a graphical scale? This would be a read-only value, so it wouldn't make sense to use a slider unless the slider can be locked and only changed programatically. Is that possible? If not, what are other suggestions?
To clarify:
Is it possible to have a Shiny slider as read only. The user can not slide it but it can be programmatically changed. Here is a Shiny slider:
library(shiny)
ui <- fluidPage(
sliderInput("aa", "Temp",
min = -20, max = 20,
value = 10, step = 10)
)
server <- function(input, output) { }
shinyApp(ui, server)
I'm not familiar with Shiny Dashboard but I saw taskItem. Can these be "dropped in" and used with a normal Shiny app that uses fluidPage, sidebarPanel, mainPanel? How does one remove the bullet point and the percentage? Here is an example of a taskItem.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
taskItem(value = temp <- 89, color = "red",
"Temp"
))
)
server <- function(input, output) { }
temp <- 89
shinyApp(ui, server)
AFAIK, sliderInput cannot be used as an output. However here's a potential solution using progressBar from shinyWidgets package
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
h3("Sidebar")
),
mainPanel(
br(), br(), br(),
progressBar("tempbar", value = 0, title = "Temperature", status = "danger")
)
)
)
server <- function(input, output, session) {
temp <- 89
updateProgressBar(session, id = "tempbar", value = temp)
}
shinyApp(ui, server)
shiny app with temperature bar
Replace temp in server with whatever calculated value you might have. For fixed temperature value just set it in ui, no need to use updateProgressBar. By default progressBar is scaled from 0-100. To modify see documentation for it.
You can use updateSliderInput to achieve such an behaviour. Couple this with shinyjs::disabled and you get what you want. I would however look for a less hackish solution:
library(shiny)
library(shinyjs)
ui <- fluidPage(
## add style to remove the opacity effect of disabled elements
tags$head(
tags$style(HTML("
.irs-disabled {
opacity: 1
}")
)
),
useShinyjs(),
disabled(sliderInput("aa", "Temp",
min = -20, max = 20,
value = 10, step = 10)),
actionButton("Change", "Change")
)
server <- function(input, output, session) {
observeEvent(input$Change, {
new_temp <- sample(seq(-20, 20, 10), 1)
updateSliderInput(session, "aa", value = new_temp)
})
}
shinyApp(ui, server)