Statystyka i Analiza danych

Laboratorium 11 - Metody nieparametryczne

Ćwiczenie 1:

W 1987 roku japońscy producenci postanowili zdobyć amerykański rynek luksusowych samochodów. Honda, a później także Nissan Auto Company doszli do wniosku, że rynek ten zbyt długo był zdominowany przez firmy niemieckie. Firmy japońskie zaprojektowały więc luksusowe samochody, które miały zdobyć rynek amerykański. Pierwszym japońskim luksusowym samochodem osobowym wprowadzonym w Stanach Zjednoczonych była zaprojektowana w pracowni Hondy Acura Legend. Poszukując strategii marketingowych dla nowego samochodu, Honda postanowiła przetestować zadowolenie kierowców z prowadzenia tego auta w porównaniu z odpowiednim modelem BMW. 28 kierowców wybrano losowo spośród grupy ludzi, do których miano skierować reklamę. Poproszono ich o odbycie jazdy próbnej w obydwu samochodach. Kolejność próbowania samochodów była losowo wybierana dla każdego z kierowców. Po jeździe próbnej kierowca oceniał komfort jazdy w skali od 1 do 10 (10 najlepsza). Wyniki tego sondażu są wczytane do ramki danych Samochody. Honda chciała wykazać, że kierowcy z interesującej ich grupy preferują samochód Acura Legend. Czy i jak można to sprawdzić? Uwaga: ze względów dydaktycznych należy najpierw przeprowadzić test dwustronny

In [1]:
Samochody<-data.frame(
  id_kierowcy=1:28,
  bmw=c(6,7,8,9,5,6,9,10,9,6,4,8,6,9,8,9,10,9,3,7,6,10,9,8,8,7,8,9), 
  honda=c(9,10,8,10,7,5,9,9,10,9,6,7,10,8,9,10,9,9,5,9,10,10,8,7,9,10,8,10)
  )

Dane są sparowane - oblicz różnice pomiędzy ocenami

In [2]:
roznice <- Samochody$honda-Samochody$bmw

czy możemy użyć sparowanego testu t? Sprawdź warunki tego testu.

In [3]:
hist(roznice)
qqnorm(roznice)
qqline(roznice)

Na histogramie widać, że rozkład nie jest normalny, a próba nie jest duża... Zastosujmy więc metody nieparametryczne. Zacznijmy od testu znaków. Sformuuj hipotezę zerową i alternatywną i przyjmij poziom istotności $\alpha = 0.05$.

In [4]:
#H0: nie ma różnicy między Hondą a Acurą
#H1: jest różnica między Hondą a Acurą

alpha<-0.05

Oblicz liczbę znaczących par:

In [5]:
n <- sum(roznice!=0)

Oblicz wartość statystyki testowej (liczba różnic dodatnich):

In [6]:
T <- sum(roznice>0)
T
16

Sprawdź wartości krytyczne wyznaczając dokładne kwantyle z rozkłądu dwumianowego (bez przybliżenia normalnego):

In [7]:
qbinom(alpha/2, n, 0.5) - 1
qbinom(1-(alpha/2), n, 0.5) + 1
6
17

Czy odrzucamy hipotezę zerową?

In [8]:
# nie

Wykonaj ten test funkcją binom.test:

In [9]:
binom.test(T, n)
	Exact binomial test

data:  T and n
number of successes = 16, number of trials = 23, p-value = 0.09314
alternative hypothesis: true probability of success is not equal to 0.5
95 percent confidence interval:
 0.4708083 0.8678971
sample estimates:
probability of success 
             0.6956522 

Ćwiczenie 1b

Spróbujmy zastosować do tego samego problemu test Wilcoxona. Ponieważ w tym teście również będziemy brali pod uwagę jedynie znaczące różnice, aby ułatwić sobie obliczenia stwórz wektor zawierający jedynie znaczące różnice.

In [10]:
roznice<-roznice[roznice!=0]

Oblicz moduł różnic:

In [11]:
modul_roznic<-abs(roznice)

Przypisz rangi różnicom poprzez wywołanie funkcji rank()

In [12]:
rangi_modulow<-rank(modul_roznic)

Oblicz sumę rang dodatnich i ujemnych różnic:

In [13]:
dodatnie<-sum(rangi_modulow[roznice>0])
ujemne<-sum(rangi_modulow[roznice<0])

Oblicz wartość statystyki testowej

In [14]:
T <- min(dodatnie,ujemne)
T
49

Sprawdź wartość krytyczną (rozkład w R nazywa się signrank):

In [15]:
qsignrank(alpha/2, length(rangi_modulow)) - 1
73

Alternatywnie, można policzyć również p-wartość:

In [16]:
psignrank(T ,length(rangi_modulow))*2
0.00541448593139648

