Enable geom_sf to automatically determine the legend type #3646

microly · 2019-11-29T12:13:37Z

fix #3572 and relate to #3636.

This pr works in LayerSf$setup_layer().

The determination rule is:

1.Get the all the geometry types of every rows of sf data.
2.If all the rows have the same geometry type, this unique type will be recognised as the geometry type of sf data.
- 2.1 if the geometry type of sf data %in% c("POINT", "MULTIPOINT"), the legend type of geom_sf will be set to point, which indicates that the layer is composed of point(s) only.
- 2.2 if the geometry type of sf data %in% c("LINESTRING", "MULTILINESTRING",
  "CIRCULARSTRING", "COMPOUNDCURVE", "CURVE", "MULTICURVE"), the legend type of geom_sf will be set to line, which indicates that the layer is composed of line(s) only.
- 2.3 if the geometry type of sf data is any other type, the legend type of geom_sf will be set to polygon. These geometry types can be divided into two groups: the types in the first group are composed of polygon(s), such as "POLYGON" and "MULTIPOLYGON"; the types in the other group is mixtures of more than one type of point, line and polygon, such as "GEOMETRYCOLLECTION".
3.If the rows of sf data have different geometry types, the geometry type of sf data will be set to "blend" and the legend type of geom_sf will be set to polygon.

In short, point is point, line is line, polygon is polygon, any mixture of more than one type is also polygon. (please forgive my poor english~)

Moreover, after this pr, users still have full control of the lengend type by setting show.legend to "point", "line" or "polygon"; and users also can turn off the legend by setting show.legend to FALSE.

