WSTĘP
BIBLIOTEKI
library(dplyr)
library(ggplot2)
library(car)
library("VIM")
library(readxl)ZAŁADOWANIE DANYCH
dane <- read.csv("C:/Users/majko/OneDrive/Dokumenty/Zajecia_WZR/PRZYGOTOWANIE_DANYCH/Insurance/train3.csv", sep = ";")
head(dane,10)## Gender Age Driving_License Region_Code Previously_Insured Vehicle_Age
## 1 Male 44 1 28 0 > 2 Years
## 2 Male 76 1 3 0 1-2 Year
## 3 Male 47 1 28 0 > 2 Years
## 4 Male 21 1 11 1 < 1 Year
## 5 Female NA 1 41 1 < 1 Year
## 6 Female 24 1 33 0 < 1 Year
## 7 Male 23 1 11 0 < 1 Year
## 8 Female 56 1 28 0 1-2 Year
## 9 Female 24 1 3 1 < 1 Year
## 10 Female 32 1 6 1 < 1 Year
## Vehicle_Damage Annual_Premium Policy_Sales_Channel Vintage Response
## 1 Yes 40454 26 217 1
## 2 No 33536 26 183 0
## 3 Yes 38294 26 27 1
## 4 No 28619 152 203 0
## 5 No 27496 152 39 0
## 6 Yes 2630 160 176 0
## 7 Yes 23367 152 249 0
## 8 Yes 32031 26 72 1
## 9 No 27619 NA 28 0
## 10 No 28771 NA 80 0
## Year_Birth
## 1 1978
## 2 1946
## 3 1975
## 4 2001
## 5 1993
## 6 1998
## 7 1999
## 8 1966
## 9 1998
## 10 1990SKALE POMIAROWE
SKALA NOMINALNA
skala dychotomiczna
table(dane$Gender)##
## Female Male
## 4 175018 206087ggplot(dane , aes(x=factor(Gender), fill=factor(Gender))) +
geom_bar() +
theme(legend.position="none")
skala nominalna
Region_Code
table(dane$Region_Code)##
## 0 1 2 3 4 5 6 7 8 9 10
## 2021 1008 4038 9251 1801 1279 6280 3279 33877 3101 4374
## 11 12 13 14 15 16 17 18 19 20 21
## 9232 3198 4036 4678 13308 2007 2617 5153 1535 1935 4266
## 22 23 24 25 26 27 28 29 30 31 32
## 1309 1960 2415 2503 2587 2823 106415 11065 12191 1960 2787
## 33 34 35 36 37 38 39 40 41 42 43
## 7654 1664 6942 8797 5501 2026 4644 1295 18263 591 2639
## 44 45 46 47 48 49 50 51 52
## 808 5605 19749 7436 4681 1832 10243 183 267ggplot(dane , aes(x=factor(Region_Code), fill=factor(Region_Code))) +
geom_bar() +
theme(legend.position="none")
SKALA PORZĄDKOWA
vehicle_age
table(dane$Vehicle_Age)##
## < 1 Year > 2 Years 1-2 Year
## 4 164784 16007 200314ggplot(dane , aes(x=factor(Vehicle_Age), fill=factor(Vehicle_Age))) +
geom_bar() +
theme(legend.position="none")
SKALA PEZEDZIAŁOWA
table(dane$Year_Birth)##
## 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949
## 11 11 22 29 56 909 915 1216 1388 1396 1605 1832 1925
## 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962
## 2035 2051 2349 2530 2440 2624 2725 2791 2850 3084 3104 3341 3534
## 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975
## 3614 3822 3944 4063 4495 4997 5331 5590 5915 6263 6615 7113 7351
## 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988
## 7879 8183 8357 8437 8007 7736 7168 6460 5710 5408 5066 4936 4895
## 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001
## 5010 4998 5512 6258 7429 8974 10760 13535 20636 25960 24256 20964 16457
## 2002
## 6232ggplot(dane , aes(x=factor(Year_Birth), fill=factor(Year_Birth))) +
geom_bar() +
theme(legend.position="none")
SKALA ILORAZOWA
age
mean(dane$Age)## [1] NAggplot(dane, aes(x=Age)) +
geom_histogram(color="white", fill="darkgrey")## ## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 18 rows containing non-finite values (`stat_bin()`).
ZADANIE 1
Określ skale pomiarowe dla wszystkich zmiennych w zbiorze. Zwizualizuj je.
PRZEKSZTAŁCANIE SKAL POMIAROWYCH
SKALA ILORAZOWA NA SKALĘ PORZĄDKOWĄ
dane$age_1 <- recode(dane$Age, "18:24 ='<25'; 25:35= '25-35' ; 36:46='36-46' ; ;else = '>46'")
table(dane$age_1)##
## <25 >46 25-35 36-46
## 93864 115899 92936 78410ZADANIE
Zmień skalę pomiarową dla zmiennej “Region_Code”.
PODSTAWOWE STATYSTYKI
summary(dane)## Gender Age Driving_License Region_Code
## Length:381109 Min. :20.00 Min. :0.0000 Min. : 0.00
## Class :character 1st Qu.:25.00 1st Qu.:1.0000 1st Qu.:15.00
## Mode :character Median :36.00 Median :1.0000 Median :28.00
## Mean :38.82 Mean :0.9979 Mean :26.39
## 3rd Qu.:49.00 3rd Qu.:1.0000 3rd Qu.:35.00
## Max. :85.00 Max. :1.0000 Max. :52.00
## NA's :18
## Previously_Insured Vehicle_Age Vehicle_Damage Annual_Premium
## Min. :0.0000 Length:381109 Length:381109 Min. : 2630
## 1st Qu.:0.0000 Class :character Class :character 1st Qu.: 24405
## Median :0.0000 Mode :character Mode :character Median : 31668
## Mean :0.4582 Mean : 30564
## 3rd Qu.:1.0000 3rd Qu.: 39400
## Max. :1.0000 Max. :540165
## NA's :17
## Policy_Sales_Channel Vintage Response Year_Birth
## Min. : 1 Min. : 10.0 Min. :0.0000 Min. :1937
## 1st Qu.: 29 1st Qu.: 82.0 1st Qu.:0.0000 1st Qu.:1973
## Median :133 Median :154.0 Median :0.0000 Median :1986
## Mean :112 Mean :154.3 Mean :0.1226 Mean :1983
## 3rd Qu.:152 3rd Qu.:227.0 3rd Qu.:0.0000 3rd Qu.:1997
## Max. :163 Max. :299.0 Max. :1.0000 Max. :2002
## NA's :3
## age_1
## Length:381109
## Class :character
## Mode :character
##
##
##
## IMPUTACJE DANYCH
Analiza braków danych
dane<-as.data.frame(dane)
head(dane,10)## Gender Age Driving_License Region_Code Previously_Insured Vehicle_Age
## 1 Male 44 1 28 0 > 2 Years
## 2 Male 76 1 3 0 1-2 Year
## 3 Male 47 1 28 0 > 2 Years
## 4 Male 21 1 11 1 < 1 Year
## 5 Female NA 1 41 1 < 1 Year
## 6 Female 24 1 33 0 < 1 Year
## 7 Male 23 1 11 0 < 1 Year
## 8 Female 56 1 28 0 1-2 Year
## 9 Female 24 1 3 1 < 1 Year
## 10 Female 32 1 6 1 < 1 Year
## Vehicle_Damage Annual_Premium Policy_Sales_Channel Vintage Response
## 1 Yes 40454 26 217 1
## 2 No 33536 26 183 0
## 3 Yes 38294 26 27 1
## 4 No 28619 152 203 0
## 5 No 27496 152 39 0
## 6 Yes 2630 160 176 0
## 7 Yes 23367 152 249 0
## 8 Yes 32031 26 72 1
## 9 No 27619 NA 28 0
## 10 No 28771 NA 80 0
## Year_Birth age_1
## 1 1978 36-46
## 2 1946 >46
## 3 1975 >46
## 4 2001 <25
## 5 1993 >46
## 6 1998 <25
## 7 1999 <25
## 8 1966 >46
## 9 1998 <25
## 10 1990 25-35plot_missing<-aggr(dane, col=c('darkgrey','tomato'),
numbers=TRUE, sortVars=TRUE,
labels=names(dane), cex.axis=0.6,
cex.lab=1.5,
gap=1, ylab=c('Braki',"Wzór braków"))
##
## Variables sorted by number of missings:
## Variable Count
## Age 4.723058e-05
## Annual_Premium 4.460666e-05
## Policy_Sales_Channel 7.871764e-06
## Gender 0.000000e+00
## Driving_License 0.000000e+00
## Region_Code 0.000000e+00
## Previously_Insured 0.000000e+00
## Vehicle_Age 0.000000e+00
## Vehicle_Damage 0.000000e+00
## Vintage 0.000000e+00
## Response 0.000000e+00
## Year_Birth 0.000000e+00
## age_1 0.000000e+00 summary(aggr(dane, plot=FALSE))##
## Missings per variable:
## Variable Count
## Gender 0
## Age 18
## Driving_License 0
## Region_Code 0
## Previously_Insured 0
## Vehicle_Age 0
## Vehicle_Damage 0
## Annual_Premium 17
## Policy_Sales_Channel 3
## Vintage 0
## Response 0
## Year_Birth 0
## age_1 0
##
## Missings in combinations of variables:
## Combinations Count Percent
## 0:0:0:0:0:0:0:0:0:0:0:0:0 381071 9.999003e+01
## 0:0:0:0:0:0:0:0:1:0:0:0:0 3 7.871764e-04
## 0:0:0:0:0:0:0:1:0:0:0:0:0 17 4.460666e-03
## 0:1:0:0:0:0:0:0:0:0:0:0:0 18 4.723058e-03Imputacja
Zmienna “age”
Średnia arytmetyczna
dane$Age<-as.numeric(dane$Age)
dane<-dane%>%
mutate(age3=if_else(is.na(Age), mean(Age,na.rm = T), Age))Mediana
dane<-dane%>%
mutate(age3=if_else(is.na(Age), median(Age,na.rm = T), Age))ZADANIE 2
Sprawdź podstawowe statytyki po imputacji. Co się zmieniło?
ZADANIE 3
Proszę dokonać imputacji zmiennej “Annual_Premium” za pomocą średniej i mediany. Jak zmieni się rozkład zmiennej?
TRANSFORMACJE
http://keii.ue.wroc.pl/przeglad/Rok%202014/Zeszyt%204/2014_61_4_363-372.pdf
SKALA ILORAZOWA:
-PRZEKSZTAŁCENIA ILORAZOWE
-ISTNIEJE ABSOLUTNY PUNKT ZEROWY
SKALI PRZEDZIAŁOWA BĄDŹ PRZEDZIAŁOWA I ILORAZOWA
## Warning: pakiet 'clusterSim' został zbudowany w wersji R 4.1.3## Ładowanie wymaganego pakietu: cluster## Ładowanie wymaganego pakietu: MASS##
## Dołączanie pakietu: 'MASS'## Następujący obiekt został zakryty z 'package:dplyr':
##
## selectPRZEKSZTAŁCENIA ILORAZOWE
ANALIZA WARTOŚCI SKRAJNYCH
library(gridExtra)##
## Dołączanie pakietu: 'gridExtra'## Następujący obiekt został zakryty z 'package:dplyr':
##
## combinex = c(10,4,6,8,9,8,7,6,12,14,11,9,8,4,5,10,14,12,15,7,10,14,24,28)
# histogram, Q-Q plot i boxplot
par(mfrow = c(1, 3))
hist(x, main = "Histogram")
boxplot(x, main = "Boxplot")
qqnorm(x, main = "Normal Q-Q plot") # wykres kwartyl-kwartyl
# średnia i odchylenie standardowe
mean = mean(x)
std = sd(x)
# wykorzystanie reguły 3 odchyleń
Tmin = mean-(3*std)
Tmax = mean+(3*std)
# znalezienie outliersów - wartości skrajnych
x[which(x < Tmin | x > Tmax)]## [1] 28# wyrzucenie wartości skrajnych
x[which(x > Tmin & x < Tmax)]## [1] 10 4 6 8 9 8 7 6 12 14 11 9 8 4 5 10 14 12 15 7 10 14 24Mediana i odchylenie medianowe
# dane
x = c(10,4,6,8,9,8,7,6,12,14,11,9,8,4,5,10,14,12,15,7,10,14,24,28)
# mediana
med = median(x)
# odchyelnie od mediany dla każej wartości z bazy danych
abs_dev = abs(x-med)
# odchylenie medianowe
mad = 1.4826 * median(abs_dev)
Tmin = med-(3*mad)
Tmax = med+(3*mad)
# znalezienie wartości skrajnych
x[which(x < Tmin | x > Tmax)]## [1] 24 28# usunięcie wartości skrajnych
x[which(x > Tmin & x < Tmax)]## [1] 10 4 6 8 9 8 7 6 12 14 11 9 8 4 5 10 14 12 15 7 10 14The interquartile range (IQR)
boxplot(x, horizontal = TRUE)
x = c(10,4,6,8,9,8,7,6,12,14,11,9,8,4,5,10,14,12,15,7,10,14,24,28)
# statystyki opisowe, podstawowe
summary(x)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 4.00 7.00 9.50 10.62 12.50 28.00# IQR
IQR(x)## [1] 5.5#
Tmin = 7-(1.5*5.5)
Tmax = 12.50+(1.5*5.5)
# znalezienie wartości skrajnych
x[which(x < Tmin | x > Tmax)]## [1] 24 28# remove outlier
x[which(x > Tmin & x < Tmax)]## [1] 10 4 6 8 9 8 7 6 12 14 11 9 8 4 5 10 14 12 15 7 10 14TESTY STATYSTYCZNE: IDENTYFIKACJA WARTOŚCI SKARJNYCH, NIETYPOWYCH
Testy statystyczne ukazane poniżej mogą zostać użyte wowczas, gdy dane są aproksymowane do rozkładu normalnego.
Dixon’s Q Test
Dla wartości największych:
H0: Największa wartość nie jest wartością skrajną
H1: Największa wartość jest wartością skrajną
library(outliers)## Warning: pakiet 'outliers' został zbudowany w wersji R 4.1.3x = c(10,4,6,8,9,8,7,6,12,14,11,9,8,4,5,10,14,12,15,7,10,14,24,28)
dixon.test(x)##
## Dixon test for outliers
##
## data: x
## Q = 0.56522, p-value < 2.2e-16
## alternative hypothesis: highest value 28 is an outlierp-value < 2.2e-16 statystycznie istotne, zatem odrzucamy hipotezę zerową na rzecz alternatywnej, mówiącej,że 28 jest wartością skrajną
Dla wartości najmniejszych:
H0: Najmniejsza wartość nie jest wartością skrajną
H1: Najmniejsza wartość jest wartością skrajną
dixon.test(x, opposite = TRUE)##
## Dixon test for outliers
##
## data: x
## Q = 0.090909, p-value = 0.2841
## alternative hypothesis: lowest value 4 is an outlierp-value =0.2841 statystycznie nieistotne, zatem nie odrzucamy hipotezy zerowej mówiącej , że 4 nie jest wartością skrajną
Grubb’s Test
library(outliers)
x = c(10,4,6,8,9,8,7,6,12,14,11,9,8,4,5,10,14,12,15,7,10,14,24,28)
grubbs.test(x)##
## Grubbs test for one outlier
##
## data: x
## G = 3.0354, U = 0.5820, p-value = 0.007692
## alternative hypothesis: highest value 28 is an outlierp-value= 0.007692 , statystycznie istotne, zatem odrzucamy hipotezę zerową na rzecz alternatywnej, mówiącej, że 28 jest wartością skrajną
grubbs.test(x, opposite = TRUE)##
## Grubbs test for one outlier
##
## data: x
## G = 1.15737, U = 0.93923, p-value = 1
## alternative hypothesis: lowest value 4 is an outlierp-value=1, statystycznie nieistotne, zatem nie odrzucamy hipotezy zerowej mówiące, że 4 jest wartością skrajną
Rosner’s test
H0: Nie wystepują wartosci skrajne w zbiorze
H1: W zbiorze występuje k wartości skrajnych
library(EnvStats)## Warning: pakiet 'EnvStats' został zbudowany w wersji R 4.1.3##
## Dołączanie pakietu: 'EnvStats'## Następujący obiekt został zakryty z 'package:MASS':
##
## boxcox## Następujący obiekt został zakryty z 'package:car':
##
## qqPlot## Następujące obiekty zostały zakryte z 'package:stats':
##
## predict, predict.lm## Następujący obiekt został zakryty z 'package:base':
##
## print.default# parameter k mówi ile potencjalnych wartości skrajnych wystepuje w zbiorze
# default k = 3
rosnerTest(x, k = 3)$all.stats## Warning in rosnerTest(x, k = 3): The true Type I error may be larger than
## assumed. See the help file for 'rosnerTest' for a table with information on the
## estimated Type I error level.## i Mean.i SD.i Value Obs.Num R.i+1 lambda.i+1 Outlier
## 1 0 10.625000 5.724186 28 24 3.035366 2.801551 TRUE
## 2 1 9.869565 4.465060 24 23 3.164669 2.780277 TRUE
## 3 2 9.227273 3.308457 15 19 1.744840 2.757735 FALSEWYBÓR ZMIENNYCH DO BADANIA
ANALIZA KORELACJI
#cor(baza)PRZY KORELACJI 0,9 MOŻEMY STRACIC NAWET DO 20% INFORMACJI.
ANALIZA WARIANCJI
WYBÓR JENOSTEK DO BADANIA
https://medium.com/analytics-vidhya/sampling-methods-in-r-b3c92e580c57
LOSOWANIE PROSTE
los_1=sample(length(dane$Gender),10) sample(c('red','green'),10,replace=T,prob=c(0.6,0.4))## [1] "red" "red" "red" "red" "green" "green" "green" "red" "red"
## [10] "red"LOSOWANIE SYSTEMATYCZNE
library(TeachingSampling)## Warning: pakiet 'TeachingSampling' został zbudowany w wersji R 4.1.3## Ładowanie wymaganego pakietu: magrittr## Warning: pakiet 'magrittr' został zbudowany w wersji R 4.1.3P <- c("Mon-8", "Tues-4", "Wed-4", "Thurs-6", "Fri-7","Sat-45","Sun-34","Mon-21", "Tues-11","Wed-34","Thurs-16","Fri-10","Sat-17","Sun-19")
#losuj systematycznie co drugi elementz 14 elementów
systematic_sample <- S.SY(14,2)
systematic_sample## [,1]
## [1,] 2
## [2,] 4
## [3,] 6
## [4,] 8
## [5,] 10
## [6,] 12
## [7,] 14P[systematic_sample]## [1] "Tues-4" "Thurs-6" "Sat-45" "Mon-21" "Wed-34" "Fri-10" "Sun-19"systematic_sample <- S.SY(length(dane$Gender),2)head(dane[systematic_sample,],10)## Gender Age Driving_License Region_Code Previously_Insured Vehicle_Age
## 2 Male 76 1 3 0 1-2 Year
## 4 Male 21 1 11 1 < 1 Year
## 6 Female 24 1 33 0 < 1 Year
## 8 Female 56 1 28 0 1-2 Year
## 10 Female 32 1 6 1 < 1 Year
## 12 Female 24 1 50 1 < 1 Year
## 14 Male 76 1 28 0 1-2 Year
## 16 Male 37 1 6 0
## 18 Female 25 1 35 1
## 20 Female 60 1 33 0 1-2 Year
## Vehicle_Damage Annual_Premium Policy_Sales_Channel Vintage Response
## 2 No 33536 26 183 0
## 4 No 28619 152 203 0
## 6 Yes 2630 160 176 0
## 8 Yes 32031 26 72 1
## 10 No 28771 NA 80 0
## 12 No 48699 152 289 0
## 14 Yes 36770 13 15 0
## 16 Yes 2630 156 147 1
## 18 No 46622 152 299 0
## 20 Yes NA 124 102 1
## Year_Birth age_1 age3
## 2 1946 >46 76
## 4 2001 <25 21
## 6 1998 <25 24
## 8 1966 >46 56
## 10 1990 25-35 32
## 12 1998 <25 24
## 14 1946 >46 76
## 16 1985 36-46 37
## 18 1997 25-35 25
## 20 1962 >46 60LOSOWANIE WARSTWOWE
library(dplyr)
# losuje po 3 rekordy z każdej kategorii
set.seed(1)
dane %>%
group_by (Gender) %>%
sample_n(., 3)## # A tibble: 9 x 14
## # Groups: Gender [3]
## Gender Age Driving_License Region_Code Previously_Insured Vehicle_Age
## <chr> <dbl> <int> <int> <int> <chr>
## 1 "" 26 1 8 1 < 1 Year
## 2 "" 26 1 8 1 < 1 Year
## 3 "" 54 1 28 1 1-2 Year
## 4 "Female" 58 1 18 0 1-2 Year
## 5 "Female" 42 1 28 0 1-2 Year
## 6 "Female" 58 1 28 0 1-2 Year
## 7 "Male" 26 1 6 1 < 1 Year
## 8 "Male" 53 1 24 1 1-2 Year
## 9 "Male" 77 1 28 0 1-2 Year
## # i 8 more variables: Vehicle_Damage <chr>, Annual_Premium <int>,
## # Policy_Sales_Channel <int>, Vintage <int>, Response <int>,
## # Year_Birth <int>, age_1 <chr>, age3 <dbl>library(sampling) ## Warning: pakiet 'sampling' został zbudowany w wersji R 4.1.3stratas = strata(dane, c("Gender"),size = c(5,3,3), method = "srswor")
stratas## Gender ID_unit Prob Stratum
## 15214 Male 15214 2.426160e-05 1
## 25773 Male 25773 2.426160e-05 1
## 46874 Male 46874 2.426160e-05 1
## 215581 Male 215581 2.426160e-05 1
## 241510 Male 241510 2.426160e-05 1
## 48487 Female 48487 1.714109e-05 2
## 197067 Female 197067 1.714109e-05 2
## 228099 Female 228099 1.714109e-05 2
## 385 385 7.500000e-01 3
## 421 421 7.500000e-01 3
## 428 428 7.500000e-01 3