GGPLOT - Показать связность ежегодной регистрации по классам и годам

Question

У меня есть данные о зачислении студентов за 1990-2017 гг .:

nominal_roll1 <- tribble(~"Grade",~"1991-92", ~"1992-93", ~"1993-94", ~"1994-95", ~"1995-96",~"1996-97", ~"1997-98", ~"1998-99", ~"1999-00", ~"2000-01", ~"2001-02",~"2002-03", ~"2003-04", ~"2004-05", ~"2005-06", ~"2006-07", ~"2007-08",~"2008-09", ~"2009-10", ~"2010-11", ~"2011-12", ~"2012-13", ~"2013-14",~"2014-15", ~"2015-16", ~"2016-17", ~"2017-18",
        "K4",   88,92,99,101,90,99,103,111,95,92,84,92,107,86,93,82,98,92,96,121,154,137,137,145,155,160,160,
        "K5",   87,89,88,102,107,94,102,106,111,102,98,88,72,89,84,108,82,115,98,93,121,154,137,137,145,155,160,
        "Gr. 1",    107,102,105,104,122,114,119,134,111,125,120,113,118,121,104,109,103,113,135,88,93,121,154,137,137,137,155,
        "Gr. 2",    90,113,100,109,99,118,102,105,130,104,132,128,114,108,97,99,109,98,97,87,88,93,121,154,137,137,137,
        "Gr. 3",    81,86,102,102,112,108,119,103,112,121,105,121,107,113,90,101,93,101,102,97,87,88,93,121,154,154,137,
        "Gr. 4",    67,84,86,91,88,105,111,113,94,114,122,127,138,109,92,92,99,89,98,90,97,87,88,93,121,121,154,
        "Gr. 5",    67,76,84,94,96,97,117,112,119,109,106,104,121,145,100,102,90,103,94,98,90,97,87,88,93,93,121,
        "Gr. 6",    66,76,74,83,92,95,81,113,105,102,106,106,100,115,120,107,101,89,106,127,98,90,97,87,88,88,93,
        "Gr. 3",    81,77,86,85,88,88,112,96,113,110,120,111,120,121,94,126,103,110,93,83,127,98,90,97,87,87,88,
        "Gr. 8",    59,76,71,68,84,74,48,85,94,85,102,124,131,111,84,113,123,104,111,88,83,127,98,90,97,97,87,
        "Sr. 1",    62,62,64,89,77,73,90,82,104,122,120,106,103,177,138,149,152,174,184,88,111,83,127,98,90,90,97,
        "Sr. 2",    55,78,62,68,62,76,71,131,69,85,130,132,113,141,91,175,125,159,182,182,184,111,83,127,98,98,90,
        "Sr. 3",    3,71,60,51,66,44,53,97,75,59,82,143,136,136,76,108,144,126,98,98,182,184,88,83,127,127,98,
        "SR. 4",    0,66,65,32,49,67,83,56,77,45,79,68,182,160,69,121,97,127,157,157,98,182,59,88,83,83,127,
        "MSP",  0,1,1,1,0,0,0,0,0,0,16,20,41,10,22,36,42,38,51,NA,NA,NA,20,NA,NA,NA,NA)

#tidy the dataset

nominal_tidy1 <- nominal_roll1 %>%
  mutate(FakeCrudeBirthRate = rnorm(nrow(.), mean = 12.5, sd = .5),
         FakeFertilityRate = rnorm(nrow(.), mean = 2.2, sd = .05)) %>% 
  gather(Year, Attendance, `1991-92`:`2017-18`) %>%
  mutate(Year_ = as.numeric(str_trunc(.$Year, side = "right", width = 4, ellipsis = "")),
         Grade = factor(Grade, levels = c("K4","K5","Gr. 1","Gr. 2","Gr. 3","Gr. 4","Gr. 5","Gr. 6","Gr. 7",
                                          "Gr. 8","Sr. 1", "Sr. 2", "Sr. 3", "Sr. 4", "MSP")))

, которые я отображаю как:

nominal_tidy1 %>% ggplot(aes(x = Year, y = Attendance, group = Grade)) +
  geom_line(aes(col = Grade)) +
  theme_minimal(16) +
  theme(legend.title = element_text(size = 14),
        legend.text = element_text(size = 14),
        axis.text.x = element_text(angle = 90),
        text = element_text(family="Lato"),
        plot.title = element_text(size=18, hjust = 0.5),
        plot.caption = element_text(size = 12, hjust = 1),
        axis.text.y = element_text(hjust = 0),
        panel.grid = element_line(colour = "#F0F0F0"),
        plot.margin = unit(c(1,1,0.5,1), "cm")) +
  labs(title = "Nominal Roll, 1991 - 2018") 

