我希望用户能够单击绘图,并且当他们进行记录时,在他们单击的位置留下标记或消息。
我在绘图环境中使用反应值。这似乎是在重置剧情。几乎在消息出现后立即。
这是一个最小的不完全工作的例子
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)
Run Code Online (Sandbox Code Playgroud)
我不确定目的是仅显示最近单击的点,还是显示所有单击的点。由于 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)
Run Code Online (Sandbox Code Playgroud)