如何在闪亮的情节中显示情节点击

时间:2018-03-18 18:37:34

标签: r shiny

我希望用户能够点击一个情节,当他们进行录制时,会在他们点击的位置留下标记或消息。

我在绘图环境中使用反应值。这似乎正在重置情节。消息出现后几乎立即。

这是一个最低限度的非完整工作示例

library(shiny)

## ui.R
ui <- fluidPage(
    shinyjs::useShinyjs(),
    column(12,
        plotOutput("Locations", width=500, height=500,
            click="plot_click") )
)


## server.R
server <- function( input, output, session){


    ## Source Locations (Home Base)
    source_coords <- reactiveValues(xy=c(x=1, y=2) )

    ## Dest Coords
    dest_coords <- reactive({
        if (is.null(input$plot_click) ){
            list( x=source_coords$xy[1],
                  y=source_coords$xy[2])
        }  else {
            list( x=floor(input$plot_click$x),
                  y=floor(input$plot_click$y))
        }
    })


    ## Calculate Manhattan Distance from Source to Destination
    DistCost <- reactive({
        list( Lost=sum( abs(
            c(dest_coords()$x, dest_coords()$y) - source_coords$xy
        ) ) )
    })


    ## RenderPlot 
    output$Locations <- renderPlot({ 

        par(bg=NA)
        plot.new()
        plot.window(
            xlim=c(0,10), ylim=c(0,10),
            yaxs="i", xaxs="i")
        axis(1)
        axis(2)
        grid(10,10, col="black")
        box()

        ## Source
        points( source_coords$xy[1], source_coords$xy[2], cex=3, pch=intToUtf8(8962)) 

        ## Destination
        text(dest_coords()$x, dest_coords()$y, paste0("Distance=", DistCost() ))
    })        
}




### Run Application
shinyApp(ui, server)

2 个答案:

答案 0 :(得分:2)

我不确定目的是仅显示最近点击的点,还是显示点击的所有点。由于Pawel的答案涵盖了前一种情况(并且已经是一个可接受的答案,这意味着它可能是意图),我将向前者发布一个解决方案,以备日后参考,以防它再有帮助

library(magrittr)
library(shiny)

## ui.R
ui <- fluidPage(
    shinyjs::useShinyjs(),
    column(12,
        plotOutput("Locations", width=500, height=500,
            click="plot_click") )
)


## server.R
server <- function( input, output, session){

    initX <- 1
    initY <- 2

    ## Source Locations (Home Base)
    source_coords <- reactiveValues(xy=c(x=initX, y=initY) )

    ## Dest Coords
    dest_coords <- reactiveValues(x=initX, y=initY)
    observeEvent(plot_click_slow(), {
      dest_coords$x <- c(dest_coords$x, floor(plot_click_slow()$x))
      dest_coords$y <- c(dest_coords$y, floor(plot_click_slow()$y))
    })

    ## Don't fire off the plot click too often
    plot_click_slow <- debounce(reactive(input$plot_click), 300)

    ## Calculate Manhattan Distance from Source to Destination
    DistCost <- reactive({
        num_points <- length(dest_coords$x)

        list( Lost= lapply(seq(num_points), function(n) {
          sum( abs(
            c(dest_coords$x[n], dest_coords$y[n]) - source_coords$xy
          ) )
        }) )
    })


    ## RenderPlot
    output$Locations <- renderPlot({

        par(bg=NA)
        plot.new()
        plot.window(
            xlim=c(0,10), ylim=c(0,10),
            yaxs="i", xaxs="i")
        axis(1)
        axis(2)
        grid(10,10, col="black")
        box()

        ## Source
        points( source_coords$xy[1], source_coords$xy[2], cex=3, pch=intToUtf8(8962))

        ## Destination
        text(dest_coords$x, dest_coords$y, paste0("Distance=", DistCost()$Lost ))
    })
}




### Run Application
shinyApp(ui, server)

答案 1 :(得分:1)

问题是input$plot_click在从用户点击获取值后立即刷新,并返回NULL。您可以通过创建空列表stored <- list()来自行测试,然后添加

 stored[[length(stored)+1]] <<- as.character(c(input$plot_click$x, input$plot_click$y))

你的dest_coords里面有反应。你可以看到,如果你只点击一次它将存储三个值。第一个是NULL,第二个是点击的点坐标,但也会有第三个,再次是NULL。因此,在将它们推向依赖于他的反应之后,它会立即清除其值。但是,即使它是NULL,反应也会依赖于输入的任何变化。解决这个问题的方法是使用eventReactiveobserveEvent并确保ignoreNULL参数设置为TRUE(默认情况下它实际设置为TRUE) 。要使其适用于您的应用,您应该已经存储了在reactiveValues中创建绘图所需的所有最小值,并且在点击之后只需使用input$plot_click提供的数据覆盖数据。

以下是我修改过的示例:

library(shiny)

## ui.R
ui <- fluidPage(
  shinyjs::useShinyjs(),
  column(12,
         plotOutput("Locations", width=500, height=500,
                    click="plot_click"))
)


## server.R
server <- function( input, output, session){

  source_coords <- reactiveValues(xy=data.frame(x=c(1,1),  y=c(1,1)))

  observeEvent(input$plot_click, {
    source_coords$xy[2,] <- c(input$plot_click$x, input$plot_click$y)
    })

  ## RenderPlot 
  output$Locations <- renderPlot({ 
    par(bg=NA)
    plot.new()
    plot.window(
      xlim=c(0,10), ylim=c(0,10),
      yaxs="i", xaxs="i")
    axis(1)
    axis(2)
    grid(10,10, col="black")
    box()

    ## Source
    points( source_coords$xy[1,1], source_coords$xy[1,2], cex=3, pch=intToUtf8(8962)) 

    ## Destination
    text(source_coords$xy[2,1], source_coords$xy[2,2], paste0("Distance=", sum(abs(source_coords$xy[1,]-source_coords$xy[2,]))))
  })        

}

### Run Application
shinyApp(ui, server)