无法将反应值传递给闪亮的变量

Question

我正在尝试使用imager::imsub 动态地将图像切碎。结果是空图像，根据打印的值，我意识到输入的值未能按预期传递给变量subArea。

更糟糕的是，即使reactiveVlaues 中定义的值也没有显示出来。 reactiveValues不被视为初始值会随着环境和依赖项的变化而变化吗？

请找到玩具样品供您参考。

除了empty image 消息之外，我还收到错误消息(subscript) logical subscript too long，它只在我取消注释imsub 部分时出现，不知道错误来自哪里。非常感谢。

library(shiny)
library(shinydashboard)
library(imager)
{
rm(list=ls())

ui <- 
  dashboardPage(
    dashboardHeader(title = NULL),
    dashboardSidebar(
      sliderInput("ixs", "init x start", value = 50, min = 1, max = 250),
      sliderInput("ixr", "init x range", value = 50, min = 1, max = 250),
      sliderInput("iys", "init y start", value = 50, min = 1, max = 250),
      sliderInput("iyr", "init y range", value = 50, min = 1, max = 250),
      actionButton("submit", "submit")
    ),
    dashboardBody(
      plotOutput("pl"),
      textOutput("txt")
    )
  )

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

    #subArea <- list()
    im <- load.image("Rlogo.png")

    subArea <- reactiveValues(xs = 0, xr = 500, ys = 0, yr =500)

    observeEvent(input$submit,{
      subArea$xs <- input$ixs
      subArea$ys <- input$iys
      subArea$xr <- input$ixr
      subArea$yr <- input$iyr
    })
      subArea$xs <- 0
      subArea$ys <- 0
      subArea$xr <- dim(im)[1]
      subArea$yr <- dim(im)[2]

    output$txt <- 
      renderPrint(cat(c(
        paste0("   submit", input$submit  ),
        paste0("   dim =", dim(im)[1:2]  ),
        paste0("   ixs =", input$ixs),
        paste0("   ixr =", input$ixr),
        paste0("   iys =", input$iys),
        paste0("   iyr =", input$iyr),
        paste0("subArea$ixs =", subArea$ixs),
        paste0("subArea$ixr =", subArea$ixr),
        paste0("subArea$iys =", subArea$iys),
        paste0("subArea$iyr =", subArea$iyr)
        ))) 

    output$pl <- renderPlot({

      load.image("Rlogo.png") %>% 
        imsub( x > subArea$xs,
               x < subArea$rx,
               y > subArea$ys,
               y < subArea$yr) %>%
        plot
    })

  }

shinyApp(ui, server)
}

Answer 1

错误是由于拼写错误。见下文。

library(shiny)
library(shinydashboard)
library(imager)
{
  rm(list=ls())

  ui <- 
    dashboardPage(
      dashboardHeader(title = NULL),
      dashboardSidebar(
        sliderInput("ixs", "init x start", value = 50, min = 1, max = 250),
        sliderInput("ixr", "init x range", value = 50, min = 1, max = 250),
        sliderInput("iys", "init y start", value = 50, min = 1, max = 250),
        sliderInput("iyr", "init y range", value = 50, min = 1, max = 250),
        actionButton("submit", "submit")
      ),
      dashboardBody(
        plotOutput("pl"),
        textOutput("txt")
      )
    )

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

      #subArea <- list()
      im <- load.image("Rlogo.png")

      subArea <- reactiveValues(xs = 0, xr = 500, ys = 0, yr =500)

      observeEvent(input$submit,{
        subArea$xs <- input$ixs
        subArea$ys <- input$iys
        subArea$xr <- input$ixr
        subArea$yr <- input$iyr
      })
      subArea$xs <- 0
      subArea$ys <- 0
      subArea$xr <- dim(im)[1]
      subArea$yr <- dim(im)[2]

      output$txt <- 
        renderPrint(cat(c(
          paste0("   submit", input$submit  ),
          paste0("   dim =", dim(im)[1:2]  ),
          paste0("   ixs =", input$ixs),
          paste0("   ixr =", input$ixr),
          paste0("   iys =", input$iys),
          paste0("   iyr =", input$iyr),
          #paste0("subArea$ixs =", subArea$ixs),
          #paste0("subArea$ixr =", subArea$ixr),
          #paste0("subArea$iys =", subArea$iys),
          #paste0("subArea$iyr =", subArea$iyr)
          paste0("subArea$ixs =", subArea$xs),
          paste0("subArea$ixr =", subArea$xr),
          paste0("subArea$iys =", subArea$ys),
          paste0("subArea$iyr =", subArea$yr)
      ))) 

      output$pl <- renderPlot({

        load.image("Rlogo.png") %>% 
          imsub( x > subArea$xs,
                 #x < subArea$rx,
                 x < subArea$xr,
                 y > subArea$ys,
                 y < subArea$yr) %>%
          plot
      })

    }

  shinyApp(ui, server)
}