我正在一個閃亮的應用程式中開發一個功能，顯示一個dataTableOutput和與之相關的圖。該圖按組和日期顯示唯一 ID 的計數，而該表顯示與過濾的時間和日期相關的資料。表中的列標題是資料中的日期，這些資料是使用pivot_wider帶有tidyr. 這是一些示例代碼：-
資料
#relevant libraries
library(wakefield)#for generating the Status variable
library(dplyr)
library(stringi)
library(Pareto)
library(uuid)
library(ggplot2)
library(data.table)
library(shiny)
library(DT)
#mock data creation
set.seed(1)
#data<-data.frame()
Date<-seq(as.Date("2015-01-01"), as.Date("2015-12-31"), by = "1 day")
Date<-sample(rep(Date,each=10),replace = T)
event<-r_sample_factor(x = c("Wrestling", "Drama",
"Information", "Football", "Rugby", "Movie", "Music", "News"), n=length(Date))
channel<-r_sample_factor(x = c("Channel 1", "Channel 2", "Channel 3", "Channel 4"), n=length(Date))
Hour<-r_sample_factor(x = c(0:23), n=length(Date))
Group<-r_sample_factor(x = c("A","B","C","D","E"), n=length(Date))
#creating user ID
set.seed(1)
n_users <- 100
n_rows <- 3650
relative_probs <- rPareto(n = n_users, t = 1, alpha = 0.3, truncation = 500)
unique_ids <- UUIDgenerate(n = n_users)
AnonID <- sample(unique_ids, size = n_rows, prob = relative_probs, replace = TRUE)
data<-data.frame(AnonID,Group,Date,Hour,channel,event)
data$Hour<-as.numeric(data$Hour)
head(data)
閃亮代碼
#ui================================
ui<-fluidPage(
titlePanel("Example panel"),
tabsetPanel(
tabPanel("example text",
sidebarPanel(width = 4,
dateRangeInput("daterange","Select dates", format = "yyyy-mm-dd",
start = min("2015-01-01"),
end = max("2015-01-10")),
numericInput("hourmin", "Select mininum hour",10,0,23),
numericInput("hourmax", "Select maximum hour", 22,0,23),
pickerInput("channel", "Select channel",
choices = unique(channel), options = list('actions-box'=T,'live-search'=T),multiple = T)),#end of sidebarPanel
mainPanel(
column(width = 10, plotOutput("barplot", width = "100%")),
column(width = 8, dataTableOutput("table"))
)#end of mainPanel
)
)#end of tabPanel
)#end of tabsetPanel
)#end of fluidPage
#server===========================================
server<-function(input,output,session){
rv <- reactiveVal(NULL)
observe({
rv(data)
output$table<-renderDataTable({
rv()%>%
arrange(desc(Date))%>%
filter(Date>=input$daterange[1] & Date<=input$daterange[2])%>%
filter(Hour>=input$hourmin & Hour<=input$hourmax)%>%
filter(channel %in% input$channel)%>%
group_by(channel,Hour,Date)%>%
arrange(Hour,Date)%>%
summarise(Programme=event, .groups = 'drop')%>%
mutate(rn=rowid(Hour,Date))%>%
pivot_wider(names_from = Date,values_from = Programme)%>%
select(-rn)
})
output$barplot<-renderPlot({
rv()%>%
filter(Date>=input$daterange[1] & Date<=input$daterange[2])%>%
filter(Hour>=input$hourmin & Hour<=input$hourmax)%>%
filter(channel %in% input$channel)%>%
group_by(Date,Group)%>%
summarise(UniqueID=n_distinct(AnonID))%>%
ggplot()
geom_bar(aes(x=Date,y=UniqueID, fill=Group), stat = "identity", position = "dodge")
})
})#end of observe
}
shinyApp(ui,server)
這是輸出：-
你可以看到資料表，我創建了一種“電視指南”，顯示了節目的日期和時間。但是，我認為缺少欄位有點礙眼。與其用其他文本填充它們，我想知道是否有更好的方法來顯示這樣的表格，以便幾乎沒有/沒有空白空間并且使它更簡潔？
其次，我想知道如何使它具有互動性。我希望能夠點擊資料表的單元格/行，結果是使用UniqueID給定小時和日期的新計數被動更新繪圖？這是否容易實施，如果可以，有人可以告訴我如何實施嗎？謝謝你 ：）
uj5u.com熱心網友回復：
您應該考慮提出兩個不同的問題。對于第一部分，您可以同時顯示小時和事件，這樣您就可以為每個通道顯示一行。然后您可以在表格底部提供密鑰，因為每個事件只顯示前 3 個字母。嘗試這個
output$table<-renderDT({
rv()%>%
arrange(desc(Date))%>%
filter(Date>=input$daterange[1] & Date<=input$daterange[2])%>%
filter(Hour>=input$hourmin & Hour<=input$hourmax)%>%
filter(channel %in% input$channel)%>%
group_by(channel,Date)%>%
arrange(Date)%>%
summarise(Programme=paste0(Hour,":",substr(event,1,3)), .groups = 'drop')%>%
#mutate(rn=rowid(Date))%>%
pivot_wider(names_from = Date,values_from = Programme) # %>%
#select(-rn)
})
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/358902.html