- 🐟 Śledzie
- 0. Wstęp
- 1. Kod wyliczający wykorzystane biblioteki
- 2. Kod zapewniający powtarzalność wyników przy każdym uruchomieniu raportu na tych samych danych.
- 3. Kod pozwalający wczytać dane z pliku
- 4. Kod przetwarzający brakujące dane
- 5. Sekcja podsumowująca rozmiar zbioru i podstawowe statystyki
- 6. Szczegółowa analiza wartości atrybutów
- 7. Sekcja sprawdzającą korelacje między zmiennymi
- 8. Interaktywny wykres lub animację prezentującą zmianę rozmiaru śledzi w czasie
- 9. Sekcja regresora przewidującego rozmiar śledzia, parametry modelu oraz oszacowanie jego skuteczności
- 10. Analiza ważności atrybutów najlepszego znalezionego modelu regresji
Projekt z Eksploracji Masywnych Danych, analiza długości śledzi
- Wstęp
Długość śledzi oceanicznych w Europie zmniejsza się wraz z upływem lat. W niniejszym raporcie przeanalizowano dane z połowów komercyjnych jednostek przez ostatnie 60 lat. W ramach połowu losowo wybierano od 50 do 100 sztuk trzyletnich śledzi. Wykonano m.in. interpretację i analizę atrybutów, analizę korelacji atrybutów, stworzenie klasyfikatorów w celu znalezienia najistotniejszej cechy.
- Kod wyliczający wykorzystane biblioteki
## [1] "knitr" "kableExtra" "plotly" "dplyr" "tidyverse"
## [6] "ggplot2" "ggExtra" "cowplot" "gridExtra" "imputeTS"
## [11] "corrplot" "reshape2" "caret" "gganimate" "png"
## [16] "gifski"
- Kod zapewniający powtarzalność wyników przy każdym uruchomieniu raportu na tych samych danych.
set.seed(40)- Kod pozwalający wczytać dane z pliku
headers <- read.table("sledzie.csv", nrow=1, stringsAsFactors = FALSE, sep = ",")
content <- read.table("sledzie.csv", header=TRUE, stringsAsFactors = FALSE, sep=",", na.strings = c("", "?", "NA"))
head(content)## X length cfin1 cfin2 chel1 chel2 lcop1 lcop2 fbar recr
## 1 0 23.0 0.02778 0.27785 2.46875 NA 2.54787 26.35881 0.356 482831
## 2 1 22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 3 2 25.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 4 3 25.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 5 4 24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 6 5 22.0 0.02778 0.27785 2.46875 21.43548 2.54787 NA 0.356 482831
## cumf totaln sst sal xmonth nao
## 1 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 2 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 3 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 4 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 5 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 6 0.3059879 267380.8 14.30693 35.51234 7 2.8
- Kod przetwarzający brakujące dane
content$cfin1 <- na_kalman(content$cfin1)
content$cfin2 <- na_kalman(content$cfin2)
content$chel1 <- na_kalman(content$chel1)
content$chel2 <- na_kalman(content$chel2)
content$lcop1 <- na_kalman(content$lcop1)
content$lcop2 <- na_kalman(content$lcop2)
content$sst <- na_kalman(content$sst)
head(content)## X length cfin1 cfin2 chel1 chel2 lcop1 lcop2 fbar recr
## 1 0 23.0 0.02778 0.27785 2.46875 21.43549 2.54787 26.35881 0.356 482831
## 2 1 22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 3 2 25.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 4 3 25.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 5 4 24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## 6 5 22.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831
## cumf totaln sst sal xmonth nao
## 1 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 2 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 3 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 4 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 5 0.3059879 267380.8 14.30693 35.51234 7 2.8
## 6 0.3059879 267380.8 14.30693 35.51234 7 2.8
- Sekcja podsumowująca rozmiar zbioru i podstawowe statystyki
Rozmiar zbioru:
nrow(content)## [1] 52582
Podstawowe statystyki:
content %>%
summary()## X length cfin1 cfin2
## Min. : 0 Min. :19.0 Min. : 0.0000 Min. : 0.0000
## 1st Qu.:13145 1st Qu.:24.0 1st Qu.: 0.0000 1st Qu.: 0.2778
## Median :26290 Median :25.5 Median : 0.1111 Median : 0.7012
## Mean :26290 Mean :25.3 Mean : 0.4460 Mean : 2.0255
## 3rd Qu.:39436 3rd Qu.:26.5 3rd Qu.: 0.3333 3rd Qu.: 1.7936
## Max. :52581 Max. :32.5 Max. :37.6667 Max. :19.3958
## chel1 chel2 lcop1 lcop2
## Min. : 0.000 Min. : 5.238 Min. : 0.3074 Min. : 7.849
## 1st Qu.: 2.469 1st Qu.:13.427 1st Qu.: 2.5479 1st Qu.:17.808
## Median : 5.750 Median :21.436 Median : 7.0000 Median :24.859
## Mean :10.004 Mean :21.217 Mean : 12.8053 Mean :28.421
## 3rd Qu.:11.500 3rd Qu.:27.193 3rd Qu.: 21.2315 3rd Qu.:37.232
## Max. :75.000 Max. :57.706 Max. :115.5833 Max. :68.736
## fbar recr cumf totaln
## Min. :0.0680 Min. : 140515 Min. :0.06833 Min. : 144137
## 1st Qu.:0.2270 1st Qu.: 360061 1st Qu.:0.14809 1st Qu.: 306068
## Median :0.3320 Median : 421391 Median :0.23191 Median : 539558
## Mean :0.3304 Mean : 520366 Mean :0.22981 Mean : 514973
## 3rd Qu.:0.4560 3rd Qu.: 724151 3rd Qu.:0.29803 3rd Qu.: 730351
## Max. :0.8490 Max. :1565890 Max. :0.39801 Max. :1015595
## sst sal xmonth nao
## Min. :12.77 Min. :35.40 Min. : 1.000 Min. :-4.89000
## 1st Qu.:13.60 1st Qu.:35.51 1st Qu.: 5.000 1st Qu.:-1.89000
## Median :13.86 Median :35.51 Median : 8.000 Median : 0.20000
## Mean :13.88 Mean :35.51 Mean : 7.258 Mean :-0.09236
## 3rd Qu.:14.16 3rd Qu.:35.52 3rd Qu.: 9.000 3rd Qu.: 1.63000
## Max. :14.73 Max. :35.61 Max. :12.000 Max. : 5.08000
- Szczegółowa analiza wartości atrybutów
Rozkład cech:
plots <- (
lapply(names(content)[-1], function(var_x) {
ggplot(content) + aes_string(var_x) + geom_histogram() + theme_bw()
})
)
plot_grid(plotlist = plots)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
- Sekcja sprawdzającą korelacje między zmiennymi
par(xpd=TRUE)
corrplot.mixed(cor(content[-1]), tl.srt = 90, tl.pos="lt", diag = "l", tl.col="black", number.cex=.6, tl.cex=.6, mar = c(0, 0, 2, 0))
- Można zauważyć dodatnią korelację pomiędzy chel1 (zagęszczenie
Calanus helgolandicus gat. 1) a lcop1 (zagęszczenie widłonogów
gat. 1) ~=
0.96 - Można zauważyć dodatnią korelację pomiędzy chel2 (zagęszczenie
Calanus helgolandicus gat. 2) a lcop2 (zagęszczenie widłonogów
gat. 2) ~=
0.88 - Można zauważyć dodatnią korelację pomiędzy cfin2 (zagęszczenie
Calanus finmarchicus gat. 2) a lcop2 (zagęszczenie widłonogów
gat. 2) ~=
0.65 - Można zauważyć dodatnią korelację pomiędzy sst (temperatura przy
powierzchni wody [°C]) a nao (oscylacja północnoatlantycka
[mb]) ~=
0.51 - [Najciekawsze] - można zauważyć ujemną korelację pomiędzy
length (długość złowionego śledzia [cm]) a sst (temperatura
przy powierzchni wody) ~=
-0.45
ggplot(content, aes(sst, length)) + geom_point() + geom_smooth(method="lm") + ylab(sprintf("długość")) + xlab("temperatura") + ggtitle("Ze wzrostem temperatury maleje długość")
- Interaktywny wykres lub animację prezentującą zmianę rozmiaru śledzi w czasie
p <- ggplot(content, aes(X, length)) +
geom_point() +
geom_smooth(method = "auto", color = "red")
# ggplotly(p) - Plotly is not working for me - dependency issue
p## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
- Można zauważyć wzrost długości śledzia do pewnego momentu (~row 17500) po czym następuje spadek długości.
- Sekcja regresora przewidującego rozmiar śledzia, parametry modelu oraz oszacowanie jego skuteczności
Podzielmy dane na: - zbiór uczący - 0.75 zbioru początkowego - zbiór
testowy - 0.25 zbioru początkowego
normalized_content <- data.frame(content[-1])
training_indexes <- createDataPartition(y = normalized_content$length, p = .75, list = FALSE)
training_set <- normalized_content[ training_indexes]
testing_set <- normalized_content[-training_indexes]
rounded_content <- sapply(normalized_content$length, round, digits = 0)
control_params <- trainControl( method = "repeatedcv", number = 5, repeats = 10)set.seed(40)
# bug
# n <- names(normalized_content)
# f <- as.formula(paste("length ~", paste(n[!n %in% "length"], collapse = " + ")))
# f <- reformulate(setdiff(colnames(normalized_content), "length"), response="length")
# model <- lm(f, data=training_set)
# new <- data.frame(testing_set)
# predict(model, newdata=new, interval="confidence")
# model_regression <- caret::train(f, data=training_set, method = "lm", trControl = control_params)
# regression_classes <- predict(model_regression, newdata = testing_set)
# regression_classes <- sapply(regression_classes, round, digits = 0)
# levels <- unique(c(rounded_content, regression_classes))
# postResample(pred = regression_classes, obs = rounded_content)#model_knn <- train(length ~ ., data = training_set, method = "knn", importance=T, trControl = control_params)
#knn_classes <- predict(model_knn, newdata = testing_set)
#knn_classes <- sapply(knn_classes, round, digits = 0)
#levels <- unique(c(rounded_content, knn_classes))
#postResample(pred = knn_classes, obs = rounded_content)
#plot(model_knn)#model_random_forest <- train(length ~ ., data = training_set, method = "rf", importance=T, trControl = control_params, ntree = 10)
#random_forest_classes <- predict(model_random_forest, newdata = testing_set)
#random_forest_classes <- sapply(random_forest_classes, round, digits = 0)
#levels <- unique(c(rounded_content, random_forest_classes))
#postResample(pred = random_forest_classes, obs = rounded_content)- Analiza ważności atrybutów najlepszego znalezionego modelu regresji
#models <- list(randomForest = model_random_forest, linearRegression = model_regression, kNN = model_knn) %>% resamples()
#dotplot(models, metric = "RMSE")
#dotplot(models, metric = "Rsquared")Niestety z powodów problemu z biblioteką carot nie byłem w stanie
sprawdzić wyników modeli :(