В R Shiny, как обновить только одно значение в матрице ввода пользователя?

#r #matrix #shiny #shiny-reactivity

Вопрос:

В приведенном ниже коде MWE я пытаюсь заставить любые пользовательские данные в матрице 1 реактивно отражаться только в верхнем правом углу матрицы 2 ([1,2)], сохраняя при этом все остальные значения, ранее введенные в матрицу 2. Три изображения внизу объясняют проблему: не все значения точно сохранены. Возможно ли сохранение предыдущих входных данных, кроме матрицы 2 [1,2]? Как это можно сделать?

Я повозился с матричными индексами и уперся в стену.

Обратите внимание на предупреждение, опубликованное в консоли R Studio, как показано на заключительном изображении.

Это «почти MWE», но UDF interpol() для дополнительной/интерполяции можно безопасно игнорировать, упрощая код.

Код MWE:

 library(shiny) library(shinyMatrix)  interpol lt;- function(a, b) { # [a] = modeled periods, [b] = matrix inputs  c lt;- b  c[,1][c[,1] gt; a] lt;- a  d lt;- diff(c[,1, drop = FALSE])  d[d lt;= 0] lt;- NA  d lt;- c(1,d)  c lt;- cbind(c,d)  c lt;- na.omit(c)  c lt;- c[,-c(3),drop=FALSE]  e lt;- rep(NA, a)  e[c[,1]] lt;- c[,2]  e[seq_len(min(c[,1])-1)] lt;- e[min(c[,1])]  if(max(c[,1]) lt; a){e[seq(max(c[,1])   1, a, 1)] lt;- 0}  e lt;- approx(seq_along(e)[!is.na(e)], e[!is.na(e)], seq_along(e))$y # Interpolates  return(e) }  ui lt;- fluidPage(  sliderInput('periods', 'Modeled periods (X):', min=1, max=10, value=10),    h5(strong("Matrix 1:")),   matrixInput("matrix1",   value = matrix(c(5), nrow = 1, ncol = 1, dimnames = list("Base rate (Y)",NULL)),  rows = list(extend = FALSE, names = TRUE),  cols = list(names = FALSE),  class = "numeric"),    h5(strong("Matrix 2:")),   matrixInput("matrix2",  value = matrix(c(10,5), nrow = 1, ncol = 2, dimnames = list(NULL,c("X","Y"))),  rows = list(extend = TRUE, names = TRUE, delete = TRUE),  class = "numeric"),    plotOutput("plot") )  server lt;- function(input, output, session){    observeEvent(input$periods,{  updateMatrixInput(  session,   inputId = "matrix2",   value = matrix(c(input$periods,input$matrix2[1,2]), 1, 2, dimnames = list(NULL,c("X","Y")))  )  })    observeEvent(input$matrix1, {  updateMatrixInput(  session,   inputId = "matrix2",  value = matrix(c(input$matrix2[,1],input$matrix1[,1]), ncol = 2, dimnames = list(NULL,c("X","Y")))  )  })    observeEvent(input$matrix2, {   if(any(rownames(input$matrix2) == "")){  tmpMatrix lt;- input$matrix2  rownames(tmpMatrix) lt;- paste("Row", seq_len(nrow(input$matrix2)))  isolate(updateMatrixInput(session, inputId = "matrix2", value = tmpMatrix))  }  input$matrix2  })    output$plot lt;- renderPlot({  req(input$matrix2)  plot(interpol(input$periods, input$matrix2))  })   }  shinyApp(ui, server)  

введите описание изображения здесь

введите описание изображения здесь

введите описание изображения здесь

Ответ №1:

Ладно, это было легко. В observeEvent для matrix1 я просто разобрал два входных столбца для matrix2 (на объекты col1 и col2 ), заменил значение matrix1 в правильное положение в векторе объединенных входных столбцов matrix2 ( joinCol ) и обновил matrix2 с помощью updateMatrixInput функции, как показано ниже:

 observeEvent(input$matrix1, {    col1 lt;- input$matrix2[,1]  col2 lt;- input$matrix2[,2]  joinCol lt;- c(col1,col2)  joinCol[length(input$matrix2)/2 1] lt;- input$matrix1[,1]    updateMatrixInput(  session,   inputId = "matrix2",  value = matrix(joinCol,  ncol = 2,   dimnames = list(NULL,c("X","Y")))  )  })