Nothing
#' @title Double Proportional Triangle Layer
#' @description Plot a double proportional triangles layer.
#' @name propTrianglesLayer
#' @param x an sf object, a simple feature collection. If x is used then spdf, df, spdfid and dfid are not.
#' @param spdf a SpatialPointsDataFrame or a SpatialPolygonsDataFrame; if spdf
#' is a SpatialPolygonsDataFrame symbols are plotted on centroids.
#' @param df a data frame that contains the values to plot. If df is missing
#' spdf@data is used instead.
#' @param spdfid name of the identifier variable in spdf, default to the first column
#' of the spdf data frame. (optional)
#' @param dfid name of the identifier variable in df, default to the first column
#' of df. (optional)
#' @param var1 name of the first numeric variable to plot, positive values
#' only (top triangle).
#' @param var2 name of the second numeric variable to plot, positive values
#' only (bottom triangle).
#' @param col1 color of top triangles.
#' @param col2 color of bottom triangles.
#' @param k share of the map occupied by the biggest symbol.
#' @param legend.pos position of the legend, one of "topleft", "top",
#' "topright", "left", "right", "bottomleft", "bottom", "bottomright". If
#' legend.pos is "n" then the legend is not plotted.
#' @param legend.title.txt title of the legend.
#' @param legend.title.cex size of the legend title.
#' @param legend.var1.txt label of the top variable.
#' @param legend.var2.txt label of the bottom variable.
#' @param legend.values.cex size of the values in the legend.
#' @param legend.values.rnd number of decimal places of the values
#' displayed in the legend.
#' @param legend.style either "c" or "e". The legend has two display
#' styles, "c" stands for compact and "e" for extended.
#' @param legend.frame boolean; whether to add a frame to the legend (TRUE) or
#' not (FALSE).
#' @param add whether to add the layer to an existing plot (TRUE) or
#' not (FALSE).
#' @export
#' @seealso \link{legendPropTriangles}
#' @examples
#' library(sf)
#' mtq <- st_read(system.file("gpkg/mtq.gpkg", package="cartography"))
#' # Employed Active Population
#' mtq$OCC <- mtq$ACT-mtq$CHOM
#' plot(st_geometry(mtq), col = "lightblue4",border = "lightblue3",
#' bg = "lightblue1")
#' propTrianglesLayer(x = mtq, var1 = "OCC", var2 = "CHOM",
#' col1="green4",col2="red4",k = 0.1)
#' layoutLayer(title = "Active Population in Martinique, 2015")
#' @export
propTrianglesLayer <- function(x, spdf, df, spdfid = NULL, dfid = NULL,
var1, col1 = "#E84923",
var2, col2 = "#7DC437",
k = 0.02,
legend.pos = "topright",
legend.title.txt = paste(var1,var2,sep=" / "),
legend.title.cex = 0.8,
legend.var1.txt = var1,
legend.var2.txt = var2,
legend.values.cex = 0.6,
legend.values.rnd = 0,
legend.style = "c",
legend.frame = FALSE,
add = TRUE)
{
if(!missing(x)){spdf <- methods::as(x, "Spatial")}
if (missing(df)){df <- spdf@data}
if (is.null(spdfid)){spdfid <- names(spdf@data)[1]}
if (is.null(dfid)){dfid <- names(df)[1]}
dots <- cbind(spdf@data[, spdfid], as.data.frame(sp::coordinates(spdf)))
colnames(dots) <- c(spdfid,"x","y")
dots <- data.frame(dots, df[match(dots[,spdfid], df[,dfid]),])
dots <- dots[,c(spdfid,"x","y", var1, var2)]
# Ajustage de la atille des cercles
x1 <- sp::bbox(spdf)[1]
y1 <- sp::bbox(spdf)[2]
x2 <- sp::bbox(spdf)[3]
y2 <- sp::bbox(spdf)[4]
if (sum(df[,var1], na.rm = TRUE)>=sum(df[,var2], na.rm = TRUE)){
var <- var1
} else {
var <- var2
}
sfdc <- (x2-x1)*(y2-y1)
# sc <- sum(abs(dots[,var]),na.rm = TRUE)
sc <- max(abs(dots[,var]),na.rm = TRUE)
if(add==FALSE){suppressWarnings(sp::plot(spdf))}
# TRIANGLE TOP
dots$size1 <- sqrt(dots[,var1]*k* sfdc / sc /2)
dots$y1<-dots$y+dots$size1/2
dots <- dots[order(dots[,var1],decreasing=TRUE),]
dots$xx1a<-dots$x-dots$size1/2
dots$xx1b<-dots$x
dots$xx1c<-dots$x+dots$size1/2
dots$yy1a<-dots$y
dots$yy1b<-dots$y+dots$size1/2
dots$yy1c<-dots$y
for (i in 1:length(dots$x)){
polygon(c(dots$xx1a[i],dots$xx1b[i],dots$xx1c[i]),
c(dots$yy1a[i],dots$yy1b[i],dots$yy1c[i]),
col = col1, border = "#DDDDDD")
}
# TRIANGLE BOTTOM
dots$size2 <- sqrt(dots[,var2]*k* sfdc / sc /2)
dots$y1<-dots$y+dots$size2/2
dots <- dots[order(dots[,var2],decreasing=TRUE),]
dots$xx1a<-dots$x-dots$size2/2
dots$xx1b<-dots$x
dots$xx1c<-dots$x+dots$size2/2
dots$yy1a<-dots$y
dots$yy1b<-dots$y-dots$size2/2
dots$yy1c<-dots$y
for (i in 1:length(dots$x)){
polygon(c(dots$xx1a[i],dots$xx1b[i],dots$xx1c[i]),
c(dots$yy1a[i],dots$yy1b[i],dots$yy1c[i]),
col = col2, border = "#DDDDDD")
}
if(legend.pos!="n"){
legendPropTriangles(pos = legend.pos, title.txt = legend.title.txt,
var.txt = legend.var1.txt,
var2.txt = legend.var2.txt,
title.cex = legend.title.cex,
values.cex = legend.values.cex,
var = dots[,var1],
var2 = dots[,var2],
r = dots$size1,
r2 = dots$size2,
col = col1,
col2 = col2,
frame = legend.frame,
values.rnd = legend.values.rnd,
style = legend.style)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.