Statystyka i Analiza danych

Laboratorium 2 - Statystyka opisowa

Powtórka

Stwórz wektor dane zawierający następujące liczby

1123, 198, 473, 784, 305, 423, 397, 298, 698, 237
In [1]:
dane <- c(1123, 198, 473, 784, 305, 423, 397, 298, 698, 237)

Następnie wypisz liczby z tego wektora przemnożone przez 2

In [2]:
dane * 2
  1. 2246
  2. 396
  3. 946
  4. 1568
  5. 610
  6. 846
  7. 794
  8. 596
  9. 1396
  10. 474

Przekonwertuj podane temperatury w Fahrenheitach na stopnie Celsjusza fahrenheit<-c(32, 59, 86). Wzór na konwersję masz podany poniżej. $$c = \frac{(f-32)\cdot 5}{9}$$

In [3]:
fahrenheit <- c(32, 59, 86)
(fahrenheit-32)*5/9
  1. 0
  2. 15
  3. 30

Wypisz:

  • piąty element wektora dane
In [4]:
dane[5]
305
  • pierwszy i piąty element wektora dane (razem!)
In [5]:
dane[c(1,5)]
  1. 1123
  2. 305

Ćwiczenie 1

Porównaj medianę i średnią dla liczby punktów zdobytych przez zawodników drużyny A i drużyny B -- jakie wnioski możesz wysnuć na podstawie tych danych?

In [6]:
team_a <- c(8,5,4,38,10,5,2,0)
names(team_a) <- c('Andrzej U.', 'Artur M.', 'Grzegorz W.', 'Jan W.', 'Marek M.', 'Mikołaj S.', 'Rafal R.', 'Stefan G.')

team_b <- c(12, 15, 18, 8, 0, 2, 10, 23)
names(team_b) <- c('Andrzej J.', 'Jacek J.', 'Jerzy S.', 'Krzysztof K.', 'Maciej H.', 'Maciej K.', 'Pawel K.', 'Roman S.')

Wypisz wartość wektorów team_a i team_b

In [7]:
team_a
team_b
Andrzej U.
8
Artur M.
5
Grzegorz W.
4
Jan W.
38
Marek M.
10
Mikołaj S.
5
Rafal R.
2
Stefan G.
0
Andrzej J.
12
Jacek J.
15
Jerzy S.
18
Krzysztof K.
8
Maciej H.
0
Maciej K.
2
Pawel K.
10
Roman S.
23

Policz średnią i medianę dla team_a na kartce, a następnie sprawdź w R

In [8]:
mean(team_a)
median(team_a)
9
5

Policz średnią i medianę dla team_b na kartce, a następnie sprawdź w R

In [9]:
mean(team_b)
median(team_b)
11
11

Jakie wnioski możesz wysnuć na podstawie tych danych?

Cwiczenie 1b

Do wyników obu drużyn dodaj dodatkowego uczestnika z liczbą punktów 1000.

In [10]:
team_a2 <- c(team_a, 1000)
team_b2 <- c(team_b, 1000)

Jak zmieniła się średnia? Jak zmieniła się mediana?

In [11]:
mean(team_a2)
median(team_a2)
mean(team_b2)
median(team_b2)
119.111111111111
5
120.888888888889
12

Ćwiczenie 2 (*)

Policzmy średnią i medianę czterech załadowanych do pamięci rozkładów (dane1, dane2, dane3, dane4).

In [12]:
dane1 <- c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
dane2 <- c(-2, -2, -2, -2, -2, -1, 0, 0, 0, 0, 0, 1, 2, 2, 2, 2, 2)
dane3 <- c(-2, -2, 1, 1, 1, 1, 0, 0, 0, 0, 0, -1, -1, -1, -1, 2, 2)
dane4 <- c(-4, -3, -2, -1, -1, -1, 0, 0, 0, 0, 0, 1, 1, 1, 2, 3, 4)

zbiory_danych <- list(dane1, dane2, dane3, dane4)
for ( i in 1:length(zbiory_danych) ){
    print(paste("Srednia i mediana dla zbioru ", i)) 
    dane <- zbiory_danych[[i]]
    # Wypisz średnią i medianę dla zmiennej dane <------------ MIEJSCE NA TWÓJ KOD
    print(c(mean(dane), median(dane)))
}
[1] "Srednia i mediana dla zbioru  1"
[1] 0 0
[1] "Srednia i mediana dla zbioru  2"
[1] 0 0
[1] "Srednia i mediana dla zbioru  3"
[1] 0 0
[1] "Srednia i mediana dla zbioru  4"
[1] 0 0

