Сброс DataTable в R Shiny

Question

Я хотел бы сбросить значение (а именно row_last_clicked в DataTable), принадлежащее объекту в R Shiny, когда происходит конкретное событие.

The (упрощенно) рабочий процесс выглядит следующим образом (мое исходное приложение включает в себя запрос к базе данных, так что я упрощенный его здесь): Тип

1. Пользователь термин для поиска (например, «лишай») в поле поиска ('which_species').
2. Результат отображается в DataTable (query_result_table).
3. Пользователь выбирает строку в отображаемой таблице данных (query_result_table).
4. Выбранная строка просто отображается в новом DataTable (selected_row_table).
5. Пользователь вводит новый термин запроса (например, «setosa»). Мы ожидаем, что второй DataTable (selected_row_table) будет сброшен и не отобразится ничего (до тех пор, пока шаг 3 не добьется успеха).

Проблема заключается в том, что если пользователь вводит новый термин запроса, то значение первого DataTable (query_result_table) row_last_clicked сохраняет свое текущее значение, так второго DataTable selected_row_table будет отображать строку текущего результата запроса на основе предыдущего выбор.

Я попытался изменить значение input$query_result_table_row_last_clicked с кодом, но оно только для чтения.

ui.R

shinyUI(fluidPage(
    fluidRow(
    column(4, 
      selectInput("which_species", label = h5("Specify species"), 
         choices = c("versicolor","setosa","virginica"))) 
), 
    fluidRow(
    column(12, 
      dataTableOutput(outputId = "query_result_table")) 
), 

    fluidRow(
    column(12, 
      dataTableOutput(outputId = "selected_row_table")) 
) 
)) 

server.R

library(DT) 
shinyServer(function(input, output) { 

    # This might be a time consuming database query so I use reactive expression 
    query_result <- reactive({ 
    data <- iris[iris$Species==input$which_species,] 
    # Below code is needed to ensure |row_last_clicked| returns the actually clicked row and not rowname of the data.frame 
    q <- dim(data) 
    if (q[1]==0) {return(data)} 
    rownames(data) <- 1:q[1] 
    data 
    }) 

    output$query_result_table <- renderDataTable({ 
    query_result() 
    },selection = 'single') 


    output$selected_row_table <- renderDataTable({ 

    selected_row_in_query_result <- input$query_result_table_row_last_clicked 
    if (is.null(selected_row_in_query_result)) {return()} 
    selected_row_in_query_result <- as.integer(selected_row_in_query_result) 
    message(selected_row_in_query_result) 
    data_to_display <- query_result() 
    data_to_display <- data_to_display[selected_row_in_query_result,] 
    }) 

Answer 1

ниже код делает то, что вам нужно. Основная идея заключается в том, что данные, отображаемые в таблице одиночных строк (data_to_display), управляются двумя функциями eventReactive(). Один активируется при изменении input$which_species и просто устанавливает data_to_display в NULL, поэтому вы не видите таблицу. Вторая активируется при изменении input$query_result_table_row_last_clicked (т. Е. Вы щелкните по строке), и это отображает таблицу на основе выбранной строки.

library(shiny) 
library(DT) 

ui<-fluidPage(
    fluidRow(
    column(4, 
      selectInput("which_species", label = h5("Specify species"), 
         choices = c("versicolor","setosa","virginica"))) 
), 
    fluidRow(
    column(12, 
      DT::dataTableOutput(outputId = "query_result_table")) 
), 

    fluidRow(
    column(12, 
      DT::dataTableOutput(outputId = "selected_row_table")) 
) 
) 

server<-shinyServer(function(input, output) { 

    # This might be a time consuming database query so I use reactive expression 
    query_result <- reactive({ 
    data <- iris[iris$Species==input$which_species,] 
    # Below code is needed to ensure |row_last_clicked| 
    # returns the actually clicked row and not rowname of the data.frame 
    q <- dim(data) 
    if (q[1]==0) {return(data)} 
    rownames(data) <- 1:q[1] 
    data 
    }) 

    output$query_result_table <- DT::renderDataTable({ 
    query_result() 
    },selection = 'single') 

    data_to_display<-eventReactive(input$query_result_table_rows_selected,ignoreNULL=TRUE, 
       query_result()[as.integer(input$query_result_table_row_last_clicked),] 
    ) 

    output$selected_row_table<-DT::renderDataTable(data_to_display()) 

}) 

shinyApp(ui,server) 

Отредактировано одну линию, основанную на commnents