Is there a way for hiding those arrows that point to the same chord diagram sector? Meaning that the chord diagram shows only migration to other continents but includes a non-arrowed area which represents intra-continent migration.
These arrows should be deleted or hided
Code
The code is taken from here: https://www.data-to-viz.com/graph/chord.html
# Libraries
library(tidyverse)
library(viridis)
library(patchwork)
library(hrbrthemes)
library(circlize)
library(chorddiag) #devtools::install_github("mattflor/chorddiag")
# Load dataset from github
data <- read.table("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/13_AdjacencyDirectedWeighted.csv", header=TRUE)
# short names
colnames(data) <- c("Africa", "East Asia", "Europe", "Latin Ame.", "North Ame.", "Oceania", "South Asia", "South East Asia", "Soviet Union", "West.Asia")
rownames(data) <- colnames(data)
# I need a long format
data_long <- data %>%
rownames_to_column %>%
gather(key = 'key', value = 'value', -rowname)
# parameters
circos.clear()
circos.par(start.degree = 90, gap.degree = 4, track.margin = c(-0.1, 0.1), points.overflow.warning = FALSE)
par(mar = rep(0, 4))
# color palette
mycolor <- viridis(10, alpha = 1, begin = 0, end = 1, option = "D")
mycolor <- mycolor[sample(1:10)]
# Base plot
chordDiagram(
x = data_long,
grid.col = mycolor,
transparency = 0.25,
directional = 1,
direction.type = c("arrows", "diffHeight"),
diffHeight = -0.04,
annotationTrack = "grid",
annotationTrackHeight = c(0.05, 0.1),
link.arr.type = "big.arrow",
link.sort = TRUE,
link.largest.ontop = TRUE)
# Add text and axis
circos.trackPlotRegion(
track.index = 1,
bg.border = NA,
panel.fun = function(x, y) {
xlim = get.cell.meta.data("xlim")
sector.index = get.cell.meta.data("sector.index")
# Add names to the sector.
circos.text(
x = mean(xlim),
y = 3.2,
labels = sector.index,
facing = "bending",
cex = 0.8
)
# Add graduation on axis
circos.axis(
h = "top",
major.at = seq(from = 0, to = xlim[2], by = ifelse(test = xlim[2]>10, yes = 2, no = 1)),
minor.ticks = 1,
major.tick.percentage = 0.5,
labels.niceFacing = FALSE)
}
)
edit: added a note that axes widths should remain the same
Something along these lines should work:
# Libraries
library(tidyverse)
library(viridis)
library(patchwork)
library(hrbrthemes)
library(circlize)
library(chorddiag) #devtools::install_github("mattflor/chorddiag")
# Load dataset from github
data <- read.table("https://raw.githubusercontent.com/holtzy/data_to_viz/master/Example_dataset/13_AdjacencyDirectedWeighted.csv", header=TRUE)
# short names
colnames(data) <- c("Africa", "East Asia", "Europe", "Latin Ame.", "North Ame.", "Oceania", "South Asia", "South East Asia", "Soviet Union", "West.Asia")
rownames(data) <- colnames(data)
# I need a long format
data_long <- data %>%
rownames_to_column %>%
gather(key = 'key', value = 'value', -rowname)
# parameters
circos.clear()
circos.par(start.degree = 90, gap.degree = 4, track.margin = c(-0.1, 0.1), points.overflow.warning = FALSE)
par(mar = rep(0, 4))
# color palette
mycolor <- viridis(10, alpha = 1, begin = 0, end = 1, option = "D")
mycolor <- mycolor[sample(1:10)]
# new code
mat <- as.matrix(data)
col_mat <- matrix("a", 10, 10)
for(i in 1:10){
col_mat[i, ] <- mycolor[i]
}
diag(col_mat) = "#00000000"
# Base plot
chordDiagram(
x = mat,
grid.col = mycolor,
col = col_mat,
transparency = 0.25,
directional = 1,
direction.type = c("arrows", "diffHeight"),
diffHeight = -0.04,
annotationTrack = "grid",
annotationTrackHeight = c(0.05, 0.1),
link.arr.type = "big.arrow",
link.sort = TRUE,
link.largest.ontop = TRUE)
# Add text and axis
circos.trackPlotRegion(
track.index = 1,
bg.border = NA,
panel.fun = function(x, y) {
xlim = get.cell.meta.data("xlim")
sector.index = get.cell.meta.data("sector.index")
# Add names to the sector.
circos.text(
x = mean(xlim),
y = 3.2,
labels = sector.index,
facing = "bending",
cex = 0.8
)
# Add graduation on axis
circos.axis(
h = "top",
major.at = seq(from = 0, to = xlim[2], by = ifelse(test = xlim[2]>10, yes = 2, no = 1)),
minor.ticks = 1,
major.tick.percentage = 0.5,
labels.niceFacing = FALSE)
}
)
Related
I am plotting an image with this code but I am having some trouble when I Try to save it.
library(markovchain)
library(expm)
library(diagram)
library(pracma)
stateNames <- c("Fischer", "Lewis", "Medium")
q0 <- new("markovchain", states = stateNames,
transitionMatrix =matrix(c(0.08,0.15,0.77,
0.25,0.13,0.62,
0.16,0.18,0.66),
byrow = TRUE, nrow = 3), name = "state t0")
q0_p <- matrix(c(0.08,0.15,0.77,
0.25,0.13,0.62,
0.16,0.18,0.66),
byrow = TRUE, nrow = 3)
row.names(q0_p) <- stateNames; colnames(q0_p) <- stateNames
plotmat(q0_p,pos = c(1,2),
lwd = 1, box.lwd = 1,
cex.txt = 0.8,
box.size = 0.1,
box.type = "circle",
box.prop = 0.7,
box.col = c("#F8766D", "#00BA38","#619CFF"),
shadow.size = 0,
arr.length=.2,
arr.width=.1,
self.cex =.4,
self.shifty = -.01,
self.shiftx = .13,
main = "")
tiff(file="plotq0_3.tiff",width=15,height=10,units="cm",res=300)
but when I go to the file, it weight 6128 kb but I can't see the image. Here is a copy.
I am trying to plot a nested pie chart. However, I do not get a full pie chart. Top and bottom side of the pie is missing.
For example, I am only interested in expanding "Agriculture" in the nested pie. I have calculated size in % for each
I am interested in pie chart look likes below
Here is my working script.
library(ggplot2)
library(plotrix)
df <- structure(list(parent = c("Energy", "Industry", "Transport", "Buildings ", "Agriculture", "Agriculture", "Agriculture", "Agriculture", "Agriculture", "Agriculture", "Agriculture", "Forestry and Land Use " ), node = c("Energy", "Industry", "Transport", "Buildings ", "Enteric Fermentation", "Manure Left on Pasture", "Synthetic Fertilizers", "Paddy Rice", "Manure Management ", "Burning of savannahs", "Other", "Forestry and Land Use "), size = c(35, 21, 14, 6, 4.8, 1.92, 1.56, 1.2, 0.84, 0.6, 1.08, 12)), row.names = c(NA, -12L), class = c("data.table", "data.frame"))
# aggregate data for the df pie chart
df_data <-
aggregate(df$size,
by = list(df = df$parent),
FUN = sum)
# order sub_data data by df so it will line up with df pie chart
sub_data <- df[order(df$node), ]
df_colors <- c('#85EA72', '#3B3B3F', '#71ACE9', '#747AE6', '#F69852','#F69992')
# adjust these as desired (currently colors all subdatas the same as df)
sub_data_colors <-
c('#85EA72', '#3B3B3F', '#71ACE9', '#747AE6', '#F69852','#F69992', '#85EA88', '#3B3B4F', '#71ACC9', '#747EE6', '#F69899','#F68882')
# format labels to display subdata and % market size
sub_data_labels <- paste(sub_data$sub_data, ": ", sub_data$size, "%", sep = "")
# coordinates for the center of the chart
center_x <- 0.5
center_y <- 0.5
plot.new()
# draw sub_data pie chart first
sub_data_chart <-
floating.pie(
xpos = center_x,
ypos = center_y,
x = sub_data$size,
radius = 0.35,
border = "white",
col = sub_data_colors
)
# add labels for sub_data pie chart
pie.labels(
x = center_x,
y = center_y,
angles = sub_data_chart,
labels = sub_data_labels,
radius = 0.38,
bg = NULL,
cex = 0.8,
font = 2,
col = "gray40"
)
# overlay df pie chart
df_chart <-
floating.pie(
xpos = center_x,
ypos = center_y,
x = df_data$x,
radius = 0.25,
border = "white",
col = df_colors
)
# add labels for df pie chart
pie.labels(
x = center_x,
y = center_y,
angles = df_chart,
labels = df_data$df,
radius = 0.125,
bg = NULL,
cex = 0.8,
font = 2,
col = "white"
)
Could someone assist me to figure out the error? Thank you.
Regarding the missing edges, just increase your "Plots" Tab to the needed size.
Regarding the splitted subsection, my solution is basically to set all other sections to a white color so you wouldn't see them on a white background.
library(ggplot2)
library(plotrix)
library(data.table)
df <- structure(list(parent = c("Energy", "Industry", "Transport", "Buildings ",
"Agriculture", "Agriculture", "Agriculture",
"Agriculture", "Agriculture", "Agriculture",
"Agriculture", "Forestry and Land Use " ),
node = c("Energy", "Industry", "Transport", "Buildings ",
"Enteric Fermentation", "Manure Left on Pasture",
"Synthetic Fertilizers", "Paddy Rice",
"Manure Management ", "Burning of savannahs",
"Other", "Forestry and Land Use "),
size = c(35, 21, 14, 6, 4.8, 1.92, 1.56,
1.2, 0.84, 0.6, 1.08, 12)),
row.names = c(NA, -12L),
class = c("data.table", "data.frame"))
# aggregate data for the df pie chart
df_data <-
aggregate(df$size,
by = list(df = df$parent),
FUN = sum)
# order sub_data data by df so it will line up with df pie chart
sub_data <- df[order(df$node), ]
df_colors <- c('#85EA72', '#3B3B3F', '#71ACE9', '#747AE6', '#F69852','#F69992')
# adjust these as desired (currently colors all subdatas the same as df)
sub_data_colors <-
c('#85EA72', '#3B3B3F', '#71ACE9', '#747AE6', '#F69852','#F69992', '#85EA88',
'#3B3B4F', '#71ACC9', '#747EE6', '#F69899','#F68882')
# format labels to display subdata and % market size
sub_data_labels <- paste(sub_data$sub_data, ": ", sub_data$size, "%", sep = "")
# coordinates for the center of the chart
center_x <- 0.5
center_y <- 0.5
# colors should always match with the group
sub_data$color <- sub_data_colors
# set all other groups to white. Hence, they are not shown in the plot
sub_data[parent != "Agriculture", color := "#ffffff"]
# correct order is important
data.table::setorder(sub_data, -parent)
# Enlarge the "Plots" tab to the needed size
plot.new()
# draw sub_data pie chart first
sub_data_chart <-
floating.pie(
xpos = center_x,
ypos = center_y,
x = sub_data$size,
radius = 0.35,
border = "white",
col = sub_data$color
)
# add labels for sub_data pie chart
pie.labels(
x = center_x,
y = center_y,
angles = sub_data_chart,
labels = sub_data_labels,
radius = 0.38,
bg = NULL,
cex = 0.8,
font = 2,
col = "gray40"
)
data.table::setorder(df_data, -df)
# overlay df pie chart
df_chart <-
floating.pie(
xpos = center_x,
ypos = center_y,
x = df_data$x,
radius = 0.25,
border = "white",
col = df_colors
)
# add labels for df pie chart
pie.labels(
x = center_x,
y = center_y,
angles = df_chart,
labels = df_data$df,
radius = 0.125,
bg = NULL,
cex = 0.8,
font = 2,
col = "white"
)
This is a reproducible example of my heatmap that shows the differentially expressed genes in R plotly for multiple samples:
colMax <- function(data) sapply(data, max, na.rm = TRUE)
colMin <- function(data) sapply(data, min, na.rm = TRUE)
test <- structure(list(`#Log2FC_00e41e6a` = c(0, 0, 0, 0, 0, 0), `#Log2FC_0730216b` = c(0,
0, 0, 2.85798206145049, 0, 0), `#Log2FC_07ccb4e9` = c(-2.92159741497064,
0, -2.32475763591175, 0, 0, 0), `#Log2FC_1426b4bf` = c(0, 0,
0, -2.95962954629017, 0, 0), `#Log2FC_181c6d37` = c(0, 0, 0,
0, 0, 0), `#Log2FC_1d7ffbe7` = c(0, 0, 0, 0, 0, 0)), .Names = c("#Log2FC_00e41e6a",
"#Log2FC_0730216b", "#Log2FC_07ccb4e9", "#Log2FC_1426b4bf", "#Log2FC_181c6d37",
"#Log2FC_1d7ffbe7"), row.names = c("A1BG-AS1", "A1CF", "A2M",
"A2ML1", "A4GALT", "AADAC"), class = "data.frame")
and this is the code to produce the R heatmap using plotly:
f1 <- list(
family = "Arial, sans-serif",
size = 5,
color = "lightgrey")
f2 <- list(
family = "Old Standard TT, serif",
size = 10,
color = "black")
a <- list(
title = "",
titlefont = f1,
showticklabels = TRUE,
tickangle = 45,
tickfont = f2,
exponentformat = "E")
plot_ly(z = as.matrix(test),
zmin=round(min(colMin(test))),
zmax=round(max(colMax(test))),
x = colnames(test),
xgap = 2,
y = rownames(test),
ygap = 2,
type = "heatmap",
colors = c("red", "green") ) %>%
layout(xaxis = a,
margin = list(l =90,
r = 10,
b = 100,
t = 10))
produces:
Question: How can I set the 0 value of the colorbar to black color ?
If I do:
plot_ly(z = as.matrix(test),
zmin=round(min(colMin(test))),
zmax=round(max(colMax(test))),
x = colnames(test),
xgap = 2,
y = rownames(test),
ygap = 2,
type = "heatmap",
colors = c("red", "black", "green") ) %>%
layout(xaxis = a,
margin = list(l =90,
r = 10,
b = 100,
t = 10))
Then this produce:
but the problem the reproducible example is a small set of my whole data. Applying it to my data gives a different scale where the 0 have a different color than black. This Stackoverflow question is a similar question but is different than mine where I only need a specific color for a specific value.
Edit 1: Also, from the answer of my previous question, #MarcoSandri said that by defining a colorscale array, we can pass these values to plotly. I tried :
colorScale <- data.frame(z=c(zmin=round(min(colMin(big_data))),
0,
zmax=round(max(colMax(big_data)))),
col=c("#ff0000", "#000000", "#00ff00"))
colorScale$col <- as.character(colorScale$col)
plot_ly(z = as.matrix(test),
zmin=round(min(colMin(test))),
zmax=round(max(colMax(test))),
x = colnames(test),
xgap = 2,
y = rownames(test),
ygap = 2,
type = "heatmap",
colorscale = colorScale ) %>%
layout(xaxis = a,
margin = list(l =90,
r = 10,
b = 100,
t = 10))
and:
As you see, this has two issues, first the colors doesn't correspond to the values I gave in my array and second, similarly to the previous one, doesn't work on my whole data.
Thanks in advance !
Your color scale is not defined correctly. The z column of colorScale should be between 0 and 1 and not between zmin and zmax. See below a possibile solution:
ncols <- 7 # Number of colors in the color scale
mypalette <- colorRampPalette(c("#ff0000","#000000","#00ff00"))
cols <- mypalette(ncols)
zseq <- seq(0,1,length.out=ncols+1)
colorScale <- data.frame(
z = c(0,rep(zseq[-c(1,length(zseq))],each=2),1),
col=rep(cols,each=2)
)
colorScale$col <- as.character(colorScale$col)
zmx <- round(max(test))
zmn <- round(min(test))
plot_ly(z = as.matrix(test),
zmin=zmn,
zmax=zmx,
x = colnames(test),
xgap = 2,
y = rownames(test),
ygap = 2,
type = "heatmap",
colorscale = colorScale,
colorbar=list(ypad = 30, tick0=-zmn, dtick=1) ) %>%
layout(xaxis = a,
margin = list(l =90,
r = 10,
b = 100,
t = 10))
EDIT
When the scale is not centered at zero this solution should work better.
mypal1 <- colorRampPalette(c("#ff0000","#000000"))
mypal2 <- colorRampPalette(c("#000000","#00ff00"))
x <- pretty(c(min(test),max(test)))
dltx <- diff(x)[1]
x <- sort(c(x,-dltx/16,dltx/16))
x <- x[x!=0]
x.resc <- (x-min(x))/(max(x)-min(x))
cols <- unique(c(mypal1(sum(x<=0)),mypal2(sum(x>0))))
colorScale <- data.frame(
z = c(0,rep(x.resc[2:(length(x.resc)-1)],each=2),1),
col=rep(cols,each=2)
)
plot_ly(z = as.matrix(test),
zmin=x[1],
zmax=x[length(x)],
x = colnames(test),
xgap = 2,
y = rownames(test),
ygap = 2,
type = "heatmap",
colorscale = colorScale,
colorbar=list(ypad = 30, tick0=x[1], dtick=dltx) ) %>%
layout(xaxis = a,
margin = list(l =90,
r = 10,
b = 100,
t = 10))
I am trying to plot few countries using leaflet but the countries that it is showing is incorrect. Following is my minimal reproducible example:
library(leaflet)
library(maps)
df <- data.frame(name = c("Afghanistan", "Albania" , "Algeria" , "Armenia"),
code = c("AFG", "ALB", "DZA", "ARM"),
val = c(5, 10, 15, 20), stringsAsFactors = FALSE)
pal <- colorNumeric(
palette = "Blues",
domain = as.numeric(df$val))
labels <- sprintf(
"<strong>Country:%s</strong><br/>Value:%g /",
df$name, df$val)%>% lapply(htmltools::HTML)
Country = map("world", fill = TRUE, plot = FALSE, regions=iso.expand(df$code,regex = TRUE))
leaflet(Country) %>% addTiles() %>%
addPolygons(fillOpacity = 0.6, smoothFactor = 0.5, stroke = TRUE, weight = 1,
color = ~pal(as.numeric(df$val)),
label = labels)
I get the following leaflet with this:
As you can see Algeria is shown as Albania. If I remove the Armenia from my data and plot the leaflet I get correct location. Following is the code and image for that.
library(leaflet)
library(maps)
df <- data.frame(name = c("Afghanistan", "Albania" , "Algeria" ),
code = c("AFG", "ALB", "DZA"),
val = c(5, 10, 15), stringsAsFactors = FALSE)
pal <- colorNumeric(
palette = "Blues",
domain = as.numeric(df$val))
labels <- sprintf(
"<strong>Country:%s</strong><br/>Value:%g /",
df$name, df$val)%>% lapply(htmltools::HTML)
Country = map("world", fill = TRUE, plot = FALSE, regions=iso.expand(df$code,regex = TRUE))
leaflet(Country) %>% addTiles() %>%
addPolygons(fillOpacity = 0.6, smoothFactor = 0.5, stroke = TRUE, weight = 1,
color = ~pal(as.numeric(df$val)),
label = labels)
Am I missing something?
I think the issue is related to the polygons order in map object (if you set label = Country$names, the labels are now correct). Anyway, you can solve the problem by converting Country into a SpatialPolygons object (see here).
library(maptools)
IDs <- sapply(strsplit(Country$names, ":"), function(x) x[1])
Country <- map2SpatialPolygons(Country,
IDs=IDs,
proj4string=CRS("+proj=longlat +datum=WGS84"))
leaflet(Country) %>% addTiles() %>%
addPolygons(fillOpacity = 0.6, smoothFactor = 0.5, stroke = TRUE, weight = 1,
color = pal(as.numeric(df$val)),
label = labels)
I have successfully managed to recreate the drive time polygon in R using This Example Post
The above post only deals with ONE single polygon with isochrones
Problem - I want to plot MULTIPLE drive time polygons on 5 different map points
I have managed to do this in a VERY laborious fashion by creating 5 seperate isochrones, and then adding 5 polygons to my Leaflet Map
#Preparing multiple dependancies----
packages <- c("readxl","dplyr","leaflet","htmltools", "sp", "osrm")
install.packages(packages)
lapply(packages, library,character.only=TRUE)
###
#Loading in Locations----
Location <- read_excel("filepath.xlsx", sheet=1)
###
#Extract Lon and Lat and create spatial dataframe
xy <- Location[, c(3,4)]
spatialdf <- SpatialPointsDataFrame(coords = xy, data = Location, proj4string = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"))
class(spatialdf)
#Create Isochrone points
iso1 <- osrmIsochrone(loc = c(-2.3827439,53.425705), breaks = seq(from = 0, to = 60, by = 5))
iso2 <- osrmIsochrone(loc = c(-0.85074928,51.325871), breaks = seq(from = 0, to = 60, by = 5))
iso3 <- osrmIsochrone(loc = c(-2.939367,51.570344), breaks = seq(from = 0, to = 60, by = 5))
iso4 <- osrmIsochrone(loc = c(-3.9868026,55.823102), breaks = seq(from = 0, to = 60, by = 5))
iso5 <- osrmIsochrone(loc = c(-0.92104073,53.709006), breaks = seq(from = 0, to = 60, by = 5))
#Create Drive Time Interval descriptions
iso1#data$drive_times <- factor(paste(iso1#data$min, "to", iso1#data$max, "mins"))
iso2#data$drive_times <- factor(paste(iso2#data$min, "to", iso2#data$max, "mins"))
iso3#data$drive_times <- factor(paste(iso3#data$min, "to", iso3#data$max, "mins"))
iso4#data$drive_times <- factor(paste(iso4#data$min, "to", iso4#data$max, "mins"))
iso5#data$drive_times <- factor(paste(iso5#data$min, "to", iso5#data$max, "mins"))
#Create Colour Palette for each time interval
factPal1 <- colorFactor(rev(heat.colors(12)), iso1#data$drive_times)
factPal2 <- colorFactor(rev(heat.colors(12)), iso2#data$drive_times)
factPal3 <- colorFactor(rev(heat.colors(12)), iso3#data$drive_times)
factPal4 <- colorFactor(rev(heat.colors(12)), iso4#data$drive_times)
factPal5 <- colorFactor(rev(heat.colors(12)), iso5#data$drive_times)
#Draw Map
leaflet()%>%
addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
addMarkers(data=spatialdf,lng=spatialdf$Longitude, lat=spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal1(iso1#data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso1, popup = iso1#data$drive_times, group = "Drive Time")%>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal2(iso2#data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso2, popup = iso2#data$drive_times, group = "Drive Time")%>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal3(iso3#data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso3, popup = iso3#data$drive_times, group = "Drive Time")%>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal4(iso4#data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso4, popup = iso4#data$drive_times, group = "Drive Time")%>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal5(iso5#data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso5, popup = iso5#data$drive_times, group = "Drive Time")%>%
addLegend("bottomright", pal = factPal1, values = iso1#data$drive_times, title = "Drive Time")
Not sure why i cannot just refer to the Spatial dataframe that i made ? like this...
iso <- osrmIsochrone(loc = c(spatialdf$Longitude,spatialdf$Latitude), breaks = seq(from = 0, to = 60, by = 5))
This gives me the error: break values do not fit the raster values
and then just use 1 polygon to map all of them? like this...
leaflet()%>%
addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
addMarkers(data=spatialdf,lng=spatialdf$Longitude, lat=spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal(iso#data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso, popup = iso#data$drive_times, group = "Drive Time")%>%
addLegend("bottomright", pal = factPal, values = iso#data$drive_times, title = "Drive Time")
Consider a DRY-er (i.e., Don't Repeat Yourself) approach by building a list of items and then iterate through the piping chain:
# LIST OF COORDS
loc_list <- list(c(-2.3827439, 53.425705), c(-0.85074928, 51.325871),
c(-2.939367,51.570344), c(-3.9868026, 55.823102),
c(-0.92104073, 53.709006))
isoc_items <- lapply(loc_list, function(i) {
iso <- osrmIsochrone(loc = i, breaks = seq(from = 0, to = 60, by = 5))
iso#data$drive_times <- factor(paste(iso#data$min, "to", iso#data$max, "mins"))
# NAMED LIST OF TWO ITEMS
list(iso = iso, factPal = colorFactor(rev(heat.colors(12)), iso#data$drive_times))
})
leaflet()%>%
addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
addMarkers(data = spatialdf, lng = spatialdf$Longitude,
lat = spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%
# ITERATE TO ADD POLYGONS
for (item in isoc_items) {
addPolygons(fill = TRUE, stroke = TRUE, color = "black",
fillColor = ~item$factPal(item$iso#data$drive_times),
weight = 0.5, fillOpacity = 0.2, data = item$iso,
popup = item$iso#data$drive_times, group = "Drive Time")%>%
}
addLegend("bottomright", pal = isoc_items[[1]]$factPal,
values = isoc_items[[1]]$iso#data$drive_times, title = "Drive Time")
#Parfait has a good use of lapply that I would keep, so I won't recreate it for my answer. For your question of only looking to refer to one spatial polygon dataframe in your call to addPolygon you can use rbind once they are created. Note this only uses one colorFactor set.
#Create Isochrone points
iso1 <- osrmIsochrone(loc = c(-2.3827439,53.425705), breaks = seq(from = 0, to = 60, by = 5))
iso2 <- osrmIsochrone(loc = c(-0.85074928,51.325871), breaks = seq(from = 0, to = 60, by = 5))
iso3 <- osrmIsochrone(loc = c(-2.939367,51.570344), breaks = seq(from = 0, to = 60, by = 5))
iso4 <- osrmIsochrone(loc = c(-3.9868026,55.823102), breaks = seq(from = 0, to = 60, by = 5))
iso5 <- osrmIsochrone(loc = c(-0.92104073,53.709006), breaks = seq(from = 0, to = 60, by = 5))
iso <- rbind(iso1, iso2,iso3,iso4,iso5)
#Create Drive Time Interval descriptions
iso#data$drive_times <- factor(paste(iso#data$min, "to", iso#data$max, "mins"))
#Create Colour Palette for each time interval
factPal <- colorFactor(rev(heat.colors(12)), iso#data$drive_times)
#Draw Map
leaflet()%>%
addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
# addMarkers(data=spatialdf,lng=spatialdf$Longitude, lat=spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal(iso#data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso, popup = iso#data$drive_times, group = "Drive Time") %>%
addLegend("bottomright", pal = factPal, values = iso#data$drive_times, title = "Drive Time")