#r #shiny
#r #блестящий
Вопрос:
Я создаю простое блестящее приложение, которое выдает тривиальные вопросы преследования, которые сочетаются с версией настольной игры.
У меня есть код, который собирает вопросы и запускает приложение, которое случайным образом выбирает 6 категорий. Когда вы нажимаете «начать игру», открывается новая вкладка actionButtons для каждой категории. Идея заключается в том, что когда вы нажимаете actionButton на нее, она случайным образом выбирает 1 строку из фрейма данных, который соответствует этой категории, и отображает строку.
Я написал блок, завернутый в eventReactive который должен реагировать на кнопку 1-й категории, однако, когда я нажимаю на нее, она не отображает строку данных. Ошибок не возникает, поэтому не уверен, почему ничего не отображается при нажатии на 1-ю категорию actionButton
library(shiny)
library(DT)
library(dplyr)
csv_questions <- structure(list(question = c("Q 4105", "Q 5360", "Q 3948", "Q 32347",
"Q 98", "Q 32668", "Q 596", "Q 43370", "Q 35001", "Q 33899",
"Q 35529", "Q 11902", "Q 35598", "Q 42518", "Q 20935", "Q 44847",
"Q 39341", "Q 1419", "Q 25431", "Q 33351", "Q 45095", "Q 21851",
"Q 4798", "Q 10213", "Q 8069", "Q 31661", "Q 8536", "Q 33027",
"Q 6584", "Q 25062", "Q 21855", "Q 18518", "Q 30481", "Q 28354",
"Q 31308", "Q 48175", "Q 6835", "Q 42680", "Q 14729", "Q 34827",
"Q 28698", "Q 43018", "Q 31076", "Q 14388", "Q 32963", "Q 1770",
"Q 5172", "Q 13483", "Q 26718", "Q 49467"), category = c("celebrities",
"for-kids", "celebrities", "rated", "animals", "rated", "animals",
"television", "science-technology", "science-technology", "science-technology",
"hobbies", "science-technology", "television", "music", "world",
"television", "brain-teasers", "newest", "religion-faith", "world",
"music", "entertainment", "history", "general", "rated", "general",
"rated", "general", "music", "music", "movies", "people", "people",
"rated", "world", "general", "television", "literature", "science-technology",
"people", "television", "rated", "literature", "rated", "celebrities",
"for-kids", "humanities", "newest", "world"), answer = c("answer",
"answer", "answer", "answer", "answer", "answer", "answer", "answer",
"answer", "answer", "answer", "answer", "answer", "answer", "answer",
"answer", "answer", "answer", "answer", "answer", "answer", "answer",
"answer", "answer", "answer", "answer", "answer", "answer", "answer",
"answer", "answer", "answer", "answer", "answer", "answer", "answer",
"answer", "answer", "answer", "answer", "answer", "answer", "answer",
"answer", "answer", "answer", "answer", "answer", "answer", "answer"
)), row.names = c(NA, -50L), class = "data.frame")
create_random_choices <- function(){
qs <- get_questions()
cats <- unique(qs$category)
choices <- sample(cats, 6, replace = FALSE)
return(choices)
}
# Define UI
ui <- navbarPage(title = "Trivial Pursuit", id = "navpage",
tabPanel("Setup",
sidebarLayout(
sidebarPanel(
checkboxGroupInput(
"selectedCategories",
"Select Categories",
choices = unique(csv_questions$category),
selected = create_random_choices()
)
),
mainPanel(
actionButton("startGame", "Start Game")
)
)
),
tabPanel("Game",
mainPanel(
fluidRow(
column(4,
uiOutput("cat1")),
column(4,
uiOutput("cat2"), offset = 4)
),
fluidRow(
DTOutput("cat1Data")
)
))
)
# Define server logic
server <- function(input, output, session) {
filter_questions <- reactive({
csv_questions %>%
dplyr::filter(category %in% input$selectedCategories)
})
observeEvent(input$startGame, {
updateTabsetPanel(session, "navpage", "Game")
})
# Game Server Logic
randomized_categories <- reactive({
sample(input$selectedCategories)
})
output$cat1 <- renderUI({
actionButton("cat1Button",
label = randomized_categories()[1],
style = "background-color: blue;")
})
output$cat2 <- renderUI({
actionButton("cat2Button",
label = randomized_categories()[2],
style = "background-color: green;")
})
eventReactive("cat1", {
output$cat1Data <- renderDT({filter_questions() %>%
filter(category == randomized_categories()[1]) %>%
dplyr::sample_n(1) %>%
as.data.frame()})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Комментарии:
1. Пожалуйста, сократите свой вопрос и образец данных. Я чувствую, что вам не нужны все эти страны и тому подобное только для демонстрации вашей проблемы.
2. Это набор данных вопросов и ответов — он, естественно, будет длинным. Это было всего 150 строк. Несмотря на это, я уменьшил количество символов на две трети
3. Я понимаю, что это, естественно, будет долго, но посмотрите на это по-другому: лучший способ заставить кого-то помочь вам с вашей проблемой — это быстро решить проблему. Если мне приходится прокручивать более 5 раз, чтобы просто увидеть соответствующий код, то это начинает становиться обременительным и — поскольку я делаю это в перерывах между оплатой задач — более легко отклоняется. Ваша цель должна состоять в том, чтобы сделать ее как можно более удобной для просмотра и попыток, включая читаемое, но минимальное пустое пространство, чтобы одновременно было видно больше. Не имеет значения, являются ли вопросы юридическими английскими или «Q1», «Q2» и т. Д.
4. Вы абсолютно правы — я прошу прощения за язвительность. Дополнительные уменьшенные данные плюс некоторый посторонний код
Ответ №1:
Измените eventReactive observeEvent и используйте actionButton идентификаторы. Тогда это должно сработать. См. Ниже:
# Define UI
ui <- navbarPage(title = "Trivial Pursuit", id = "navpage",
tabPanel("Setup",
sidebarLayout(
sidebarPanel(
checkboxGroupInput(
"selectedCategories",
"Select Categories",
choices = unique(csv_questions$category),
selected = create_random_choices()
)
),
mainPanel(
actionButton("startGame", "Start Game")
)
)
),
tabPanel("Game",
mainPanel(
fluidRow(
column(4,
uiOutput("cat1")),
column(4,
uiOutput("cat2"), offset = 4)
),
fluidRow(
DTOutput("tb1"),
DTOutput("cat1Data"),
DTOutput("cat2Data")
)
))
)
# Define server logic
server <- function(input, output, session) {
filter_questions <- reactive({
csv_questions %>%
dplyr::filter(category %in% input$selectedCategories)
})
observeEvent(input$startGame, {
updateTabsetPanel(session, "navpage", "Game")
})
# Game Server Logic
randomized_categories <- reactive({
sample(input$selectedCategories)
})
output$tb1 <- renderDT({
filter_questions() %>%
filter(category == randomized_categories()[1]) %>%
#dplyr::sample_n(1) %>%
as.data.frame()
})
output$cat1 <- renderUI({
actionButton("cat1Button",
label = randomized_categories()[1],
style = "background-color: cyan;")
})
output$cat2 <- renderUI({
actionButton("cat2Button",
label = randomized_categories()[2],
style = "background-color: yellow;")
})
observeEvent(input$cat1Button, {
output$cat1Data <- renderDT({filter_questions() %>%
dplyr::filter(category == randomized_categories()[1]) %>%
dplyr::sample_n(1) %>%
as.data.frame()})
})
observeEvent(input$cat2Button, {
output$cat2Data <- renderDT({filter_questions() %>%
dplyr::filter(category == randomized_categories()[2]) %>%
dplyr::sample_n(1) %>%
as.data.frame()})
})
}
# Run the application
shinyApp(ui = ui, server = server)