Wydaje się że są to zbiory bardzo podobne do siebie, skoro średnia i mediana są dla nich takie same. Zwizualizujmy te zbiory na wykresie!

In [13]:
par(mfrow=c(2,2)) 
    barplot(table(dane1), main="Dane 1")
    barplot(table(dane2), main="Dane 2")
    barplot(table(dane3), main="Dane 3")
    barplot(table(dane4), main="Dane 4")

Rzeczywiście, rozkłady te mają taką samą średnią i medianę, jednak pomimo tego znacząco się od siebie różnią. Jedną z cech, które je różnicują jest ich wariancja.

Zaimplementuj funkcje wariancja i odchylenie_std.

In [14]:
wariancja <- function(dane){
    sum((dane- mean(dane))^2) / (length(dane)-1)
}

odchylenie_std <- function(dane){
    sqrt(wariancja(dane))
}

zbiory_danych <- list(dane1, dane2, dane3, dane4)
for ( i in 1:length(zbiory_danych) ){
    print(paste("Statystyki opisowe dla zbioru ", i)) 
    dane <- zbiory_danych[[i]]
    print(c(Srednia=mean(dane), Mediana=median(dane), Wariancja = wariancja(dane), Odchylenie = odchylenie_std(dane)))
}
[1] "Statystyki opisowe dla zbioru  1"
   Srednia    Mediana  Wariancja Odchylenie 
         0          0          0          0 
[1] "Statystyki opisowe dla zbioru  2"
   Srednia    Mediana  Wariancja Odchylenie 
  0.000000   0.000000   2.625000   1.620185 
[1] "Statystyki opisowe dla zbioru  3"
   Srednia    Mediana  Wariancja Odchylenie 
  0.000000   0.000000   1.500000   1.224745 
[1] "Statystyki opisowe dla zbioru  4"
   Srednia    Mediana  Wariancja Odchylenie 
         0          0          4          2 

Do przestrzeni załadowano 4 nowe zbiory danych. Uzupełnij kod obliczający ich statystyki opisowe i zinterpretuj wyniki. W R są oczywiście gotowe funkcje na odchylenie standardowe sd i wariancje var.

In [15]:
dane1 <-c(-4 ,-4 ,-4 ,-4 ,-4 ,-4 ,-3 ,-3 ,-3 ,-3 ,-2 ,-2 ,-2 ,-1 ,-1 ,0 ,1 )
dane2 <- c(4 ,4 ,4 ,4 ,4 ,4 ,3 ,3 ,3 ,3 ,2 ,2 ,2 ,1 ,1 ,0 ,-1 )
dane3 <- c(-4 ,-3 ,-2 ,-1 ,-1 ,-1 ,0 ,0 ,0 ,0 ,0 ,1 ,1 ,1 ,2 ,3 ,4 )
dane4 <- c(-2 ,-2 ,-1 ,-1 ,-1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,1 ,1 ,2 ,2 -1,1,-1,1,2,-2,2,-1,-1,-2,2,-2,2,-3,3,-3,3,-3,3,-3,3,-3,3,-2,2,-3,3)


zbiory_danych <- list(dane1, dane2, dane3, dane4)
for ( i in 1:length(zbiory_danych) ){
    print(paste("Statystyki opisowe dla zbioru ", i)) 
    dane <- zbiory_danych[[i]]
    
    # Uzupełnij kod dla wariancji i odchylenia standardowego
    print(c(Srednia=mean(dane), Mediana=median(dane), Wariancja = var(dane), Odchylenie = sd(dane)))
}
[1] "Statystyki opisowe dla zbioru  1"
   Srednia    Mediana  Wariancja Odchylenie 
 -2.529412  -3.000000   2.389706   1.545867 
[1] "Statystyki opisowe dla zbioru  2"
   Srednia    Mediana  Wariancja Odchylenie 
  2.529412   3.000000   2.389706   1.545867 
[1] "Statystyki opisowe dla zbioru  3"
   Srednia    Mediana  Wariancja Odchylenie 
         0          0          4          2 
[1] "Statystyki opisowe dla zbioru  4"
   Srednia    Mediana  Wariancja Odchylenie 
         0          0          4          2 

Znów spróbujmy zwizualizować zbiory

In [16]:
par(mfrow=c(2,2)) 
    barplot(table(dane1), main="Dane 1", ylim = c(0,7))
    barplot(table(dane2), main="Dane 2", ylim = c(0,7))
    barplot(table(dane3), main="Dane 3", ylim = c(0,7))
    barplot(table(dane4), main="Dane 4", ylim = c(0,7))

