{ "cells": [ { "cell_type": "markdown", "metadata": {}, "source": [ "## Statystyka i Analiza danych\n", "# Laboratorium 11 - Metody nieparametryczne" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "### Ćwiczenie 1: \n", "\n", "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ć? \n", "**Uwaga: ze względów dydaktycznych należy najpierw przeprowadzić test dwustronny**" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "Samochody<-data.frame(\n", " id_kierowcy=1:28,\n", " 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), \n", " 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)\n", " )" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Dane są sparowane - oblicz różnice pomiędzy ocenami" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "roznice <- " ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "czy możemy użyć sparowanego testu t? Sprawdź warunki tego testu." ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "hist(roznice)\n", "qqnorm(roznice)\n", "qqline(roznice)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Na histogramie widać, że rozkład nie jest normalny, a próba nie jest duża...\n", "Zastosujmy więc metody **nieparametryczne**. Zacznijmy od testu znaków. Sformuuj hipotezę zerową i alternatywną i przyjmij poziom istotności $\\alpha = 0.05$." ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "#H0: \n", "#H1: \n", "\n", "alpha<-0.05" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Oblicz liczbę znaczących par:" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "n <- " ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Oblicz wartość statystyki testowej (liczba różnic dodatnich):" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "T <- " ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Sprawdź wartości krytyczne wyznaczając *dokładne* kwantyle z rozkłądu *dwumianowego* (bez przybliżenia normalnego):" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "qbinom(alpha/2, n, 0.5) - 1\n", "qbinom(1-(alpha/2), n, 0.5) + 1" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Czy odrzucamy hipotezę zerową?" ] }, { "cell_type": "code", "execution_count": null, "metadata": { "collapsed": true }, "outputs": [], "source": [ "# " ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Wykonaj ten test funkcją ``binom.test``:" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "binom.test(T, n)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "### Ćwiczenie 1b\n", "\n", "Spróbujmy zastosować do tego samego problemu **test Wilcoxona**.\n", "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." ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "roznice<-" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Oblicz moduł różnic:" ] }, { "cell_type": "code", "execution_count": null, "metadata": { "scrolled": true }, "outputs": [], "source": [ "modul_roznic<-" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Przypisz rangi różnicom poprzez wywołanie funkcji ``rank()``" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "rangi_modulow<-" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Oblicz sumę rang dodatnich i ujemnych różnic:" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "dodatnie<-\n", "ujemne<-" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Oblicz wartość statystyki testowej" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "T <- " ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Sprawdź wartość krytyczną (rozkład w ``R`` nazywa się signrank):" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "qsignrank(alpha/2, length(rangi_modulow)) - 1" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Alternatywnie, można policzyć również wartość krytyczną:" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "psignrank(T ,length(rangi_modulow))*2" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Odrzucić hipotezę zerową?" ] }, { "cell_type": "code", "execution_count": null, "metadata": { "collapsed": true }, "outputs": [], "source": [ "# Tak, Honda i BMW są znacząco różne" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Wykonaj test Wilcoxona przy użyciu funkcji ``wilcox.test``" ] }, { "cell_type": "code", "execution_count": null, "metadata": { "scrolled": true }, "outputs": [], "source": [ "wilcox.test(Samochody$bmw,Samochody$honda , paired = T)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "### Ćwiczenie 2\n", "\n", "Wygeneruj wektor *X* liczb losowych z rozkładu jednorodnego *[0,1]* oraz wektor *Y* z rozkładu jednorodnego *[1,2]*." ] }, { "cell_type": "code", "execution_count": null, "metadata": { "collapsed": true }, "outputs": [], "source": [ "X<-runif(50)\n", "Y<-runif(50, 1, 2)" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Policz **współczynnik korelacji Spearmana** poprzez policzenie korelacji na rangach wektorów *X* i *Y*:" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [] }, { "cell_type": "markdown", "metadata": {}, "source": [ "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?" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "Z <- 2*X\n" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Zwizualizuj wektory *X* i *Z* przed i po rangowaniu." ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "plot(X,Z)\n", "plot(rank(X),rank(Z))" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "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?" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "Z <- X^4\n" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Zwizualizuj wektory *X* i *Z* przed i po rangowaniu." ] }, { "cell_type": "code", "execution_count": null, "metadata": { "collapsed": true }, "outputs": [], "source": [] }, { "cell_type": "markdown", "metadata": {}, "source": [ "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" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "Z<-X^4 + 0.1*rnorm(length(Z))\n" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Zwizualizuj wektory *X* i *Z* przed i po rangowaniu." ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Olicz współczynnik korelacji Spearman'a pomiędzy wektorami *X* i *Z* z wykorzystaniem funkcji ``cor`` - znajdź w pomocy odpowiedni parametr" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [] }, { "cell_type": "markdown", "metadata": {}, "source": [ "### Ćwiczenie 3\n", "\n", "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." ] }, { "cell_type": "code", "execution_count": null, "metadata": { "collapsed": true }, "outputs": [], "source": [ "Dane <- data.frame(\n", " dotacje <- c(5.1,5.3,5.2,4.9,4.8,4.7,4.5,5,4.6,4.4,5.4), \n", " eksport <- c(22,30,35,29,27,36,40,39,42,45,21) \n", ")" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Oblicz współczynnik korelacji Spearman'a i zinterpretuj go" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Postaw hipotezę zerową i alternatywną i istotności współczynnika korelacji Spearmana:" ] }, { "cell_type": "code", "execution_count": null, "metadata": { "collapsed": true }, "outputs": [], "source": [ "# H0: \n", "# H1: " ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Policz test funkcją ``cor.test`` z odpowiednim parametrem, aby test dotyczył korelacji Spearmana" ] }, { "cell_type": "code", "execution_count": null, "metadata": {}, "outputs": [], "source": [ "cor.test(Dane$dotacje, Dane$eksport,method=\"spearman\")" ] }, { "cell_type": "markdown", "metadata": {}, "source": [ "Wniosek z testu:" ] }, { "cell_type": "code", "execution_count": null, "metadata": { "collapsed": true }, "outputs": [], "source": [ "#" ] } ], "metadata": { "kernelspec": { "display_name": "R", "language": "R", "name": "ir" }, "language_info": { "codemirror_mode": "r", "file_extension": ".r", "mimetype": "text/x-r-source", "name": "R", "pygments_lexer": "r", "version": "3.6.3" } }, "nbformat": 4, "nbformat_minor": 2 }