Это хорошо, но за последние 5 лет вы можете наиболее четко увидеть, насколько стабильно зачисление учащихся: такое же количество учеников поступает из 4-го класса - 5-го класса.как будто это нестабильно

Кто-нибудь имеет представление о том, как я могу лучше представить это, показывая связь между одним выпускным годом и следующим?Я играю с cumsum и другими подходами, но не могу получить межгодовое соединение.То, на что я хотел бы, чтобы результат выглядел, - это представление о стабильности за последние несколько лет, которая выглядит хаотично, как это визуализируется сейчас.

Answer 1

ОК, продолжая мои комментарии:

Мы предполагаем, что зачисление в класс g в год t более или менее совпадает с зачислением в класс (g-1) в год (t-1).Например, учащиеся, которые посещали 4 класс в 2000 году, должны посещать 5 класс через год (+/- некоторые случайные колебания):

e(g, t) = e(g-1, t-1) * \gamma(g, t) +\epsilon

(извините за внешний вид, кажется, что переполнение стекаподдержка формул LaTeX).

Функция \gamma(g, t) является функцией роста;в основном, также матрица, как ваш nominal_roll1.Если ваше предположение верно, то его строки (элементы с одинаковой оценкой для разных лет) должны быть более или менее постоянными.Столбцы могут быть меньше, например, вы можете ожидать чрезмерного увеличения числа учащихся в 1-м классе.

Однако, если вы составляете участок плитки \gamma, вы получите это (кредиты www):

Значения находятся где-то около 1, и есть некоторый случайный шум, но, от 2011 года на матрице подозрительно спокойно (без шума, без колебаний, кроме 2016-17).Видимо, изменение политики имело некоторый эффект.

Вот код:

gamma <- nominal_roll1[2:nrow(nominal_roll1), 3:ncol(nominal_roll1)] /
         nominal_roll1[1:(nrow(nominal_roll1)-1), 2:(ncol(nominal_roll1)-1)]
gamma$intoGrade <- nominal_roll1$Grade[2:nrow(nominal_roll1)]

library(tidyverse)

gamma_tidy <- gamma %>%
  mutate(FakeCrudeBirthRate = rnorm(nrow(.), mean = 12.5, sd = .5),
    FakeFertilityRate = rnorm(nrow(.), mean = 2.2, sd = .05)) %>% 
  gather(Year, AttndRise, `1992-93`:`2017-18`) %>%
  mutate(Year_ = as.numeric(str_trunc(.$Year, side = "right", width = 4, ellipsis = "")),
    intoGrade = factor(intoGrade, levels = c("K5","Gr. 1","Gr. 2","Gr. 3","Gr. 4",
        "Gr. 5","Gr. 6","Gr. 7","Gr. 8","Sr. 1", "Sr. 2", "Sr. 3", "Sr. 4", "MSP")))
gamma_tidy$AttndRise[is.infinite(gamma_tidy$AttndRise)] = NA


gamma_tidy %>% 
  drop_na(intoGrade) %>%
  ggplot(aes(x = Year, y = intoGrade, fill = AttndRise)) +
  geom_tile() +
  scale_fill_viridis_c() +
  theme_minimal(16) +
  theme(legend.title = element_text(size = 14),
    legend.text = element_text(size = 14),
    axis.text.x = element_text(angle = 90),
    text = element_text(family="Lato"),
    plot.title = element_text(size=18, hjust = 0.5),
    plot.caption = element_text(size = 12, hjust = 1),
    axis.text.y = element_text(hjust = 0),
    panel.grid = element_line(colour = "#F0F0F0"),
    plot.margin = unit(c(1,1,0.5,1), "cm")) +
  labs(title = "Rise in Roll, 1992 - 2018") 

Answer 2

Возможно, если вы хотите, чтобы люди чувствовали себя менее чувствительными к изменениям числа в Attendance.

library(tidyverse)

nominal_tidy1 %>% 
  drop_na(Grade) %>%
  ggplot(aes(x = Year, y = Grade, fill = Attendance)) +
  geom_tile() +
  scale_fill_viridis_c() +
  theme_minimal(16) +
  theme(legend.title = element_text(size = 14),
        legend.text = element_text(size = 14),
        axis.text.x = element_text(angle = 90),
        text = element_text(family="Lato"),
        plot.title = element_text(size=18, hjust = 0.5),
        plot.caption = element_text(size = 12, hjust = 1),
        axis.text.y = element_text(hjust = 0),
        panel.grid = element_line(colour = "#F0F0F0"),
        plot.margin = unit(c(1,1,0.5,1), "cm")) +
  labs(title = "Nominal Roll, 1991 - 2018")