ggplot2 Heatmap 2 Различные цветовые схемы - Матрица путаницы: Совпадения в другой цветовой схеме, чем неправильные классификации

Question

Я адаптировал график тепловой карты для матрицы путаницы из этого ответа .
Однако я бы хотел повернуть его. На диагонали (сверху слева внизу справа) указаны совпадения (правильные классификации). Моей целью было бы построить эту диагональ в желтой цветовой палитре. И не совпадает (так что все плитки, кроме тех, что по диагонали) в красной цветовой палитре.

В моей функции plot.cm я могу получить диагональ с помощью

  cm_d$diag <- cm_d$Prediction == cm_d$Reference # Get the Diagonal
  cm_d$ndiag <- cm_d$Prediction != cm_d$Reference # Not the Diagonal

, а при правильной эстетике geom_tile я могу получить только диагональ (в желтом желтом-i sh) цветовая схема

geom_tile( data = cm_d[!is.na(cm_d$diag), ],aes(color = Freq)) +
scale_fill_gradient(guide = FALSE,low=alpha("lightyellow",0.75), high="yellow",na.value = 'white') 

Однако я не могу получить вторую цветовую схему для элементов cm_d$ndiag Я нашел пакет ggnewscale , который предлагает new_scale(), а также new_scale_fill().
Я устал реализовывать его с помощью этого блога . Однако в результате получаются только тёмно-серые плитки для остальной части тепловой карты

# adapted from https://stackoverflow.com/a/60150826/7318488
library(ggplot2)     # to plot
library(gridExtra)   # to put more
library(grid)        # plot together
library(likert)      # for reversing the factor order
library(ggnewscale)

plot.cm <- function(cm){
  # extract the confusion matrix values as data.frame
  cm_d <- as.data.frame(cm$table)
  cm_d$diag <- cm_d$Prediction == cm_d$Reference # Get the Diagonal
  cm_d$ndiag <- cm_d$Prediction != cm_d$Reference # Not the Diagonal     
  cm_d[cm_d == 0] <- NA # Replace 0 with NA for white tiles
  cm_d$Reference <-  reverse.levels(cm_d$Reference) # diagonal starts at top left

  # plotting the matrix
  cm_d_p <-  ggplot(data = cm_d, aes(x = Prediction , y =  Reference, fill = Freq))+
    scale_x_discrete(position = "top") +
    geom_tile( data = cm_d[!is.na(cm_d$diag), ],aes(color = Freq)) +
    scale_fill_gradient(guide = FALSE,low=alpha("lightyellow",0.75), high="yellow",na.value = 'white') +
    # THIS DOESNT WORK
    # new_scale("fill") +
    # geom_tile( data = cm_d[!is.na(cm_d$ndiag), ],aes(color = Freq)) +
    # scale_fill_gradient(guide = FALSE,low=alpha("red",0.75), high="darkred",na.value = 'white') +

    geom_text(aes(label = Freq), color = 'black', size = 6) +
    theme_light() +
    theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
      legend.position = "none",
      panel.border = element_blank(),
      plot.background = element_blank(),
      axis.line = element_blank())

  return(cm_d_p)
}

Образец данных:
Матрица путаницы симулированного карета

library(caret)
# simulated data
set.seed(23)
pred <- factor(sample(1:7,100,replace=T))
ref<- factor(sample(1:7,100,replace=T))
cm <- caret::confusionMatrix(pred,ref)
g <- plot.cm(cm)
g

Answer 1

