英文:
cleaning up my understanding of Shiny modules
问题
我有一个项目，我想开始将我的Shiny应用程序中的代码模块化。我想理清几件事情。
1) 我可以毫无问题地将`UI`模块传递到用户界面，例如`ui_MODULE`和`ui_MODULE_LOCATIONS`。当我尝试将服务器模块传递到应用程序时 `server_location_dropdown_filter`，问题就出现了。**我该如何解决这个问题？**
2) 我的模块被称为 `ui_MODULE("myMODUEL")` 和 `ui_MODULE_LOCATIONS("myMODULE2")` - 我知道 `myMODULE` 和 `myMODULE2` 被传递给 `NS`，但我仍然在直觉上有点难以理解这部分如何工作 - 我以为我们可以通过再次调用它们来重用模块，但这次要传递一个新的`NS`到模块 - 例如，在应用程序中我传递 `ui_MODULE_LOCATIONS("USE_AGAIN")` - 但我并没有再次获得位置下拉菜单... **我该如何正确地重用这些模块？**
3) 我想更好地理解如何正确地将我的项目模块化。我在网上阅读了很多关于模块的内容，但我发现通过将其应用到自己的代码中学习会更容易一些。你能帮忙将以下的应用程序模块化吗？
（注：上述内容是代码的翻译，而不是实际执行的代码。）
英文:
I have a project and I would like to start modularising my code in my Shiny App. I would like to get my head around a few things regarding modules.
-
I can pass the
UImodules to the user interface without any issueui_MODULEandui_MODULE_LOCATIONS. My problem arises when I try to pass the server module to the Appserver_location_dropdown_filter. How can I fix this issue? -
My modules are called
ui_MODULE("myMODUEL")andui_MODULE_LOCATIONS("myMODULE2")- I know themyMODULEandmyMODULE2are passed to theNSbut I am still having a little difficulty understanding how this part works intuitively - I thought we could reuse the modules by calling them again but this time passing a newNSto the module - i.e. in the App I passui_MODULE_LOCATIONS("USE_AGAIN")- but I do not get the location dropdowns again... How can I correctly re-use the modules? -
I would like to understand a bit better how I can correctly modularise my projects. I read a lot about modules online but I find it easier to learn by applying it to my own code. Can you help modularise the following App?
Shiny App:
library(bslib)
library(shiny)
library(dplyr)
library(tidyr)
library(reactable)
################ GENERATE DATA ##############################
# Define the US states and cities
us_states <- c("Alabama", "Alaska", "Arizona", "Arkansas", "California")
alabama_cities <- c("Birmingham", "Huntsville", "Mobile", "Montgomery", "Tuscaloosa")
alaska_cities <- c("Anchorage", "Fairbanks", "Juneau", "Sitka", "Wasilla")
arizona_cities <- c("Phoenix", "Tucson", "Mesa", "Chandler", "Scottsdale")
arkansas_cities <- c("Little Rock", "Fort Smith", "Fayetteville", "Springdale", "Jonesboro")
california_cities <- c("Los Angeles", "San Francisco", "San Diego", "San Jose", "Fresno")
# Set the seed for reproducibility
set.seed(123)
# Generate random price and quantity data
data <- tibble(
state = sample(us_states, 5000, replace = TRUE),
city = case_when(
state == "Alabama" ~ sample(alabama_cities, 5000, replace = TRUE),
state == "Alaska" ~ sample(alaska_cities, 5000, replace = TRUE),
state == "Arizona" ~ sample(arizona_cities, 5000, replace = TRUE),
state == "Arkansas" ~ sample(arkansas_cities, 5000, replace = TRUE),
state == "California" ~ sample(california_cities, 5000, replace = TRUE)
),
price = runif(5000, 10, 100),
quantity = sample(1:10, 5000, replace = TRUE)
)
#############################################################
################# UI ###################
ui_MODULE <- function(id) {
ns <- NS(id)
tagList(
tags$div(
class = "panel-header",
numericInput("price", label = "Price?", value = 10, min = 1, step = 500),
numericInput("quantity", label = "Quantity?", value = 10000, min = 1, step = 50),
sliderInput("discount", label = "Discount", min = 0, max = 0.25, post = " %", value = 0.08, step = 0.001),
actionButton("compute", "Compute!")
)
)
}
################# UI LOCATIONS ###############
ui_MODULE_LOCATIONS = function(id){
ns <- NS(id)
tagList(
tags$div(
class = "panel-header-locations",
selectInput("stateSelect", label = "Select State Data", choices = c()),
selectInput("citySelect", label = "Select City Variable", choices = c()),
)
)
}
################## SERVER MODUEL ############
# This doesn't work correctly...
server_location_dropdown_filter <- function(id){
moduleServer(id, function(input, output, session){
# Changes with changes in the slider input
updatedTable = reactive(
data %>%
filter(state == input$stateSelect) %>%
filter(city == input$citySelect)
)
output$table = DT::renderDT({
updatedTable()
})
})
}
############### FUNCTIONS ###################
myFUNCTION = function(interest){
data %>%
mutate(
p_q = price * quantity,
someOtherCalc = p_q*interest
)
}
# myFUNCTION(0.08)
#############################################
ui <- bootstrapPage(
theme = bs_theme(version = 5, bootswatch = 'minty'),
#titlePanel("Old Faithful Geyser Data"),
navbarPage("App Title",
tabPanel("Plot",
fluidPage(
fluidRow(
column(6,
##### UI #######
ui_MODULE("myMODUEL")
),
column(6,
#### UI Locations ####
ui_MODULE_LOCATIONS("myMODULE2")
)
),
fluidRow(
column(6,
DT::DTOutput('table')
),
column(6,
DT::DTOutput('newTableOUT')
)
)
)
),
tabPanel("use_UI_Again",
fluidPage(
fluidRow(
column(12,
ui_MODULE_LOCATIONS("USE_AGAIN")
)
)
)
)
)
)
server <- function(input, output, session) {
# (1) First observe the states unique values in the data
observe({
choices = data %>% select(state) %>% unique() %>% pull(state)
updateSelectInput(
session,
"stateSelect",
choices = choices
)
})
## (2) ## The cities are then updated to reflect the states selection
observeEvent(input$stateSelect,{
choices = data %>% filter(state == input$stateSelect) %>% select(city) %>% unique() %>% pull(city)
updateSelectInput(
session,
"citySelect",
choices = choices
)
})
#server_location_dropdown_filter("myFILTERS") # here I can't get this working...so I have to run the updatedTable and output$table here
updatedTable = reactive(
data %>%
filter(state == input$stateSelect) %>%
filter(city == input$citySelect)
)
output$table = DT::renderDT({
updatedTable()
})
# Now I want to update the table by using a function...
newTable = reactive(
updatedTable() %>%
myFUNCTION(input$discount)
)
output$newTableOUT = DT::renderDT({
newTable()
})
}
shinyApp(ui = ui, server = server)
答案1
得分: 2
你有一些问题。首先，你需要在模块UI中为每个inputID使用命名空间（ns）。其次，你需要定义一个服务器模块来从ui_MODULE中返回输入变量。最后，如果你希望再次调用UI模块，你需要再次调用相应的服务器模块。
请尝试以下代码：
library(bslib)
library(shiny)
library(dplyr)
library(tidyr)
library(reactable)
library(DT)
################ 生成数据 ##############################
# 定义美国各州和城市
us_states <- c("Alabama", "Alaska", "Arizona", "Arkansas", "California")
alabama_cities <- c("Birmingham", "Huntsville", "Mobile", "Montgomery", "Tuscaloosa")
alaska_cities <- c("Anchorage", "Fairbanks", "Juneau", "Sitka", "Wasilla")
arizona_cities <- c("Phoenix", "Tucson", "Mesa", "Chandler", "Scottsdale")
arkansas_cities <- c("Little Rock", "Fort Smith", "Fayetteville", "Springdale", "Jonesboro")
california_cities <- c("Los Angeles", "San Francisco", "San Diego", "San Jose", "Fresno")
# 设置随机数种子以便可重复性
set.seed(123)
# 生成随机价格和数量数据
data <- tibble(
state = sample(us_states, 5000, replace = TRUE),
city = case_when(
state == "Alabama" ~ sample(alabama_cities, 5000, replace = TRUE),
state == "Alaska" ~ sample(alaska_cities, 5000, replace = TRUE),
state == "Arizona" ~ sample(arizona_cities, 5000, replace = TRUE),
state == "Arkansas" ~ sample(arkansas_cities, 5000, replace = TRUE),
state == "California" ~ sample(california_cities, 5000, replace = TRUE)
),
price = runif(5000, 10, 100),
quantity = sample(1:10, 5000, replace = TRUE)
)
#############################################################
################# UI ###################
ui_MODULE <- function(id) {
ns <- NS(id)
tagList(
tags$div(
class = "panel-header",
numericInput(ns("price"), label = "价格?", value = 10, min = 1, step = 500),
numericInput(ns("quantity"), label = "数量?", value = 10000, min = 1, step = 50),
sliderInput(ns("discount"), label = "折扣", min = 0, max = 0.25, post = " %", value = 0.08, step = 0.001),
actionButton(ns("compute"), "计算!")
)
)
}
server_module <- function(id){
moduleServer(id, function(input, output, session){
rv <- reactiveValues()
observe({
rv$price <- input$price
rv$discount <- input$discount
})
return(rv)
})
}
################# UI LOCATIONS ###############
ui_MODULE_LOCATIONS = function(id){
ns <- NS(id)
tagList(
tags$div(
class = "panel-header-locations",
selectInput(ns("stateSelect"), label = "选择州数据", choices = c()),
selectInput(ns("citySelect"), label = "选择城市变量", choices = c()),
)
)
}
################## SERVER MODULE ############
# 这个部分需要修复...
server_location_dropdown_filter <- function(id){
moduleServer(id, function(input, output, session){
# 随着滑块输入的更改而更改
# (1) 首先观察数据中州的唯一值
observe({
choices = data %>% select(state) %>% unique() %>% pull(state)
updateSelectInput(
session,
"stateSelect",
choices = choices
)
})
## (2) ## 然后根据所选州更新城市
observeEvent(input$stateSelect,{
choices = data %>% filter(state == input$stateSelect) %>% select(city) %>% unique() %>% pull(city)
updateSelectInput(
session,
"citySelect",
choices = choices
)
})
updatedTable = reactive(
data %>%
filter(state == input$stateSelect) %>%
filter(city == input$citySelect)
)
return(updatedTable)
})
}
############### 函数 ###################
myFUNCTION <- function(data, interest){
df <- data %>%
dplyr::mutate(p_q = price * quantity) %>%
dplyr::mutate(
someOtherCalc = p_q * interest
)
return(df)
}
# myFUNCTION(0.08)
###########################################
ui <- bootstrapPage(
theme = bs_theme(version = 5, bootswatch = 'minty'),
navbarPage("应用标题",
tabPanel("绘图",
fluidPage(
fluidRow(
column(6,
##### UI #######
ui_MODULE("myMODULE")
),
column(6,
#### UI Locations ####
ui_MODULE_LOCATIONS("myMODULE2")
)
),
fluidRow(
column(6,
DT::DTOutput('table')
),
column(6,
DT::DTOutput('newTableOUT')
)
)
)
),
tabPanel("再次使用_UI",
fluidPage(
fluidRow(
column(6,
ui_MODULE("USE_AGAIN")
),
column(6,
ui_MODULE_LOCATIONS("USE_AGAIN2")
)
),
fluidRow(
column(6,
DT::DTOutput('table2')
),
column(6,
DT::DTOutput('newTableOUT2')
)
)
)
)
)
)
server <- function(input, output, session) {
updatedTable <- server_location_dropdown_filter("myMODULE2")
output$table = DT::renderDT({
updatedTable()
})
values <- server_module("myMODULE")
newTable = reactive({
req(updatedTable(),values$discount)
myFUNCTION(updatedTable(),values$discount)
})
output$newTableOUT = DT::renderDT({
newTable()
})
### 再次使用模块
updatedTable2 <- server_location_dropdown_filter("USE_AGAIN2")
output$table2 = DT::renderDT(updatedTable2())
values2 <- server_module("USE_AGAIN")
newTable2 = reactive({
req(updatedTable2(),values2$discount)
myFUNCTION(updatedTable2(),values2$discount)
})
output$newTableOUT2 = DT::renderDT(new
<details>
<summary>英文:</summary>
You have a few issues. First, you need to use namespace (`ns`) for each inputID in the module UIs. Second, you need to define a server module to return the input variables from `ui_MODULE`. Lastly, if you wish to call a ui module again, you need to call the corresponding server module again.
Try this
library(bslib)
library(shiny)
library(dplyr)
library(tidyr)
library(reactable)
library(DT)
################ GENERATE DATA ##############################
# Define the US states and cities
us_states <- c("Alabama", "Alaska", "Arizona", "Arkansas", "California")
alabama_cities <- c("Birmingham", "Huntsville", "Mobile", "Montgomery", "Tuscaloosa")
alaska_cities <- c("Anchorage", "Fairbanks", "Juneau", "Sitka", "Wasilla")
arizona_cities <- c("Phoenix", "Tucson", "Mesa", "Chandler", "Scottsdale")
arkansas_cities <- c("Little Rock", "Fort Smith", "Fayetteville", "Springdale", "Jonesboro")
california_cities <- c("Los Angeles", "San Francisco", "San Diego", "San Jose", "Fresno")
# Set the seed for reproducibility
set.seed(123)
# Generate random price and quantity data
data <- tibble(
state = sample(us_states, 5000, replace = TRUE),
city = case_when(
state == "Alabama" ~ sample(alabama_cities, 5000, replace = TRUE),
state == "Alaska" ~ sample(alaska_cities, 5000, replace = TRUE),
state == "Arizona" ~ sample(arizona_cities, 5000, replace = TRUE),
state == "Arkansas" ~ sample(arkansas_cities, 5000, replace = TRUE),
state == "California" ~ sample(california_cities, 5000, replace = TRUE)
),
price = runif(5000, 10, 100),
quantity = sample(1:10, 5000, replace = TRUE)
)
#############################################################
################# UI ###################
ui_MODULE <- function(id) {
ns <- NS(id)
tagList(
tags$div(
class = "panel-header",
numericInput(ns("price"), label = "Price?", value = 10, min = 1, step = 500),
numericInput(ns("quantity"), label = "Quantity?", value = 10000, min = 1, step = 50),
sliderInput(ns("discount"), label = "Discount", min = 0, max = 0.25, post = " %", value = 0.08, step = 0.001),
actionButton(ns("compute"), "Compute!")
)
)
}
server_module <- function(id){
moduleServer(id, function(input, output, session){
rv <- reactiveValues()
observe({
rv$price <- input$price
rv$discount <- input$discount
})
return(rv)
})
}
################# UI LOCATIONS ###############
ui_MODULE_LOCATIONS = function(id){
ns <- NS(id)
tagList(
tags$div(
class = "panel-header-locations",
selectInput(ns("stateSelect"), label = "Select State Data", choices = c()),
selectInput(ns("citySelect"), label = "Select City Variable", choices = c()),
)
)
}
################## SERVER MODUEL ############
# This doesn't work correctly...
server_location_dropdown_filter <- function(id){
moduleServer(id, function(input, output, session){
# Changes with changes in the slider input
# (1) First observe the states unique values in the data
observe({
choices = data %>% select(state) %>% unique() %>% pull(state)
updateSelectInput(
session,
"stateSelect",
choices = choices
)
})
## (2) ## The cities are then updated to reflect the states selection
observeEvent(input$stateSelect,{
choices = data %>% filter(state == input$stateSelect) %>% select(city) %>% unique() %>% pull(city)
updateSelectInput(
session,
"citySelect",
choices = choices
)
})
updatedTable = reactive(
data %>%
filter(state == input$stateSelect) %>%
filter(city == input$citySelect)
)
return(updatedTable)
})
}
############### FUNCTIONS ###################
myFUNCTION <- function(data,interest){
df <- data %>%
dplyr::mutate(p_q = price * quantity) %>%
dplyr::mutate(
someOtherCalc = p_q * interest
)
return(df)
}
# myFUNCTION(0.08)
#############################################
ui <- bootstrapPage(
theme = bs_theme(version = 5, bootswatch = 'minty'),
#titlePanel("Old Faithful Geyser Data"),
navbarPage("App Title",
tabPanel("Plot",
fluidPage(
fluidRow(
column(6,
##### UI #######
ui_MODULE("myMODULE")
),
column(6,
#### UI Locations ####
ui_MODULE_LOCATIONS("myMODULE2")
)
),
fluidRow(
column(6,
DT::DTOutput('table')
),
column(6,
DT::DTOutput('newTableOUT')
)
)
)
),
tabPanel("use_UI_Again",
fluidPage(
fluidRow(
column(6,
ui_MODULE("USE_AGAIN")
),
column(6,
ui_MODULE_LOCATIONS("USE_AGAIN2")
)
),
fluidRow(
column(6,
DT::DTOutput('table2')
),
column(6,
DT::DTOutput('newTableOUT2')
)
)
)
)
)
)
server <- function(input, output, session) {
updatedTable <- server_location_dropdown_filter("myMODULE2")
output$table = DT::renderDT({
updatedTable()
})
values <- server_module("myMODULE")
newTable = reactive({
req(updatedTable(),values$discount)
myFUNCTION(updatedTable(),values$discount)
})
output$newTableOUT = DT::renderDT({
newTable()
})
### USE MODULES again
updatedTable2 <- server_location_dropdown_filter("USE_AGAIN2")
output$table2 = DT::renderDT(updatedTable2())
values2 <- server_module("USE_AGAIN")
newTable2 = reactive({
req(updatedTable2(),values2$discount)
myFUNCTION(updatedTable2(),values2$discount)
})
output$newTableOUT2 = DT::renderDT(newTable2())
}
shinyApp(ui = ui, server = server)
</details>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论