Моя блестящая приборная панель selectInputs работает, как я хочу. Однако, когда дело доходит до обновления (или суммирования) общего значения geom_text при фильтрации более одного из входов True Multiple select на панели инструментов.
selectInput("Select2","Star",choices=NULL,multiple = T)
Текст перекрывается с более чем один selectInput используется. Я хочу «суммировать» общую стоимость, когда вводятся новые данные.
Вот мой код, который я использую с воспроизводимым примером.
library(shiny)
library(datavolley)
library(tidyverse)
ezt<-sample(1:9, 50000, replace = T)
est<-sample(c("A", "B", "C", "D"), 50000, replace = T)
np<-sample(c(1:5), 50000, replace = T)
grade<-sample(c('#', '=', '/', '-', '+'), 50000, replace=T)
block<-sample(c('line', 'angle', 'peel'), 50000, replace = T)
name<-sample(c('CB', 'TW'), 50000, replace = T)
teamname<-sample(c('Gig/Gog'), 50000, replace=T)
opponent<-sample(c('UKR', 'LAT', 'NOR', 'FIN', 'FRA'), 50000, replace = T)
star<-sample(c('4*', '3*', '2*', '1*', '5*'), 50000, replace = T)
sst <- data.frame(ezt, est, np, grade, block, name, teamname, opponent, star)
sst$est <- as.character(sst$est)
sst$teamname <- as.character(sst$teamname)
sst$name <- as.character(sst$name)
sst$opponent <- as.character(sst$opponent)
sst$star <- as.character(sst$star)
sst$np <- as.integer(sst$np)
sst$grade <- as.character(sst$grade)
sst$block <- as.character(sst$block)
sst <- sst %>%
dplyr::group_by(teamname, name, ezt, est, np, block, opponent, star) %>%
dplyr::summarise(att = n(),
kill = sum(grade == '#'))
filteredxy <- datavolley::dv_xy(sst$ezt, end = 'lower', subzone = sst$est)
sst<-cbind.data.frame(sst, filteredxy)
ui <- fluidPage(
titlePanel("Dashboard"),
sidebarLayout(
sidebarPanel(
selectInput("Select1","Team",unique(sst$teamname)),
selectInput("Select2","Star",choices=NULL,multiple = T),
selectInput("Select3","Player",choices = NULL),
selectInput("Select4","Opponent",choices=NULL,multiple = T),
selectInput("Select5","Block",choices=NULL),
selectInput("Select6","NP",choices=NULL)),
mainPanel(plotOutput("coolplot"))))
server <- function(input, output, session) {
observeEvent(input$Select1,{
updateSelectInput(session,'Select2',
choices=unique(sst$star[sst$teamname==input$Select1]))
})
observeEvent(input$Select2,{
updateSelectInput(session,'Select3',
choices=unique(sst$name[sst$teamname==input$Select1 & sst$star %in% input$Select2]))
})
observeEvent(input$Select3,{
updateSelectInput(session,'Select4',
choices=unique(sst$opponent[sst$teamname==input$Select1 & sst$star %in% input$Select2 &
sst$name == input$Select3]))
})
observeEvent(input$Select4,{
updateSelectInput(session,'Select5',
choices=unique(sst$block[sst$teamname==input$Select1 & sst$star %in% input$Select2 &
sst$name == input$Select3 & sst$opponent %in% input$Select4]))
})
observeEvent(input$Select5,{
updateSelectInput(session,'Select6',
choices=unique(sst$np[sst$teamname==input$Select1 & sst$star %in% input$Select2 &
sst$name == input$Select3 & sst$opponent %in% input$Select4 & sst$block == input$Select5]))
})
output$coolplot <- renderPlot({
filtered <-
sst %>%
filter(opponent %in% input$Select4, star %in% input$Select2) %>%
filter(block == input$Select5, teamname == input$Select1, name == input$Select3, np == input$Select6) %>%
group_by(name, teamname, np, block, x, y, opponent, star) %>%
dplyr::summarise(att = sum(att),
kill = sum(kill))
ggplot(filtered, aes(x, y, fill = (kill/att))) +
geom_tile() +
ggcourt("lower", labels = NULL, show_minor_zones = T) +
geom_text(aes(label = att), position = position_dodge(0),vjust = -1)
})}
shinyApp(ui = ui, server = server)
Мое первое предположение - мой код в части графика рендеринга. Но потратив много времени на исследования, я решил, что пришло время написать об этом сообщение ... Это мой первый раз используя блестящий.