Мне кажется, проблема в том, что вы указываете aes(color = Freq) вместо aes(fill = Freq. Является ли сюжет тем, к чему вы стремились? Вы также можете упростить все это, просто используя расходящуюся цветовую шкалу и создав новую переменную, которая помечает Freq как отрицательное, если оно выходит за диагональ? См. Второй пример ниже

# adapted from https://stackoverflow.com/a/60150826/7318488
library(ggplot2)     # to plot
library(gridExtra)   # to put more
library(grid)        # plot together
library(likert)      # for reversing the factor order
#> Loading required package: xtable
library(ggnewscale)

plot.cm <- function(cm){
  # extract the confusion matrix values as data.frame
  cm_d <- as.data.frame(cm$table)
  cm_d$diag <- cm_d$Prediction == cm_d$Reference # Get the Diagonal
  cm_d$ndiag <- cm_d$Prediction != cm_d$Reference # Not the Diagonal     
  cm_d[cm_d == 0] <- NA # Replace 0 with NA for white tiles
  cm_d$Reference <-  reverse.levels(cm_d$Reference) # diagonal starts at top left

  # plotting the matrix
  cm_d_p <-  ggplot(data = cm_d, aes(x = Prediction , y =  Reference, fill = Freq))+
    scale_x_discrete(position = "top") +
    geom_tile( data = cm_d[!is.na(cm_d$diag), ],aes(fill = Freq)) +
    scale_fill_gradient(guide = FALSE,low=alpha("lightyellow",0.75), high="yellow",na.value = 'white') +
    # THIS DOESNT WORK
    new_scale("fill") +
    geom_tile( data = cm_d[!is.na(cm_d$ndiag), ],aes(fill = Freq)) +
    scale_fill_gradient(guide = FALSE,low=alpha("red",0.75), high="red",na.value = 'white') +

    geom_text(aes(label = Freq), color = 'black', size = 6) +
    theme_light() +
    theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
          legend.position = "none",
          panel.border = element_blank(),
          plot.background = element_blank(),
          axis.line = element_blank())

  return(cm_d_p)
}

library(caret)
#> Loading required package: lattice
# simulated data
set.seed(23)
pred <- factor(sample(1:7,100,replace=T))
ref<- factor(sample(1:7,100,replace=T))
cm <- caret::confusionMatrix(pred,ref)
g <- plot.cm(cm)
g
#> Warning: Removed 8 rows containing missing values (geom_text).

^{Создано в 2020-04-29 пакетом Представить (v0.3.0)}

# adapted from https://stackoverflow.com/a/60150826/7318488
library(ggplot2)     # to plot
library(gridExtra)   # to put more
library(grid)        # plot together
library(likert)      # for reversing the factor order
#> Loading required package: xtable
library(ggnewscale)

plot.cm <- function(cm){
  # extract the confusion matrix values as data.frame
  cm_d <- as.data.frame(cm$table)
  cm_d$diag <- cm_d$Prediction == cm_d$Reference # Get the Diagonal
  cm_d$ndiag <- cm_d$Prediction != cm_d$Reference # Not the Diagonal     
  cm_d[cm_d == 0] <- NA # Replace 0 with NA for white tiles
  cm_d$Reference <-  reverse.levels(cm_d$Reference) # diagonal starts at top left

  cm_d$ref_freq <- cm_d$Freq * ifelse(is.na(cm_d$diag),-1,1)

  # plotting the matrix
  cm_d_p <-  ggplot(data = cm_d, aes(x = Prediction , y =  Reference, fill = Freq))+
    scale_x_discrete(position = "top") +
    geom_tile( data = cm_d,aes(fill = ref_freq)) +
    scale_fill_gradient2(guide = FALSE,low="red",high="yellow", midpoint = 0,na.value = 'white') +
    geom_text(aes(label = Freq), color = 'black', size = 6)+
     theme_light() +
    theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
          legend.position = "none",
          panel.border = element_blank(),
          plot.background = element_blank(),
          axis.line = element_blank())

  return(cm_d_p)
}

library(caret)
#> Loading required package: lattice
# simulated data
set.seed(23)
pred <- factor(sample(1:7,100,replace=T))
ref<- factor(sample(1:7,100,replace=T))
cm <- caret::confusionMatrix(pred,ref)
g <- plot.cm(cm)
g
#> Warning: Removed 8 rows containing missing values (geom_text).

^{Создано в 2020-04-29 пакетом Представить (v0.3.0)}