Clean up theme addition (tidyverse#3570)

update to tidyverse edition 20191118

update to tidyverse edition 20191129

microly · 2019-11-29T12:57:00Z

Some simple examples:

library(dplyr)
library(sf)
library(ggplot2)
library(cowplot)

# MULTIPOINT
p <- rbind(c(3.2,4), c(3,4.6), c(3.8,4.4), c(3.5,3.8), c(3.4,3.6), c(3.9,4.5))
mp <- st_multipoint(p) %>% st_sfc() %>% st_sf() %>% mutate(v = "a")

# MULTILINESTRING
s1 <- rbind(c(0,3),c(0,4),c(1,5),c(2,5))
s2 <- rbind(c(0.2,3), c(0.2,4), c(1,4.8), c(2,4.8))
s3 <- rbind(c(0,4.4), c(0.6,5))
mls <- st_multilinestring(list(s1,s2,s3)) %>% 
  st_sfc() %>% st_sf() %>% mutate(v = "b")

# MULTIPOLYGON
p1 <- rbind(c(0,0), c(1,0), c(3,2), c(2,4), c(1,4), c(0,0))
p2 <- rbind(c(1,1), c(1,2), c(2,2), c(1,1))
p3 <- rbind(c(3,0), c(4,0), c(4,1), c(3,1), c(3,0))
p4 <- rbind(c(3.3,0.3), c(3.8,0.3), c(3.8,0.8), c(3.3,0.8), c(3.3,0.3))[5:1,]
p5 <- rbind(c(3,3), c(4,2), c(4,3), c(3,3))
mpol <- st_multipolygon(list(list(p1,p2), list(p3,p4), list(p5))) %>% 
  st_sfc() %>% st_sf() %>% mutate(v = "c")

# "blend" sf
blend <- rbind(mp, mls, mpol)

p_mp <- ggplot(mp, aes(colour = v)) + geom_sf(size = 10)
p_mls <- ggplot(mls, aes(colour = v)) + geom_sf(size = 2)
p_mpol <- ggplot(mpol, aes(colour = v)) + geom_sf(size = 2)

plot_grid(p_mp, p_mls, p_mpol, nrow = 1)

1.before this pr:

2.after this pr:

# multiple layers
ggplot() + 
  geom_sf(aes(colour = v), data = mpol, size = 2) +
  geom_sf(aes(colour = v), data = mls, size = 2) +
  geom_sf(aes(colour = v), data = mp, size = 2)

# "blend" layer
ggplot(blend, aes(colour = "red")) + geom_sf()

microly · 2019-11-29T13:11:52Z

The legend of multiple layers seems weird：

This is because ggplot2 always draws all the layer-geoms in the keys of every breaks.
Althogth the keys of legend can be optimised by override.aes, but this is a verbose solution.
Maybe, this problem can be solved gracefully by adding a new argument (e.g. show.key) to guide_legend(). I am preparing another pr for this.

microly · 2019-11-29T13:24:11Z

Please consider this pr. @yutannihilation @clauswilke
If there is any problem, just tell me and I will improve it.
Thanks!

yutannihilation · 2019-11-29T15:31:12Z

Just a quick comment.

It's not always accurate to guess what the legend should be at the setup_layer() stage because the data might get geographically aggregated (c.f. https://ggplot2.tidyverse.org/reference/stat_sf_coordinates.html). That said, it's probably correct in most cases, so, considering there's no mechanism to let legends know the type of data dynamically (I might be wrong), this might be acceptable improvement. I don't know. I'll wait for others' comments.

For per-layer legend feature, I'd recommend you to create it as an extension package, not as a PR; I'm afraid your PR would be unlikely to be accepted. I believe it's not impossible, but, IMHO, it would be only after we implement per-layer scales, which doesn't seem to happen in any near future. I don't want you to waste your time.

microly · 2019-11-30T00:38:00Z

Thanks for your reply~
At first, I respect all your 53 commits for ggplot2, especially stat_sf_coordinates(), geom_sf_label(), geom_sf_text().

You raised two problems, but I think I can properly response to them.
Please wait for my reply.
I need some time to write a reply in english, because of my poor english...:(

microly · 2019-11-30T09:59:13Z

Reply for the first problem.

Essentially, your problem is that my pr is not automatical enough when layer_sf$stat is replaced by another Stat* which will change the geometry type of sf data.
Yes! You are right!
The layer_sf$setup_layer() is before the process of layer_sf$stat in ggplot_build.ggplot(), so it seems that setup_layer() can not forcast the geometry type of sf data after the stat process.
But this dose not prove that my pr is not automatical enough!

Two reasons:

layer_sf$setup_layer() can know the geometry type after the stat process. But it is inefficient.
In short, layer_sf$setup_layer() can access everything in the layer including layer_sf$stat (e.g. stat <- self$stat). So it can know the geometry type after the stat pocess. But I will not do it in my pr, because it means running the stat process twice and it is too inefficient.
Moreover, it is usually meanless to know the geometry type after the stat process.
A very clear example is stat_sf_coordinates, which you mentioned.
The legend type of stat_sf_coordinates is determined by its geom parameter, and has nothing to do with the sf geometry type.
An example:

library(sf)
library(ggplot2)
library(cowplot)

nc <- sf::st_read(system.file("shape/nc.shp", package="sf"))

p1 <- ggplot(nc) + 
    stat_sf_coordinates(geom = "point")

p2 <- ggplot(nc) +
    stat_sf_coordinates(geom = "segment", aes(geometry = geometry,
                                              x = stat(x),
                                              y = stat(y),
                                              xend = stat(x) + 0.1, 
                                              yend = stat(y) + 0.1))

p3 <- ggplot(nc) +
    stat_sf_coordinates(geom = "rect", color = "red", fill = NA, 
                        aes(geometry = geometry,
                            xmin = stat(x),
                            ymin = stat(y),
                            xmax = stat(x) + 0.1, 
                            ymax = stat(y) + 0.1))

plot_grid(p1, p2, p3, nrow = 1)

For the above two reasons, I think my pr would be an efficient and harmless approach.

At last, @clauswilke created a way to automatically determine the name of the geometry column:

ggplot2/R/layer-sf.R

Lines 29 to 37 in 6424808

    
           # automatically determine the name of the geometry column 
        
           # and add the mapping if it doesn't exist 
        
           if ((isTRUE(self$inherit.aes) && is.null(self$mapping$geometry) && is.null(plot$mapping$geometry)) || 
        
               (!isTRUE(self$inherit.aes) && is.null(self$mapping$geometry))) { 
        
             if (is_sf(data)) { 
        
               geometry_col <- attr(data, "sf_column") 
        
               self$mapping$geometry <- as.name(geometry_col) 
        
             } 
        
           }

It also dose not know the dynamical sf geometry type.
I can construct a new stat, which can be named StatChange_sfc_column_name. In this stat, I will change the name of sfc column. Then, you will find that the approach of @clauswilke is not automatical enough either.

If @clauswilke add support to the dynamical name of sfc column, I will improve my pr in the same way.

microly · 2019-11-30T10:06:27Z

The plot of stat_sf_coordinates example was not uploaded successfully, so I upload it again:

You can see that the legend type is associated with the geom, not the sf geometry type. So, this is beyond the scope of my pr.

microly · 2019-11-30T10:15:35Z

Reply for the second problem.

The main point of the second problem is the lack of a geometry scale.
My solution is simple: I can supply one in a new pr.

By now, the code is completed, it can work!
But because of my poor english again, I need more time to finish the documentation and the pr description.
Please consider it then.

clauswilke · 2019-11-30T17:30:40Z

I think it's fine to guess the correct legend type in setup_layer(), but there are a number of issues with this PR that need to be addressed:

The CI builds are failing.
We don't use %>% in internal ggplot2 code.
The current code allows users to choose the legend type via the show.legend argument (though this is not well documented). It looks to me like this PR overrides this feature.
What is the point of adding a new type "blend"? I don't see it used anywhere. Current geometry types we use are "point", "line", "collection", and "other".

clauswilke · 2019-11-30T20:39:02Z

Per-layer legend glyphs is a separate issue that should be addressed for all of ggplot2, not just for geom_sf(). I have filed an issue: #3648

microly · 2019-12-01T00:14:55Z

@clauswilke
Thanks for your kind reply!
I think I can improve my pr for your 4 issues.
I need some time to reply these issues in English.

yutannihilation · 2019-12-01T01:29:45Z

I think it's fine to guess the correct legend type in setup_layer()

OK, then let's move this forward. I'll add a few more comments.

yutannihilation · 2019-12-01T01:34:05Z

R/layer-sf.R

+        if (sf_geometry_type(data) %in% c("POINT", "MULTIPOINT"))
+          self$geom_params$legend <- "point"
+        else if (sf_geometry_type(data) %in% c("LINESTRING", "MULTILINESTRING",
+                                               "CIRCULARSTRING", "COMPOUNDCURVE",
+                                               "CURVE", "MULTICURVE"))
+          self$geom_params$legend <- "line"


Probably you can use sf_types instead of a raw list of sf types.

ggplot2/R/geom-sf.R

Lines 300 to 306 in 6424808

sf_types <- c(GEOMETRY = "other", POINT = "point", LINESTRING = "line",

POLYGON = "other", MULTIPOINT = "point", MULTILINESTRING = "line",

MULTIPOLYGON = "other", GEOMETRYCOLLECTION = "collection",

CIRCULARSTRING = "line", COMPOUNDCURVE = "other", CURVEPOLYGON = "other",

MULTICURVE = "other", MULTISURFACE = "other", CURVE = "other",

SURFACE = "other", POLYHEDRALSURFACE = "other", TIN = "other",

TRIANGLE = "other")

yutannihilation · 2019-12-01T01:43:45Z

R/layer-sf.R

@@ -35,6 +35,18 @@ LayerSf <- ggproto("LayerSf", Layer,
        self$mapping$geometry <- as.name(geometry_col)
      }
    }
+
+    # automatically determine the legend type
+    if (is.na(self$show.legend) || self$show.legend == TRUE) {


We should not assume show.legend is a object of length 1. The conditions here should be wrapped all(), any() or isTRUE().

Yes. Writing code of the form if (x == TRUE) {...} is almost always bad in R, because x can be unexpectedly of length > 1 (even if nonsensical). Please get into the habit of writing if (isTRUE(x)) {...}.

Got it~ Thanks for your kind instruction!

microly · 2019-12-01T06:32:32Z

@yutannihilation
I am glad to see your comments, thanks!
More comments are welcome~

Reply for the first one:

The main difference between sf_types and my determine rule is that my line group has three more geometry types: "COMPOUNDCURVE", "CURVE" and "MULTICURVE".
I think the legend type of these geometry types should be "line", because they are line(s) although they are not straight line(s).

Reply for the second one:

I am afraid that the length of show.legend has to be 1.
This can be easily confirmed by some simple examples:

library(dplyr)
library(sf)
library(ggplot2)

nc <- sf::st_read(system.file("shape/nc.shp", package="sf")) %>% 
    arrange(desc(AREA)) %>% slice(1:3)

ggplot(nc, aes(fill = NAME)) + geom_sf(show.legend = c("point","line"))

Warning messages:
1: In if (type == "point") { :
  the condition has length > 1 and only the first element will be used
2: In if (params$legend == "point") { :
  the condition has length > 1 and only the first element will be used
3: In if (type == "point") { :
  the condition has length > 1 and only the first element will be used
4: In if (params$legend == "point") { :
  the condition has length > 1 and only the first element will be used
5: In if (type == "point") { :
  the condition has length > 1 and only the first element will be used
6: In if (params$legend == "point") { :
  the condition has length > 1 and only the first element will be used

ggplot(nc, aes(fill = NAME)) + geom_sf(show.legend = c(TRUE, TRUE))

You can see that the legend dose not show, even if you tell ggplot2 twice that the show.legend is set to be TRUE.

yutannihilation · 2019-12-01T08:13:12Z

The main difference between sf_types and my determine rule is that my line group has three more geometry types: "COMPOUNDCURVE", "CURVE" and "MULTICURVE".

Oh, good catch. But, if so, it should be fixed on the sf_types's side to draw them properly, instead of introducing another rule. (For now, I don't think we can fix this. These types are not well-supported even on sf's plot() so we don't know what is the right thing to do...)

I am afraid that the length of show.legend has to be 1.

show.legend itself is designed to accept >1 length of logical. But, I'm not immediately sure how it's supported on geom_sf(). Please ignore my comment at the moment, sorry.

microly · 2019-12-01T08:28:45Z

@yutannihilation
Thanks for your reply!
I am preparing the reply for the 4 issues from @clauswilke .
I need to work hard to express my idea in English....

yutannihilation · 2019-12-01T08:55:25Z

@microly You don't need to reply just to notify us that you read the comment. No worries, I understand it takes you time to write in English and we don't mind if you are not super-responsive.

clauswilke · 2019-12-02T05:34:18Z

R/layer-sf.R

+      if (is_sf(data)) {
+        if (sf_geometry_type(data) %in% c("POINT", "MULTIPOINT"))
+          self$geom_params$legend <- "point"
+        else if (sf_geometry_type(data) %in% c("LINESTRING", "MULTILINESTRING",


You're calling sf_geometry_type() twice. Better to call it once, assign the result to a temp variable, and use that in the if statements.

I am sorry that I can not express all my thanks in English! I feel that I am a young pupil and you are my teacher who teaches me hand by hand. Thanks!

clauswilke · 2019-12-02T05:38:17Z

R/layer-sf.R

+# helper function to determine the geometry type of sf object
+sf_geometry_type <- function(sf) {
+  geometry_type <- unique(as.vector(sf::st_geometry_type(sf)))
+  if (length(geometry_type) != 1)  geometry_type <- "blend"


I still don't like "blend". It is introduced here without documentation and not used anywhere else. I'd be fine with "other", since that is used elsewhere in the code.

clauswilke · 2019-12-02T05:38:38Z

R/layer-sf.R

@@ -62,3 +74,9 @@ is_sf <- function(data) {
 #' @export
 scale_type.sfc <- function(x) "identity"

+# helper function to determine the geometry type of sf object
+sf_geometry_type <- function(sf) {
+  geometry_type <- unique(as.vector(sf::st_geometry_type(sf)))


Why as.vector()? Why not as.character()?

microly · 2019-12-02T16:58:29Z

@clauswilke
Four issues:
1.The CI builds are failing.
2.We don't use %>% in internal ggplot2 code.
3.The current code allows users to choose the legend type via the show.legend argument (though this is not well documented). It looks to me like this PR overrides this feature.
4.What is the point of adding a new type "blend"? I don't see it used anywhere. Current geometry types we use are "point", "line", "collection", and "other".

Issue 1, 2 and 4 have been solved.

Issue 3:
When show.legend is FALSE, the legend dose not show, this is OK.
When show.legend is a character, there is a bug. The source is here:

ggplot2/R/geom-sf.R

Line 200 in 6424808

show.legend = if (is.character(show.legend)) TRUE else show.legend,

Because of it, show.legend will never be a character in the stage of setup_layer().

I think that a new params of layer_sf (e.g. show.legend_origin), may be needed to solve this problem.

The code of this pr:

if (is.na(self$show.legend) || isTRUE(self$show.legend))

will be changed to something like:

if (is.na(self$show.legend_origin) || isTRUE(self$show.legend_origin))

I think that this solution can work, but it looks ugly.
Could you please give me some suggestions? Thanks!

clauswilke · 2019-12-02T17:35:23Z

I think the solution is simple: In line 200, just write show.legend = show.legend, and delete line 204:

ggplot2/R/geom-sf.R

Line 204 in 6424808

legend = if (is.character(show.legend)) show.legend else "polygon",

Then move all the logic to setup_layer().

You'll have to do the same for stat_sf():

ggplot2/R/stat-sf.R

Lines 31 to 35 in 6424808

    
           show.legend = if (is.character(show.legend)) TRUE else show.legend, 
        
           inherit.aes = inherit.aes, 
        
           params = list( 
        
             na.rm = na.rm, 
        
             legend = if (is.character(show.legend)) show.legend else "polygon",

But please make sure this works as expected for geom_sf_label() and geom_sf_text().

microly · 2019-12-03T15:54:40Z

test code:

library(ggplot2)

library(dplyr)
library(sf)
library(tibble)
library(purrr)
library(cowplot)

## data

# MULTIPOINT
p <- rbind(c(3.2,4), c(3,4.6), c(3.8,4.4), c(3.5,3.8), c(3.4,3.6), c(3.9,4.5))
mp <- st_multipoint(p) %>% st_sfc() %>% st_sf() %>% mutate(v = "a")

# MULTILINESTRING
s1 <- rbind(c(0,3),c(0,4),c(1,5),c(2,5))
s2 <- rbind(c(0.2,3), c(0.2,4), c(1,4.8), c(2,4.8))
s3 <- rbind(c(0,4.4), c(0.6,5))
mls <- st_multilinestring(list(s1,s2,s3)) %>% 
    st_sfc() %>% st_sf() %>% mutate(v = "b")

# MULTIPOLYGON
p1 <- rbind(c(0,0), c(1,0), c(3,2), c(2,4), c(1,4), c(0,0))
p2 <- rbind(c(1,1), c(1,2), c(2,2), c(1,1))
p3 <- rbind(c(3,0), c(4,0), c(4,1), c(3,1), c(3,0))
p4 <- rbind(c(3.3,0.3), c(3.8,0.3), c(3.8,0.8), c(3.3,0.8), c(3.3,0.3))[5:1,]
p5 <- rbind(c(3,3), c(4,2), c(4,3), c(3,3))
mpol <- st_multipolygon(list(list(p1,p2), list(p3,p4), list(p5))) %>% 
    st_sfc() %>% st_sf() %>% mutate(v = "c")


sf_list <- list(mp, mls, mpol) %>% rep(6)

show.lgs <- rep(list(NA, TRUE, FALSE, "point", "line", "polygon"), each = 3)

## test geom_sf

fun_geom_sf <- function(sf, show.legend) {
    ggplot() + geom_sf(aes(colour = v), 
                       data = sf, show.legend = show.legend)
}

gglist <- tibble(data = sf_list, legend = show.lgs) %>% 
    mutate(plot = map2(data, legend, fun_geom_sf)) %>% 
    pull(plot)
    
p <- plot_grid(plotlist = gglist, ncol = 3,
          align = "hv", axis = "trbl",
          labels = show.lgs, hjust = 0)   

save_plot(filename = "D:\\work\\Desktop\\geom_sf.png", 
          plot = p, base_height = 7)

## test geom_sf_label

fun_geom_sf_label <- function(sf, show.legend) {
    ggplot() + geom_sf_label(aes(label = v, colour = v), 
                       data = sf, show.legend = show.legend)
}

gglist <- tibble(data = sf_list, legend = show.lgs) %>% 
    mutate(plot = map2(data, legend, fun_geom_sf_label)) %>% 
    pull(plot)

p <- plot_grid(plotlist = gglist, ncol = 3,
          align = "hv", axis = "trbl",
          labels = show.lgs, hjust = 0)   

save_plot(filename = "D:\\work\\Desktop\\geom_sf_label.png", 
          plot = p, base_height = 9)

## test geom_sf_text

fun_geom_sf_text <- function(sf, show.legend) {
    ggplot() + geom_sf_text(aes(label = v, colour = v), 
                             data = sf, show.legend = show.legend)
}

gglist <- tibble(data = sf_list, legend = show.lgs) %>% 
    mutate(plot = map2(data, legend, fun_geom_sf_text)) %>% 
    pull(plot)

p <- plot_grid(plotlist = gglist, ncol = 3,
          align = "hv", axis = "trbl",
          labels = show.lgs, hjust = 0)   

save_plot(filename = "D:\\work\\Desktop\\geom_sf_text.png", 
          plot = p, base_height = 9)

## test stat_sf_coordinates

fun_stat_sf_coordinates <- function(sf, show.legend) {
    ggplot() + stat_sf_coordinates(aes(colour = v), 
                            data = sf, show.legend = show.legend)
}

gglist <- tibble(data = sf_list, legend = show.lgs) %>% 
    mutate(plot = map2(data, legend, fun_stat_sf_coordinates)) %>% 
    pull(plot)

p <- plot_grid(plotlist = gglist, ncol = 3,
          align = "hv", axis = "trbl",
          labels = show.lgs, hjust = 0)   

save_plot(filename = "D:\\work\\Desktop\\stat_sf_coordinates.png", 
          plot = p, base_height = 9)

## test complex sf

complex_sf <- rbind(mp, mls, mpol)

gglist <- map(list(NA, TRUE, FALSE, "point", "line", "polygon"), ~
              ggplot(complex_sf, aes(colour = v)) + geom_sf(show.legend = .))

p <- plot_grid(plotlist = gglist, ncol = 3,
          align = "hv", axis = "trbl",
          labels = list(NA, TRUE, FALSE, "point", "line", "polygon"), 
          hjust = 0)   

save_plot(filename = "D:\\work\\Desktop\\complex_sf.png", 
          plot = p, base_height = 7)

## test multiple sf_layers

gglist <- map(list(NA, TRUE, FALSE, "point", "line", "polygon"), ~
                  ggplot(mapping = aes(colour = v)) + 
                    geom_sf(data = mpol, show.legend = .) +
                    geom_sf(data = mls, show.legend = .) +
                    geom_sf(data = mp, show.legend = .))

p <- plot_grid(plotlist = gglist, ncol = 3,
          align = "hv", axis = "trbl",
          labels = list(NA, TRUE, FALSE, "point", "line", "polygon"), 
          hjust = 0)   

save_plot(filename = "D:\\work\\Desktop\\multiple_layers.png", 
          plot = p, base_height = 7)

## test non-layer_sf

p1 <- ggplot(mpol) +
    geom_errorbarh(
        aes(geometry = geometry,
            xmin = stat(x) - 0.1,
            xmax = stat(x) + 0.1,
            y = stat(y),
            colour = v),
        stat = "sf_coordinates",
        show.legend = NA)

p2 <- ggplot(mpol) +
    geom_errorbarh(
        aes(geometry = geometry,
            xmin = stat(x) - 0.1,
            xmax = stat(x) + 0.1,
            y = stat(y),
            colour = v),
        stat = "sf_coordinates",
        show.legend = TRUE)

p3 <- ggplot(mpol) +
    geom_errorbarh(
        aes(geometry = geometry,
            xmin = stat(x) - 0.1,
            xmax = stat(x) + 0.1,
            y = stat(y),
            colour = v),
        stat = "sf_coordinates",
        show.legend = FALSE)

p4 <- ggplot(mpol) +
    geom_errorbarh(
        aes(geometry = geometry,
            xmin = stat(x) - 0.1,
            xmax = stat(x) + 0.1,
            y = stat(y),
            colour = v),
        stat = "sf_coordinates",
        show.legend = "point")

# The warning should be raised here:
# raise a warning: show.legend` must be a logical vector.

p <- plot_grid(p1, p2, p3, p4, ncol = 2,
               align = "hv", axis = "trbl",
               labels = list(NA, TRUE, FALSE, "point"), 
               hjust = 0)  

save_plot(filename = "D:\\work\\Desktop\\non-layer_sf.png", 
          plot = p)

microly · 2019-12-03T15:59:07Z

@yutannihilation
Please confirm the results of stat_sf_coordinates(), geom_sf_label() and geom_sf_text() are right.
I am not sure about them.

clauswilke · 2019-12-03T16:57:52Z

R/layer-sf.R

+sf_geometry_type <- function(sf) {
+  geometry_type <- unique(as.character(sf::st_geometry_type(sf)))
+  if (length(geometry_type) != 1)  geometry_type <- "GEOMETRY"
+  geometry_type


I think this function should return sf_types[geometry_type] here, to simplify the code further up. I would also propose renaming it, since sf_geometry_type() sounds so similar to sf::st_geometry_type() but does somewhat different things. I recommend the name detect_geometry_type().

clauswilke · 2019-12-03T17:09:12Z

The test results look good to me. A subset of these should be added to the unit test suite. I would propose code similar to the below (but again, without %>%).

library(tidyverse)
library(sf)
#> Linking to GEOS 3.7.2, GDAL 2.4.2, PROJ 5.2.0
library(testthat)
#> 
#> Attaching package: 'testthat'
#> The following object is masked from 'package:dplyr':
#> 
#>     matches
#> The following object is masked from 'package:purrr':
#> 
#>     is_null
#> The following object is masked from 'package:tidyr':
#> 
#>     matches

p <- rbind(c(3.2,4), c(3,4.6), c(3.8,4.4), c(3.5,3.8), c(3.4,3.6), c(3.9,4.5))
mp <- st_multipoint(p) %>% st_sfc() %>% st_sf() %>% mutate(v = "a")

fun_geom_sf <- function(sf, show.legend) {
  p <- ggplot() + 
    geom_sf(
      aes(colour = v), 
      data = sf, show.legend = show.legend
    )
  ggplot_build(p)
}

b <- fun_geom_sf(mp, "point")

expect_identical(b$plot$layers[[1]]$geom_params$legend, "point")
expect_identical(b$plot$layers[[1]]$show.legend, TRUE)

^{Created on 2019-12-03 by the reprex package (v0.3.0)}

clauswilke · 2019-12-03T23:07:21Z

R/geom-sf.R

@@ -197,11 +197,12 @@ geom_sf <- function(mapping = aes(), data = NULL, stat = "sf",
      mapping = mapping,
      stat = stat,
      position = position,
-      show.legend = if (is.character(show.legend)) TRUE else show.legend,
+      #show.legend = if (is.character(show.legend)) TRUE else show.legend,


Please delete.

clauswilke · 2019-12-03T23:07:36Z

R/geom-sf.R

      inherit.aes = inherit.aes,
      params = list(
        na.rm = na.rm,
-        legend = if (is.character(show.legend)) show.legend else "polygon",
+        #legend = if (is.character(show.legend)) show.legend else "polygon",


Please delete.

clauswilke · 2019-12-03T23:09:24Z

R/stat-sf.R

@@ -28,11 +28,12 @@ stat_sf <- function(mapping = NULL, data = NULL, geom = "rect",
    mapping = mapping,
    geom = geom,
    position = position,
-    show.legend = if (is.character(show.legend)) TRUE else show.legend,
+    #show.legend = if (is.character(show.legend)) TRUE else show.legend,


Please delete.

clauswilke · 2019-12-03T23:09:38Z

R/stat-sf.R

    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
-      legend = if (is.character(show.legend)) show.legend else "polygon",
+      #legend = if (is.character(show.legend)) show.legend else "polygon",


Please delete.

clauswilke · 2019-12-03T23:50:24Z

R/layer.r

+    if (!inherits(layer_class, "LayerSf")) {
+      warning("`show.legend` must be a logical vector.", call. = FALSE)
+      show.legend <- FALSE
+    }


I'm not particularly excited by this special casing here. Can we just move the warning to the point in the code where the decision about drawing a legend is actually made?

Hm, looks like that will be even uglier. Maybe we can just eliminate this warning, since it's not entirely true? @yutannihilation Any opinion?

I don't have an opinion yet here, but I was thinking it was a design mistake to let show.legend to be used as the specification of the type of legend instead of creating a new parameter. Let me think a bit more...

Yes, agreed. However, I think we're stuck with it, see e.g. here. At the same time, I don't think it's big enough of an issue to worry much about it.

The source of this inconvenience is that the sf geom is special, it can be point, line, polygon...
We have two choice: adding a new parameter, or allowing a chaos in show.legend.

I think the warning 'warning("show.legend must be a logical vector.", call. = FALSE)' is still needed to keep the API safe and consistance.
After all, layer_sf is the only exception.

I have a simpler proposition, just needs a big of refactoring in the guide code. Will try to do a PR in the next few hours or tomorrow.

Sure. Honestly, I'm not familiar with the codes around legends/guide, so I'll wait for your PR.

@microly Sorry for confusing you with my random comments. Let's wait for a while...

I've submitted my PR (#3652). With it, we can just delete these lines and not think about them anymore here. :-)

@microly I think you can move this PR forward by addressing all the other comments (deleting unneeded code instead of commenting it out, adding unit tests) and leaving this issue as is for now.

I have merged my refactored code, so this code block can now be eliminated.

@microly Please merge the master branch into your PR and then delete this code block.

R/geom-sf.R

microly · 2019-12-04T22:41:45Z

sure:）

…

---Original--- From: "Claus Wilke"<notifications@github.com> Date: Thu, Dec 5, 2019 00:39 AM To: "tidyverse/ggplot2"<ggplot2@noreply.github.com>; Cc: "microly"<microly@126.com>;"Mention"<mention@noreply.github.com>; Subject: Re: [tidyverse/ggplot2] Enable geom_sf to automatically determine the legend type (#3646) @clauswilke commented on this pull request. In R/layer.r: > @@ -81,8 +81,12 @@ layer <- function(geom = NULL, stat = NULL, params$show_guide <- NULL } if (!is.logical(show.legend)) { - warning("`show.legend` must be a logical vector.", call. = FALSE) - show.legend <- FALSE + # a charater vector have to be allowed for LayerSf$show.legend + # in order to set its legend type. + if (!inherits(layer_class, "LayerSf")) { + warning("`show.legend` must be a logical vector.", call. = FALSE) + show.legend <- FALSE + } @microly I think you can move this PR forward by addressing all the other comments (deleting unneeded code instead of commenting it out, adding unit tests) and leaving this issue as is for now. — You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub, or unsubscribe.

microly · 2019-12-05T14:47:28Z

I have updated this PR.
But I do not know why it cannot pass the codecov/patch check and have no idea about how to handle this problem...
@clauswilke

clauswilke · 2019-12-05T15:49:24Z

Don't worry about the codecov check. The tests look good, but could you also add one test to verify that the automatic choice can be overridden manually? For example, test that you can set the legend type to "point" when the automatic choice would be "line".

…ually.

microly · 2019-12-05T23:28:26Z

hi, @clauswilke , I add more tests to confirm that automatic choices of legend type can be overridden manually. Please check it, thanks~

clauswilke · 2019-12-06T01:03:48Z

The tests look good to me. Please also add a brief (1-2 sentences) news item to NEWS.md, as described here: https://style.tidyverse.org/news.html#acknowledgement

update to tidyverse edition 20191206

microly · 2019-12-06T04:17:24Z

There is still something wrong about codecov check :(

…/microly/ggplot2 into layer-sf_patch1_auto-legend-type

clauswilke

Looks good to me.

@yutannihilation Anything else from your side?

yutannihilation · 2019-12-06T06:48:18Z

R/layer-sf.R

+        if (sf_type == "point")
+          self$geom_params$legend <- "point"
+        else if (sf_type == "line")
+          self$geom_params$legend <- "line"
+        else self$geom_params$legend <- "polygon"


Minor comment. According to the tidyverse style guide,

It’s ok to drop the curly braces for very simple statements that fit on one line, as long as they don’t have side-effects.

so you need {} here since they are multiple lines.

yutannihilation · 2019-12-06T06:54:41Z

R/layer-sf.R

+        else self$geom_params$legend <- "polygon"
+      }
+    } else if (is.character(self$show.legend)) {
+      self$geom_params$legend = self$show.legend


Suggested change

self$geom_params$legend = self$show.legend

self$geom_params$legend <- self$show.legend

yutannihilation · 2019-12-06T06:55:12Z

R/layer-sf.R

+      }
+    } else if (is.character(self$show.legend)) {
+      self$geom_params$legend = self$show.legend
+      self$show.legend = TRUE


Suggested change

self$show.legend = TRUE

self$show.legend <- TRUE

yutannihilation · 2019-12-06T08:24:10Z

R/layer-sf.R

+        else if (sf_type == "line") {
+          self$geom_params$legend <- "line"
+        }
+        else self$geom_params$legend <- "polygon"


Probably, should be this?

if (sf_type == "point") { self$geom_params$legend <- "point" } else if (sf_type == "line") { self$geom_params$legend <- "line" } else { self$geom_params$legend <- "polygon" }

yutannihilation

Looks good!

microly · 2019-12-06T23:51:54Z

Thanks for merging!
Thanks both of you during the preparing of this PR, thanks!
@clauswilke @yutannihilation

microly added 4 commits October 24, 2019 23:00

Merge pull request #2 from tidyverse/master

2fd47b8

Clean up theme addition (tidyverse#3570)

Merge pull request #3 from tidyverse/master

40bdc73

update to tidyverse edition 20191118

Merge pull request #4 from tidyverse/master

346a8f0

update to tidyverse edition 20191129

automatically determine the legend type

f8a85ef

yutannihilation reviewed Dec 1, 2019

View reviewed changes

yutannihilation mentioned this pull request Dec 1, 2019

Implement smart merging of guides so inappropriate key glyphs are omitted #3648

Closed

microly added 3 commits December 1, 2019 23:02

drop "%>%"

68a3599

add "sf::"

5927cc9

use "isTRUE()"

c6f6565

clauswilke requested changes Dec 2, 2019

View reviewed changes

microly requested a review from clauswilke December 2, 2019 14:58

kind instructions from @clauswilke

95e29fa

clauswilke reviewed Dec 3, 2019

View reviewed changes

clauswilke requested changes Dec 3, 2019

View reviewed changes

clauswilke reviewed Dec 3, 2019

View reviewed changes

microly commented Dec 4, 2019

View reviewed changes

R/geom-sf.R Show resolved Hide resolved

microly added 2 commits December 5, 2019 21:37

I think this is the final edition -_-!

e1d3de5

add test

60ed8db

add more tests to confirm that automatic choice can be overridden man…

34dee47

…ually.

microly added 2 commits December 6, 2019 10:45

handle layer.r

4313b5e

Merge pull request #5 from tidyverse/master

a8e1e3a

update to tidyverse edition 20191206

microly added 2 commits December 6, 2019 13:12

handle NEWS.md

78e5fde

Merge branch 'layer-sf_patch1_auto-legend-type' of https://github.com…

6dfb21f

…/microly/ggplot2 into layer-sf_patch1_auto-legend-type

clauswilke approved these changes Dec 6, 2019

View reviewed changes

yutannihilation reviewed Dec 6, 2019

View reviewed changes

kind suggestions from @yutannihilation, thanks! You are good!

c8e633a

yutannihilation reviewed Dec 6, 2019

View reviewed changes

I am so sorry...

841c3fb

yutannihilation approved these changes Dec 6, 2019

View reviewed changes

clauswilke merged commit 48660e1 into tidyverse:master Dec 6, 2019

yutannihilation mentioned this pull request Apr 11, 2020

Don't modify legend key settings in geom_sf() during plot build. #3942

Merged

	sf_types <- c(GEOMETRY = "other", POINT = "point", LINESTRING = "line",
	POLYGON = "other", MULTIPOINT = "point", MULTILINESTRING = "line",
	MULTIPOLYGON = "other", GEOMETRYCOLLECTION = "collection",
	CIRCULARSTRING = "line", COMPOUNDCURVE = "other", CURVEPOLYGON = "other",
	MULTICURVE = "other", MULTISURFACE = "other", CURVE = "other",
	SURFACE = "other", POLYHEDRALSURFACE = "other", TIN = "other",
	TRIANGLE = "other")

	self$geom_params$legend = self$show.legend
	self$geom_params$legend <- self$show.legend

Enable geom_sf to automatically determine the legend type #3646

Enable geom_sf to automatically determine the legend type #3646

Conversation

microly commented Nov 29, 2019

microly commented Nov 29, 2019

microly commented Nov 29, 2019

microly commented Nov 29, 2019

yutannihilation commented Nov 29, 2019 • edited Loading

microly commented Nov 30, 2019

microly commented Nov 30, 2019

microly commented Nov 30, 2019 • edited Loading

microly commented Nov 30, 2019 • edited Loading

clauswilke commented Nov 30, 2019

clauswilke commented Nov 30, 2019

microly commented Dec 1, 2019

yutannihilation commented Dec 1, 2019

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

microly commented Dec 1, 2019

yutannihilation commented Dec 1, 2019

microly commented Dec 1, 2019

yutannihilation commented Dec 1, 2019 • edited Loading

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

microly commented Dec 2, 2019

clauswilke commented Dec 2, 2019

microly commented Dec 3, 2019

microly commented Dec 3, 2019

Choose a reason for hiding this comment

clauswilke commented Dec 3, 2019

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

microly commented Dec 4, 2019 via email

microly commented Dec 5, 2019

clauswilke commented Dec 5, 2019

microly commented Dec 5, 2019

clauswilke commented Dec 6, 2019

microly commented Dec 6, 2019

clauswilke left a comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

Choose a reason for hiding this comment

yutannihilation left a comment

Choose a reason for hiding this comment

microly commented Dec 6, 2019

yutannihilation commented Nov 29, 2019 •

edited

Loading

microly commented Nov 30, 2019 •

edited

Loading

microly commented Nov 30, 2019 •

edited

Loading

yutannihilation commented Dec 1, 2019 •

edited

Loading