Реактивные участки боковых панелей и вкладок
Я пытаюсь создать блестящее приложение, которое имеет несколько вкладок, которые извлекают из одних и тех же данных, которые я отфильтровываю с помощью переключателей и selectizeInput на боковой панели.
Вы можете сгенерировать данные для первой тепловой карты с помощью следующего кода:
dat<-expand.grid(2:6,7:20,letters[1:8],LETTERS[1:26])
dat$Var5<-sample(0:200,nrow(dat),replace = T)
names(dat)<-c("WEEKDAY" ,
"HOUR" ,
"MEETING_LOCATION" ,
"COURSE_SUBJECT",
"n.SESSIONS")
dat[,"WEEKDAY"]<-factor(dat[,1],levels = c("2","3","4","5","6"),ordered = T)
dat[,c("MEETING_LOCATION","COURSE_SUBJECT")]<-lapply(dat[,c("MEETING_LOCATION","COURSE_SUBJECT")],as.character)
Я могу заставить интерфейс отображаться, но многие примеры, которые я нахожу в стеке, не дают мне четкого представления о том, как мне нужно обернуть все функции, и я знаю, что я почти готов с этим первым.
Блестящий код приложения, который я использую, выглядит примерно так:
ui <- fluidPage(
titlePanel("Oh My God Please Help"),
fluidRow(
column(3,
wellPanel(
h4("Filter"),
radioButtons("MEETING_LOCATION",
"Location:",
c("a" = "a",
"b" = "b",
"c" = "c",
"d" = "d",
"e" = "e",
"f" = "f",
"g" = "g",
"h" = "h")),
selectizeInput("COURSE_SUBJECT",
label = "Course Subject: ",
choices = LETTERS[1:26],
selected = NULL,
multiple = T)
))
))
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Usage",plotOutput("USAGE")))
# other tabs I need to put in don't pay attention to this
# other tabs I need to put in don't pay attention to this
# other tabs I need to put in don't pay attention to this
)
server <- function(input, output) {
usage.0<-reactive({
dat%>%
dplyr::filter(COURSE_SUBJECT %in% input$COURSE_SUBJECT)%>%
dplyr::filter(MEETING_LOCATION==input$MEETING_LOCATION)%>%
group_by(WEEKDAY,HOUR)%>%
sumarise(TOTAL.SESSIONS = sum(n.SESSIONS))
})
output$USAGE <- renderPlot({
usage.0()%>%
ggplot(aes(x = WEEKDAY,y = HOUR))+
geom_tile(aes(fill = TOTAL.SESSIONS))+
geom_text(aes(label = TOTAL.SESSIONS),colour = "white",fontface = "bold",size = 3)+
scale_fill_gradient(guide = guide_legend(title = "Total Number of\nMeetings"),low = "#00ABE1",high = "#FFCD00")+
theme(axis.ticks = element_blank(),
legend.background = element_blank(),
legend.key = element_blank(),
panel.background = element_blank(),
axis.text.x = element_text(angle = 35, hjust = 1),
panel.border = element_blank(),
strip.background = element_blank(),
plot.background = element_blank())+
xlab("Weekday")+
ylab("Hour")+
ggtitle("Busiest Tutoring Days/Hours")
})
}
# Run the application
shinyApp(ui = ui, server = server)
Я думаю, что проблема связана с тем, как / где я (не) рендеринг сюжета. может быть, мне нужно иметь еще одну вкладку, чтобы R знал, что делать, я не знаю... Я знаю, что это, вероятно, действительно неэффективный код, поэтому любая помощь там была бы полезной, но главное - просто получить это тепловая карта, которая отображается, когда я выбираю подмножество данных на боковой панели / переключатели.
Заранее спасибо.
1 ответ
Пара проблем, которые я вижу здесь.
1) Ваш fluidPage закрыто ) прежде чем включить основную панель. Хитрость для определения этого заключается в том, что а) ваши вещи не отображаются. Или б) Перепишите строки в меню кода. Если они не выстраиваются в очередь, вы знаете, что-то не так.
2) Я настоятельно рекомендую вам написать свои данные и графики как функции, которые вы можете протестировать вне контекста вашего приложения. Затем используйте функции в приложении. Я сделал это ниже. Это дает вам возможность протестировать их независимо от приложения (без запуска приложения, перезагрузки, промывки, повторения замедлений). Это делает ваше приложение намного чище и легче ориентироваться при редактировании элементов пользовательского интерфейса / сервера. А также сделать рост и тестирование более вменяемым.
3) В своем коде никогда не используйте числовые ссылки на столбцы (например, dat[,1]). Всегда используйте имя столбца. Это займет немного больше времени, но спасет вас, когда данные изменятся в будущем, и спасет кого-то другого при чтении вашего кода.
4) При публикации кода, пожалуйста, проверьте, работает ли он на самом деле. Построчно! Если вы посмотрите на результат dat Вы можете быть удивлены тем, что вы найдете.
Ваша работа сейчас, исправить функции так, чтобы они делали то, что вы ожидаете от них.
app.R
ui <- fluidPage(
titlePanel("Oh My God Please Help"),
fluidRow(
column(
3,
wellPanel(
h4("Filter"),
radioButtons(
inputId = "MEETING_LOCATION",
"Location:",
c("a" = "a",
"b" = "b",
"c" = "c",
"d" = "d",
"e" = "e",
"f" = "f",
"g" = "g",
"h" = "h")),
selectizeInput(
inputId = "COURSE_SUBJECT",
label = "Course Subject: ",
choices = LETTERS[1:26],
selected = NULL,
multiple = T)
))
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel(
"Usage",
plotOutput("USAGE")
)
) # Don't forget the comma here! ,
# other tabs I need to put in don't pay attention to this
# other tabs I need to put in don't pay attention to this
# other tabs I need to put in don't pay attention to this
)
)
server <- function(input, output, session) {
usage_prep <- reactive({
cat(input$MEETING_LOCATION)
cat(input$COURSE_SUBJECT)
myData(dat, input$MEETING_LOCATION, input$COURSE_SUBJECT)
})
output$USAGE <- renderPlot({
myPlot(usage_prep())
})
}
# Run the application
shinyApp(ui = ui, server = server)
global.R
library(dplyr)
library(ggplot2)
dat<-expand.grid(2:6,7:20,letters[1:8],LETTERS[1:26])
dat$Var5<-sample(0:200,nrow(dat),replace = T)
names(dat)<-c("WEEKDAY" ,
"HOUR" ,
"MEETING_LOCATION" ,
"COURSE_SUBJECT",
"n.SESSIONS")
dat$WEEKDAY <-factor(dat$WEEKDAY,levels = c("2","3","4","5","6"),ordered = T)
myData <- function(dat, meeting_location, course_subject) {
dat %>%
filter(COURSE_SUBJECT %in% course_subject)%>%
filter(MEETING_LOCATION==meeting_location)%>%
group_by(WEEKDAY,HOUR)%>%
summarise(TOTAL.SESSIONS = sum(n.SESSIONS))
}
myPlot <- function(pd) {
ggplot(pd, aes(x = WEEKDAY,y = HOUR))+
geom_tile(aes(fill = TOTAL.SESSIONS))+
geom_text(aes(label = TOTAL.SESSIONS),colour = "white",fontface = "bold",size = 3)+
scale_fill_gradient(guide = guide_legend(title = "Total Number of\nMeetings"),low = "#00ABE1",high = "#FFCD00")+
theme(axis.ticks = element_blank(),
legend.background = element_blank(),
legend.key = element_blank(),
panel.background = element_blank(),
axis.text.x = element_text(angle = 35, hjust = 1),
panel.border = element_blank(),
strip.background = element_blank(),
plot.background = element_blank())+
xlab("Weekday")+
ylab("Hour")+
ggtitle("Busiest Tutoring Days/Hours")
}