Podstawowe statystyki opisowe dla Dochodów Rodzin studenta

opis=describe(studenci$dochod)

opis<- knitr::kable(opis, caption="statystyki opisowe dla zmiennej Dochód rodziny studenta")
kable_classic(opis)

Estymacja błędu standardowego dla pełnej próby

## [1] 1.592611

## [1] 0.01380629

#przedziałowo klasycznie
mean(dochod)-1.96*se   #dolna krawędź

## [1] 112.2325

## [1] 118.4755

Estymacja błędu standardowego dla próbek bootstrapowych

nobs=50

poniżej Średnia, odch. standardowe, SE i SEP

B=999
mean.dochod=rep(0,B)
nobs=50 #liczba próbek bootstrapowych - zwiększaj ich liczbę: 50, 250, 500, 1000, 10000

## [1] 118.38

## [1] 35.09514

## [1] 4.963203

## [1] 0.01345338

przedziałowo bootstrapowo 95% ufności

dolny	gorny
108.6521	128.1079

przedziałowo Efron 97.5% ufności

	dolny	gorny
2.5%	63.35	186.925

nobs=15

poniżej Średnia, odch. standardowe, SE i SEP

attach(studenci)
B=999
mean.dochod=rep(0,B)
nobs=15 #liczba próbek bootstrapowych - zwiększaj ich liczbę: 50, 250, 500, 1000, 10000

## [1] 115.5333

## [1] 23.90716

## [1] 6.172803

## [1] 0.01378486

przedziałowo bootstrapowo 95% ufności

dolny	gorny
103.4346	127.632

przedziałowo Efron

	dolny	gorny
2.5%	77.7	158.9

nobs=30

poniżej Średnia, odch. standardowe, SE i SEP

attach(studenci)
B=999
mean.dochod=rep(0,B)
nobs=30 #liczba próbek bootstrapowych - zwiększaj ich liczbę: 50, 250, 500, 1000, 10000

## [1] 114.7

## [1] 24.23612

## [1] 4.42489

## [1] 0.01388501

przedziałowo bootstrapowo 95% ufności

dolny	gorny
106.0272	123.3728

przedziałowo Efron

	dolny	gorny
2.5%	79.725	163.925

nobs=100

poniżej Średnia, odch. standardowe, SE i SEP

attach(studenci)
B=999
mean.dochod=rep(0,B)
nobs=100 #liczba próbek bootstrapowych - zwiększaj ich liczbę: 50, 250, 500, 1000, 10000

## [1] 113.75

## [1] 32.87177

## [1] 3.287177

## [1] 0.01400098

przedziałowo bootstrapowo 95% ufności

dolny	gorny
107.3071	120.1929

przedziałowo Efron

	dolny	gorny
2.5%	56.95	171.05

Wnioski

Na podstawie powyżej tabeli można wysnuć wniosek, że wraz ze zwiększeniem liczebności próbek N, zwiększa się błąd standardowy procentowy i (SEP). Dlatego też ta metoda jest bardzo korzystna, ponieważ małe próby dają niewielkie procentowe błędy standardowe.

Oszacowania modelu bootstrap dla 500 próbek

N dla każdej próbki wynosi tyle samo co pierwotne dane, tzn. 500 obserwacji

set.seed(123)
boot_dane<- bootstraps(studenci, times=500)
boot_dane

## # Bootstrap sampling 
## # A tibble: 500 × 2
##    splits            id          
##    <list>            <chr>       
##  1 <split [500/185]> Bootstrap001
##  2 <split [500/185]> Bootstrap002
##  3 <split [500/187]> Bootstrap003
##  4 <split [500/177]> Bootstrap004
##  5 <split [500/199]> Bootstrap005
##  6 <split [500/180]> Bootstrap006
##  7 <split [500/180]> Bootstrap007
##  8 <split [500/190]> Bootstrap008
##  9 <split [500/193]> Bootstrap009
## 10 <split [500/184]> Bootstrap010
## # ℹ 490 more rows

