R 从动态输入元素数量创建动态数量的输出ui元素
我试图减少renderUI和reactive的输入和输出的一些重复函数,以便使用purr使代码更加简单。 我发现我试图用pmap制作一个版本,但似乎不起作用。 你能给我提供一些见解或方法来理解如何调试它吗 桌子R 从动态输入元素数量创建动态数量的输出ui元素,r,shiny,tidyverse,purrr,R,Shiny,Tidyverse,Purrr,我试图减少renderUI和reactive的输入和输出的一些重复函数,以便使用purr使代码更加简单。 我发现我试图用pmap制作一个版本,但似乎不起作用。 你能给我提供一些见解或方法来理解如何调试它吗 桌子 我想你可以试着用闪亮的 但我认为在代码中更新可用选项的方式中存在缺陷。如果用户首先选择Charisma,则其他属性的可用选项将不会更新。解决这个问题的一种方法是使用dra和drop包,比如or。选择一行将更新拖放值,然后用户将选择放置每个值的位置。感谢您的建议,我不知道可排序包,它似乎
我想你可以试着用闪亮的
但我认为在代码中更新可用选项的方式中存在缺陷。如果用户首先选择Charisma,则其他属性的可用选项将不会更新。解决这个问题的一种方法是使用dra和drop包,比如or。选择一行将更新拖放值,然后用户将选择放置每个值的位置。感谢您的建议,我不知道可排序包,它似乎可以直接使用它们,甚至不需要使用以前的方法,完全删除问题。这样做是为了不删除已使用的值。现在我不知道这个问题是否得到了回答,因为它提供了一种完全不同的工作方式。你可以等一等,看看有没有人有更好的答案。我给出这个答案是因为它听起来更“干净”的回答是关于更新选择问题的(尽管问题没有指出这是一个问题)。如果你对接受答案感到好奇,你可以在meta上阅读更多关于它的内容:)
library('tidyverse')
library('data.table')
library("shiny")
Attr_scores <- structure(list(scope = c("Sel1", "Sel2", "Sel3", "Sel4", "Sel5",
"Sel6", "Sel7", "Sel8", "Sel9", "Sel10", "Sel11", "Sel12", "Sel13"
), A1 = c(14, 14, 14, 15, 15, 15, 16, 16, 16, 17, 17, 17, 18),
A2 = c(13, 14, 14, 14, 15, 15, 13, 14, 16, 14, 15, 17, 12
), A3 = c(13, 13, 14, 13, 12, 15, 12, 14, 10, 12, 11, 8,
12), A4 = c(13, 13, 13, 12, 12, 11, 12, 10, 10, 10, 11, 8,
10), A5 = c(13, 13, 10, 12, 11, 8, 12, 10, 10, 10, 10, 8,
10), A6 = c(12, 10, 8, 11, 11, 8, 12, 10, 10, 10, 8, 8, 10
)), row.names = c(NA, -13L), class = c("tbl_df", "tbl", "data.frame"
))
Attr_score_select <- function(y){
Attr_scores %>%
as.data.table() %>%
.[y] %>%
pivot_longer(-scope) %>%
count(value)
}
## change the number of the score you still have
Attr_score_remove <- function(df, score){
df %>%
mutate(n = ifelse(value == score, n-1, n)) %>%
mutate(n = ifelse(n == 0, NA, n)) %>%
drop_na()
}
ui <- fluidPage(
titlePanel("Create your Character:"),
navlistPanel(
"Header B",
tabPanel("Main Attributes",
sidebarPanel(
"Attributes",
# select the values for each attr
c("Strength_ui", "Dexterity_ui",
"Constitution_ui","Intelligence_ui",
"Wisdom_ui","Charisma_ui") %>%
map(~uiOutput(.x))
),
mainPanel(
# table with Attributes score
h4("Select the row with the Attribute scores for your character:"),
DT::dataTableOutput("table"))
),
"-----",
tabPanel("Component 4"),
"-----",
tabPanel("Component 5")
)
)
server <- function(input, output) {
output$table <- DT::renderDataTable(
DT::datatable(
data = Attr_scores,
style = 'bootstrap',
options = list(pageLength = 10),
selection = "single"))
Scores <- reactive(Attr_score_select(input$table_row_last_clicked))
output$Strength_ui <- renderUI({
#Strength
selectInput('Strength_1',
label = "Choose Strength score for your character:",
c(Choose='',
as.character(Scores()$value))
)
})
Scores1 <- reactive(Scores() %>%
Attr_score_remove(input$Strength_1))
#Dexterity
output$Dexterity_ui = renderUI(
selectInput('Dexterity_1',
label = "Choose Dexterity score for your character:",
c(Choose='', as.character(Scores1()$value))
)
)
Scores2 <- reactive(Scores1() %>%
Attr_score_remove(input$Dexterity_1))
#Constitution
output$Constitution_ui = renderUI(
selectInput('Constitution_1',
label = "Choose Constitution score for your character:",
c(Choose='', as.character(Scores2()$value))
)
)
Scores3 <- reactive(Scores2() %>%
Attr_score_remove(input$Constitution_1))
#Intelligence
output$Intelligence_ui = renderUI(
selectInput('Intelligence_1',
label = "Choose Intelligence score for your character:",
c(Choose='', as.character(Scores3()$value) )
)
)
Scores4 <- reactive(Scores3() %>%
Attr_score_remove(input$Intelligence_1))
#Wisdom
output$Wisdom_ui = renderUI(
selectInput('Wisdom_1',
label = "Choose 'Wisdom score for your character:",
c(Choose='', as.character(Scores4()$value) )
)
)
Scores5 <- reactive(Scores4() %>%
Attr_score_remove(input$Wisdom_1))
#Charisma
output$Charisma_ui = renderUI(
selectInput('Charisma_1',
label = "Choose 'Charisma score for your character:",
c(Choose='',
as.character(Scores5()$value))
)
)
}
Scores <- list(
"Strength_ui",
"Dexterity_ui",
"Constitution_ui",
"Intelligence_ui",
"Wisdom_ui",
"Charisma_ui"
) %>% set_names(.)
server <- function(input, output) {
output$table <- DT::renderDataTable(
DT::datatable(
data = Attr_scores,
style = 'bootstrap',
options = list(pageLength = 10),
selection = "single"))
Scores[["Strength_ui"]] <- reactive(
Attr_score_select(input$table_row_last_clicked))
pmap(..1 = names(Scores), ..2 = names(Scores) %>% seq_along(),
..3 = c("Strength_1", "Dexterity_1",
"Constitution_1","Intelligence_1",
"Wisdom_1","Charisma_1"),
.f = ~ function(x, y, z){
output[[..1]] <- renderUI({
selectInput(..3,
label = str_c("Choose",str_remove(..1,"_ui") ,
"score for your character:"),
c(Choose='',as.character(Scores[[..1]]()$value))
)
})
Scores[[..2+1]] <- reactive(Scores[[..1]]() %>%
Attr_score_remove(input[[..3]]))
}
)
}
shinyApp(ui = ui, server = server)
Listening on http://127.0.0.1:3295
Warning: Error in is.data.frame: argument ".l" is missing, with no default
54: is.data.frame
53: pmap
52: server [#13]
Error in is.data.frame(.l) : argument ".l" is missing, with no default