In martinmodrak/revize-rs: Code for analysis of revize-rs project data

source(here::here("setup_dotaznik.R"), encoding = "UTF-8")
knitr::opts_chunk$set(echo=FALSE, cache=TRUE)

library(lubridate)
library(readxl)
library(tidyverse)
library(forcats)
library(here)
library(bindrcpp)
library(brms)
library(knitr)
library(cowplot)
#theme_set(theme_cowplot())
set_theme_revizers()

tolerovana_prestavka <- 0
min_rok <- 2012
min_vek <- 6
max_vek <- 21

Odchody na přechodu do RS {#odchody-lidi}

Ve skauting se často operuje s představou, že nízké množství roverů je dáno problematickým přechodem mezi skautskou a roverskou výchovnou kategorií. Dle mého soukromého názoru převládá představa, že kolem patnáctého roku věku, při přechodu do roverské kategorie, Junák ztrácí velké množství mladých lidí. Chci tedy zjistit do jaké míry je tato zvýšená míra odchodů viditelná v datech z registrace.

Shrnutí výsledků {#odchody-shrnuti}

V datech z registrace za roky 2012---2018 lze v některých skupinách členů vidět mírný vzestup míry odchodů kolem 15tého roku věku. Nejsilnější takový nárůst jsme pozorovali u chlapců, kteří jsou již členy Junáka alespoň 4 roky. Ve 12ti letech opouští organizaci v průměru 14% takovýchto chlapců z ročníku (tj. zhruba jeden ze sedmi). Tato míra pak roste plynule až k 16ti letům, kdy jich odchází 17% z ročníku (tj. zhruba jeden z šesti). V jiných kategoriích je nárůst odchodů kolem přechodu do roverského věku nižší. V roverském věku pak míra odchodů s rostoucím věkem klesá.

Jistou míru optimismu lze brát z toho, že v datech z let 2017---2018 již tento vzestup kolem 15tého roku není viditelný, jakkoliv nelze vyloučit, že to je pouze náhoda.

V každém případě data nenaznačují, že by nárůst odchodů kolem přechodu do roverského věku byl zásadní problém. Zároveň lze očekávat, že data z registrace jsou v tomto ohledu spíše pesimistická --- u členů do 15ti let je velmi nezvyklé, že by nebyli registrování, zatímcu u roverských kmenů lze registrační disciplínu očekávat nižší. Na druhou stranu není v roverském věku neobvyklé, že je člen registrován, ale není aktivní --- závěry z registrace nemohou bohužel mezi aktivními a neaktivními členy rozlišit.

Nízký počet roverů je pravděpodobně více ovlivněn výrazným poklesem přílivu nováčků s rostoucím věkem a celkově vysokým "odpadem" nováčků --- až 33% prvně registrovaných se neregistruje podruhé. Velká míra odchodů je ale vidět i u zkušenějších členů napříč skautským věkem --- každý rok odchází až 18% zkušenějších členů. Odchod člena v rovererském věku je také pro středisko závažnější, což může subjektivně vést ke zveličování počtu odchodů.

I pokud bychom předpokládali, že při přechodu ze skautského věku do roverů dojde ke stejné míře odchodů jako během skautského věku, nedá se očekávat nárůst počtu registrovaných roverů o víc jak jednotky procent. Nelze vyloučit, že existuje velká skupina registrovaných ale neaktivních roverů a tedy že kolem 15tého roku dochází k velkému úbytku aktivních členů, který v registrace nevidíme. Z osobní zkušenosti to ale nepovažuji za příliš pravděpodobné.

Zajímavým poznatkem je také to, že dívky odcházejí obecně ve stejné nebo menší míře než chlapci.

Bylo by zajímavé se podívat zvlášť na odchody dle velikosti města/kraje --- lze očekávat, že v menších obcích dochází k větší míře odchodů v souvislosti s přechodem na střední nebo vysokou školu. To v datech, které máme nelze zjistit. Nicméně jelikož v průměru k nárůstu odchodů spíše nedochází, musel by být nárůst odchodů kolem 15ti let v menších městech kompenzován snížením množství takových odchodů ve větších městech, což bych považoval za spíše nepravděpodobné.

Hlavní kvantitativní výstupy {#odchody-hlavni-vystupy}

registrace <- registrace_jednotlivci() %>% rename(Sex = ID_Sex)

posledni_rok <- max(registrace$Year)

Poznámka: Všude bereme že věk = rok registrace - rok narození.

rozsah_clenstvi <- rozsah_clenstvi_z_registrace(registrace)

#Zvlast prvni a posledni odchody, duvody a analyza nize
odchazeni <- 
  registrace %>%
  mutate(vek = Year - rok_narozeni) %>%
  filter(Year >= min_rok, Year < posledni_rok - tolerovana_prestavka, vek >= min_vek & vek <= max_vek) %>%
  inner_join(rozsah_clenstvi %>% select(-rok_narozeni, -Sex), by = c("Person_PseudoID" = "Person_PseudoID")) %>%
  mutate(delka_clenstvi = Year - prvni_registrace + 1)

odchazeni_posledni <- odchazeni %>%
  mutate(ukonceno = Year == posledni_registrace) 

odchazeni_prvni <- odchazeni %>%
  filter(Year <= prvni_konec) %>%
  mutate(ukonceno = Year == prvni_konec) 

Zde vidíme, jaká část členské základny Junáka daného věku odešla během sledovaného období, rozděleno na nováčky (registrují se poprvé) a ostatní. Raději příklad: kdyby za roky 2012---2018 období bylo v Junáku celkem 1000 chlapců, kteří se poprvé registrovali během svých 13ti let a z toho se jich 200 již znovu neregistrovalo, bude v grafu 0.2. Pruh kolem údajů ukazuje očekávanou nejistotu/šum (čím méně lidí v kategorii, tím méně si jsme jisti, že to co vidíme je reprezentativní).

odchazeni_posledni_focus <- odchazeni_posledni %>% filter(vek >= 10, vek <= 18)
plot_odchody_hlavni <- plot_odchody(odchazeni_posledni_focus , "delka_clenstvi") + ggtitle("Podíl odchodů", "dle délky předchozí registrace a věku")

ggsave(here::here("shared_figs/odchody.png"), plot_odchody_hlavni, width = default_plot_width, height = default_plot_height)
plot_odchody_hlavni

Vysoká míra nejistoty u nováčků je daná tím, že ve vyšším věku máme už docela málo nováčků. To samé platí pro členy s 2 ---3 letou zkušeností v roverském věku. Kvůli této nejistotě nelze brát příliš vážně nárůst podílu odchodů u méně zkušených členů po 17 roce. V celkovém pohledu (viz níže) je dokonce vidět pokles. Jakkoliv zde vidíme jístý nárůst ke konci skautského věku, nezdá se být příliš výrazný (max tři procentní body).

Nedostatek roverů lze tedy snáze vysvětlit nízkým počtem nováčků ve skautském věku:

plot_prichody(odchazeni, by = "year", response = n_novych) + ggtitle("Počty nováčků", "Absolutní počet dle věku a roku příchodu")

Zde vidíme, že počet nováčků napříč lety stabilně klesá v celém skautském věku a v roverském věku je minimální.

S jistou mírou optimismu je pak možné se podívat na odchody jen za poslední dva roky, kde se zdá, že se stoupající trend ve skautském věku vytrácí, ale s jistotou si to netroufám říct.

plot_odchody(odchazeni_posledni_focus %>% filter(Year >= 2016) , "delka_clenstvi") + ggtitle("Podíl odchodů", "dle délky předchozí registrace a věku od roku 2016")

Příchody nováčků {#prichody-novacku}

Zde vidíme podíl nováčků v každém registrovaném ročníku

plot_prichody(odchazeni_posledni) + ggtitle("Podíl nováčků souhrně")

plot_prichody(odchazeni_posledni, response = n_novych) + ggtitle("Počet nováčků souhrně")

plot_prichody(odchazeni_posledni, by = "year") + ggtitle("Podíl nováčků po letech")
plot_prichody(odchazeni_posledni, by = "year", response = n_novych) + ggtitle("Počet nováčků po letech")

Celkové počty členů {#celkove-pocty-clenu}

A ještě se můžeme podívat na celkové počty členů --- souhrný graf má vysoká čísla, protože sčítá přes všechny sledované roky.

plot_pocty(odchazeni_posledni) + ggtitle("Souhrnný počet členů (2012-2017)")
plot_pocty(odchazeni_posledni, by = "year") + ggtitle("Počet členů pro každý rok")
plot_pocty(odchazeni_posledni %>% filter(delka_clenstvi >= 2)) + ggtitle("Souhrný počet členů kromě nováčků")

Co by znamenalo srovnat odchody napříč skautským věkem {#co-by-znamenalo-srovnat-odchody}

optimisticky_odhad_zmeny <- 0.03
optimisticky_odhad_poctu_2016 <- odchazeni %>% filter(Year == 2016 & (vek == 14)) %>% 
  summarise(pocet  = length(Person_PseudoID), zustavsi =  pocet * (optimisticky_odhad_zmeny + optimisticky_odhad_zmeny ^ 2), .groups = "drop") 
optimisticky_odhad_poctu_2017 <- odchazeni %>% filter(Year == 2017 & (vek == 15)) %>% 
  summarise(pocet  = length(Person_PseudoID), zustavsi =  pocet * (optimisticky_odhad_zmeny), .groups = "drop") 
optimisticky_odhad_poctu <- optimisticky_odhad_poctu_2016$zustavsi + optimisticky_odhad_poctu_2017$zustavsi

soucasny_pocet <- registrace %>% filter(Year == 2018 & (vek == 16)) %>%
   summarise(pocet  = length(Person_PseudoID), .groups = "drop")

optimisticky_odhad_podilu <- optimisticky_odhad_poctu / soucasny_pocet$pocet

Při optimistickém odhadu, že ve 14ti a 15ti letech zvládneme snížit odchod o r optimisticky_odhad_zmeny *100 procentní body, tj. že z r optimisticky_odhad_poctu_2016$pocet čtrnáctiletých v roce 2016 a z r optimisticky_odhad_poctu_2017$pocet patnáctiletých v roce 2017 by vždy r optimisticky_odhad_zmeny *100% lidí NEodešly, pak bychom "získali" r round(optimisticky_odhad_poctu) šestnáctiletých roverů navíc k současnému počtu r soucasny_pocet$pocet (tj. r round(optimisticky_odhad_podilu * 100)%)

Odchody v roverském věku {#odchody-roveri}

Zajímá nás též, jak výrazně z organizace mizí starší členové - můžeme se tedy podívat na podíl odchodů z ročníku jen v roverském věku. Zde je vidět, že klesající trend trvá, ale podíl odchodů nikdy neklesne pod 10% a docela dlouho je větší než 15%. Tedy opět - vzhledem k absenci nováčků se i relativně malá míra odchodů posčítá a výsledkem je malý počet starších roverů v organizaci.

plot_odchody(odchazeni_posledni %>% filter(vek >= 15, vek <= 26) ) + ggtitle("Podíl odchodů mezi rovery")

Tato míra odchodů a absence nováčků se pak promítá do toho, v jakém věku odchází roveři z organizace - tedy povětšinou v mladším roverském věku.

rozsah_clenstvi %>% 
  filter(posledni_registrace >= min_rok, posledni_registrace < posledni_rok - tolerovana_prestavka, prvni_registrace > 2003, posledni_registrace - rok_narozeni > 15, posledni_registrace - rok_narozeni <= 26  ) %>%
  ggplot(aes(x=posledni_registrace - rok_narozeni)) + geom_histogram(binwidth = 1) + vodorovne_popisky_x + ggtitle("Počet odchodů z organizace v roverském věku")

Délka členství {#delka-clenstvi}

Zdá se, že až na rozdíl mezi nováčky a ostatními se délka řídí geometrickým rozložením.

rozsah_clenstvi %>% 
  filter(posledni_registrace >= min_rok, posledni_registrace < posledni_rok - tolerovana_prestavka, prvni_registrace > 2003) %>%
  ggplot(aes(x=posledni_registrace - prvni_registrace)) + geom_histogram(binwidth = 1) + vodorovne_popisky_x

Doplňkové a kontrolní výstupy {#odchody-doplnky-a-kontroly}

Zkontroluji, jak časté jsou přestávky v členství

rozsah_clenstvi %>% group_by(pocet_prestavek) %>% summarise(pocet_osob = length(rok_narozeni), .groups = "drop") %>% kable()
rozsah_clenstvi %>% group_by(prestavky_celkem_let) %>% summarise(pocet_osob = length(rok_narozeni), .groups = "drop") %>% kable()

cat("Počet členů kteří odešli do 12 let a pak znovu do 16ti let:", sum(rozsah_clenstvi$konec_do_12_let & rozsah_clenstvi$konec_13_az_16_let))

Bohužel je tu dost lidí, kteří odešli vícekrát a to i ve věku, který nás zajímá. Budeme tedy zvlášť analyzovat první odchody a poslední odchody. V této analýze bereme neregistraci jako konec členství. Výsledky jsou ale podobné i když vezmeme jednoroční přestávku jako souvislé členství.

Poslední odchody {#posledni-odchody}

plot_odchody(odchazeni_posledni) + ggtitle("Souhrnný podíl odchodů")

Asi vás překvapí, že na tomto grafu není v podstatě žádná špička kolem 15tého roku vidět --- důvodem je, že mícháme dvě dost odlišné skupiny: nováčky a ostatní. Jak to, že když odchody v každé skupině zvlášť během skautského věku rostou, tak součet neroste? Důvodem je, že se s věkem zmenšuje podíl nováčků (kteří odcházejí hodně) a tím se snižuje celková míra odchodů, ač v obou skupinách zvlášť roste. To je hezká ukázka toho, jak snadné je se mýlit špatným pohledem na data.

Zdá se tedy, že z Junáka odchází během skautského věku poměrně rovnoměrně kolem 18% členů z ročníku (chlapců o něco víc). To odpovídá "poločasu rozpadu" pro skauty cca 3.5 roku. Po 15tém roce se toto číslo nezvyšuje, naopak klesá. Nezdá se tedy, že by 15tý rok byl více zlomový pro členství než jiné roky.

Pro jistotu se podívejme zvlášť na každý rok. Opět vidíme podíl členů, kteří odešli v daném roce a věku (tj. když v roce 2006 měl Junáka 5000 dvanáctiletých děvčat a 500 dvanáctiletých děvčat ten rok odešlo, bude uvedeno 0.1).

plot_odchody(odchazeni_posledni, "year") + ggtitle("Souhrnný podíl odchodů po letech")

spicka_2015 <- odchazeni_posledni %>% filter(Year == 2015, vek == 16, Sex == "male") %>%
  summarise(n_ukonceno = sum(ukonceno), pocet = length(Person_PseudoID), .groups = "drop")
avg_16 <- odchazeni_posledni %>% filter(vek == 16, Year != 2015, Sex == "male") %>%
  summarise(n_ukonceno = sum(ukonceno), pocet = length(Person_PseudoID), podil = n_ukonceno/pocet, .groups = "drop")

Trend ve všech letech víceméně podobný --- žádná výrazná změna kolem 15tého roku. Výjimkou je zvláštní špička v roce 2015, kdy z r spicka_2015$pocet šestnácti letých chlapců odešlo r spicka_2015$n_ukonceno zatímco při průměrné míře odchodu by to bylo cca r round(spicka_2015$pocet * avg_16$podil). Tuto špičku neumím vysvětlit, ale může to být klidně jen náhoda.

Data mají mírně sestupný trend v čase (tj. poslední dobou méně lidí odchází) ale nutno podotknout, že zde očekáváme sestupný trend v čase i kdyby se nic neměnilo --- část lidí se do Junáka vrací a ti z posledních let kteří se v budoucnu vrátí jsou v grafu vedeni jako ztracení.

První odchody {#prvni-odchody}

Pro jistotu se podíváme na ty samé grafy, ale s prvními odchody, tj. kdy poprvé měl člověk v pauzu v registraci. Ti, kteří se pak vrátili jsou počítáni pouze ke svému prvnímu odchodu.

plot_odchody(odchazeni_prvni) + ggtitle("Souhrný podíl prvních odchodů")
plot_odchody(odchazeni_prvni, "year") + ggtitle("Podíl prvních odchodů po letech")

Vidíme, že trendy v prvních odchodech jsou velmi podobné jako v posledních odchodech, dál bereme tedy poslední odchody (ty jsou také počítány ve shrnutí na začátku).

Poslední odchody, dlouhodobí členové {#posledni-odchody-dlouhodobi}

V grafech výše se spíše nevyskytuje žádná špička u přechodu do roverského věku. Ale vidíme, že odchází celkem hodně lidí (cca pětina ročníku). To budou asi lidé, kteří se registrovali jen krátce. Podíváme se tedy, jestli to vypadá stejně u členů, kteří již chodili déle. Údaje jsou relativní k celkovému počtu dlouhodobých členů v té době registrovaných.

plot_odchody(odchazeni_posledni, "delka_clenstvi") + ggtitle("Podíl odchodů dle délky předchozí registrace")

Vysoký míra nejistoty u zkušených členů v nízkém věku není překvapivá --- jedná se malou skupinu (9ti letí, kteří se registrují počtvrté a vícté)

Můžeme se taky na tyto segmenty podívat napříč sledovaným časem.

odchazeni_posledni_novacci <- odchazeni_posledni %>% filter(vek >= 10, delka_clenstvi == 1)  
odchazeni_posledni_2_roky <- odchazeni_posledni %>% filter(vek >= 10, delka_clenstvi >= 2, delka_clenstvi <= 3)  
odchazeni_posledni_4_roky <- odchazeni_posledni %>% filter(vek >= 10, delka_clenstvi >= 4)  
plot_odchody(odchazeni_posledni_novacci,"year") + ggtitle("Odchody nováčků")
plot_odchody(odchazeni_posledni_2_roky, "year") + ggtitle("Odchody 2-3 roky")
plot_odchody(odchazeni_posledni_4_roky, "year") + ggtitle("Odchody 4+ let")

S jístou mírou mžourání si můžeme myslet, že špička kolem 15tého roku v čase spíše mizí.

Shoda se skautskými opendata {#shoda-opendata}

Data úplně nesedí s daty z https://opendata.skaut.cz, ale taky nejsou úplně mimo... :-( těžko říct, co si o tom myslet.

# pocty_is_raw <- read.csv2("https://is.skaut.cz/opendata/data/person/clenove-vekova-struktura-pohlavi.csv")
# pocty_is <- skautis_to_tidy(pocty_is_raw)
# 
# pocty_my <- registrace_pro_porovnani_se_skautisem(registrace) %>%
#       summarise(pocet = length(Person_PseudoID))
# 
# porovnej_skautis_my(pocty_is, pocty_my ) + ggtitle("Kontrola - počty reg. členů")

novacci_is_raw <- read.csv2(here("public_data","clenove-novacci-vek-pohlavi.csv")) 
novacci_is <-  skautis_to_tidy(novacci_is_raw)

novacci_my <- sumar_prichody(odchazeni_posledni, by = "year", response = n_novych) %>% 
  registrace_pro_porovnani_se_skautisem() %>%
  summarise(pocet = sum(n_novych), .groups = "drop")

porovnej_skautis_my(novacci_is, novacci_my) + ggtitle("Kontrola - počty nováčků")

martinmodrak/revize-rs documentation built on March 9, 2021, 5:30 a.m.