我有一个以特定方式格式化的数据表，其中列名使用草图定义的自定义表容器以两列为中心。列名称列出为Store1或Store2，但我希望能够填充实际的商店名称，这取决于选择的状态。
是否可以根据所选状态输入来更新列名？还是有一种更好的方法可以完全做到这一点？
下面是我的代码：
#Packages
library(reshape2)
library(shiny)
library(DT)
library(shinydashboard)
library(dplyr)
#Data
data<-data.frame("State"=c("AK","AK","AK","AK","AK","AK","AK","AK","AR","AR","AR","AR","AR","AR","AR","AR"),
"StoreRank" = c(1,1,1,1,2,2,2,2,1,1,1,1,2,2,2,2),
"Year" = c(2017,2018,2017,2018,2017,2018,2017,2018,2017,2018,2017,2018,2017,2018,2017,2018),
"Region" = c("East","East","West","West","East","East","West","West","East","East","West","West","East","East","West","West"),
"Store" = c("Ingles","Ingles","Ingles","Ingles","Safeway","Safeway","Safeway","Safeway","Albertsons","Albertsons","Albertsons","Albertsons","Safeway","Safeway","Safeway","Safeway"),
"Total" = c(500000,520000,480000,485000,600000,600000,500000,515000,500100,520100,480100,485100,601010,601000,501000,515100))
#Formatting data for Data table
reform.data<-dcast(data, State+Region~StoreRank+Year, value.var = 'Total')
#For selecting state inputs
state.list<-reform.data %>%
select(State) %>%
unique
#List for state, store, and rank
Store.Ranks<-data %>%
select('State', 'Store', 'StoreRank') %>%
unique()
#Custom Table Container
sketch = htmltools::withTags(table(
class = 'display',
thead(
tr(
th(rowspan = 2, 'Region'),
th(colspan = 2, 'Store1', style="text-align:center"), #Tried and failer to create a function with sketch and change Store1 to Store.Ranks$Store[Store.Ranks$State == input$selectstate & Store.Ranks$StoreRank == 1]
th(colspan = 2, 'Store2', style="text-align:center")
),
tr(
lapply(rep(c('2017 Total', '2018 Total'), 2), th)
)
)
))
#App. Code
shinyApp (
ui<-dashboardPage(
dashboardHeader(),
dashboardSidebar(width=200,
sidebarMenu(id = "tabs",
menuItem(text = "State", tabName="state", icon=icon("chevron-right")),
conditionalPanel(condition = "input.tabs == 'state' ",
menuSubItem((selectInput("selectstate", "Select state",
choices = state.list))))
)),
dashboardBody(
tabItem(tabName = 'Store',
fluidRow(
column(10,
tabBox(width = 12,
title = tagList(shiny::icon("gear"), "Stores"),
id = "storedat",
tabPanel(
title = "Store Ranks",
textOutput("selected_state"),
DT::dataTableOutput("storetable"))
)
))
))
),
server <- function(input, output) {
output$storetable <- DT::renderDataTable({
DT::datatable(reform.data[ ,c(2:6)] %>%
dplyr::filter(reform.data$State == input$selectstate),
rownames = FALSE,
extensions = c('FixedColumns', "FixedHeader"),
container = sketch)
})
}
)
答案 0 :(得分：0)
您可以创建一个函数来创建容器，该函数将采用名称并相应地创建容器。我已经编辑了您提供的代码以完全做到这一点：
#Packages
library(reshape2)
library(shiny)
library(DT)
library(shinydashboard)
library(dplyr)
#Data
data<-data.frame("State"=c("AK","AK","AK","AK","AK","AK","AK","AK","AR","AR","AR","AR","AR","AR","AR","AR"),
"StoreRank" = c(1,1,1,1,2,2,2,2,1,1,1,1,2,2,2,2),
"Year" = c(2017,2018,2017,2018,2017,2018,2017,2018,2017,2018,2017,2018,2017,2018,2017,2018),
"Region" = c("East","East","West","West","East","East","West","West","East","East","West","West","East","East","West","West"),
"Store" = c("Ingles","Ingles","Ingles","Ingles","Safeway","Safeway","Safeway","Safeway","Albertsons","Albertsons","Albertsons","Albertsons","Safeway","Safeway","Safeway","Safeway"),
"Total" = c(500000,520000,480000,485000,600000,600000,500000,515000,500100,520100,480100,485100,601010,601000,501000,515100))
#Formatting data for Data table
reform.data<-dcast(data, State+Region~StoreRank+Year, value.var = 'Total')
#For selecting state inputs
state.list<-reform.data %>%
select(State) %>%
unique
#List for state, store, and rank
Store.Ranks<-data %>%
select('State', 'Store', 'StoreRank') %>%
unique()
#Custom Table Container
createContainer <- function(store1Name = 'Store1', store2Name='Store2'){
sketch = htmltools::withTags(table(
class = 'display',
thead(
tr(
th(rowspan = 2, 'Region'),
th(colspan = 2, store1Name, style="text-align:center"), #Tried and failer to create a function with sketch and change Store1 to Store.Ranks$Store[Store.Ranks$State == input$selectstate & Store.Ranks$StoreRank == 1]
th(colspan = 2, store2Name, style="text-align:center")
),
tr(
lapply(rep(c('2017 Total', '2018 Total'), 2), th)
)
)
))
return(sketch);
}
#App. Code
shinyApp (
ui<-dashboardPage(
dashboardHeader(),
dashboardSidebar(width=200,
sidebarMenu(id = "tabs",
menuItem(text = "State", tabName="state", icon=icon("chevron-right")),
conditionalPanel(condition = "input.tabs == 'state' ",
menuSubItem((selectInput("selectstate", "Select state",
choices = state.list))))
)),
dashboardBody(
tabItem(tabName = 'Store',
fluidRow(
column(10,
tabBox(width = 12,
title = tagList(shiny::icon("gear"), "Stores"),
id = "storedat",
tabPanel(
title = "Store Ranks",
textOutput("selected_state"),
DT::dataTableOutput("storetable"))
)
))
))
),
server <- function(input, output) {
output$storetable <- DT::renderDataTable({
store1Name = Store.Ranks$Store[Store.Ranks$State == input$selectstate & Store.Ranks$StoreRank ==1]
store2Name = Store.Ranks$Store[Store.Ranks$State == input$selectstate & Store.Ranks$StoreRank ==2]
DT::datatable(reform.data[ ,c(2:6)] %>%
dplyr::filter(reform.data$State == input$selectstate),
rownames = FALSE,
extensions = c('FixedColumns', "FixedHeader"),
container = createContainer(store1Name, store2Name))
})
}
)
希望有帮助！