Автономная легенда в ggpairs - PullRequest
Новая
       79

Автономная легенда в ggpairs

1 голос
/ 09 октября 2019

Как включить легенду в одну из пустых панелей следующего матричного графика?

У меня есть цветные регрессионные линии на графиках. Мне нужна легенда, основанная на цвете.

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

Что касается фона кода, я пытаюсь изучить различные надежные и не устойчивые методы регрессии, применяемые к многомерным данным с выбросами и без них. 

library(ggplot2)
library(GGally)
library(MASS)
library(robustbase)

## Just create data -- you can safely SKIP this function.
## 
## Take in number of input variables (k), vector of ranges of k inputs
## ranges = c(min1, max1, min2, max2, ...) (must have 2k elements),
## parameters to create data (must be consistent with the number of
## input variables plus one), parameters are vector of linear
## coefficients (b) and random seed (seed), number of observations
## (n), vector of outliers (outliers)
## 
## Return uncontaminated dataframe and contaminated dataframe
create_data <- function(k, ranges, b, seed = 6, n,
                        outliers = NULL) {
    x <- NULL                           # x: matrix of input variables
    for (i in 1:k) {
    set.seed(seed^i)
        ## x <- cbind(x, runif(n, ranges[2*i-1], ranges[2*i]))
        x <- cbind(x, rnorm(n, ranges[2*i-1], ranges[2*i]))
    }
    set.seed(seed - 2)
    x_aug = cbind(rep(1, n), x)
    y <- x_aug %*% b
    y_mean = mean(y)
    e <- rnorm(n, 0, 0.20 * y_mean)     # rnorm x
    y <- y + e
    df <- data.frame(x = x, y = y)
    len <- length(outliers)
    n_rows <- len %/% (k+1)
    if (!is.null(outliers)) {
        outliers <- matrix(outliers, n_rows, k+1, byrow = TRUE)
        df_contamin <- data.frame(x = rbind(x, outliers[,1:k]), y = c(y, outliers[,k+1]))
    } else {
        df_contamin <- df
    }
    dat <- list(df, df_contamin)
}

# plot different regression models (some are robust) for two types of
# data (one is contaminated with outliers)
plot_models <- function(data, mapping, data2) {
    cb_palette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
    ## 1.grey, 2.light orange, 3.light blue, 4.green, 5.yellow, 6.blue, 7.red, 8.purple
    plt <- ggplot(data = data, mapping = mapping) +
        geom_point() +
        theme_bw() +
        geom_smooth(method = lm, formula = y ~ x, data = data2, color = cb_palette[3], se = FALSE) +
        geom_smooth(method = lm, formula = y ~ x, color = cb_palette[7], se = FALSE) +
        geom_smooth(method = rlm, formula = y ~ x, color = cb_palette[4], se = FALSE)  +
        geom_smooth(method = lmrob, formula = y ~ x, color = cb_palette[1], se = FALSE)
    plt
}

# trim the upper and right panels of plots
trim_gg <- function(gg) {
    n <- gg$nrow
    gg$nrow <- gg$ncol <- n-1
    v <- 1:n^2
    gg$plots <- gg$plots[v > n & v%%n != 0]
    gg$xAxisLabels <- gg$xAxisLabels[-n]
    gg$yAxisLabels <- gg$yAxisLabels[-1]
    gg
}

dat <- create_data(3, c(1, 10, 1, 10, 1, 10), c(5, 8, 6, 7), 6, 20, c(30, 30, 50, 400))
df <- dat[[1]]
df_contamin <- dat[[2]]

## Note that plot_models is called here
g <- ggpairs(df_contamin, columns = 1:4, lower = list(continuous = wrap(plot_models, data2 = df)), diag = list(continuous = "blankDiag"), upper = list(continuous = "blank")) #, legend = lgd)

gr <- trim_gg(g)
print(gr)

Создано в 2019-10-09 пакетом Представить (v0.3.0)

Извините за длинный код, но большинствовероятно, нужно изменить только функцию plot_models и строку, где вызывается ggpairs.

Я хочу получить легенду в пустой верхней половине графиков. Это можно сделать, настроив функцию plot_models, установив mapping в ggpairs на color, используя ggplot2::aes_string, и используя getPlot и putPlot из пакета GGally. Но я не могу понять, как это сделать.

...