Odrzucić hipotezę zerową?

In [17]:
# tak

Wykonaj test Wilcoxona przy użyciu funkcji wilcox.test

In [18]:
wilcox.test(Samochody$bmw,Samochody$honda , paired = T)
Warning message in wilcox.test.default(Samochody$bmw, Samochody$honda, paired = T):
“cannot compute exact p-value with ties”
Warning message in wilcox.test.default(Samochody$bmw, Samochody$honda, paired = T):
“cannot compute exact p-value with zeroes”
	Wilcoxon signed rank test with continuity correction

data:  Samochody$bmw and Samochody$honda
V = 49, p-value = 0.005892
alternative hypothesis: true location shift is not equal to 0

Ćwiczenie 2

Wygeneruj wektor X liczb losowych z rozkładu jednorodnego [0,1] oraz wektor Y z rozkładu jednorodnego [1,2].

In [19]:
X<-runif(50)
Y<-runif(50, 1, 2)

Policz współczynnik korelacji Spearmana poprzez policzenie korelacji na rangach wektorów X i Y:

In [20]:
rX <- rank(X)
rY <- rank(Y)
cor(rX, rY)
-0.0226170468187275

Sprawdź ile będzie wynosił współczynnik korelacji Spearman'a dla zależności liniowej np. $Z=2X$. Ile będzie wynosił współczynnik korelacji Pearson'a?

In [21]:
Z <- 2*X
cor(X, Z)
cor(rX, rank(Z))
1
1

Zwizualizuj wektory X i Z przed i po rangowaniu.

In [22]:
plot(X,Z)
plot(rank(X),rank(Z))

Sprawdź ile będzie wynosił współczynnik korelacji Spearman'a dla zależności $Z=X^4$. Ile będzie wynosił współczynnik korelacji Pearson'a?

In [23]:
Z <- X**4
cor(X, Z)
cor(rX, rank(Z))
0.874683025192961
1

Zwizualizuj wektory X i Z przed i po rangowaniu.

In [24]:
plot(X,Z)
plot(rank(X),rank(Z))

Sprawdź ile będzie wynosił współczynnik korelacji Spearman'a dla zależności $Z=X^4$, ale dodaj do niej trochę szumu z rozkładu normalnego

In [25]:
Z<-X**4 + 0.1*rnorm(length(Z))
cor(rX, rank(Z))
0.794669867947179

Zwizualizuj wektory X i Z przed i po rangowaniu.

In [26]:
plot(X,Z)
plot(rank(X),rank(Z))

Olicz współczynnik korelacji Spearman'a pomiędzy wektorami X i Z z wykorzystaniem funkcji cor - znajdź w pomocy odpowiedni parametr

In [27]:
cor(X, Z, method='spearman')
0.794669867947179

Ćwiczenie 3

Unia Europejska postanowiła zmniejszyć dotacje dla producentów makaronu. W ramach ustalania, o ile zmniejszyć całkowite dotacje, przeprowadzono eksperymenty mające na celu określenie możliwego spadku eksportu, głównie do Stanów Zjednoczonych, wynikającego z redukcji dotacji. Ekonomiści chcieli sprawdzić w wąskim zakresie wartości, czy istnieje dodatnia korelacja między poziomem dotacji a poziomem eksportu. Przeprowadzono symulację komputerową zmiennych ekonomicznych mających znaczenie dla rynków eksportu makaronu. Wyniki znajdują się poniżej. Zakładając, że wyniki symulacji są dokładnym opisem rzeczywistości, a otrzymane wartości mogą być uważane za próbę losową pobrana z populacji możliwych wyników, ustal, czy istnieje dodatnia korelacja rang między poziomem dotacji i poziomem eksportu.

In [28]:
Dane <- data.frame(
    dotacje <- c(5.1,5.3,5.2,4.9,4.8,4.7,4.5,5,4.6,4.4,5.4), 
    eksport <- c(22,30,35,29,27,36,40,39,42,45,21) 
)

Oblicz współczynnik korelacji Spearman'a i zinterpretuj go

In [29]:
cor(Dane$dotacje, Dane$eksport, method='spearman')
-0.754545454545455

Postaw hipotezę zerową i alternatywną i istotności współczynnika korelacji Spearmana:

In [30]:
# H0 r_s = 0
# H1 r_s != 0

Policz test funkcją cor.test z odpowiednim parametrem, aby test dotyczył korelacji Spearmana

In [31]:
cor.test(Dane$dotacje, Dane$eksport,method="spearman")
	Spearman's rank correlation rho

data:  Dane$dotacje and Dane$eksport
S = 386, p-value = 0.01048
alternative hypothesis: true rho is not equal to 0
sample estimates:
       rho 
-0.7545455 

Wniosek z testu:

In [32]:
# Odrzucamy H_0