boot_dane$splits[[1]]

## <Analysis/Assess/Total>
## <500/185/500>

boot_models<-boot_dane%>%
  mutate(model = map(splits, ~lm(dochod~0+samodzielnie, data=.)),
         coefs=map(model, tidy))
boot_models

## # Bootstrap sampling 
## # A tibble: 500 × 4
##    splits            id           model  coefs           
##    <list>            <chr>        <list> <list>          
##  1 <split [500/185]> Bootstrap001 <lm>   <tibble [2 × 5]>
##  2 <split [500/185]> Bootstrap002 <lm>   <tibble [2 × 5]>
##  3 <split [500/187]> Bootstrap003 <lm>   <tibble [2 × 5]>
##  4 <split [500/177]> Bootstrap004 <lm>   <tibble [2 × 5]>
##  5 <split [500/199]> Bootstrap005 <lm>   <tibble [2 × 5]>
##  6 <split [500/180]> Bootstrap006 <lm>   <tibble [2 × 5]>
##  7 <split [500/180]> Bootstrap007 <lm>   <tibble [2 × 5]>
##  8 <split [500/190]> Bootstrap008 <lm>   <tibble [2 × 5]>
##  9 <split [500/193]> Bootstrap009 <lm>   <tibble [2 × 5]>
## 10 <split [500/184]> Bootstrap010 <lm>   <tibble [2 × 5]>
## # ℹ 490 more rows

bootsraps( ) : times - The number of bootstrap samples.

boot_coefs <- boot_models %>%
  unnest(coefs)%>%
  select(term,estimate)
boot_coefs

## # A tibble: 1,000 × 2
##    term          estimate
##    <chr>            <dbl>
##  1 samodzielnie0     107.
##  2 samodzielnie1     127.
##  3 samodzielnie0     102.
##  4 samodzielnie1     124.
##  5 samodzielnie0     104.
##  6 samodzielnie1     127.
##  7 samodzielnie0     106.
##  8 samodzielnie1     127.
##  9 samodzielnie0     105.
## 10 samodzielnie1     128.
## # ℹ 990 more rows

boot_coefs%>%
  ggplot(aes(x=estimate))+
  geom_histogram()+
  facet_wrap(~term, scales="free")

Przedziały ufności

Poniżej tabela z przedziałami ufności w modelu dochody~samodzielnie.

boot_meds<-boot_coefs%>%
  group_by(term)%>%
  summarise(
    mediana_est=median(estimate),
    quintile=quantile(estimate,0.5),
    conf.low_2.5=quantile(estimate, 0.025),
    conf.high_97.5=quantile(estimate,0.975),
    conf.25=quantile(estimate,0.25),
    conf.75=quantile(estimate,0.75)
  )
 knitr::kable(boot_meds)%>%
 kable_classic()

Histogram dla parametrów przy zmiennej samodzielne zamieszkanie

Na wykresie poniżej poza wykresem gęstości dla paramaterów zostały również zaznaczone przedziały ufności (zielone i niebieskie obszary) oraz mediana (linia pionowa).

Zewnętrzne pola jasno zielone oznaczają przedziały ufności 2,5% i 97,5%. Obszar zaznaczony na niebieski kolor to przedziały 25%-75%.

boot_coefs%>%
  ggplot(aes(x=estimate))+
  geom_rect(data=boot_meds, alpha=0.3, fill="green",
            aes(x=mediana_est, xmin=conf.low_2.5, xmax=conf.high_97.5, ymin=0, ymax=Inf))+
  geom_rect(data=boot_meds, alpha=0.4, fill="blue", aes(x=mediana_est, xmin=conf.25, xmax=conf.75,ymin=0, ymax=Inf))+
  geom_density()+
  geom_vline(data=boot_meds, aes(xintercept=mediana_est))+
  facet_wrap(~term, scales = "free")

