Question

我已经构建了一个小的Shiny应用程序。首先，在与应用程序相同的文件夹中，保存了一个列表，该列表的元素是带有有关人的信息的小标题（每人一张桌子）。该代码（首先运行）：

library(dplyr)
people <- list(john_smith = tibble(first_name = "John", last_name = "Smith",
                                   DOB = "2000-01-01"),
               mary_silver = tibble(first_name = "Mary", last_name = "Silver",
                                    DOB = "1999-12-12"))
saveRDS(people, file = "people.rds")

以下是我使用该对象的Shiny应用程序的代码。（请忽略用于创建handontable的函数的代码；之所以这么长，是因为我从其他地方复制了它-我是handsontable的新手-这就是为什么它如此丑陋且标头行为异常的原因。）

问题：我想在一个人的表中进行更改（例如，更改该人的出生日期DOB），然后通过点击左侧的“更新人员信息”按钮来保存这些更改。结果，我希望在“ people”列表和“ people.rds”文件中更新该人的整个表。我的挑战是：服务器对象'output $ person_table'包含原始信息。对其进行更改后，是否应该在其他对象中进行某种更改？我对所有的圆度感到迷茫。

非常感谢您的帮助！

library(shiny)
library(dplyr)
library(rhandsontable)
library(DT)

# Read in the existing people's list:
people <- readRDS("people.rds")

# Function to create an editable table in the app:
GetTablePersonInfo <- function(one_person_table){
    ### All columns are editable:
    editableCols <- 1:3
    sketch <- htmltools::withTags(table(
        tableHeader(one_person_table)
    ))
    datatable(one_person_table, 
              container = sketch,
              extensions = 'FixedHeader',
              class = "mytable nowrap hover row-border",
              rownames = F,
              escape = F,
              selection = list(mode = "none"),
              editable = list(target = 'cell', disable = list(columns = 0)),
              options = list(pageLength = 10, server = F,
                             dom = 't',pagination = F,
                             ordering = F, autoWidth = F,  
                             scrollX = T, language.thousands = ",",
                             columnDefs = list(list(targets = editableCols - 1,
                                                    width = "100px"),
                                               list(targets = 0,
                                                    width = "30px")),
                             fixedHeader = T)) %>%
        formatStyle(editableCols, backgroundColor = '#eef6f6')
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### ui code ####
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
ui <- fluidPage(

    # Application title
    titlePanel("My App"),

    # Sidebar with a pull-down to select a person:
    sidebarLayout(
        sidebarPanel(
              # Select the person:            
              selectizeInput("person_select", label = "Select Person",
                           choices = names(people), multiple = FALSE,
                           selected = names(people)[1]),
              # Update changes:
              actionButton("update_person", "Update Person Info")
        ),
        # Main panel with an editable table for the selected person:
        mainPanel(
            DT::dataTableOutput("person_table")
        )
    )
)

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### server code ####
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
server <- function(input, output, session) {
    # Using my function 'GetTablePersonInfo' to grab the table for the person selected:
    output$person_table <- renderRHandsontable({
        person_name <- input$person_select
        person_table <- people[[person_name]]
        GetTablePersonInfo(one_person_table = person_table)
    })
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Run the app #### 
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
shinyApp(ui = ui, server = server)

根据在rhandsontable中保存的信息在后台更新对象

0 个答案: