Gibt es in R eine Möglichkeit, eine Legende mit zwei Achsen zu zeichnen?

Ich möchte eine Legende mit zwei Achsen zeichnen. Insbesondere habe ich zwei klassifizierte räumliche Objekte kombiniert, wobei das erste die Intensität eines Ereignisses und das zweite die Wahrscheinlichkeit des Ereignisses an diesem Ort zeigt. Ich möchte eine Legende erstellen, die zeigt, wo die Pixel des kombinierten Rasters in jede Kategorie fallen. Die Legende, die ich erstellen möchte, sieht ungefähr so ​​aus: Legende mit zwei Achsen .

Die normale Legende der klassifizierten Daten sieht folgendermaßen aus: Originallegende

Hier ist ein reproduzierbares Beispiel für die Art der Daten, die ich verwende:

library(raster)
library(rasterVis)

# setseed
set.seed(999)

# create raster (example of what would be the outcome of combining intensity and probability rasters)
plot.me<- raster(xmn=-110, xmx=-90, ymn=40, ymx=60, ncols=40, nrows=40)
val <- c(100:104, 200:204, 300:304, 400:404)
plot.me<- setValues(plot.me, sample(val,ncell(plot.me),replace=T))


######  Plotting

plot.me <- ratify(plot.me)
levelplot(plot.me,att="ID" ,
          col.regions=c("#beffff","#73dfff","#d0ff73","#55ff00",
                        "#73b2ff","#0070ff","#70a800","#267300",
                        "#f5f57a","#ffff00","#e8beff","#df73ff",
                        "#f5ca7a","#ffaa00","#e600a9","#a80084"))

Zeichnen Sie die Ausgabe von oben

Der einfachste Weg wäre, den Plot zu erstellen und die Legende später in einem Grafikeditor hinzuzufügen ... aber ich bin sicher, dass es einen Weg geben muss, dies in R selbst zu tun! Ich plane derzeit mit dem rasterVis-Paket, aber wenn es Antworten in ggplot oder base R gibt, sind diese gleichermaßen willkommen.

Wenn es sinnvoller wäre, ein reproduzierbares Beispiel für die Zwischenschritte (dh mit den Intensitäts- / Wahrscheinlichkeitsrastern) zu haben, lassen Sie es mich wissen und ich kann diese erstellen.

Eine Lösung besteht darin, zwei Diagramme zu erstellen und diese beispielsweise mithilfe der grid.arrangeFunktion aus dem gridExtraPaket zu kombinieren

Zuerst konvertiere ich Ihren rasterLayer mithilfe der in diesem Beitrag veröffentlichten Funktion in einen Tibble: Überlagern Sie den Raster-Layer auf der Karte in ggplot2 in R?

(PS: Ich habe Ihr valObjekt so geändert, dass nur 16 verschiedene Farben zu dem von Ihnen angegebenen Farbmuster passen. In Ihrem Beispiel valhat es 20 verschiedene Werte.)

val <- c(101:104, 201:204, 301:304, 401:404) # correction from OP's question to match 16 different values

library(raster)
gplot_data <- function(x, maxpixels = 50000)  {
  x <- raster::sampleRegular(x, maxpixels, asRaster = TRUE)
  coords <- raster::xyFromCell(x, seq_len(raster::ncell(x)))
  ## Extract values
  dat <- utils::stack(as.data.frame(raster::getValues(x))) 
  names(dat) <- c('value', 'variable')

  dat <- dplyr::as.tbl(data.frame(coords, dat))

  if (!is.null(levels(x))) {
    dat <- dplyr::left_join(dat, levels(x)[[1]], 
                            by = c("value" = "ID"))
  }
  dat
}

df <- gplot_data(plot.me)

Dann erstelle ich das Faustdiagramm, die Heatmap mit geom_tile:

library(ggplot2)
plot <- ggplot(df, aes(x = x, y = y, fill = as.factor(value)))+
  geom_tile(show.legend = FALSE)+
  coord_fixed(ratio = 20/20)+
  scale_fill_manual(values = c("#beffff","#73dfff","#d0ff73","#55ff00",
                               "#73b2ff","#0070ff","#70a800","#267300",
                               "#f5f57a","#ffff00","#e8beff","#df73ff",
                               "#f5ca7a","#ffaa00","#e600a9","#a80084"))+
  scale_y_continuous(name = "Latitude",labels = paste(c(40,45,50,55,60),"°N"))+
  scale_x_continuous(name = "Longitude",labels = paste(c(-110,-105,-100,-95,-90),"°W"))+
  theme_linedraw()+
  theme(panel.border = element_rect(size = 2),
        axis.text = element_text(size = 10),
        axis.title = element_text(size = 10),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())

Dann erstelle ich einen separaten Datenrahmen für die Legende:

library(tidyverse)
df_legend <- data.frame(value = unique(df$value))
df_legend <- df_legend %>% rowwise() %>% 
  mutate(Dim1 = unlist(strsplit(as.character(value),""))[1],
         Dim3 = unlist(strsplit(as.character(value),""))[3])

Source: local data frame [16 x 3]
Groups: <by row>

# A tibble: 16 x 3
   value Dim1  Dim3 
   <int> <chr> <chr>
 1   404 4     4    
 2   204 2     4    
 3   304 3     4    
 4   104 1     4    
 5   202 2     2    
 6   302 3     2    
 7   203 2     3    
 8   301 3     1    
 9   402 4     2    
10   401 4     1    
11   303 3     3    
12   102 1     2    
13   201 2     1    
14   103 1     3    
15   403 4     3    
16   101 1     1    

Jetzt habe ich die Handlung für die Legende gemacht:

legend <- ggplot(df_legend, aes(x = as.factor(Dim1), y = as.factor(Dim3), fill = as.factor(value)))+
  geom_tile(show.legend = FALSE, color = "black")+
  coord_fixed(ratio = 1)+
  scale_fill_manual(values = c("#beffff","#73dfff","#d0ff73","#55ff00",
                               "#73b2ff","#0070ff","#70a800","#267300",
                               "#f5f57a","#ffff00","#e8beff","#df73ff",
                               "#f5ca7a","#ffaa00","#e600a9","#a80084"))+
  theme_linedraw()+
  labs(x = "Dim1", y = "Dim3")+
  theme(panel.border = element_rect(size = 2),
        axis.text = element_text(size = 10),
        axis.title = element_text(size = 10))

Und schließlich kombiniere ich sie:

library(gridExtra)
grid.arrange(plot, legend, layout_matrix = rbind(c(1,1,2),c(1,1,3)))

Sieht es so aus, wie Sie es bekommen wollen?

NB: Sie können Ihr Rasterobjekt wahrscheinlich direkt zeichnen, ggplot2aber ich war mir nicht sicher, wie genau es ablaufen soll. Sie können auch mit dem Layout von spielen grid.arrange, damit die Handlung genau so aussieht, wie Sie es möchten