Сбросить DataTable в R Shiny

66
6

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

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

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

Проблема заключается в том, что если пользователь вводит новый термин запроса, тогда значение row_last_clicked для первого DataTable (query_result_table) сохраняет текущее значение, поэтому вторая 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,]
})

спросил(а) 2016-01-08T16:07:00+03:00 4 года, 6 месяцев назад
1
Решение
54

Приведенный ниже код делает то, что вам нужно. Основная идея заключается в том, что данные, отображаемые в таблице одиночной строки (data_to_display), управляются двумя eventReactive(). Один активируется, когда input$which_species и просто устанавливает для параметра data_to_display NULL поэтому вы не видите таблицу. Вторая активируется при input$query_result_table_row_last_clicked изменений input$query_result_table_row_last_clicked (т. 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)

Отредактирована одна строка на основе компонентов

ответил(а) 2016-01-08T16:29:00+03:00 4 года, 6 месяцев назад
Ваш ответ
Введите минимум 50 символов
Чтобы , пожалуйста,
Выберите тему жалобы:

Другая проблема