не удается передать реактивное значение переменным в блестящем - PullRequest
Новая
       12

не удается передать реактивное значение переменным в блестящем

0 голосов
/ 05 мая 2020

Я пытаюсь динамически вырезать блестящее изображение с помощью imager::imsub. Результатом является пустое изображение, согласно напечатанным значениям, я понимаю, что введенные значения не передаются в переменную subArea, как ожидалось.

Еще хуже, даже значения, определенные в reactiveVlaues, не объявиться. Разве reactiveValues не рассматривается как начальные значения, которые изменятся при изменении среды и иждивенцев?

Пожалуйста, найдите образец игрушки для справки.

Помимо empty image msg, Я также получаю сообщение об ошибке (subscript) logical subscript too long, которое появляется только тогда, когда я делаю часть imsub раскомментированной, не знаю, откуда взялась ошибка. Большое спасибо.

Rlogo

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)
}

1 Ответ

1 голос
/ 05 мая 2020

Ошибка из-за опечаток. См. Ниже. 

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)
}
...