如何用 R Shiny 中具有相同目的的另一个反应性管理函数替换isolate()？

问题描述 投票：0回答：1

下面的示例代码有 3 个链接的用户输入矩阵：第一个 

base_input
允许用户进行静态输入，接下来的 2 个用户输入矩阵 
var_1_input
和 
var_2_input
（统称为“var_x_input”）是反应性地反馈来自 
base_input
的值和时间范围的滑块输入，并允许用户更改其各自最左侧标记为“X”的用户输入列中的时间维度。下图显示了数据流。如何用其他反应性管理代码替换此代码中的 
isolate()
？

我遇到的问题是

isolate()
与管理小数的js代码冲突。 js 代码确保矩阵输入单元格中至少显示 2 位小数。当激活 js 代码（下面注释掉）时，
base_input
和 
var_x_input
矩阵之间的反应流不再起作用（这意味着 
base_input[1,1]
中的输入需要立即反映在 
 的右上角单元格中） var_1_input
），尽管小数可以完美地工作。如果我删除 
isolate()
，则会发生另一种不良情况：更改 
base_input
中一个单元格中的值会重置两个 
var_x_input
矩阵，而不仅仅是链接到 
var_x_input
的 
base_input
矩阵。 
isolate()
确保每个 
var_x_input
独立链接到 
base_input
中相应的单元格。

我正在尝试让所有 3 个功能发挥作用：

base_input
和 
var_x_input
矩阵之间的下游反应性；指定用户输入单元格的格式，至少保留 2 位小数（根据 js 代码）；将 
base_input
单元格更改为一个 
var_x_input
应该仅重置该 
var_x_input
矩阵，而不是所有 
var_x_input
矩阵。

代码：

library(shinyMatrix)
library(shiny)
library(shinyjs)

# js <- "
# $(document).on('shiny:bound', function(event) {
#   var $elem = $(event.target);
#   if($elem.hasClass('vue-input')) {
#     $elem.find('td').each(function() {
#       var $td = $(this);
#       var columnIndex = $td.index();
#       var $table = $td.closest('.vue-input');
#       var tableId = $table.attr('id');
#       var isVarInput = tableId.startsWith('var_') && tableId.endsWith('_input');
#       var text = $td.find('span').text();
#       var num = parseFloat(text);
# 
#       if (!isNaN(num)) {
#         if (isVarInput && columnIndex == 0) {
#           // Format with 0 decimal places for the first column of var_x_input
#           $td.find('span').html(num.toFixed(0));
#         } else {
#           // Use 2 decimal places for the second column of var_x_input and other cases
#           var decimalPlaces = (text.split('.')[1] || []).length;
#           var fixed = decimalPlaces < 2 ? 2 : decimalPlaces;
#           $td.find('span').html(num.toFixed(fixed));
#         }
#       }
#     });
#   }
# });
# 
# $(document).ready(function() {
#   $('body').on('focusout', '.vue-input table td input', function(e) {
#     var $td = $(this).parent();
#     var columnIndex = $td.index();
#     var $table = $td.closest('.vue-input');
#     var tableId = $table.attr('id');
#     var isVarInput = tableId.startsWith('var_') && tableId.endsWith('_input');
# 
#     var interval = setInterval(function() {
#       if ($td.children().is('span')) {
#         clearInterval(interval);
#         var $span = $td.find('span');
#         var text = $span.text();
#         var num = parseFloat(text);
# 
#         if (!isNaN(num)) {
#           if (isVarInput && columnIndex == 0) {
#             // Format with 0 decimal places for the first column of var_x_input
#             $span.html(num.toFixed(0));
#           } else {
#             // Use 2 decimal places for the second column of var_x_input and other cases
#             var decimalPlaces = (text.split('.')[1] || []).length;
#             var fixed = decimalPlaces < 2 ? 2 : decimalPlaces;
#             $span.html(num.toFixed(fixed));
#           }
#         }
#       }
#     }, 50);
#   });
# });
# "

matInputBase <- function(name) {
  matrixInput(name,
              value = matrix(rep(0.20,2),2, 1,dimnames = list(c("A","B"), NULL)),
              rows = list(extend = FALSE, names = TRUE),
              cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
              class = "numeric")
}

matInputVary <- function(name, x,y) {
  matrixInput(
    name,
    value = matrix(c(x, y), 1, 2, dimnames = list(NULL,c("X","Y"))),
    rows = list(extend = TRUE, names = FALSE),
    cols = list(extend = TRUE, delta = 0, names = TRUE, editableNames = FALSE),
    class = "numeric"
  )
}

