在下面的代码1中，我尝试使用plotly包创建一个可拖动的绘图。用户应该能够拖动绘图的点并捕获呈现在左侧的称为“Data1”的数据框中的新点。运行代码时，我收到错误“警告:<-:赋值左侧无效(NULL)错误”。我做错了什么？
仅供引用，下面的 Code2 就是这样做的，但使用了不同的数据集，尽管两者的结构相同。在运行 Code2 时，我将在 Code2 中工作的数据帧(称为“Data”)与在 Code1 中不起作用的数据帧(“Data1”)进行比较，以显示这两个数据帧在结构上的相似程度。拖动 Code2 中绘制的数据点，看看左侧的“数据”表更新得如何。这就是我试图在 Code1 中实现的目标，但通过使用 Data1 数据来实现。
解决方案剧透:请参阅下面的 ismirsehregal 答案。 Code1 和 Code2 之间的差异(Code1 失败而 Code2 没有)是由于在 Code1 中定义 data1() 数据帧时不恰本地使用了 reactive() 造成的。由于 data1() 是从不同地方修改的(sliderInput()，plotly 中的拖动功能)，reactiveVal() 或 reactiveValues在定义数据帧时必须使用 () 而不是 reactive() 。另请注意在拖动绘图点后渲染修改后的数据帧时使用 reactiveValuesToList() 。
代码1:
library(plotly)
library(purrr)
library(shiny)
ui <- fluidPage(
fluidRow(column(5,sliderInput('periods','Nbr of periods:',min=0,max=24,value=12))),
fluidRow(column(2,h5("Data1:"),tableOutput('data1')),
column(6, plotlyOutput("p")))
)
server <- function(input, output, session) {
data1 <- reactive({
data.frame(
x = c(1:input$periods),
y = c((0.15-0.70)*(exp(-50/100*(1:input$periods))-exp(-50/100*input$periods)*
(1:input$periods)/input$periods)) + 0.70
)
})
output$p <- renderPlotly({
circles <- map2(data1()$x, data1()$y,
~list(type = "circle",
xanchor = .x,
yanchor = .y,
x0 = -4, x1 = 4,
y0 = -4, y1 = 4,
xsizemode = "pixel",
ysizemode = "pixel",
fillcolor = "blue",
line = list(color = "transparent"))
)
plot_ly() %>%
add_lines(x = data1()$x, y = data1()$y, color = I("red")) %>%
layout(shapes = circles) %>%
config(edits = list(shapePosition = TRUE))
})
output$data1 <- renderTable(data1())
# update x/y reactive values in response to changes in shape anchors
observe({
ed <- event_data("plotly_relayout")
shape_anchors <- ed[grepl("^shapes.*anchor$", names(ed))]
if (length(shape_anchors) != 2) return()
row_index <- unique(readr::parse_number(names(shape_anchors)) + 1)
pts <- as.numeric(shape_anchors)
data1()$x[row_index] <- pts[1]
data1()$y[row_index] <- pts[2]
})
}
shinyApp(ui, server)
代码2:
library(plotly)
library(purrr)
library(shiny)
ui <- fluidPage(
fluidRow(column(5,sliderInput('periods','Nbr of periods:',min=0,max=24,value=12))),
fluidRow(
column(2,h5(strong(("Data:"))),tableOutput('data')),
column(2,h5(strong(("Data1:"))),tableOutput('data1')),
column(6,h5(strong(("Move the points and see how `Data` table to left updates:"))), plotlyOutput("p")),
),
fluidRow(h5(strong(("Data1 above shown for comparison purposes, would like to substitute Data with Data1 in the plot"))))
)
server <- function(input, output, session) {
rv <- reactiveValues( x = mtcars$mpg,y = mtcars$wt)
data <- reactive(data.frame(x=(rv$x_sub),y=(rv$y_sub)))
data1 <- reactive({
data.frame(
x = c(1:input$periods),
y = c((0.15-0.70) * (exp(-50/100*(1:input$periods))-
exp(-50/100*input$periods)*(1:input$periods)/input$periods)) + 0.70
)
})
observe({
rv$x_sub <- rv$x[1:input$periods]
rv$y_sub <- rv$y[1:input$periods]
})
output$p <- renderPlotly({
circles <- map2(rv$x_sub, rv$y_sub,
~list(
type = "circle",
xanchor = .x,
yanchor = .y,
x0 = -4, x1 = 4,
y0 = -4, y1 = 4,
xsizemode = "pixel",
ysizemode = "pixel",
fillcolor = "blue",
line = list(color = "transparent")
)
)
plot_ly() %>%
add_lines(x = rv$x_sub, y = rv$y_sub, color = I("red")) %>%
layout(shapes = circles) %>%
config(edits = list(shapePosition = TRUE))
})
output$data <- renderTable(data())
output$data1 <- renderTable(data1())
# update x/y reactive values in response to changes in shape anchors
observe({
ed <- event_data("plotly_relayout")
shape_anchors <- ed[grepl("^shapes.*anchor$", names(ed))]
if (length(shape_anchors) != 2) return()
row_index <- unique(readr::parse_number(names(shape_anchors)) + 1)
pts <- as.numeric(shape_anchors)
rv$x[row_index] <- pts[1]
rv$y[row_index] <- pts[2]
})
}
shinyApp(ui, server)
最佳答案
不幸的是，您无法在多个位置修改reactive。对于此用例，旨在使用 reactiveVal 或 reactiveValues。
请检查以下内容:
library(plotly)
library(purrr)
library(shiny)
ui <- fluidPage(
fluidRow(column(5,sliderInput('periods','Nbr of periods:',min=0,max=24,value=12))),
fluidRow(column(2,h5("Data1:"),tableOutput('data1table')),
column(6, plotlyOutput("p")))
)
server <- function(input, output, session) {
data1 <- reactiveValues(x = NULL, y = NULL)
observe({
data1$x <- c(1:input$periods)
data1$y <- c((0.15-0.70)*(exp(-50/100*(1:input$periods))-exp(-50/100*input$periods)*
(1:input$periods)/input$periods)) + 0.70
})
output$p <- renderPlotly({
circles <- map2(data1$x, data1$y,
~list(type = "circle",
xanchor = .x,
yanchor = .y,
x0 = -4, x1 = 4,
y0 = -4, y1 = 4,
xsizemode = "pixel",
ysizemode = "pixel",
fillcolor = "blue",
line = list(color = "transparent"))
)
plot_ly() %>%
add_lines(x = data1$x, y = data1$y, color = I("red")) %>%
layout(shapes = circles) %>%
config(edits = list(shapePosition = TRUE))
})
output$data1table <- renderTable({
as.data.frame(reactiveValuesToList(data1))
})
# update x/y reactive values in response to changes in shape anchors
observe({
ed <- event_data("plotly_relayout")
shape_anchors <- ed[grepl("^shapes.*anchor$", names(ed))]
if (length(shape_anchors) != 2) return()
row_index <- unique(readr::parse_number(names(shape_anchors)) + 1)
pts <- as.numeric(shape_anchors)
data1$x[row_index] <- pts[1]
data1$y[row_index] <- pts[2]
})
}
shinyApp(ui, server)
关于r - 如何使用响应式(Reactive)数据框在 R Shiny 中创建可拖动的绘图？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/74148981/