R ggplot2 geom_smooth - функция монотонного сглаживания

Возможно ли, чтобы geom_smooth производил монотонную убывающую функцию?

Первый пример выглядит монотонно убывающим:

library(tidyverse)

df <- structure(list(x = c(-55, 11, 19, 123, 133, 123, 123, 2, 86, 
84, 179, 179, 179, 179, 25, 85, 84, 179, 179, 179, 179, 25, 86, 
84, 179, 179, 179, 179, 25, 86, 84, 179, 179, 179, 179, 25, 86, 
70, 123, 123, 123, 123, 0, -45, -45, -17, -17, -17, -17, -63, 
48, 40, 67, 67, 67, 67, -25, 11, 10, 67, 67, 67, 67, -25, 11, 
10, 67, 67, 67, 67, -25, 11), y = c(126, -29, -37, -63, -76, 
-70, -58, 23, -17, -26, -74, -72, -70, -73, 6, -24, -10, -54, 
-67, -59, -59, 27, -37, -12, -51, -69, -61, -58, 52, -52, -25, 
-46, -64, -54, -55, 41, -11, -22, -48, -63, -57, -56, 34, 17, 
56, -26, -13, -16, -25, 99, -39, -16, -54, -74, -52, -60, 9, 
-32, -17, -62, -66, -50, -65, 60, -34, -24, -62, -76, -62, -58, 
27, -36)), row.names = c(NA, -72L), class = "data.frame")

ggplot(df) + geom_point(aes(x, y)) + geom_smooth(aes(x, y))

geom smooth monotonic looks OK

Второй пример не выглядит однообразным:

df <- structure(list(x = c(33, -14, -14, -15, -10, -33, 2, 28, -33, 
-33, -33, -33, -48, -22, 0, 33, 33, 33, 33, 3, 37, 75, 17, 17, 
17, 17, 8, 95, 151, 67, 67, 67, 67, 31, 95, 151, 67, 67, 67, 
67, 31, 95, 151, 67, 67, 67, 67, 31, 95, 151, 67, 67, 67, 67, 
31, 95, 151, 67, 67, 67, 67, 31, 95, 139, 50, 50, 50, 50, 16, 
56, 101, 33), y = c(-50, 75, 77, 137, 36, 97, -42, -67, 147, 
163, 176, 132, 384, 100, 65, -17, -53, -11, -49, -48, -77, -87, 
-25, -23, -11, 4, -45, -54, -81, -36, -19, 3, -26, -6, -68, -74, 
-11, -21, 32, -28, -19, -41, -74, -36, -33, 47, -4, -35, -52, 
-69, -8, 47, 0, -45, 26, -48, -71, 19, 14, 18, -40, -71, -44, 
-61, 19, 5, -16, 15, 29, -48, -72, 0)), row.names = c(NA, -72L
), class = c("tbl_df", "tbl", "data.frame"))

ggplot(df) + geom_point(aes(x, y)) + geom_smooth(aes(x, y))

enter image description here

Вы можете видеть, что функция понижается, затем повышается между x = 25 to 65, затем снова понижается. Это нехорошо - функция никогда не должна увеличиваться при увеличении x.

Я также пробовал использовать nls() с функциями монотонного уменьшения, такими как y ~ 1/x или y ~ exp(1/x), но не смог определить эффективный способ автоматического поиска начальных значений, поскольку у меня есть тысячи наборов данных. geom_smooth, кажется, работает достаточно хорошо для многих случаев, кроме тех, где есть выпуклость, как во втором примере.

вы видели этот сообщение

mnm 10.08.2018 15:54
2
1
778
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Ответ принят как подходящий

Если вам просто нужна красивая кривая, вы можете использовать это:

library(tidyverse)

df <- structure(list(x = c(33, -14, -14, -15, -10, -33, 2, 28, -33, 
                           -33, -33, -33, -48, -22, 0, 33, 33, 33, 33, 3, 37, 75, 17, 17, 
                           17, 17, 8, 95, 151, 67, 67, 67, 67, 31, 95, 151, 67, 67, 67, 
                           67, 31, 95, 151, 67, 67, 67, 67, 31, 95, 151, 67, 67, 67, 67, 
                           31, 95, 151, 67, 67, 67, 67, 31, 95, 139, 50, 50, 50, 50, 16, 
                           56, 101, 33), y = c(-50, 75, 77, 137, 36, 97, -42, -67, 147, 
                                               163, 176, 132, 384, 100, 65, -17, -53, -11, -49, -48, -77, -87, 
                                               -25, -23, -11, 4, -45, -54, -81, -36, -19, 3, -26, -6, -68, -74, 
                                               -11, -21, 32, -28, -19, -41, -74, -36, -33, 47, -4, -35, -52, 
                                               -69, -8, 47, 0, -45, 26, -48, -71, 19, 14, 18, -40, -71, -44, 
                                               -61, 19, 5, -16, 15, 29, -48, -72, 0)), row.names = c(NA, -72L
                                               ), class = c("tbl_df", "tbl", "data.frame"))
plot = ggplot(df) + 
  geom_point(aes(x, y)) + 
  geom_smooth(aes(x, y),
              method = "lm",
              formula = y ~ log(x-min(df$x)-1),
              se = FALSE)

print(plot)

enter image description here

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

Для потомков ознакомьтесь с пакетом мошенничество для аддитивных моделей с ограничениями формы.

library(ggplot2)
library(scam)

df <- structure(list(x = c(33, -14, -14, -15, -10, -33, 2, 28, -33, 
    -33, -33, -33, -48, -22, 0, 33, 33, 33, 33, 3, 37, 75, 17, 17, 
    17, 17, 8, 95, 151, 67, 67, 67, 67, 31, 95, 151, 67, 67, 67, 
    67, 31, 95, 151, 67, 67, 67, 67, 31, 95, 151, 67, 67, 67, 67, 
    31, 95, 151, 67, 67, 67, 67, 31, 95, 139, 50, 50, 50, 50, 16, 
    56, 101, 33), y = c(-50, 75, 77, 137, 36, 97, -42, -67, 147, 
        163, 176, 132, 384, 100, 65, -17, -53, -11, -49, -48, -77, -87, 
        -25, -23, -11, 4, -45, -54, -81, -36, -19, 3, -26, -6, -68, -74, 
        -11, -21, 32, -28, -19, -41, -74, -36, -33, 47, -4, -35, -52, 
        -69, -8, 47, 0, -45, 26, -48, -71, 19, 14, 18, -40, -71, -44, 
        -61, 19, 5, -16, 15, 29, -48, -72, 0)), row.names = c(NA, -72L
        ), class = c("tbl_df", "tbl", "data.frame"))

Формулу нужно немного переделать, если вы очень заботитесь о форме шлица, но этот метод всегда будет создавать монотонно убывающую посадку, когда вы определяете сплайн как монотонно убывающий ("mpd").

# for some reason an object called `weight` needs 
# to be present at ggplot2_3.1.1
weight <- rep(1, times = nrow(df))
ggplot(df, mapping = aes(x, y)) + 
    geom_point() + 
    geom_smooth(method = "scam", 
        # b-spline monotonic deceasing
        # see ?shape.constrained.smooth.terms
        formula = y ~ s(x, k = 5, bs = "mpd"), 
        se = FALSE)

enter image description here

Другие вопросы по теме