继此问题之后,我希望将传单地图保存和下载为 png 或 jpeg 图像。我有以下代码,但我不断收到错误消息。
ui <- fluidPage(
leafletOutput("map"),
downloadButton("dl")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles()
})
output$dl <- downloadHandler(
filename = "map.png",
content = function(file) {
mapshot(input[["map"]], file = file)
}
)
}
shinyApp(ui = ui, server = server)
Run Code Online (Sandbox Code Playgroud)
我尝试下载(通过单击按钮)时遇到的错误是
Warning: Error in system.file: 'package' must be of length 1
Stack trace (innermost first):
65: system.file
64: readLines
63: paste
62: yaml.load
61: yaml::yaml.load_file
60: getDependency
59: widget_dependencies
58: htmltools::attachDependencies …
Run Code Online (Sandbox Code Playgroud) 我正在尝试绘制流程图(适用于新加坡).我有Entry(Lat,Long)和Exit(Lat,long).我试图在新加坡地图中映射从入口到出口的流量.
structure(list(token_id = c(1.12374e+19, 1.12374e+19, 1.81313e+19,
1.85075e+19, 1.30752e+19, 1.30752e+19, 1.32828e+19, 1.70088e+19,
1.70088e+19, 1.70088e+19, 1.05536e+19, 1.44818e+19, 1.44736e+19,
1.44736e+19, 1.44736e+19, 1.44736e+19, 1.89909e+19, 1.15795e+19,
1.15795e+19, 1.15795e+19, 1.70234e+19, 1.70234e+19, 1.44062e+19,
1.21512e+19, 1.21512e+19, 1.95909e+19, 1.95909e+19, 1.50179e+19,
1.50179e+19, 1.24174e+19, 1.36445e+19, 1.98549e+19, 1.92068e+19,
1.18468e+19, 1.18468e+19, 1.92409e+19, 1.92409e+19, 1.21387e+19,
1.9162e+19, 1.9162e+19, 1.40385e+19, 1.40385e+19, 1.32996e+19,
1.32996e+19, 1.69103e+19, 1.69103e+19, 1.57387e+19, 1.40552e+19,
1.40552e+19, 1.00302e+19), Entry_Station_Lat = c(1.31509, 1.33261,
1.28425, 1.31812, 1.33858, 1.29287, 1.39692, 1.37773, 1.33858,
1.33322, 1.28179, 1.30036, 1.43697, 1.39752, 1.27637, 1.39752,
1.41747, 1.35733, 1.28405, 1.37773, 1.35898, 1.42948, 1.32774,
1.42948, 1.349, …
Run Code Online (Sandbox Code Playgroud) 在选择(单击)数据表中的相应记录时,是否可以在传单地图上突出显示标记或折线?
我看了这些问题/线索:
https://github.com/r-spatial/mapedit/issues/56- 检查及时投资组合在2017年7月23日的评论。如gif所示,我希望能够在数据表中选择一行,以便相应的地图对象(标记/折线)也将突出显示(无需编辑地图)。
这是一个工作示例,其中在下面的数据表中选择了高亮显示的地图对象,但反之则不然,这就是我要实现的目标。
##############################################################################
# Libraries
##############################################################################
library(shiny)
library(shinythemes)
library(ggplot2)
library(plotly)
library(leaflet)
library(DT)
##############################################################################
# Data
##############################################################################
qDat <- quakes
qDat$id <- seq.int(nrow(qDat))
str(qDat)
##############################################################################
# UI Side
##############################################################################
ui <- fluidPage(
titlePanel("Visualization of Fiji Earthquake"),
# side panel
sidebarPanel(
h3('Fiji Earthquake Data'),
sliderInput(
inputId = "sld01_Mag",
label="Show earthquakes of magnitude:",
min=min(qDat$mag), max=max(qDat$mag),
value=c(min(qDat$mag),max(qDat$mag)), step=0.1
),
plotlyOutput('hist01')
),
# main panel
mainPanel(
leafletOutput('map01'),
dataTableOutput('table01')
)
)
##############################################################################
# Server Side
##############################################################################
server <- function(input,output){
qSub <- …
Run Code Online (Sandbox Code Playgroud) 我正在制作一个使用闪亮的应用程序,该应用程序使用多个选项卡。在一个选项卡(不是起始选项卡)上,我显示一张传单地图,该地图由不同选项卡上的小部件控制。
问题是,如果我更改一个选项卡上的输入,而不先访问地图,然后访问地图,则地图不会更新。但是,在地图选项卡之后或期间更改输入,地图会更新。
要复制该问题:
observe()
没有被触发(注意观察被触发但没有效果),或者传单没有渲染)同样,当应用程序启动并且我们直接转到地图时,我希望会显示一个红点。相反,没有点。
代码:
library(shiny)
library(leaflet)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("color", "Color", choices = c("red", "blue", "yellow", "green"))
),
mainPanel(
tabsetPanel(
tabPanel("Other", h1("Empty Tab 1")),
tabPanel("Map", leafletOutput("map"))
)
)
)
)
server <- function(input, output, session) {
# the base map and the circles are separated due to data restrictions
# in the actual app!
output$map <- renderLeaflet({
leaflet() %>%
addTiles()
})
observe({
leafletProxy("map") %>%
addCircles(lng = 0, …
Run Code Online (Sandbox Code Playgroud) 我想修改R中的传单弹出窗口的外观。
帮助文件规定,...
在popupOptions()
功能以“传递给Javascript对象的构造基本额外的选项。”
在此示例中,该style
选项设置为可修改标记外观的CSS参数列表:
addMarkers(
lng = -118.456554, lat = 34.075,
label = "Label w/ custom CSS style",
labelOptions = labelOptions(noHide = T, direction = "bottom",
style = list(
"color" = "red",
"font-family" = "serif",
"font-style" = "italic",
"box-shadow" = "3px 3px rgba(0,0,0,0.25)",
"font-size" = "12px",
"border-color" = "rgba(0,0,0,0.5)"
)))
Run Code Online (Sandbox Code Playgroud)
但是,此方法似乎不适用于Popups,如以下最小工作示例所示:
if (!require("pacman")) install.packages("pacman")
pacman::p_load(leaflet, eurostat, dplyr)
map <- get_eurostat_geospatial() %>% subset(., .$NUTS_ID == "AT11")
leaflet() %>%
addPolygons(data = map ,
group = …
Run Code Online (Sandbox Code Playgroud) 所有善良的灵魂,都需要帮助。我正在创建传单地图,无法解决标签的奇怪问题。我创建了带有很少变量的标签,如果第一个变量是数字,则标签呈现正常,但如果第一个变量是字符串,则它们会失败 - 知道问题是什么吗?让我们从一个虚拟的 spdf 开始:
library(htmltools)
library(sp)
library(leaflet)
df <- new("SpatialPointsDataFrame", data = structure(list(PMID = c(184397, 184397), SPACEID = c("184397_1", "184397_2")), .Names = c("PMID", "SPACEID"), row.names = 1:2, class = "data.frame"), coords.nrs = numeric(0), coords = structure(c(-0.14463936, -0.14468822, 51.50726534, 51.50730171), .Dim = c(2L, 2L), .Dimnames = list(c("1", "2"), c("x", "y"))), bbox = structure(c(-0.14468822, 51.50726534, -0.14463936, 51.50730171), .Dim = c(2L, 2L), .Dimnames = list(c("x", "y"), c("min", "max"))), proj4string = new("CRS", projargs = "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))
Run Code Online (Sandbox Code Playgroud)
现在我们(m)应用一个简单的 HTML 行(原来使用 df …
我有以下数据集:
library(rgdal)
library(leaflet)
tmp <- tempdir()
url <- "http://personal.tcu.edu/kylewalker/data/mexico.zip"
file <- basename(url)
download.file(url, file)
unzip(file, exdir = tmp)
mexico <- readOGR(dsn = tmp, layer = "mexico", encoding = "UTF-8")
pal <- colorQuantile("YlGn", NULL, n = 5)
state_popup <- paste0("<strong>Estado: </strong>",
mexico$name,
"<br><strong>PIB per c?pita, miles de pesos, 2008: </strong>",
mexico$gdp08)
Run Code Online (Sandbox Code Playgroud)
除了这些数据之外,我还构建了以下Shiny应用程序:
# load necessary packages
library(leaflet)
library(shiny)
library(shinydashboard)
ui <- fluidPage(
# place the contents inside a box
shinydashboard::box(
width = 12
, title = "Click on the map!"
# …
Run Code Online (Sandbox Code Playgroud) 我创建了一个闪亮的应用程序,用于显示数据框中点的传单地图。
我想允许用户单击地图上的任意位置以获取附近点的一些信息并在该点上留下标记。
他们可能想点击其他地方。当他们单击其他地方时,我希望留下一个新标记,并删除旧标记。
我已经编写了一个工作闪亮的应用程序,但我无法让它工作。
我尝试使用clearMarkers,但这会删除所有标记,包括我创建的标记和底层数据帧中的标记。
我尝试指定单击点的 id,以便clearMarkers 可能只是删除该点,但我不知道由谁来找出单击点的 id。
我怎样才能让它发挥作用?
这是我的玩具代码:
library(shiny)
library(sp)
library(shinydashboard)
library(leaflet)
#### Make a spatial data frame
lats<-c(37.38,39)
lons<-c(-94,-95,-96)
df<-data.frame(cbind(lons,lats))
coordinates(df)<-~lons+lats
#### Define UI for application that draws a histogram
ui <- dashboardPage(
dashboardHeader(
),
# Sidebar layout with input and output definitions
dashboardSidebar(
),
# Main panel for displaying outputs
dashboardBody(
h2("My Map", align="center"),
h5("Click anywhere to draw a circle", align="center"),
leafletOutput("mymap", width="100%", height="500px")
),
)
#### Define server logic required to draw a histogram …
Run Code Online (Sandbox Code Playgroud) 我试图在 R 传单中找到一种方法来包含覆盖按钮,该按钮可以过滤掉数据中的组。我还需要包括单选按钮,用于切换数据中表示的列。我似乎无法找到使用 addLayersControl() 函数在 R 传单中执行此操作的方法。
我最初认为可以将多个组添加到单个图层并使用 baseGroups 和 OverlayGroups(如下面的代码所示)。然而,这并没有达到预期的结果。如果有人能建议一种替代方法来实现这一目标,我将不胜感激。最好没有光泽。
library(dplyr)
library(leaflet)
data <- data.frame(Name = c("A", "A", "A", "B", "B", "C", "C", "C"),
Value1 = c(12,43,54,34,23,77,44,22),
Value2 = c(6,5,2,7,5,6,4,3),
Lat = c(51.1, 51.6, 57.3, 52.4, 56.3, 54.3, 60.4, 49.2),
Lon = c(5, -3, -2, -1, 4, 3, -5, 0))
data %>%
leaflet() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addCircles(lat=~Lat, lng=~Lon, radius = ~Value1*1000, group=c(~Name, "Value1")) %>%
addCircles(lat=~Lat, lng=~Lon, radius = ~Value2, group=c(~Name, "Value2")) %>%
addLayersControl(
baseGroups = c("Value1", "Value2"),
overlayGroups = …
Run Code Online (Sandbox Code Playgroud) 如何向传单地图上绘制的每个多边形添加鼠标“单击”事件?我想这样做,这样我就可以根据功能中的数据过滤单独的小部件(在本例中为 WD21CD)。
---
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
library(tidyverse)
library(htmltools)
library(leaflet)
```
```{r cars, echo=FALSE}
url <- 'https://opendata.arcgis.com/api/v3/datasets/bf9d32b1aa9941af84e6c2bf0c54b1bb_0/downloads/data?format=geojson&spatialRefId=4326'
wardShapes <- sf::st_read(url) %>%
filter(WD21CD >= "E05011175" & WD21CD <= "E05011181")
leaflet(wardShapes,elementId = "bhamMap",
height = 550,# width = 10,
options = leafletOptions(minZoom = 10, maxZoom = 14)) %>%
addTiles() %>%
setView(lng = -1.810, lat = 52.555, zoom = 12) %>%
addPolygons(
weight = 0.5, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 0.2,
highlightOptions = highlightOptions(color = …
Run Code Online (Sandbox Code Playgroud)