I am trying to rendering the data table in Shiny using "DT" option in R. But, not sure, what is wrong with the patch. Tried everything but "the table is not getting displayed on the page". Any help appreciated.
Below is the code for that page -
navbarMenu("Data Tracker", icon = icon("database"),
tabPanel("A", fluid = TRUE,
sidebarLayout(
sidebarPanel(width = 3,
dateRangeInput("daterange1", "Date range:",
start = "2000-01-01",
end = "2010-12-31"),
#### Time Frame and Data Type Selector
selectInput(inputId = "TimeFrame",
choices = c("1","2"),
selected = "1",
width = "220px")
),
fluidRow(
column(12,
box(
title = "Data Secription - ",
closable = TRUE,
width = 12,
status = "primary",
solidHeader = TRUE,
collapsible = TRUE,
p("Box Content")
),
valueBox(10 * 2, "D"),
valueBox(10 * 2, "E"),
valueBox(10 * 2, "F?"),
))),
mainPanel(width = 12,
DT::dataTableOutput("table1")
))
Related
I have a question regarding adding a horizontal and vertical scroll bars to my R Shiny App to display a complete heatmap plot (382 rows and 800 columns). I managed to configure most of the features in the app, however I am confused and stuck how to add a scroll bars since only partial plots are being displayed. After going through few questions in Stack Overflow, I learnt that this issue could be related to html, css and javascript which I am not familiar and some suggested to try with adding options = list(scrollX = TRUE) or 'overflow-x': 'scroll', and 'overflow-y': 'scroll',for horizontal and vertical scroll bar. Please assist me with how the scroll bars can be added horizontally and vertically to view the complete heatmap plot.
Thank you,
Toufiq
Example code UI and Server code is provided below along with the example screenshot of the plot4:
Define UI
ui <- dashboardPage(skin = "green",
dashboardHeader(title = "Test") ,
dashboardSidebar(
sidebarMenu(
menuItem("MENU")
),
sidebarMenuOutput("menu")
),
dashboardBody(
tabItems(
tabItem("gridfingerprint",
fluidRow(
box(width = NULL,solidHeader = TRUE,
plotOutput("plot2", height = 500)
),
fluidRow(
box(width = NULL,solidHeader = TRUE,
plotOutput("plot_map", height = 500))
),
fluidRow(
column(width = 4,
box(width = NULL,status = "warning",
downloadButton("gridplot",label = "Download image")
)
),
column(width = 3, offset = 1,
box(width = NULL, status = "warning",
downloadButton("downloadlist",label = "Download table")
))
)
)
),
tabItem(tabName = "individualfingerprint",
h5("Fingerprint heatmap displaying patterns of annotated modules across individual study subjects"),
fluidRow(
box(width = 12,solidHeader = TRUE,
plotOutput("plot4",height = 1200)
),
fluidRow(
column(width = 4,
box(width = NULL,status = "warning",
downloadButton("downloadindplot",label = "Download image")
)
),
column(width = 3, offset = 1,
box(width = NULL, status = "warning",
downloadButton("individualtable",label = "Download table")
))
)
)),
tabItem("complexplot",
fluidRow(
column(width = 12,
box(width = NULL,solidHeader = TRUE,
plotOutput("plot3",height = 800)),
fluidRow(
column(width = 4,
box(width = NULL,status = "warning",
downloadButton("aggregateplot",label = "Download image")
)
),
column(width = 3, offset = 1,
box(width = NULL, status = "warning",
downloadButton("downloadaggregate",label = "Download table")
))
)
)
))
)
)
)
I added the below code to the plot4 and this resolved the issue.
fluidRow(
box(width = 12,solidHeader = TRUE, (div(style='width:1400px;overflow-x: scroll;height:800px;overflow-y: scroll;',
plotOutput("plot4",height = 1200, width = 2000)))
I am in the process of creating a shiny app for a process at work and am struggling to figure something out on the UI side of the app. I would like to display a data table next to a sidebar menu containing options for the app. The issue is that when I do so, the data table is pushed down below the sidebar panel instead of beside it (see the original data tab).
I found a work around as seen in the suggested tab, but that comes with its own issues. I need to be able to lock the column headers while scrolling through the app and when the data table is inside the box element, I am unable to find a way to do so.
Here is the code to a simplified version of the app.
library(shiny)
library(lubridate)
library(tidyverse)
library(DT)
library(shinydashboard)
library(shinythemes)
library(sortable)
library(reactlog)
ui<- dashboardPage(
#this gives you the name displayed on the tab
dashboardHeader(title = "HHS Resin Purchasing 0.99"),
#this gives you your sidebar (page) options
dashboardSidebar(
sidebarMenu(
menuItem("Original Data", tabName = "original"),
menuItem("Suggested", tabName = "suggested")
)
),
#this is the body of the webpages
dashboardBody(
#this gives you the body options that are displayed on every page
sidebarPanel(width = 2,
h2("Menu Options"),
h4(strong("Upload Data:")),
fileInput("file", "Data", buttonLabel = "Upload..."),
textInput("delim", "Delimiter (leave blank to guess)", ""),
numericInput("skip", "Rows to skip", 0, min = 0),
h4(strong("User Options:")),
selectInput("plant", "Select a Plant", choices =
c("All")),
dateInput("latest_date", "Select the latest W_LEAD date in the data",
value = Sys.Date()),
numericInput("avg_multiple", "Multiple of Daily Useage for Cuttoff",21, min = 1, max = 50),
h4(strong("Download Options:")),
actionButton("complete_orders", "Analysis for plant orders complete"),
actionButton("complete_checks", "Mid month check complete"),
downloadButton("downloadData1", label = "Download Suggested Orders...", class = "btn-block"),
downloadButton("downloadData2", label = "Download Flags...", class = "btn-block"),
downloadButton("downloadData3", label = "Download Full Suggested Orders Data...", class = "btn-block")
),
#This is the actual data that fills those page options listed above
tabItems(
tabItem(tabName = "original",
DT::dataTableOutput(outputId = "preview1")
),
tabItem(tabName = "suggested",
box(title = "Suggested Orders",width = 9, status = "primary", height = "auto",
solidHeader = T, dataTableOutput("preview2"), style = "max-height:800px; overflow-y: scroll;overflow-x: scroll;")
)
)
)
)
server <- function(input, output) {
output$preview1 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20))
})
output$preview2 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20))
})
}
shinyApp(ui, server)
Help in fixing either of the issues outlined above would be very appreciated! Thanks in advance.
I think using the column() function will support your first question of the datatable moving under the sidebar sidebarPanel. Please see example below.
I think the second request of freezing the row header in the datatable can be resolved with the advice found at Freezing header and first column using data.table in Shiny
library(shiny)
library(lubridate)
library(tidyverse)
library(DT)
library(shinydashboard)
library(shinythemes)
library(sortable)
library(reactlog)
ui<- dashboardPage(
#this gives you the name displayed on the tab
dashboardHeader(title = "HHS Resin Purchasing 0.99"),
#this gives you your sidebar (page) options
dashboardSidebar(
sidebarMenu(
menuItem("Original Data", tabName = "original"),
menuItem("Suggested", tabName = "suggested")
)
),
#this is the body of the webpages
dashboardBody(
#this gives you the body options that are displayed on every page
fluidRow(
column(width = 2,
sidebarPanel(width = 2,
h2("Menu Options"),
h4(strong("Upload Data:")),
fileInput("file", "Data", buttonLabel = "Upload..."),
textInput("delim", "Delimiter (leave blank to guess)", ""),
numericInput("skip", "Rows to skip", 0, min = 0),
h4(strong("User Options:")),
selectInput("plant", "Select a Plant", choices =
c("All")),
dateInput("latest_date", "Select the latest W_LEAD date in the data",
value = Sys.Date()),
numericInput("avg_multiple", "Multiple of Daily Useage for Cuttoff",21, min = 1, max = 50),
h4(strong("Download Options:")),
actionButton("complete_orders", "Analysis for plant orders complete"),
actionButton("complete_checks", "Mid month check complete"),
downloadButton("downloadData1", label = "Download Suggested Orders...", class = "btn-block"),
downloadButton("downloadData2", label = "Download Flags...", class = "btn-block"),
downloadButton("downloadData3", label = "Download Full Suggested Orders Data...", class = "btn-block")
)
),
#This is the actual data that fills those page options listed above
column(width = 6,
tabItems(
tabItem(
tabName = "original",
DT::dataTableOutput("preview1",
options = list(dom = 't',
scrollX = TRUE,
paging=FALSE,
fixedHeader=TRUE,
fixedColumns = list(leftColumns = 1, rightColumns = 0)))
),
tabItem(tabName = "suggested",
box(title = "Suggested Orders",width = 9, status = "primary", height = "auto",
solidHeader = T, dataTableOutput("preview2"), style = "max-height:800px; overflow-y: scroll;overflow-x: scroll;")
)
)
)
)
)
)
server <- function(input, output) {
output$preview1 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20)))
})
output$preview2 <- renderDataTable({
DT::datatable(iris, options = list(searching = T, pageLength = 20, lengthMenu = c(5,10,15, 20)))
})
}
shinyApp(ui, server)
I'm facing an issue while deploying my app on Rshiny cloud
I am getting the following error when I run the code below code for UI:
Error in data$Type : object of type 'closure' is not subsettable
I've looked at many issues online but am unable to figure out what is wrong in my code
ui <- semantic.dashboard::dashboard_body(
semantic.dashboard::dashboard_header(color = "blue",title = "Dashboard Demo",inverted = TRUE),
semantic.dashboard::dashboard_sidebar(
# size = "thin", color = "teal",
semantic.dashboard::sidebar_menu(
semantic.dashboard::menu_item(tabName = "Visualization", "Visualization", icon = icon("chart line")),
semantic.dashboard::menu_item(tabName = "RawData", "RawData", icon = icon("table"))
)
),
semantic.dashboard::dashboard_body(
shiny::fluidRow(
column(width = 3, offset =0, div(style = "height:35px"),
selectInput("type",
"Type:",
c("All",
unique(as.character(data$Type))))
),
column(width = 3, offset =0, div(style = "height:35px"),
selectInput("Bname",
"Business Name:",
c("All",
unique(as.character(data$Business_Name))))
),
column(width = 3, offset =0, div(style = "height:35px"),
selectInput("BUnit",
"Business Unit:",
c("All",
unique(as.character(data$Business_Unit))))
),
column(width = 3, offset =0, div(style = "height:35px"),
selectInput("region",
"Region:",
c("All",
unique(as.character(data$Region))))
)
),
semantic.dashboard::tab_items(
selected = 1,
semantic.dashboard::tabItem(
tabName = "Visualization",
# Create a new row for the table.
plotOutput('waterfall')
),
semantic.dashboard::tabItem(
tabName = "RawData",
# Create a new row f
DT::dataTableOutput("table")
),
shiny::downloadButton("downloadData", "Download Raw Data")
)
)
)
I would like that based on a selectInput() which the client can select, the summary of the selected variable will be print in a box. My code for the ui.R is:
box(
title = "Informed Investor",
status = "primary",
solidHeader = TRUE,
width = 6,
selectInput("informedDset", label="Select Category", choices = list("Informed Full" = "InformedFull", "Informed Fact" = "InformedFact", "Informed Fact Positive" = "InformedFact.Pos", "Informed Fact Negative" = "InformedFact.Neg", "Informed Emotions" = "InformedEmotions", "Informed Emotions Fact" = "InformedEmotionsFact"), selected = "Informed Full")
),
box(
title = "Data Table",
status = "warning",
solidHeader = TRUE,
width = 6,
height = 142,
verbatimTextOutput("summaryDset")
)
And my code for server.R:
output$summaryDset <- renderPrint({
summary(input$informedDset)
})
As indicated in the comments, summary returns Length Class Mode 1 character character because the input$informedDset is a character string.
If you want to extract the summary of one selected variable in a dataset you can find an reproducible example below with the iris dataset :
library(shiny)
library(shinydashboard)
ui=fluidPage(
box(title = "Informed Investor",
status = "primary",
solidHeader = TRUE,
width = 6,
selectInput("informedDset", label="Select Category",
choices = list("Sepal.Length"="Sepal.Length",
"Sepal.Width"="Sepal.Width",
"Petal.Length"="Petal.Length",
"Petal.Width"="Petal.Width",
"Species"="Species"), selected = "Sepal.Length")),
box(
title = "Data Table",
status = "warning",
solidHeader = TRUE,
width = 6,
height = 142,
verbatimTextOutput("summaryDset")))
server = function (input,output){
output$summaryDset <- renderPrint({
summary(iris[[input$informedDset]])
})}
shinyApp(ui, server)
Is that what you want to do ?
I'am in the process of creating a shiny dashbord, I create 3 widgets two SelectizeInput and a radioButton, the problem is that when i added the radioButton
this was displayed
ERROR: $ operator is invalid for atomic vectors
NB: the same code it worked once then failed I don't know why
this is the code R concerning the widgets. Can someone help me please
dashboardBody(
tabItems(
tabItem(tabName = "dashboard",h2("Analyse du comportement électoral des citoyens tunisiens", align="center",style = "color:blue"),
fluidRow(
tiltle="filtre",
column(width=4,
box(
title = "Filtre",
status = "primary",
width = 8,
solidHeader = TRUE,
background="navy",
box(
solidHeader = FALSE,
width = 8,
background = "navy" ,
radioButtons("genre", "Genre", list("Homme","Femme","Tous"),"Tous")
),
box(
solidHeader = FALSE,
width = 12,
background = "navy",
selectizeInput("region", label = "Région",
choices = levels(data$REGION),
selected = "Ariana", multiple=TRUE)
),
box(
solidHeader = FALSE,
width = 12,
background = "navy",
selectizeInput("parti", label = "Parti politique",
choices = levels(data$Q99),
selected = "", multiple=TRUE)
),
box(
submitButton("Mettre à jour!",icon("refresh")),
background = "navy"
)
)),