diff --git a/.buildlibrary b/.buildlibrary index ea00a03..8e6806d 100644 --- a/.buildlibrary +++ b/.buildlibrary @@ -1,4 +1,4 @@ -ValidationKey: '71809940' +ValidationKey: '72011940' AutocreateReadme: yes AcceptedWarnings: - 'Warning: package ''.*'' was built under R version' diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 243f46a..62f13da 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -3,7 +3,7 @@ exclude: '^tests/testthat/_snaps/.*$' repos: - repo: https://github.com/pre-commit/pre-commit-hooks - rev: v4.5.0 + rev: 2c9f875913ee60ca25ce70243dc24d5b6415598c # frozen: v4.6.0 hooks: - id: check-case-conflict - id: check-json @@ -15,7 +15,7 @@ repos: - id: mixed-line-ending - repo: https://github.com/lorenzwalthert/precommit - rev: v0.4.0 + rev: 7910e0323d7213f34275a7a562b9ef0fde8ce1b9 # frozen: v0.4.2 hooks: - id: parsable-R - id: deps-in-desc diff --git a/CITATION.cff b/CITATION.cff index fe99862..5ede696 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -2,8 +2,8 @@ cff-version: 1.2.0 message: If you use this software, please cite it using the metadata from this file. type: software title: 'luplot: Landuse Plot Library' -version: 3.62.0 -date-released: '2024-04-24' +version: 3.63.0 +date-released: '2024-04-25' abstract: Some useful functions to plot data such as a map plot function for MAgPIE objects. authors: diff --git a/DESCRIPTION b/DESCRIPTION index 1fac18b..f883f4c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: luplot Title: Landuse Plot Library -Version: 3.62.0 -Date: 2024-04-24 +Version: 3.63.0 +Date: 2024-04-25 Authors@R: c( person("Benjamin Leon", "Bodirsky", , "bodirsky@pik-potsdam.de", role = c("aut", "cre")), person("Jan Philipp", "Dietrich", , "dietrich@pik-potsdam.de", role = "aut"), @@ -42,7 +42,8 @@ Imports: sp, xml2, gridExtra, - mrcommons + mrcommons, + mstools (>= 0.5.1) Suggests: covr Encoding: UTF-8 diff --git a/NAMESPACE b/NAMESPACE index 8461410..a7bfd36 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -157,7 +157,7 @@ importFrom(magclass,where) importFrom(magpiesets,findset) importFrom(magpiesets,reportingnames) importFrom(mip,plotstyle) -importFrom(mrcommons,toolGetMappingCoord2Country) +importFrom(mstools,toolGetMappingCoord2Country) importFrom(quitte,as.quitte) importFrom(reshape2,melt) importFrom(rworldmap,addMapLegendBoxes) diff --git a/R/plotmap2.R b/R/plotmap2.R index 74bff7f..eb4fa9b 100644 --- a/R/plotmap2.R +++ b/R/plotmap2.R @@ -49,35 +49,30 @@ #' # plotmap2(data) #' #' #@importFrom RColorBrewer #' @export -#' @importFrom ggplot2 ggplot aes_ geom_polygon scale_fill_manual waiver geom_raster scale_fill_gradient2 scale_fill_gradient theme coord_cartesian ggtitle element_rect element_line scale_x_continuous scale_y_continuous geom_path element_text element_blank guides guide_colorbar ggsave unit +#' @importFrom ggplot2 ggplot aes_ geom_polygon scale_fill_manual waiver geom_raster scale_fill_gradient2 +#' scale_fill_gradient theme coord_cartesian ggtitle element_rect element_line scale_x_continuous scale_y_continuous +#' geom_path element_text element_blank guides guide_colorbar ggsave unit #' @importFrom grDevices colorRampPalette #' @importFrom utils head tail -#' @importFrom mrcommons toolGetMappingCoord2Country +#' @importFrom mstools toolGetMappingCoord2Country -plotmap2 <- function(data, file = NULL, title = "World map", legend_range = - NULL, legendname = "Cell share", lowcol = "grey95", - midcol = "orange", highcol = "darkred", midpoint = - 0.5, facet_grid = "Year~Data1", nrow = NULL, ncol = - NULL, scale = 2, breaks = TRUE, labs = TRUE, borders = - TRUE, MAgPIE_regions = FALSE, axis_text_col = "black", - legend_discrete = FALSE, legend_breaks = NULL, - show_percent = FALSE, sea = TRUE, land_colour = - "white", legend_height = 2, legend_width = NULL, - text_size = 12, legend_position = "right", facet_style - = "default", plot_height = 10, plot_width = 20) { - # require("ggplot2", quietly = TRUE) - # require("RColorBrewer", quietly = TRUE) - wrld_simpl_df <- NULL +plotmap2 <- function(data, file = NULL, title = "World map", legend_range = NULL, legendname = "Cell share", # nolint: object_name_linter + lowcol = "grey95", midcol = "orange", highcol = "darkred", midpoint = 0.5, + facet_grid = "Year~Data1", nrow = NULL, ncol = NULL, scale = 2, breaks = TRUE, labs = TRUE, # nolint: object_name_linter + borders = TRUE, MAgPIE_regions = FALSE, axis_text_col = "black", legend_discrete = FALSE, # nolint: object_name_linter + legend_breaks = NULL, show_percent = FALSE, sea = TRUE, land_colour = "white", # nolint: object_name_linter + legend_height = 2, legend_width = NULL, text_size = 12, legend_position = "right", # nolint: object_name_linter + facet_style = "default", plot_height = 10, plot_width = 20) { # nolint: object_name_linter + wrld_simpl_df <- NULL # nolint: object_name_linter data("world", envir = environment(), package = "luplot") if (MAgPIE_regions) { - facet_grid <- NULL + facet_grid <- NULL # nolint: object_name_linter map <- ggplot(wrld_simpl_df, aes_(~long, ~lat)) + geom_polygon(aes_(group = ~group, fill = ~magpie)) + - # scale_fill_manual("MAgPIE\nregions",values=brewer.pal(11,"Paired")[2:11],na.value="white") - scale_fill_manual("MAgPIE\nregion", values = c("purple3", "red3", "hotpink", "cyan3", "goldenrod1", "gray44", "#8C5400FF", "darkorange2", "royalblue3", "green4"), na.value = "white") - # scale_fill_manual("MAgPIE\nregions",values=c(nice_colors(style="contrast_area",saturation=1)[1:10]),na.value="white") - # scale_fill_brewer(palette="Set3",na.value="white") + scale_fill_manual("MAgPIE\nregion", values = c("purple3", "red3", "hotpink", "cyan3", "goldenrod1", "gray44", + "#8C5400FF", "darkorange2", "royalblue3", "green4"), + na.value = "white") } else { if (!is.list(data)) { temp <- data @@ -85,7 +80,7 @@ plotmap2 <- function(data, file = NULL, title = "World map", legend_range = data[["default"]] <- temp } if (is.null(legend_range)) { - midpoint <- max(unlist(lapply(data, max, na.rm = T))) * midpoint + midpoint <- max(unlist(lapply(data, max, na.rm = TRUE))) * midpoint } else { data <- lapply(data, function(x) { x[which(x < legend_range[1])] <- legend_range[1] @@ -94,22 +89,23 @@ plotmap2 <- function(data, file = NULL, title = "World map", legend_range = }) } if (any(unlist(lapply(data, function(x) return(is.null(attr(x, "coordinates"))))))) { - if (length(getItems(data[[1]], dim = 1) == 67420)) { - mapping <- toolGetMappingCoord2Country() - mapping <- setNames(do.call(rbind.data.frame, strsplit(unlist(mapping[, "coords"]), '\\.')), - c('lon', 'lat')) - mapping <- apply(mapping, 2, function(y) as.numeric(gsub("p", "\\.", y))) - data <- lapply(data, function(x) { - attr(x, "coordinates") <-mapping - return(x) - }) - } else if (length(getItems(data[[1]], dim = 1) == 59199)) { - data <- lapply(data, function(x) { - attr(x, "coordinates") <- getCoordinates(degree = TRUE) - return(x) - }) + if (length(getItems(data[[1]], dim = 1) == 67420)) { + mapping <- toolGetMappingCoord2Country() + mapping <- setNames(do.call(rbind.data.frame, strsplit(unlist(mapping[, "coords"]), "\\.")), + c("lon", "lat")) + mapping <- apply(mapping, 2, function(y) as.numeric(gsub("p", "\\.", y))) + data <- lapply(data, function(x) { + attr(x, "coordinates") <- mapping + return(x) + }) + } else if (length(getItems(data[[1]], dim = 1) == 59199)) { + data <- lapply(data, function(x) { + attr(x, "coordinates") <- getCoordinates(degree = TRUE) + return(x) + }) } - warning("Missing coordinates in attributes for at least one MAgPIE object. Added coordinates in default MAgPIE cell order.") + warning(paste("Missing coordinates in attributes for at least one MAgPIE object.", + "Added coordinates in default MAgPIE cell order.")) } @@ -122,34 +118,34 @@ plotmap2 <- function(data, file = NULL, title = "World map", legend_range = data$Breaks[is.na(data$Breaks)] <- "No data" } data$Breaks <- as.factor(data$Breaks) - legend_labels <- levels(data$Breaks) + legendLabels <- levels(data$Breaks) } else { tmp <- as.vector(data$Value) tmp[] <- length(legend_breaks) + 1 - legend_labels <- rep("", length(legend_breaks) + 1) - legend_labels[length(legend_breaks) + 1] <- paste(">", legend_breaks[length(legend_breaks)]) + legendLabels <- rep("", length(legend_breaks) + 1) + legendLabels[length(legend_breaks) + 1] <- paste(">", legend_breaks[length(legend_breaks)]) for (i in length(legend_breaks):2) { tmp[which(as.vector(data$Value) <= legend_breaks[i])] <- i - legend_labels[i] <- paste(legend_breaks[i - 1], "-", legend_breaks[i]) + legendLabels[i] <- paste(legend_breaks[i - 1], "-", legend_breaks[i]) } tmp[which(as.vector(data$Value) < legend_breaks[1])] <- 1 tmp[which(is.na(as.vector(data$Value)))] <- NA - legend_labels[1] <- paste("<", legend_breaks[1]) - legend_labels <- legend_labels[as.numeric(rev(levels(as.factor(tmp))))] + legendLabels[1] <- paste("<", legend_breaks[1]) + legendLabels <- legendLabels[as.numeric(rev(levels(as.factor(tmp))))] tmpchar <- as.character(tmp) tmpchar[is.na(tmpchar)] <- "No data" levels <- rev(levels(as.factor(tmp))) if ("No data" %in% tmpchar) { - legend_labels <- c(legend_labels, "No data") + legendLabels <- c(legendLabels, "No data") levels <- c(levels, "No data") } data$Breaks <- factor(tmpchar, levels = levels) } - if ("No data" %in% legend_labels) { - colours <- c(colorRampPalette(c(highcol, midcol, lowcol))(length(legend_labels) - 1), "grey") + if ("No data" %in% legendLabels) { + colours <- c(colorRampPalette(c(highcol, midcol, lowcol))(length(legendLabels) - 1), "grey") } else { - colours <- colorRampPalette(c(highcol, midcol, lowcol))(length(legend_labels)) + colours <- colorRampPalette(c(highcol, midcol, lowcol))(length(legendLabels)) } if (show_percent) { @@ -157,21 +153,36 @@ plotmap2 <- function(data, file = NULL, title = "World map", legend_range = if ("No data" %in% names(tmp)) tmp <- tmp[-which(names(tmp) == "No data")] percent <- round(tmp / sum(tmp) * 100, 1) percent <- paste("(", percent, "%)", sep = "") - legend_labels[which(legend_labels != "No data")] <- paste(legend_labels[which(legend_labels != "No data")], percent, sep = " ") + legendLabels[which(legendLabels != "No data")] <- paste(legendLabels[which(legendLabels != "No data")], + percent, sep = " ") } } if (!is.null(legend_breaks)) { - labels <- c(bquote("" <= .(head(legend_breaks, 1))), legend_breaks[2:(length(legend_breaks) - 1)], bquote("" >= .(tail(legend_breaks, 1)))) + labels <- c(bquote("" <= .(head(legend_breaks, 1))), legend_breaks[2:(length(legend_breaks) - 1)], + bquote("" >= .(tail(legend_breaks, 1)))) } else { - legend_breaks <- waiver() + legend_breaks <- waiver() # nolint: object_name_linter labels <- waiver() } - map <- ggplot(data, aes_(~x, ~y)) + geom_polygon(data = wrld_simpl_df, aes_(~long, ~lat, group = ~group, fill = ~hole), fill = land_colour) + map <- ggplot(data, aes_(~x, ~y)) + geom_polygon(data = wrld_simpl_df, + aes_(~long, ~lat, group = ~group, fill = ~hole), + fill = land_colour) if (is.null(data$Breaks)) { - if (!is.null(midcol)) map <- map + geom_raster(aes_(fill = ~Value)) + scale_fill_gradient2(name = legendname, low = lowcol, mid = midcol, high = highcol, midpoint = midpoint, limits = legend_range, breaks = legend_breaks, labels = labels, na.value = "grey") - else map <- map + geom_raster(aes_(fill = ~Value)) + scale_fill_gradient(name = legendname, low = lowcol, high = highcol, limits = legend_range, breaks = legend_breaks, labels = labels, na.value = "grey") - } else map <- map + geom_raster(aes_(fill = ~Breaks)) + scale_fill_manual(name = legendname, values = colours, labels = legend_labels, na.value = "yellow") + if (!is.null(midcol)) { + map <- map + geom_raster(aes_(fill = ~Value)) + + scale_fill_gradient2(name = legendname, low = lowcol, mid = midcol, high = highcol, + midpoint = midpoint, limits = legend_range, breaks = legend_breaks, + labels = labels, na.value = "grey") + } else { + map <- map + geom_raster(aes_(fill = ~Value)) + + scale_fill_gradient(name = legendname, low = lowcol, high = highcol, limits = legend_range, + breaks = legend_breaks, labels = labels, na.value = "grey") + } + } else { + map <- map + geom_raster(aes_(fill = ~Breaks)) + + scale_fill_manual(name = legendname, values = colours, labels = legendLabels, na.value = "yellow") + } if (!is.null(legend_height)) map <- map + theme(legend.key.height = unit(legend_height, "cm")) if (!is.null(legend_width)) map <- map + theme(legend.key.width = unit(legend_width, "cm")) } @@ -179,22 +190,47 @@ plotmap2 <- function(data, file = NULL, title = "World map", legend_range = coord_cartesian(xlim = c(-180, 180), ylim = c(-58, 86)) + theme(aspect.ratio = 0.5) + ggtitle(title) - if (sea) map <- map + theme(panel.background = element_rect(fill = "lightsteelblue2")) - else map <- map + theme(panel.background = element_rect(fill = "white", colour = "black")) + theme(panel.grid.major = element_line(colour = "grey80"), panel.grid.minor = element_line(colour = "grey90")) + if (sea) { + map <- map + theme(panel.background = element_rect(fill = "lightsteelblue2")) + } else { + map <- map + theme(panel.background = element_rect(fill = "white", colour = "black")) + + theme(panel.grid.major = element_line(colour = "grey80"), panel.grid.minor = element_line(colour = "grey90")) + } if (!is.null(facet_grid)) { if (substr(facet_grid, 1, 1) == "~") map <- map + facet_wrap(facet_grid, nrow = nrow, ncol = ncol) else map <- map + facet_grid(facet_grid) - } - if (breaks) map <- map + scale_x_continuous(breaks = c(-90, 0, 90)) + scale_y_continuous(breaks = c(-66, -38, -23, 0, 23, 38, 66)) - else map <- map + scale_x_continuous(breaks = NULL) + scale_y_continuous(breaks = NULL) + } + if (breaks) { + map <- map + scale_x_continuous(breaks = c(-90, 0, 90)) + + scale_y_continuous(breaks = c(-66, -38, -23, 0, 23, 38, 66)) + } else { + map <- map + scale_x_continuous(breaks = NULL) + scale_y_continuous(breaks = NULL) + } if (labs) map <- map + labs(x = "Longitude", y = "Latitude") else map <- map + labs(y = NULL, x = NULL) - if (borders) map <- map + geom_path(data = wrld_simpl_df, aes_(~long, ~lat, group = ~group, fill = NULL), color = "grey10", size = 0.1) - if (!is.null(axis_text_col)) map <- map + theme(axis.text = element_text(colour = axis_text_col), axis.ticks = element_line(colour = axis_text_col)) - map <- map + theme(panel.grid.minor = element_line(colour = "white"), plot.title = element_text(size = text_size + 4, face = "bold", vjust = 1.5), legend.position = legend_position, legend.title = element_text(size = text_size, face = "bold"), legend.text = element_text(size = text_size), axis.title.y = element_text(angle = 90, size = text_size, vjust = 0.3), axis.text.y = element_text(size = text_size - 2), axis.title.x = element_text(size = text_size, vjust = -0.3), axis.text.x = element_text(size = text_size - 2, vjust = 0.5)) - if (facet_style == "default") map <- map + theme(strip.text.x = element_text(size = text_size - 1), strip.text.y = element_text(size = text_size - 1)) - else if (facet_style == "paper") map <- map + theme(strip.text.x = element_text(size = text_size, face = "bold"), strip.text.y = element_text(size = text_size, face = "bold")) + theme(strip.background = element_blank()) - if (legend_position %in% c("top", "bottom")) map <- map + guides(fill = guide_colorbar(title.position = "top")) + theme(legend.box.just = "left") + if (borders) map <- map + geom_path(data = wrld_simpl_df, aes_(~long, ~lat, group = ~group, fill = NULL), + color = "grey10", size = 0.1) + if (!is.null(axis_text_col)) map <- map + theme(axis.text = element_text(colour = axis_text_col), + axis.ticks = element_line(colour = axis_text_col)) + map <- map + theme(panel.grid.minor = element_line(colour = "white"), + plot.title = element_text(size = text_size + 4, face = "bold", vjust = 1.5), + legend.position = legend_position, legend.title = element_text(size = text_size, face = "bold"), + legend.text = element_text(size = text_size), + axis.title.y = element_text(angle = 90, size = text_size, vjust = 0.3), + axis.text.y = element_text(size = text_size - 2), + axis.title.x = element_text(size = text_size, vjust = -0.3), + axis.text.x = element_text(size = text_size - 2, vjust = 0.5)) + if (facet_style == "default") { + map <- map + theme(strip.text.x = element_text(size = text_size - 1), + strip.text.y = element_text(size = text_size - 1)) + } else if (facet_style == "paper") { + map <- map + theme(strip.text.x = element_text(size = text_size, face = "bold"), + strip.text.y = element_text(size = text_size, face = "bold")) + + theme(strip.background = element_blank()) + } + if (legend_position %in% c("top", "bottom")) { + map <- map + guides(fill = guide_colorbar(title.position = "top")) + theme(legend.box.just = "left") + } if (!is.null(file)) { ggsave(file, map, scale = scale, limitsize = FALSE, units = "cm", height = plot_height, width = plot_width) } else { diff --git a/README.md b/README.md index 7d0f946..a955a43 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # Landuse Plot Library -R package **luplot**, version **3.62.0** +R package **luplot**, version **3.63.0** [![CRAN status](https://www.r-pkg.org/badges/version/luplot)](https://cran.r-project.org/package=luplot) [![R build status](https://github.com/pik-piam/luplot/workflows/check/badge.svg)](https://github.com/pik-piam/luplot/actions) [![codecov](https://codecov.io/gh/pik-piam/luplot/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/luplot) [![r-universe](https://pik-piam.r-universe.dev/badges/luplot)](https://pik-piam.r-universe.dev/builds) @@ -39,7 +39,7 @@ In case of questions / problems please contact Benjamin Bodirsky . +Bodirsky B, Dietrich J, Krause M, Stevanovic M, Humpenoeder F, Weindl I, Baumstark L, Klein D, Rolinski S, Wang X, Chen D (2024). _luplot: Landuse Plot Library_. R package version 3.63.0, . A BibTeX entry for LaTeX users is @@ -48,7 +48,7 @@ A BibTeX entry for LaTeX users is title = {luplot: Landuse Plot Library}, author = {Benjamin Leon Bodirsky and Jan Philipp Dietrich and Michael Krause and Miodrag Stevanovic and Florian Humpenoeder and Isabelle Weindl and Lavinia Baumstark and David Klein and Susanne Rolinski and Xiaoxi Wang and David Chen}, year = {2024}, - note = {R package version 3.62.0}, + note = {R package version 3.63.0}, url = {https://github.com/pik-piam/luplot}, } ```