Pergunta

Following the answer given in this question, I can get a polygon to render on a plot with each click:

map with circle

However, I can't seem to find an easy way to allow the polygon() to persist. The way I have it now, the both the initial plot and the annotation are replotted each time.

What is the (a) right way to decouple the annotation and plot so that multiple annotations can be created?

I feel like I can use the "Paint Circle" button to add a new polygon(), but I am not sure how to create a new "object" like that in R.

Code:

server.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")
      )
    )
  )
))
Foi útil?

Solução

You can change your example slightly and add a reactiveValue to make this work

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

Example of multi poly

Licenciado em: CC-BY-SA com atribuição
Não afiliado a StackOverflow
scroll top