Zaimplementuj ogólną funkcję obliczającą asymetrię i kurtozę. Zinterpretuj uzyskane wyniki.

In [22]:
moment_centralny <- function(dane, rzad){
    mean((dane - mean(dane)) ^ rzad)
}

std <- function (dane){
    sqrt(moment_centralny(dane, 2))
}

skosnosc <- function(dane){
    moment_centralny(dane,3) / std(dane)^3
    
}

kurtoza <- function(dane){
    moment_centralny(dane,4) / std(dane)^4
}

#Nie zmieniaj kodu poniżej
zbiory_danych <- list(dane1, dane2, dane3, dane4)
for ( i in 1:length(zbiory_danych) ){
    print(paste("Statystyki opisowe dla zbioru ", i)) 
    dane <- zbiory_danych[[i]]
    print(c(Skewness = skosnosc(dane), Kurtosis = kurtoza(dane)))
}

print("---")

#Korzystająć z biblioteki PerformanceAnalytics
library(PerformanceAnalytics)
print(c(Skewness = skewness(dane1), Kurtosis = kurtosis(dane1, method="moment")))
print(c(Skewness = skewness(dane1, method="sample"), Kurtosis = kurtosis(dane1, method="sample")))
[1] "Statystyki opisowe dla zbioru  1"
 Skewness  Kurtosis 
0.8414287 2.7389586 
[1] "Statystyki opisowe dla zbioru  2"
  Skewness   Kurtosis 
-0.8414287  2.7389586 
[1] "Statystyki opisowe dla zbioru  3"
Skewness Kurtosis 
0.000000 2.955078 
[1] "Statystyki opisowe dla zbioru  4"
Skewness Kurtosis 
0.000000 1.791667 
[1] "---"
 Skewness  Kurtosis 
0.8414287 2.7389586 
Skewness Kurtosis 
1.013220 3.756286 

 Ćwiczenie 3

Przyjmijmy, że zamierzamy prowadzić analizę prowizji płaconej sprzedawcom zatrudnionym w pewnej firmie. W załączeniu zawarte są dane o prowizjach w dwóch grupach po 21 sprzedawców (prowizje za pewien okres wyrażane są w złotych z dokładnością do 1000 zł). Po obliczeniu podstawowych statystyk opisowych porównaj obie grupy sprzedawców i dokonaj interpretacji dokonanych obserwacji.

In [18]:
grupa1 <- c(13000 ,14000 ,12000 ,15000 ,16000 ,15000 ,17000 ,15000 ,17000 ,15000 ,15000 ,15000 ,16000 ,15000 ,16000 ,14000 ,16000 ,14000 ,16000 ,17000 ,18000)
grupa2 <- c(6000 ,23000 ,13000 ,7000 ,7000 ,20000 ,21000 ,12000 ,11000 ,16000 ,20000 ,21000 ,9000 ,7000 ,15000 ,18000 ,19000 ,22000 ,16000 ,21000 ,17000)
In [19]:
barplot(table(grupa1))
summary(grupa1)
round(c(SD= sd(grupa1),
Skewness = skosnosc(grupa1),
Kurtosis = kurtoza(grupa1)),4)

barplot(table(grupa2))
summary(grupa2)
round(c(SD= sd(grupa2),
Skewness = skosnosc(grupa2),
Kurtosis = kurtoza(grupa2)),4)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
  12000   15000   15000   15286   16000   18000 
SD
1419.2553
Skewness
-0.305
Kurtosis
3.0224
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   6000   11000   16000   15286   20000   23000 
SD
5649.273
Skewness
-0.3619
Kurtosis
1.7335

Ćwiczenie 4

Pociąg z Moskwy do Paryża przebywa poszczególne odcinki drogi z różną prędkością średnia ze względu na różny stan i typ taboru kolejowego. Odcinki, ich długość i średnia prędkość podana jest w tabeli poniżej. Oblicz średnią prędkość pociągu z jaką przebywa cała drogą z Moskwy do Paryża (dane przykładowe, dalekie od rzeczywistych :).

In [20]:
dane <- data.frame(Odcinek = 1:9, Odległosc = c(850, 600, 30, 220, 200, 150, 220, 300, 250), Srednia_predkosc = c(80, 75, 40, 120, 125, 140, 160, 150, 160))
dane
A data.frame: 9 × 3
OdcinekOdległoscSrednia_predkosc
<int><dbl><dbl>
1850 80
2600 75
3 30 40
4220120
5200125
6150140
7220160
8300150
9250160
In [21]:
sum(dane$Odległosc)/sum(dane$Odległosc/dane$Srednia_predkosc)
97.8580133435234