Na podsawie wykresów powyżej można stwierdzić, że 50% badanych studentów, którzy mieszkają z rodzicami (0) ich rodziny nie zarabiają więcej niż 107 jednostek i nie mniej niż 104j. Natomiast na wykresie po prawej widzimy, że w grupie, która mieszka samodzielnie (1), 50% badanych studentów zadeklarowało, że dochód w ich rodzinienie mieści się w przedziale 125-128j.

Co więcej 95% studentów mieszkających samodzielnie, w ich rodzinach, dochód nigdy nie był mniejszy niż 121 jednostek. Potiwerdza, to intuicyjne przekonanie, że tylko zamorzniejsze rodziny mogą sobie pozwolić na to aby, ich dziecko będące na studiach mieszkało samodzielnie, gdyż zazwyczaj większość studentów jest jeszcze wspieranych przez rodziców.

Bootstrap p-value - średnia vs mediana (1000 próbek)

Porównanie średnią i mediane dla p-value z regresji bootstrapowej w stosunku do p-value z modelu liniowego. W celu sprawdzenia czy mediana sprwadza się lepiej od średniej.

Liczna próbek = 1000 N=500 (jak pierwotne dane)

boot_models<- bootstraps(studenci, times=1000)%>%
  mutate(model=map(splits, ~lm(dochod~0+samodzielnie, data=.)),
          coefs=map(model, tidy))

boot_coefs<-boot_models%>%
  unnest(coefs) %>%
  select(term, p.value)

m<-lm(dochod~samodzielnie, data=studenci)
boot_coefs%>%
  group_by(term)%>%
  summarise(
    mean_boot_pvalue = mean(p.value),
    mediana_boot_pvalue= median(p.value)
  )%>%
  left_join(tidy(m)%>% select(term, p.value))

## # A tibble: 2 × 4
##   term          mean_boot_pvalue mediana_boot_pvalue   p.value
##   <chr>                    <dbl>               <dbl>     <dbl>
## 1 samodzielnie0        1.20e-177           1.70e-196 NA       
## 2 samodzielnie1        2.39e-192           1.56e-221  1.36e-11

Nie dostrzegamy znacznych różnic między medianą z p-value, a śrendią z p-value oszacowanym metodą bootstrap, ponieważ wartości są bardzo małe i bliskie zeru.

Nieparametryczne przedziały ufności Bootstrap

boot.ci(DOCHOD.mean.boot,conf=0.95,type=c("norm","perc"))

## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 999 bootstrap replicates
## 
## CALL : 
## boot.ci(boot.out = DOCHOD.mean.boot, conf = 0.95, type = c("norm", 
##     "perc"))
## 
## Intervals : 
## Level      Normal             Percentile     
## 95%   (112.3, 118.4 )   (112.3, 118.3 )  
## Calculations and Intervals on Original Scale

Wnioski

Otrzymano, że: - bootstrap: p-value = 0.2102 - Results without bootstrap: p-value = 0.2146

Na podstawie powyższego można stwierdzić, że p-value dla bootrstapa i bez
w obu przypadkach Testu t-studenta brak podstaw do odrzucenia H0, ponieważ p-value jest większe od alfa=0.05. Oznacza to, ze różnice między średnimi dochodami rodzin studentów w przypadku kiedy studentem była kobiet i mężczyzn są statystycznie nie istotne. Metoda boodstrap jest dobrze dobrana, gdyż wynik p-value jest bardzo zbliżony do p-value z testu bez bootstrapa (N jest wystarczają dużą prbóbką).

1) samodzielnie (Tak/Nie) ~ płec (K/M)

Czy samodzielne zamieszaknie różni się istotnie w zależności od płci studenta?

• Tak różni się istotnie. Przyjmując poziom istotnośći alfa=0.05, na podstawie testu chi2 swierdzamy, że należy odrzucić H0, na rzecz Hipotezy alternatywnej, ponieważ p-value=0.01562 (bez bootstrapa) i p-value = 0.01499 (test z boostrapem) co jest mniejszą wartością od alfa. Oznacza to, że występują istotne różnicę między statusem zamieszkania studenta (samodzielnie lub nie), a płcią studenta.

