From 03da8f90cbb49bbf2e34bac87b87c127350b449a Mon Sep 17 00:00:00 2001 From: rCarto Date: Thu, 9 Nov 2023 11:21:14 +0100 Subject: [PATCH] ci: test new --- DESCRIPTION | 2 - NAMESPACE | 3 -- R/RcppExports.R | 7 --- R/mf_annotation.R | 2 +- R/mf_label.R | 91 -------------------------------------- R/mf_labels_utils.R | 89 ------------------------------------- R/mf_pkg_utils.R | 5 +-- R/package.R | 1 - inst/tinytest/test_label.R | 7 --- man/mapsf.Rd | 1 - man/mf_label.Rd | 57 ------------------------ src/.gitignore | 3 -- src/RcppExports.cpp | 27 ----------- src/init.c | 22 --------- src/layout.cpp | 41 ----------------- vignettes/mapsf.Rmd | 4 +- 16 files changed, 4 insertions(+), 358 deletions(-) delete mode 100644 R/RcppExports.R delete mode 100644 R/mf_label.R delete mode 100644 R/mf_labels_utils.R delete mode 100644 man/mf_label.Rd delete mode 100644 src/.gitignore delete mode 100644 src/RcppExports.cpp delete mode 100644 src/init.c delete mode 100644 src/layout.cpp diff --git a/DESCRIPTION b/DESCRIPTION index a5408faf..6356c97b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,7 +29,6 @@ Imports: classInt, graphics, maplegend, - Rcpp, sf, stats, utils, @@ -43,7 +42,6 @@ Suggests: rmarkdown, tinytest, covr -LinkingTo: Rcpp Encoding: UTF-8 RoxygenNote: 7.2.3 VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 9e81174a..059c0c29 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,7 +19,6 @@ export(mf_graticule) export(mf_init) export(mf_inset_off) export(mf_inset_on) -export(mf_label) export(mf_layout) export(mf_legend) export(mf_legend_c) @@ -42,7 +41,6 @@ export(mf_title) export(mf_typo) import(graphics) import(sf) -importFrom(Rcpp,evalCpp) importFrom(grDevices,colorRampPalette) importFrom(grDevices,dev.list) importFrom(grDevices,hcl.colors) @@ -70,4 +68,3 @@ importFrom(stats,quantile) importFrom(stats,runif) importFrom(stats,sd) importFrom(utils,globalVariables) -useDynLib(mapsf,.registration = TRUE) diff --git a/R/RcppExports.R b/R/RcppExports.R deleted file mode 100644 index c52d25a8..00000000 --- a/R/RcppExports.R +++ /dev/null @@ -1,7 +0,0 @@ -# Generated by using Rcpp::compileAttributes() -> do not edit by hand -# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -is_overlap <- function(x11, y11, sw11, sh11, boxes1) { - .Call(`_mapsf_is_overlap`, x11, y11, sw11, sh11, boxes1) -} - diff --git a/R/mf_annotation.R b/R/mf_annotation.R index 3ef8e864..af91f257 100644 --- a/R/mf_annotation.R +++ b/R/mf_annotation.R @@ -91,7 +91,7 @@ mf_annotation <- function(x, txt, pos = "topright", lwd = 1.2 ) if (halo) { - shadowtext( + text( x = res$x_txt, y = res$y_txt, labels = txt, col = col_txt, bg = bg, diff --git a/R/mf_label.R b/R/mf_label.R deleted file mode 100644 index 3b6cc9fd..00000000 --- a/R/mf_label.R +++ /dev/null @@ -1,91 +0,0 @@ -#' @title Plot labels -#' @description Put labels on a map. -#' @name mf_label -#' @eval my_params(c('x', 'var')) -#' @param col labels color, it can be a single color or a vector of colors -#' @param cex labels cex, it can be a single size or a vector of sizes -#' @param ... further \link{text} arguments. -#' @param bg halo color, it can be a single color or a vector of colors -#' @param r width of the halo, it can be a single value or a vector of values -#' @param overlap if FALSE, labels are moved so they do not overlap. -#' @param halo if TRUE, a 'halo' is displayed around the text and additional -#' arguments bg and r can be modified to set the color and width of the halo. -#' @param lines if TRUE, then lines are plotted between x,y and the word, -#' for those words not covering their x,y coordinate -#' @return No return value, labels are displayed. -#' @export -#' @examples -#' mtq <- mf_get_mtq() -#' mf_map(mtq) -#' mtq$cex <- c(rep(.8, 8), 2, rep(.8, 25)) -#' mf_label( -#' x = mtq, var = "LIBGEO", col = "grey10", halo = TRUE, cex = mtq$cex, -#' overlap = FALSE, lines = FALSE -#' ) -mf_label <- function(x, var, - col, - cex = 0.7, overlap = TRUE, - lines = TRUE, - halo = FALSE, - bg, - r = 0.1, ...) { - test_cur_plot() - # margins mgmt - op <- par(mar = getOption("mapsf.mar"), no.readonly = TRUE) - on.exit(par(op)) - - if (missing(col)) { - col <- getOption("mapsf.fg") - } - if (missing(bg)) { - bg <- getOption("mapsf.bg") - } - words <- x[[var]] - cc <- sf::st_coordinates(sf::st_centroid( - x = sf::st_geometry(x), - of_largest_polygon = max(sf::st_is(sf::st_as_sf(x), "MULTIPOLYGON")) - )) - - if (nrow(x) == 1) { - overlap <- TRUE - } - - if (!overlap) { - xo <- unlist(cc[, 1]) - yo <- unlist(cc[, 2]) - lay <- wordlayout(xo, yo, words, cex) - - if (lines) { - nlab <- length(xo) - if (length(col) != nlab) { - col <- rep(col[1], nlab) - } - for (i in seq_along(xo)) { - xl <- lay[i, 1] - yl <- lay[i, 2] - w <- lay[i, 3] - h <- lay[i, 4] - if (xo[i] < xl || xo[i] > xl + w || - yo[i] < yl || yo[i] > yl + h) { - points(xo[i], yo[i], pch = 16, col = col[i], cex = .5) - nx <- xl + .5 * w - ny <- yl + .5 * h - lines(c(xo[i], nx), c(yo[i], ny), col = col[i], lwd = 1) - } - } - } - cc <- matrix( - data = c(lay[, 1] + .5 * lay[, 3], lay[, 2] + .5 * lay[, 4]), - ncol = 2, byrow = FALSE - ) - } - if (halo) { - shadowtext( - x = cc[, 1], y = cc[, 2], labels = words, - cex = cex, col = col, bg = bg, r = r, ... - ) - } else { - text(x = cc[, 1], y = cc[, 2], labels = words, cex = cex, col = col, ...) - } - return(invisible(x)) -} diff --git a/R/mf_labels_utils.R b/R/mf_labels_utils.R deleted file mode 100644 index dd97bbf0..00000000 --- a/R/mf_labels_utils.R +++ /dev/null @@ -1,89 +0,0 @@ -# shadow around the labels -#' @name shadowtext -#' @title shadowtext -#' @description shadowtext -#' @param x lon -#' @param y lat -#' @param labels labels -#' @param col col -#' @param bg bg -#' @param theta number of iteration -#' @param r radius -#' @param ... other txt params -#' @noRd -shadowtext <- function(x, y = NULL, labels, col = "white", bg = "black", - theta = seq(0, 2 * pi, length.out = 50), r = 0.1, ...) { - xo <- r * strwidth("A") - yo <- r * strheight("A") - for (i in theta) { - text(x + cos(i) * xo, y + sin(i) * yo, labels, col = bg, ...) - } - text(x, y, labels, col = col, ...) -} - -# Label placement -#' @name wordlayout -#' @title wordlayout -#' @description wordlayout -#' @param x long -#' @param y lat -#' @param words labels -#' @param cex cex -#' @param xlim xlim -#' @param ylim ylim -#' @param tstep tstep -#' @param rstep rstep -#' @param ... other stuf -#' @return coords -#' @noRd -wordlayout <- function(x, y, words, cex = 1, - xlim = c(-Inf, Inf), ylim = c(-Inf, Inf), - tstep = .1, rstep = .1, ...) { - tails <- "g|j|p|q|y" - n <- length(words) - sdx <- sd(x, na.rm = TRUE) - sdy <- sd(y, na.rm = TRUE) - if (sdx == 0) { - sdx <- 1 - } - if (sdy == 0) { - sdy <- 1 - } - if (length(cex) == 1) { - cex <- rep(cex, n) - } - boxes <- list() - for (i in seq_along(words)) { - r <- 0 - theta <- runif(1, 0, 2 * pi) - x1 <- xo <- x[i] - y1 <- yo <- y[i] - wid <- strwidth(words[i], cex = cex[i], ...) + 0.4 * - strwidth("R", cex = cex[i], ...) - ht <- strheight(words[i], cex = cex[i], ...) + 0.4 * - strheight("R", cex = cex[i], ...) - - # mind your ps and qs - if (grepl(tails, words[i])) { - ht <- ht + ht * .2 - } - is_overlaped <- TRUE - while (is_overlaped) { - if (!is_overlap(x1 - .5 * wid, y1 - .5 * ht, wid, ht, boxes) && - x1 - .5 * wid > xlim[1] && y1 - .5 * ht > ylim[1] && - x1 + .5 * wid < xlim[2] && y1 + .5 * ht < ylim[2]) { - boxes[[length(boxes) + 1]] <- c(x1 - .5 * wid, y1 - .5 * ht, wid, ht) - is_overlaped <- FALSE - } else { - theta <- theta + tstep - r <- r + rstep * tstep / (2 * pi) - x1 <- xo + sdx * r * cos(theta) - y1 <- yo + sdy * r * sin(theta) - } - } - } - result <- do.call(rbind, boxes) - colnames(result) <- c("x", "y", "width", "ht") - rownames(result) <- words - result -} diff --git a/R/mf_pkg_utils.R b/R/mf_pkg_utils.R index 4ed352f1..2a9ad6b0 100644 --- a/R/mf_pkg_utils.R +++ b/R/mf_pkg_utils.R @@ -8,10 +8,7 @@ #' @importFrom stats aggregate median na.omit quantile runif sd -# Rcpp stuff -#' @useDynLib mapsf,.registration = TRUE -#' @importFrom Rcpp evalCpp -NULL + #' @importFrom utils globalVariables .gmapsf <- new.env(parent = emptyenv()) diff --git a/R/package.R b/R/package.R index 1536288f..bdd571e2 100644 --- a/R/package.R +++ b/R/package.R @@ -15,7 +15,6 @@ #' @section Symbology: #' These functions display cartographic layers. #' - [mf_map()] Plot a map -#' - [mf_label()] Plot labels #' - [mf_raster()] Plot a raster #' - [mf_graticule()] Plot graticules #' diff --git a/inst/tinytest/test_label.R b/inst/tinytest/test_label.R index 034cfb45..e69de29b 100644 --- a/inst/tinytest/test_label.R +++ b/inst/tinytest/test_label.R @@ -1,7 +0,0 @@ -mtq <- mf_get_mtq() -mf_map(mtq) -expect_silent(mf_label(x = mtq, var = "LIBGEO", halo = TRUE, cex = 0.8, - overlap = FALSE, lines = TRUE)) -expect_silent(mf_label(x = mtq, var = "LIBGEO", halo = TRUE, - cex = 0.8, col = sample(1:5, nrow(mtq), replace = TRUE), - overlap = FALSE, lines = TRUE)) diff --git a/man/mapsf.Rd b/man/mapsf.Rd index c510996a..8409a71b 100644 --- a/man/mapsf.Rd +++ b/man/mapsf.Rd @@ -21,7 +21,6 @@ various maps: \code{vignette(topic = "mapsf", package = "mapsf")} These functions display cartographic layers. \itemize{ \item \code{\link[=mf_map]{mf_map()}} Plot a map -\item \code{\link[=mf_label]{mf_label()}} Plot labels \item \code{\link[=mf_raster]{mf_raster()}} Plot a raster \item \code{\link[=mf_graticule]{mf_graticule()}} Plot graticules } diff --git a/man/mf_label.Rd b/man/mf_label.Rd deleted file mode 100644 index b0139098..00000000 --- a/man/mf_label.Rd +++ /dev/null @@ -1,57 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mf_label.R -\name{mf_label} -\alias{mf_label} -\title{Plot labels} -\usage{ -mf_label( - x, - var, - col, - cex = 0.7, - overlap = TRUE, - lines = TRUE, - halo = FALSE, - bg, - r = 0.1, - ... -) -} -\arguments{ -\item{x}{object of class \code{sf}} - -\item{var}{name(s) of the variable(s) to plot} - -\item{col}{labels color, it can be a single color or a vector of colors} - -\item{cex}{labels cex, it can be a single size or a vector of sizes} - -\item{overlap}{if FALSE, labels are moved so they do not overlap.} - -\item{lines}{if TRUE, then lines are plotted between x,y and the word, -for those words not covering their x,y coordinate} - -\item{halo}{if TRUE, a 'halo' is displayed around the text and additional -arguments bg and r can be modified to set the color and width of the halo.} - -\item{bg}{halo color, it can be a single color or a vector of colors} - -\item{r}{width of the halo, it can be a single value or a vector of values} - -\item{...}{further \link{text} arguments.} -} -\value{ -No return value, labels are displayed. -} -\description{ -Put labels on a map. -} -\examples{ -mtq <- mf_get_mtq() -mf_map(mtq) -mtq$cex <- c(rep(.8, 8), 2, rep(.8, 25)) -mf_label( - x = mtq, var = "LIBGEO", col = "grey10", halo = TRUE, cex = mtq$cex, - overlap = FALSE, lines = FALSE -) -} diff --git a/src/.gitignore b/src/.gitignore deleted file mode 100644 index 22034c46..00000000 --- a/src/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -*.o -*.so -*.dll diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp deleted file mode 100644 index a20d9e01..00000000 --- a/src/RcppExports.cpp +++ /dev/null @@ -1,27 +0,0 @@ -// Generated by using Rcpp::compileAttributes() -> do not edit by hand -// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -#include - -using namespace Rcpp; - -#ifdef RCPP_USE_GLOBAL_ROSTREAM -Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); -Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); -#endif - -// is_overlap -RcppExport SEXP is_overlap(SEXP x11, SEXP y11, SEXP sw11, SEXP sh11, SEXP boxes1); -RcppExport SEXP _mapsf_is_overlap(SEXP x11SEXP, SEXP y11SEXP, SEXP sw11SEXP, SEXP sh11SEXP, SEXP boxes1SEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< SEXP >::type x11(x11SEXP); - Rcpp::traits::input_parameter< SEXP >::type y11(y11SEXP); - Rcpp::traits::input_parameter< SEXP >::type sw11(sw11SEXP); - Rcpp::traits::input_parameter< SEXP >::type sh11(sh11SEXP); - Rcpp::traits::input_parameter< SEXP >::type boxes1(boxes1SEXP); - rcpp_result_gen = Rcpp::wrap(is_overlap(x11, y11, sw11, sh11, boxes1)); - return rcpp_result_gen; -END_RCPP -} diff --git a/src/init.c b/src/init.c deleted file mode 100644 index 9974a6d0..00000000 --- a/src/init.c +++ /dev/null @@ -1,22 +0,0 @@ -#include -#include -#include // for NULL -#include - -/* FIXME: - Check these declarations against the C/Fortran source code. -*/ - -/* .Call calls */ -extern SEXP _mapsf_is_overlap(SEXP, SEXP, SEXP, SEXP, SEXP); - -static const R_CallMethodDef CallEntries[] = { - {"_mapsf_is_overlap", (DL_FUNC) &_mapsf_is_overlap, 5}, - {NULL, NULL, 0} -}; - -void R_init_mapsf(DllInfo *dll) -{ - R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); - R_useDynamicSymbols(dll, FALSE); -} diff --git a/src/layout.cpp b/src/layout.cpp deleted file mode 100644 index 11e4fc3d..00000000 --- a/src/layout.cpp +++ /dev/null @@ -1,41 +0,0 @@ -#include "Rcpp.h" - -/* -* Detect if a box at position (x11,y11), with width sw11 and height sh11 overlaps -* with any of the boxes in boxes1 -*/ -using namespace Rcpp; -// [[Rcpp::export]] - -RcppExport SEXP is_overlap(SEXP x11,SEXP y11,SEXP sw11,SEXP sh11,SEXP boxes1){ - double x1 = as(x11); - double y1 =as(y11); - double sw1 = as(sw11); - double sh1 = as(sh11); - Rcpp::List boxes(boxes1); - Rcpp::NumericVector bnds; - double x2, y2, sw2, sh2; - bool overlap= true; - for (int i=0;i < boxes.size();i++) { - bnds = boxes(i); - x2 = bnds(0); - y2 = bnds(1); - sw2 = bnds(2); - sh2 = bnds(3); - if (x1 < x2) - overlap = (x1 + sw1) > x2; - else - overlap = (x2 + sw2) > x1; - - - if (y1 < y2) - overlap = (overlap && ((y1 + sh1) > y2)); - else - overlap = (overlap && ((y2 + sh2) > y1)); - - if(overlap) - return Rcpp::wrap(true); - } - - return Rcpp::wrap(false); -} diff --git a/vignettes/mapsf.Rmd b/vignettes/mapsf.Rmd index 57386e70..72225fba 100644 --- a/vignettes/mapsf.Rmd +++ b/vignettes/mapsf.Rmd @@ -240,7 +240,7 @@ mf_layout( `mf_label()` displays labels on the map. -```{r mf_map_t} +```{r mf_map_t, eval=FALSE} library(mapsf) # import the sample data set mtq <- mf_get_mtq() @@ -363,7 +363,7 @@ mf_layout( In this example we have built a custom theme with `mf_theme()`. -```{r mf_label} +```{r mf_label, eval=FALSE} library(mapsf) # import the sample data set mtq <- mf_get_mtq()