Mik*_*ila 5 plot interactive r shiny
我本质上是想在一个闪亮的应用程序中复制该网站上的图表行为。
也就是说，我想创建一个交互式图表，通过将鼠标光标悬停在图表上，您可以沿 x 轴移动“目标线”。然后，根据目标线的位置，图形上绘图线的 y 值显示在目标线和绘图线的交点上。（我本来打算发布一个说明性的数字，但看来我还没有足够的声誉。）
我已经成功地让应用程序运行起来。在我当前的实现中，我使用hover选项来plotOutput获取光标在绘图上的位置，然后将目标线添加abline到新绘图中。与 一起points在text绘图上添加 y 值。
我遇到的问题是，移动一段时间后，目标线开始严重滞后于实际的鼠标光标。我认为这是因为每次鼠标悬停位置更新时都必须重新绘制整个绘图（当前光标移动时每 500 毫秒一次，因为我正在使用hoverOpts(delayType = "throttle")）。渲染速度不够快，无法跟上鼠标的移动。我想知道是否有人知道如何解决这个问题。
Shiny 应用程序示例的可运行代码：
library(shiny)
trigWaves <- function(A = 1, ...) {
xval <- seq(0, 2*pi, len = 201)
sinx <- A * sin(xval); cosx <- A * cos(xval)
plot(x = xval, y = sinx, type = 'n', ylab = "f(x)", xlab = "x", ...)
abline(h = A * c(-1, 0, 1), lty = c(2, 1, 2), col = 'gray')
abline(v = pi * seq(0, 2, by = 0.5), lty = 2, col = 'gray')
lines(x = xval, y = sinx, col = 'red')
lines(x = xval, y = cosx, col = 'blue')
box()
invisible(list(x = xval, y = list(sin = sinx, cos = cosx)))
}
# Maximum selectable amplitude
Amax <- 5
runApp(
# Define UI for application
list(ui = pageWithSidebar(
# Application title
headerPanel("Read Function Values Interactively from a Plot"),
sidebarPanel(
sliderInput("amplitude",
"Amplitude:",
min = 1,
max = Amax,
value = 2,
step = 0.1)
),
mainPanel(
plotOutput("trigGraph",
hover =
hoverOpts(
id = "plothover",
delay = 500,
delayType = "throttle"
)
)
)
),
# Define server for application
server = function(input, output, session) {
A <- reactive(input$amplitude)
hoverx <- reactiveValues(initial = 2)
# Hover position
tx <- reactive({
# If no previous hover position found, return initial = 0
if (is.null(hoverx$prev)) return(hoverx$initial)
# Hover resets to NULL every time the plot is redrawn -
# If hover is null, then use the previously saved hover value.
if (is.null(input$plothover)) hoverx$prev else input$plothover$x
})
# Function to plot the 'reader line' and the function values
readLine <- reactive({
abline(v = tx(), col = 'gray'); box()
# Plot coordinates for values and points
pcoords <- list(x = rep(tx(), 2), y = A() * c(sin(tx()), cos(tx())))
points(pcoords, pch = 16, col = c("red", "blue")) # points on lines
text(pcoords, labels = round(pcoords$y, 2), pos = 4) # function values
})
# Render the final output graph
output$trigGraph <- renderPlot({
# Create base plot
trigWaves(A = A(), ylim = Amax * c(-1, 1))
readLine() # Add the reader line and function values
# Add a legend
legend(x = 3.5, y = 0.9 * Amax,
legend = c("sin(x)", "cos(x)"),
col = c("red", "blue"), lty = 1)
# Save the hover position used as the previous position
hoverx$prev <- tx()
})
}), display.mode= "showcase"
)
六年后，JavaScript 仍然是此类图表的最佳选择。
\n这里\xe2\x80\x99s 概述了几个不同的 R 包来实现这一目标，\n包括最初在评论中提到的 dygraphs 和 highcharts。
\n# Goal is to make an interactive crosshair plot with data from this.\ntrigWaves <- function(x, A = 1, ...) {\n rbind(\n data.frame(x, y = A * sin(x), f = "sin"),\n data.frame(x, y = A * cos(x), f = "cos")\n )\n}\n\nxs <- seq(0, 2 * pi, len = 201)\nAmax <- 5 # Maximum amplitude -- determines plot range, too.\nlibrary(dygraphs)\n\nplot_dygraphs = function(data) {\n # Unlike other packages, dygraphs wants wide data\n wide <- data %>% \n tidyr::pivot_wider(\n names_from = f,\n values_from = y\n )\n \n dygraph(wide) %>% \n dyCrosshair("vertical") %>% \n dyAxis("y", valueRange = c(-1, 1) * Amax)\n}\nlibrary(highcharter)\n\nplot_highcharter = function(data) {\n hchart(data, "line", hcaes(x, y, group = f)) %>%\n hc_xAxis(crosshair = TRUE) %>% \n hc_yAxis(min = -Amax, max = Amax)\n}\nlibrary(plotly)\n\nplot_plotly = function(data) {\n plot_ly(data) %>%\n add_lines(~ x, ~ y, color = ~ f) %>% \n layout(\n hovermode = "x",\n spikedistance = -1,\n xaxis = list(\n showspikes = TRUE,\n spikemode = "across"\n ),\n yaxis = list(range = c(-1, 1) * Amax)\n )\n}\nlibrary(c3)\n\nplot_c3 = function(data) {\n c3(data, "x", "y", group = "f") %>% \n c3_line("line") %>% \n yAxis(min = -Amax, max = Amax) %>% \n point_options(show = FALSE)\n}\n所有的软件包也与 Shiny 集成。Here\xe2\x80\x99s 是一个展示它们的演示应用程序：
\nlibrary(shiny)\n\nui <- fluidPage(\n sliderInput("amplitude", "Amplitude:", 0.1, Amax, 1, step = 0.1),\n fluidRow(\n column(6,\n tags$h3("dygraphs"),\n dygraphOutput("dygraphs"),\n ),\n column(6,\n tags$h3("highcharter"),\n highchartOutput("highcharter"),\n ),\n column(6,\n tags$h3("plotly"),\n plotlyOutput("plotly"),\n ),\n column(6,\n tags$h3("c3"),\n c3Output("c3", height = "400px"), # All others have 400px default height\n )\n )\n)\n\nserver <- function(input, output, session) {\n waves <- reactive(trigWaves(xs, input$amplitude))\n \n output$dygraphs <- renderDygraph({ plot_dygraphs(waves()) })\n output$highcharter <- renderHighchart({ plot_highcharter(waves()) })\n output$plotly <- renderPlotly({ plot_plotly(waves()) })\n output$c3 <- renderC3({ plot_c3(waves()) })\n}\n\nshinyApp(ui, server)\n在这里观看直播： https: //mikkmart.shinyapps.io/crosshair/
\n| 归档时间： |
|
| 查看次数： |
1574 次 |
| 最近记录： |