-Metoda boodstrap jest dobrze dobrana (N jest wystarczają dużą prbóbką) ponieważ test dał bardzo bliski wynik jak bez.

# Przykład 2. Test Chi2 dla dwóch zmiennych jakościowych

attach(studenci)
# Czy status studenta (YES, NO) różni się istotnie wg płci (Male, Female)?
tabelka<-table(samodzielnie,plec)
chisq.test(tabelka,simulate.p.value = TRUE, B = 2000)

## 
##  Pearson's Chi-squared test with simulated p-value (based on 2000
##  replicates)
## 
## data:  tabelka
## X-squared = 6.2865, df = NA, p-value = 0.01699

chisq.test(tabelka) # różnice???

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tabelka
## X-squared = 5.8455, df = 1, p-value = 0.01562

2) rok (1-5) ~ samodzielnie (Tak/Nie)

Czy samodzielne zamieszaknie różni się istotnie w zależności od roku studiów studenta?

# Czy status studenta (YES, NO) różni się istotnie wg płci (Male, Female)?
tabelka2<-table(rok,samodzielnie)
chisq.test(tabelka2,simulate.p.value = TRUE, B = 2000)

## 
##  Pearson's Chi-squared test with simulated p-value (based on 2000
##  replicates)
## 
## data:  tabelka2
## X-squared = 11.12, df = NA, p-value = 0.02799

chisq.test(tabelka2)

## 
##  Pearson's Chi-squared test
## 
## data:  tabelka2
## X-squared = 11.12, df = 4, p-value = 0.02524

• Tak różni się istotnie. p-value< alfa 0.05. Należy odrzucić H0, na rzecz H1.
• Jest to także dodatkowe potwierdzenie, że metoda boodstrap jest dobrze dobrana (N jest wystarczają dużą prbóbką) ponieważ test z bootstrapem dał bardzo bliski wynik jak bez niego.

3) rodzeństwo (tak/nie) ~ samodzielnie mieszka (Tak/Nie)

Czy samodzielne zamieszaknie różni się istotnie w zależności od tego czy student posiadał rodzeństwo?

• Poniższy test wskazuje, że brak istotnych statystycznie różnic. P-value>0.05, co daje brak podstaw do odrzucenia H0.
• To również dodatkowe potwierdzenie, że metoda boodstrap jest dobrze dobrana (N jest wystarczają dużą prbóbką).

## 
##  Pearson's Chi-squared test with simulated p-value (based on 2000
##  replicates)
## 
## data:  tabelka3
## X-squared = 0.47717, df = NA, p-value = 0.5347

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tabelka3
## X-squared = 0.36145, df = 1, p-value = 0.5477

Wnioski

Równiez test ANOVA z bootstrapem wykazał, że przeciętne dochody rodzin istontnie różnią się w zależności czy student mieszkał sam lub nie. Dodatkowo, różnice w oszacowanych parametrach przy zmiennych objaśniających są nieznaczne. Zatem resampling okazał się być dobrze dostosowany i przyniósł spodziewane rezultaty.

Wnioski

Na podstawie powyższych oszacowań ANOVY jendoczynnikowej wykazano, że różnicę pomiędzy średnimi dochodami rodzin, a samodzielnym zamieszkaniem studenta są statystycznie istotne. P-vaule = 1.44e-11 < 0.05 zatem należy odrzucić hipoteze zerową, na rzecz hipotezy alternatywnej.

Pozostałe różnice dla przeciętnych dochodów rodzin, a oddzielnie płci, roku studiów i posiadania rodzeńtwa wykazywały brak istotności statystycznej, p-value>alfa=0.05, co świadczy o braku podstaw do hipotezy zerowej.