Может кто-нибудь помочь мне, я застрял на том, как фильтровать по дате? Я понятия не имею, как это реализовать.
И я не понимаю, как расположить две скважинные панели рядом друг с другом. Что бы я ни пытался, это выглядело ужасно.
С уважением!
library(shiny)
library(dplyr)
library(DT)
{
ui <- fluidPage(
fluidRow(
list(tags$head(HTML('<link rel="icon", href="fa.svg",
type="image/svg" />'))),
div(style="padding: 0px 0px; width: 0px; height: 0px",
titlePanel(
title="", windowTitle="Dashboard"
)
),
h2(id="title", "Dashboard"),
tags$style(HTML("#title{color: white; background-color: #d52b1e; padding-left: 100px; padding-top: 18px; padding-bottom: 18px;}")) #font-weight: bold;
),
navlistPanel(
tabPanel("D",
fluidRow(
# column(1), ## this put an extra space, dont like the look
column(2,
wellPanel(uiOutput("groups")),
),
),
# fluidRow(
column(2),
column(2,
wellPanel(
dateRangeInput('dateRange',
label = 'Filter op datum',
start = as.Date('2019-01-01') , end = as.Date('2019-12-31')
)
),
),
column(2,
dataTableOutput('my_table')
),
# ),
# column(2)
# ), ## this closes fluidrow below tabPanel
fluidRow(
# column(1),
column(8,
tabsetPanel(type = "tabs",
# Tabbladen voor visueel of tabel
tabPanel("Staafdiagram",
tags$br(),
column(6,highchartOutput(outputId = "barPlot1", width="200%",height="450px")),
# column(6,leafletOutput(outputId = "mapPlot", height=450)),
),
tabPanel("Tabel en cijfers",
tags$br(),
fluidRow(
column(10,
DT::dataTableOutput(outputId = "table1"),
downloadButton("downloadData", "Download")
)
),
tags$br(),
fluidRow(
column(6,p(id="disclaimtable","concept."), tags$style(HTML("#disclaimtable{font-style: italic}")))
)
),
tabPanel("Help",
tags$br(),
fluidRow(column(12
, class = "block"
, div(style = "padding-left:20px;padding-top: 15px; padding-bottom: 15px;"
, fluidRow("concept.")
, fluidRow("Heeft u vragen over dit dashboard of over andere mogelijkheden die u graag zou willen zien, neem dan contact op met: "
, HTML("<a href='mailto:anoniem@bullshit.nl'>anoniem</a>")))
)
),
)
)
),
column(2)
),
),
tabPanel("M"),
tabPanel("Help"),
tabPanel("Toelichting"),
tabPanel("Component 5"),
widths = c(1,10)
), ## this closes the navpanel
fluidRow(tags$br())
)
}
# De server met interactieve input
server <- function(input, output) {
# Data klaarmaken voor barplot
mydata_ <- reactive({
data_ <- df2 #
data_
})
output$my_table <- renderDataTable({
# Filter the data
df__<-my_data_()
df2__%>% filter(AanvDat >= input$dateRange[1] & AanvDat <= input$dateRange[2])
})
output$groups <- renderUI({
df_ <- mydata_()
selectInput(inputId = "grouper", label = "Group variable", choices = c("L","LV","B","Naam","Omsch", "G"), selected = "L")
})
summary_data_ <- reactive({
req(input$grouper)
mydata_() %>%
dplyr::group_by(!!!rlang::syms(input$grouper), Q) %>%
dplyr::summarise(aantal = n()) %>%
dplyr::arrange(desc(aantal)) %>%
top_n(5)
})
output$barPlot1 <- renderHighchart({
data_ <- summary_data_()
hchart(data_, "column", hcaes(x = (!!input$grouper) , y = aantal , group = Q)) %>%
hc_plotOptions(column = list(stacking = "normal"))
})
# Data klaarmaken voor tabel
mydata <- reactive({
data <- df2 #
data
})
# output$groups <- renderUI({
# df <- mydata()
# selectInput(inputId = "grouper", label = "Group variable", choices = c("L","LV","B","Naam","Omsch", "G"), selected = "L")
# })
summary_data <- reactive({
req(input$grouper)
mydata() %>%
dplyr::group_by(!!!rlang::syms(input$grouper)) %>%
dplyr::summarise(aantal = n(),
Q = case_when(sum(Q =="TRUE") == length(Q) ~"JA",
sum(Q == "FALSE") == length(Q) ~"Nee",
TRUE ~ "Beide"),
min_datum = as.Date(as.character(min(AanvDat))),
max_datum = as.Date(as.character(max(AanvDat))),%>%
dplyr::arrange(desc(aantal))
})
output$table1 <- DT::renderDataTable({
DT::datatable(summary_data())
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = function() {
paste("O",Sys.Date(),".csv", sep = "")
},
content = function(file) {
write.csv2(summary_data(), file, row.names = FALSE)
write(paste("
Dashboard-",Sys.Date(),"
Deze tabel is nog in de conceptfase. D"
),file=file,append=TRUE)
}
)
# END
}
# Create Shiny app ----
shinyApp(ui, server)
Надеюсь, мой вопрос достаточно ясен! Заранее спасибо.
они хотят, чтобы я добавил больше текста / подробностей, но я не думаю, что удаление материала делает его лучше следовать.