ui <- fluidPage(
  useShinyjs(),
  # tags$head(tags$script(HTML(js))),
  sliderInput("periods","Time window (W):", min = 1, max = 120, value = 60),
  h5(strong("Variable (Y) over window (W):")),
  matInputBase("base_input"),
  uiOutput("Vectors")
)

server <- function(input, output, session) {
  prev_base_input <- reactiveValues(data = matrix(NA, nrow = 2, ncol = 1))

  observeEvent(input$base_input, {
    for (i in 1:2) {
      if (is.na(prev_base_input$data[i,1])||input$base_input[i,1]!=prev_base_input$data[i,1]){
        updateMatrixInput(
          session,
          paste0("var_", i, "_input"),
          value = matrix(c(input$periods,input$base_input[i,1]),1,2,dimnames=list(NULL,c("X","Y")))
        )
        prev_base_input$data[i, 1] <- input$base_input[i, 1]
      }
    }
  })
  
  output$Vectors <- renderUI({
    input$resetVectorBtn
    varNames <- c("A", "B")
    tagList(
      lapply(1:2, function(i) {
        list(
          h5(strong(paste("Adjust", varNames[i], "(Y) at time X:"))),
          matInputVary(paste0("var_", i, "_input"), input$periods, isolate(input$base_input[i,1]))
        )
      })
    )
  })
}

shinyApp(ui, server)
javascript r shiny shinyjs
1个回答
0
投票
library(shiny)
library(shinyMatrix)

js <- "
$(document).ready(function() {
  $('#base_input').on('shiny:bound', function(event) {
    var matrix = $(this).data('values');
    $(this).find('td:eq(0) span').text(matrix[0][0].toFixed(2));
    $(this).find('td:eq(1) span').text(matrix[1][0].toFixed(2));
  });
  $(document).on('shiny:updateinput', function(e) {
    var $target = $(e.target);
    if($target.hasClass('vue-input')) {
      var matrix = e.message.value.data;
      $target.find('td:eq(0) span').text(matrix[0][0].toFixed(2));
      $target.find('td:eq(1) span').text(matrix[0][1].toFixed(2));
    }
  });
  $('#base_input').on('blur', 'table td input', function(e) {
    var $td = $(this).parent();
    var val = parseFloat($(this).val()).toFixed(2);
    var interval = setInterval(function() {
      if($td.children().is('span')) {
         clearInterval(interval);
         $td.find('span').text(val);
      }
    });
  });
});
"

matInputBase <- function(name) {
  matrixInput(
    name,
    value = matrix(rep(20,2),2, 1,dimnames = list(c("A", "B"), NULL)),
    rows = list(extend = FALSE, names = TRUE),
    cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
    class = "numeric"
  )
}

matInputVary <- function(name, x,y) {
  matrixInput(
    name,
    value = matrix(c(x, y), 1, 2, dimnames = list(NULL,c("X","Y"))),
    rows = list(extend = TRUE, names = FALSE),
    cols = list(extend = TRUE, delta = 0, names = TRUE, editableNames = FALSE),
    class = "numeric"
  )
}

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  sliderInput("periods","Time window (W):", min = 1, max =10, value = 5),
  h5(strong("Variable (Y) over window (W):")),
  matInputBase("base_input"),
  uiOutput("Vectors")
)

server <- function(input, output, session) {
  prev_base_input <- reactiveValues(data = matrix(NA, nrow = 2, ncol = 1))
  
  observeEvent(input$base_input, {
    for (i in 1:2) {
      if (is.na(prev_base_input$data[i,1])||input$base_input[i,1]!=prev_base_input$data[i,1]){
        updateMatrixInput(
          session,
          paste0("var_", i, "_input"),
          value = matrix(c(input$periods,input$base_input[i,1]),1,2,dimnames=list(NULL,c("X","Y")))
        )
        prev_base_input$data[i, 1] <- input$base_input[i, 1]
      }
    }
  }, ignoreInit = FALSE)
  
  output$Vectors <- renderUI({
    input$resetVectorBtn
    varNames <- c("A", "B")
    lapply(1:2, function(i) {
      list(
        h5(strong(paste("Adjust", varNames[i], "(Y) at time X:"))),
        matInputVary(paste0("var_", i, "_input"), input$periods, isolate(input$base_input)[i, 1])
      )
    })
  })
  
}

shinyApp(ui, server)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.