Проблема с печатью пользовательской многоиндексной легенды с geom_map в R блестящий - PullRequest
Новая
       28

Проблема с печатью пользовательской многоиндексной легенды с geom_map в R блестящий

0 голосов
/ 07 июня 2019

Я хочу сделать блестящий многоиндексный дисплей на главной панели, но, к сожалению, мой код не работает. 

ui <-   bootstrapPage(
  titlePanel("Population Variation"),

  sidebarPanel(
    sliderInput("time", "year",2013, 
                2017,
                value = 2013,
                step=1,
                animate=T)
  ),

  mainPanel(
    tabsetPanel(type = "tabs",
                tabPanel("Map", 
                         tags$head(tags$style(type = "text/css", "#mymap {height:85vh !important;}")),
                         # this is an extra div used ONLY to create positioned ancestor for tooltip
                         # we don't change its position
                         div(
                           style = "position:relative",
                           plotOutput("mymap", 
                                      hover = hoverOpts("plot_hover", delay = 100, delayType = "debounce")),
                           uiOutput("hover_info")
                         ),
                         width = 7
                ))
)
)

server <- function(input, output, session) {


  output$mymap <- renderPlot({


    dataFilter <- subset(map_aus_df3, map_aus_df3$Year == as.numeric(input$time))



    ggplot() +
      geom_map(data = dataFilter, map = dataFilter, aes(x = long, y = lat, map_id = id),
               color = "#2b2b2b", fill = NA) +
      geom_map(data = dataFilter, map = dataFilter, aes(fill = (Population/Migrants), alpha = (Population + Migrants), map_id = id), color = 'gray50', size = 0.1) +
      scale_fill_viridis()+guides(alpha=F,fill=F)+

      theme(plot.title=element_text(size = 16, face="bold",margin=margin(b=10))) +
      with(distcenters, annotate(geom="text", x = clong, y = clat, label=id, size=4)) +
      theme_bare +
      labs(title="Total Population and Migrant Growth")

    vp<-viewport(width=0.24,height=0.24,x=0.58,y=0.14)
    print(g.legend+labs(title=""),vp=vp)

  })

  output$hover_info <- renderUI({
    dataFilter <- subset(map_aus_df3, map_aus_df3$Year == as.numeric(input$time))

    hover <- input$plot_hover
    point <- nearPoints(dataFilter, hover, threshold = 10, maxpoints = 1, addDist = TRUE)

    if (nrow(point) == 0) return(NULL)

    # calculate point position INSIDE the image as percent of total dimensions
    # from left (horizontal) and from top (vertical)
    left_pct <- (hover$x - hover$domain$left) / (hover$domain$right - hover$domain$left)
    top_pct <- (hover$domain$top - hover$y) / (hover$domain$top - hover$domain$bottom)

    # calculate distance from left and bottom side of the picture in pixels
    left_px <- hover$range$left + left_pct * (hover$range$right - hover$range$left)
    top_px <- hover$range$top + top_pct * (hover$range$bottom - hover$range$top)

    # create style property fot tooltip
    # background color is set so tooltip is a bit transparent
    # z-index is set so we are sure are tooltip will be on top
    style <- paste0("position:absolute; z-index:100; background-color: rgba(245, 245, 245, 0.85); ",
                    "left:", left_px + 2, "px; top:", top_px + 2, "px;")

    # actual tooltip created as wellPanel
    wellPanel(
      style = style,
      p(HTML(paste0("<b> State: </b>", point$id, "<br/>",
                    "<b> Migrant Population: </b>", point$Migrants, "<br/>",
                    "<b> Total Population: </b>", point$Population, "<br/>")))
    )
  })

}

shinyApp(ui, server)

Это то, что я пробовал до сих пор. Если я поместил строку ggplot в функцию печати, то в ближней точке выдается ошибка, не идентифицирующая xVar. Я борюсь с этим уже пару часов и буду очень признателен за любую помощь. Спасибо

...