一个具有多个数据集的ggplot

Question

我试图在地图上放置点，所以我正在使用ggmap。对于这些要点，我有两个单独的数据集，下面是示例。

dta1 = data.frame(storename = c(letters[1:5]),
                      storesize = c("small","small","medium","large","large"),
                      lon = c(10,11.2,15,19,22),
                      lat = c(5,5.8,5.6,6.1,3.4))
    dta2 = data.frame(population = sample(100,100,replace = T),
                      lon = runif(100,10,22),
                      lat = runif(100,3.5,6))

这是该图的示例代码。在我的实际数据集中，我有ggmap(map)而不是ggplot()。为什么下面的代码不起作用？

ggplot() + geom_point(data=dta1,
                      aes(x=lon, y=lat,size = storesize), shape = 23,fill="blue") + 
  scale_size_manual(values = c(1,2,3)) +
  geom_point(data=dta2,
             aes(x=lon, y=lat,size = population), shape = 21,fill="orange")

如果我像这样单独运行它们，则可以使用

ggplot() + geom_point(data=dta1,
                      aes(x=lon, y=lat,size = storesize), shape = 23,fill="blue") + 
  scale_size_manual(values = c(1,2,3))

ggplot() +  geom_point(data=dta2,
             aes(x=lon, y=lat,size = population), shape = 21,fill="orange")

我希望有一个带有两个单独图例的地块，每个单独的地块都显示。

此外，如果我需要用一个不同的形状指向另一个特定的地方（比如shape = 11，该怎么办？

Answer 1

解决方案描述为here。添加这些功能：

new_scale <- function(new_aes) {
  structure(ggplot2::standardise_aes_names(new_aes), class = "new_aes")
} 

ggplot_add.new_aes <- function(object, plot, object_name) {
  plot$layers <- lapply(plot$layers, bump_aes, new_aes = object)
  plot$scales$scales <- lapply(plot$scales$scales, bump_aes, new_aes = object)
  plot$labels <- bump_aes(plot$labels, new_aes = object)
  plot
}

bump_aes <- function(layer, new_aes) {
  UseMethod("bump_aes")
}

bump_aes.Scale <- function(layer, new_aes) {
  old_aes <- layer$aesthetics[remove_new(layer$aesthetics) %in% new_aes]
  new_aes <- paste0(old_aes, "_new")

  layer$aesthetics[layer$aesthetics %in% old_aes] <- new_aes

  if (is.character(layer$guide)) {
    layer$guide <- match.fun(paste("guide_", layer$guide, sep = ""))()
  }
  layer$guide$available_aes[layer$guide$available_aes %in% old_aes] <- new_aes
  layer
}

bump_aes.Layer <- function(layer, new_aes) {
  original_aes <- new_aes

  old_aes <- names(layer$mapping)[remove_new(names(layer$mapping)) %in% new_aes]
  new_aes <- paste0(old_aes, "_new")

  old_geom <- layer$geom

  old_setup <- old_geom$handle_na
  new_setup <- function(self, data, params) {
    colnames(data)[colnames(data) %in% new_aes] <- original_aes
    old_setup(data, params)
  }

  new_geom <- ggplot2::ggproto(paste0("New", class(old_geom)[1]), old_geom,
                               handle_na = new_setup)

  new_geom$default_aes <- change_name(new_geom$default_aes, old_aes, new_aes)
  new_geom$non_missing_aes <- change_name(new_geom$non_missing_aes, old_aes, new_aes)
  new_geom$required_aes <- change_name(new_geom$required_aes, old_aes, new_aes)
  new_geom$optional_aes <- change_name(new_geom$optional_aes, old_aes, new_aes)

  layer$geom <- new_geom

  old_stat <- layer$stat

  old_setup2 <- old_stat$handle_na
  new_setup <- function(self, data, params) {
    colnames(data)[colnames(data) %in% new_aes] <- original_aes
    old_setup2(data, params)
  }

  new_stat <- ggplot2::ggproto(paste0("New", class(old_stat)[1]), old_stat,
                               handle_na = new_setup)

  new_stat$default_aes <- change_name(new_stat$default_aes, old_aes, new_aes)
  new_stat$non_missing_aes <- change_name(new_stat$non_missing_aes, old_aes, new_aes)
  new_stat$required_aes <- change_name(new_stat$required_aes, old_aes, new_aes)
  new_stat$optional_aes <- change_name(new_stat$optional_aes, old_aes, new_aes)

  layer$stat <- new_stat

  layer$mapping <- change_name(layer$mapping, old_aes, new_aes)
  layer
}

bump_aes.list <- function(layer, new_aes) {
  old_aes <-  names(layer)[remove_new(names(layer)) %in% new_aes]
  new_aes <- paste0(old_aes, "_new")

  names(layer)[names(layer) %in% old_aes] <- new_aes
  layer
}

change_name <- function(list, old, new) {
  UseMethod("change_name")
}

change_name.character <- function(list, old, new) {
  list[list %in% old] <- new
  list
}

change_name.default <- function(list, old, new) {
  nam <- names(list)
  nam[nam %in% old] <- new
  names(list) <- nam
  list
}

change_name.NULL <- function(list, old, new) {
  NULL
}

remove_new <- function(aes) {
  stringi::stri_replace_all(aes, "", regex = "(_new)*")
}

然后运行代码：

ggplot() + 
geom_point(data=dta1,  aes(x=lon, y=lat,size=storesize), shape=23, fill="blue") + 
scale_size_manual(values = c(1,2,3)) +
new_scale("size") +
geom_point(data=dta2, aes(x=lon, y=lat, size=population), shape=21, fill="orange")