InsertUI添加反应性ggplot图层

时间:2019-02-10 19:58:19

标签: r shiny

我正在尝试使用insertUI动态添加ggplot图层,包括其所有反应性组件(例如aes(x,y),fill,color,alpha)。

我已经通过插入UI添加了UI。我为添加的每个新UI创建了唯一的ID#。我已经能够将每个Geom存储在reactValues列表中。我希望我可以用一个简单的例子来重新创建它:

library(shiny)
library(ggforce)

CircleGeomUI <- function(id) {
ns <- NS(id)

tagList(
fluidRow(
  column(3, numericInput(ns("center.x"), "X", value = 0, width = "75px")),
  column(3, numericInput(ns("center.y"), "Y", value = 0, width = "75px"))),
fluidRow(sliderInput(ns("radius"),"Select Radius",
                     min = 1, 
                     max = 100, 
                     value = 10, 
                     width = "75%")
         ))
}


CircleGeom <- function(input, output, session) {
geom_circle(mapping = aes(x0=input$center.x, 
                          y0=input$center.y, 
                          r=input$radius)
            )
}

TriangleGeomUI <- function(id) {
ns <- NS(id)

tagList(
column(3,
fluidRow(numericInput(ns("a.x"), "a.x", value = 0, width = "75px")),
fluidRow(numericInput(ns("b.x"), "b.x", value = 0, width = "75px")),
fluidRow(numericInput(ns("c.x"), "c.x", value = 10, width = "75px"))),
column(3,
fluidRow(numericInput(ns("a.y"), "a.y", value = 0, width = "75px")),
fluidRow(numericInput(ns("b.y"), "b.y", value = 10, width = "75px")),
fluidRow(numericInput(ns("c.y"), "c.y", value = 0, width = "75px"))))
}

TriangleGeom <- function(input, output, session) {
geom_polygon(mapping = aes(x=c(input$a.x, input$b.x, input$c.x), 
                           y=c(input$a.y, input$b.y, input$c.y)))
}

ui <- fluidPage(
fluidRow(actionButton("add.layer", "+")),
plotOutput("plot"),
tags$div(id = "menu")
)

server <- function(input, output) {
layer.list <- reactiveValues()

observeEvent(input$add.layer, {
layer <- input$add.layer

# setup----
menu <- paste0("shape-menu", layer)
shape <- paste0("shape", layer)
options <- paste0("options", layer)
circle <- paste0("circle", layer)
triangle <- paste0("triangle", layer)

# insert ui----
insertUI(
selector = "#menu",
where = "beforeEnd",
ui = tags$div(
id = menu,
fluidRow(
column(6, selectInput(shape, NULL, choices = c("circle", "triangle"))),
column(6, uiOutput(options))))
)

# render ui----
output[[options]] <- renderUI({
  switch(input[[shape]], 
         "circle" = CircleGeomUI(circle), 
         "triangle" = TriangleGeomUI(triangle)
)
})

observeEvent(input[[shape]], {
layer.list$gg[[layer]] <- switch(input[[shape]], 
                                 "circle" = callModule(CircleGeom, circle), 
                                 "triangle" = callModule(TriangleGeom, triangle)
                                 )
})
})

output$plot <- renderPlot({
if(length(layer.list$gg) == 0) {
  x <- ggplot()
} else {
  x <- ggplot() %+% layer.list$gg
}

return(x)
})
}

shinyApp(ui, server)

我有三个问题:

  1. 我只能将geom存储在observeEvent的reactorValues列表中。我认为这应该是懒惰的,所以我想将其保留在被动式声明中。不起作用。

  2. 使用操作按钮“ add.layer”会引发初始警告: 警告:错误:tibble中的所有列都必须是1d或2d对象:

    • x0为NULL
    • y0为NULL
    • r为NULL 致电rlang::last_error()查看回溯 189:

我不知道为什么会这样。我不知道如何命令发亮的反应性或减慢它的速度,以便渲染的UI可以首先出现。我不知道如何读取回溯。

  1. 这是最大也是最奇怪的问题。当x / y坐标位于每个几何图形的“ aes”内部时,该代码似乎起作用。当我创建data.frame并仅引用la'aes(x = x,y = y)'时,它不起作用。当我为映射之外的Alpha,填充或颜色添加反应性输入时,它也会失败。

这是反应性问题,ggplot问题还是其他问题?这有可能根本没有光泽吗?

0 个答案:

没有答案