r - Shiny でクリック時に任意の数のプロット レイヤーを追加/保持する方法

Question

この質問で与えられた答えに従って、クリックするたびにプロットにレンダリングするポリゴンを取得できます。

polygon()ただし、永続化を許可する簡単な方法が見つからないようです。私が今持っている方法では、最初のプロットと注釈の両方が毎回再プロットされます。

複数の注釈を作成できるように、注釈とプロットを切り離す正しい方法は何ですか?

「ペイント サークル」ボタンを使用して新しい を追加できるような気がpolygon()しますが、R でそのような新しい「オブジェクト」を作成する方法がわかりません。

コード：

サーバー.R

library(shiny)
library(maps)
library(mapdata)
library(rworldmap)
library(gridExtra)

circleFun <- function(center = c(0,0),radius = 1, npoints = 100){
    tt <- seq(0,2*pi,length.out = npoints)
    xx <- center[1] + radius * cos(tt)
    yy <- center[2] + radius * sin(tt)
    return(data.frame(x = xx, y = yy))
}

shinyServer(function(input, output) {
  # Reactive dependencies
  buttonClicked <- reactive(input$paintupdate)

  isolate({
  theworld <- function() {
    myplot <- map("world2", wrap=TRUE, plot=TRUE,
        resolution=2)
  }})

  user.circle <- function() {
    if (buttonClicked() > 0) {
      cur.circ <- circleFun(c(input$plotclick$x,input$plotclick$y),
                            radius=input$radius*100, npoints = 30)
      polygon(x=cur.circ$x,y=cur.circ$y,
              col = rainbow(1000,s=0.5,alpha=0.5)[input$circlecolor])
    }
  }

  output$myworld <- renderPlot({
    theworld()
    user.circle()
  })

  output$clickcoord <- renderPrint({
    # get user clicks, report coords
    if ("plotclick" %in% names(input)) {
      print(input$plotclick)
    }
    print(buttonClicked())
  })



})

ui.R

library(shiny)

# Define UI for application
shinyUI(pageWithSidebar(

  # Application title
  headerPanel("App"),

  sidebarPanel(
    sliderInput("radius", 
                "Location radius", 
                min = 0,
                max = 1, 
                value = 0.1,
                round=FALSE,
                step=0.001),
    sliderInput("circlecolor",
                "Circle color (hue)",
                min=0,
                max=1000,
                step=1,
                value=sample(1:1000,1)),
    actionButton("paintupdate", "Paint Circle"),
    textOutput("clickcoord")
  ),

  mainPanel(
    tabsetPanel(
      tabPanel("Map",
               plotOutput("myworld", height="650px",width="750px",
                          clickId="plotclick")
      )
    )
  )
))

Answer 1

例を少し変更してreactiveValue、これを機能させるために a を追加できます

library(shiny)
library(maps)
library(mapdata)
library(rworldmap)
library(gridExtra)

circleFun <- function(center = c(0,0),radius = 1, npoints = 100){
  tt <- seq(0,2*pi,length.out = npoints)
  xx <- center[1] + radius * cos(tt)
  yy <- center[2] + radius * sin(tt)
  return(data.frame(x = xx, y = yy))
}

library(shiny)

# Define UI for application
runApp(
  list(ui = pageWithSidebar(

    # Application title
    headerPanel("App"),

    sidebarPanel(
      sliderInput("radius", 
                  "Location radius", 
                  min = 0,
                  max = 1, 
                  value = 0.1,
                  round=FALSE,
                  step=0.001),
      sliderInput("circlecolor",
                  "Circle color (hue)",
                  min=0,
                  max=1000,
                  step=1,
                  value=sample(1:1000,1)),
      actionButton("paintupdate", "Paint Circle"),
      textOutput("clickcoord")
    ),

    mainPanel(
      tabsetPanel(
        tabPanel("Map",
                 plotOutput("myworld", height="650px",width="750px",
                            clickId="plotclick")
        )
      )
    )
  ),
  server = function(input, output, session) {
    # Reactive dependencies
    myReact <- reactiveValues()
    buttonClicked <- reactive(input$paintupdate)

    isolate({
      theworld <- function() {
        myplot <- map("world2", wrap=TRUE, plot=TRUE,
                      resolution=2)
      }})


    user.circle <- function(a,b,c,d) {
      cur.circ <- circleFun(c(a,b),
                            radius=c, npoints = 30)
      polygon(x=cur.circ$x,y=cur.circ$y,
              col = rainbow(1000,s=0.5,alpha=0.5)[d])     
    }


    observe({
      if (buttonClicked() > 0) {
        # take a dependence on button clicked
        myReact$poly <- c(isolate(myReact$poly), list(list(a=isolate(input$plotclick$x), b= isolate(input$plotclick$y)
                                             ,c=isolate(input$radius*100), d = isolate(input$circlecolor))))
      }
    }, priority = 100)

    output$myworld <- renderPlot({
      theworld()
        for(i in seq_along(myReact$poly)){
          do.call(user.circle, myReact$poly[[i]])
        }
    })

    output$clickcoord <- renderPrint({
      # get user clicks, report coords
      if ("plotclick" %in% names(input)) {
        print(input$plotclick)
      }
      print(buttonClicked())
    })



  }), display.mode= "showcase"
)