Opis problemu

Na przestrzeni ostatnich lat zauważono stopniowy spadek rozmiaru śledzia oceanicznego wyławianego w Europie. Do analizy zebrano pomiary śledzi i warunków w jakich żyją z ostatnich 60 lat. Dane były pobierane z połowów komercyjnych jednostek. W ramach połowu jednej jednostki losowo wybierano od 50 do 100 sztuk trzyletnich śledzi.

Wnioski

TODO

Wstęp

Biblioteki

library(dplyr)         # data manipulation
library(knitr)         # report generation
library(pander)        # easy tool for rendering R objects into Pandoc's markdown
library(tidyverse)     # collection of R packages designed for data science
library(gridExtra)     # multiple plots on grid
library(imputeTS)      # imputation (replacement) of missing values in univariate time series
library(corrplot)      # correlation matrix visualisation
library(plotly)        # interactive plots
library(caret)         # data exploration lib
library(randomForest)  # rf

Powtarzalność eksperymentów

W celu zapewnienia powtarzalności wyników dla uruchamianego wielokrotnie ustawiono ziarno (ang. seed) na wartość 13.

set.seed(13)

Ładowanie i prezentacja danych

Dane zostana załadowane bezpośrednio z pliku csv pochodzącego ze strony z zadaniem.

download.file(
  "http://www.cs.put.poznan.pl/dbrzezinski/teaching/sphd/sledzie.csv",
  destfile = 'sledzie.csv'
)

data <- read.csv("sledzie.csv", header = TRUE, sep = ",", na.strings = "?") %>% rename(id = X)

Zbiór zawiera 16 kolumn i 52582 wierszy. Kolumny mają następujące nazwy: id, length, cfin1, cfin2, chel1, chel2, lcop1, lcop2, fbar, recr, cumf, totaln, sst, sal, xmonth, nao. Prezentacja pierwszych 10 wierszy:

kable(head(data, 10))
id length cfin1 cfin2 chel1 chel2 lcop1 lcop2 fbar recr cumf totaln sst sal xmonth nao
0 23.0 0.02778 0.27785 2.46875 NA 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
1 22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
2 25.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
3 25.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
4 24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
5 22.0 0.02778 0.27785 2.46875 21.43548 2.54787 NA 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
6 24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
7 23.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
8 22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
9 22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8

Opis danych

Opis kolumn:

Nazwa Opis
length: długość złowionego śledzia [cm]
cfin1: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 1]
cfin2: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 2]
chel1: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 1]
chel2: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 2]
lcop1: dostępność planktonu [zagęszczenie widłonogów gat. 1]
lcop2: dostępność planktonu [zagęszczenie widłonogów gat. 2]
fbar: natężenie połowów w regionie [ułamek pozostawionego narybku]
recr: roczny narybek [liczba śledzi]
cumf: łączne roczne natężenie połowów w regionie [ułamek pozostawionego narybku]
totaln: łączna liczba ryb złowionych w ramach połowu [liczba śledzi]
sst: temperatura przy powierzchni wody [°C]
sal: poziom zasolenia wody [Knudsen ppt]
xmonth: miesiąc połowu [numer miesiąca]
nao: oscylacja północnoatlantycka [mb]

Wiersze w zbiorze są uporządkowane chronologicznie.

Typy danych

Prezentacja typów kolumn:

glimpse(data)
## Observations: 52,582
## Variables: 16
## $ id     <int> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17...
## $ length <dbl> 23.0, 22.5, 25.0, 25.5, 24.0, 22.0, 24.0, 23.5, 22.5, 22.5, ...
## $ cfin1  <dbl> 0.02778, 0.02778, 0.02778, 0.02778, 0.02778, 0.02778, 0.0277...
## $ cfin2  <dbl> 0.27785, 0.27785, 0.27785, 0.27785, 0.27785, 0.27785, 0.2778...
## $ chel1  <dbl> 2.46875, 2.46875, 2.46875, 2.46875, 2.46875, 2.46875, 2.4687...
## $ chel2  <dbl> NA, 21.43548, 21.43548, 21.43548, 21.43548, 21.43548, 21.435...
## $ lcop1  <dbl> 2.54787, 2.54787, 2.54787, 2.54787, 2.54787, 2.54787, 2.5478...
## $ lcop2  <dbl> 26.35881, 26.35881, 26.35881, 26.35881, 26.35881, NA, 26.358...
## $ fbar   <dbl> 0.356, 0.356, 0.356, 0.356, 0.356, 0.356, 0.356, 0.356, 0.35...
## $ recr   <int> 482831, 482831, 482831, 482831, 482831, 482831, 482831, 4828...
## $ cumf   <dbl> 0.3059879, 0.3059879, 0.3059879, 0.3059879, 0.3059879, 0.305...
## $ totaln <dbl> 267380.8, 267380.8, 267380.8, 267380.8, 267380.8, 267380.8, ...
## $ sst    <dbl> 14.30693, 14.30693, 14.30693, 14.30693, 14.30693, 14.30693, ...
## $ sal    <dbl> 35.51234, 35.51234, 35.51234, 35.51234, 35.51234, 35.51234, ...
## $ xmonth <int> 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 6, 6, 6, 6, 6, 6, 6, 6, 6, ...
## $ nao    <dbl> 2.8, 2.8, 2.8, 2.8, 2.8, 2.8, 2.8, 2.8, 2.8, 2.8, 2.8, 2.8, ...

Podsumowanie rozkładów

pander(summary(data))
Table continues below
id 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 :26291 Median :25.5 Median : 0.1111 Median : 0.7012
Mean :26291 Mean :25.3 Mean : 0.4458 Mean : 2.0248
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
NA NA NA’s :1581 NA’s :1536
Table continues below
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.673 Median : 7.0000 Median :24.859
Mean :10.006 Mean :21.221 Mean : 12.8108 Mean :28.419
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
NA’s :1555 NA’s :1556 NA’s :1653 NA’s :1591
Table continues below
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 : 520367 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
NA NA NA NA
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.87 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
NA’s :1584 NA NA NA

Oczyszczanie danych

Wyświetlenie odstających

barplot(unlist(allOut), main="Procent wartości odstajacych", horiz=TRUE, las=1, cex.names=0.7)

Na podstawie wykresów obrazujących rozkład wartości można wnioskować że dla atrybutów sal oraz cfin1 występują wartości odstające. Należy te wartości dokładniej zweryfikować na graficznych wykresach rozkładów wartości.

Oczyszczanie z odstajacych

Na każdym z wykresów przedstawiono rozkład wartości każdego kolejnego atrybutu ze zbioru. W przypadku wystąpienia wartości wyraźnie skrajnych, będą one zastepowane brakiem wartości (N/A).

Długość śledzia

p_length <- ggplot(data, aes(length)) +
     geom_histogram(binwidth = 0.5) +  
     scale_x_discrete(name="Długość [cm]", limits= seq(min(data$length), max(data$length), by=1) ) +
     ylab("Liczba wystąpień") +
     ggtitle("Długość śledzia") + 
     theme(plot.title = element_text(hjust = 0.5))

Komentarz: rozkład zbliżony do normalnego. Nie ma potrzeby zmian.

Zagęszczenie planktonu

p_cfin1 <- ggplot(data, aes(cfin1)) +
  geom_histogram(binwidth = 1.0) + 
  xlab("Zagęszczenie planktonu") +
  ylab("Liczba wystąpień") + ggtitle("Calanus finmarchicus gat. 1") + 
  theme(plot.title = element_text(hjust = 0.5))
p_cfin2 <- ggplot(data, aes(cfin2)) +
  geom_histogram(binwidth = 1.0) +
  xlab("Zagęszczenie planktonu") +  
  ylab("Liczba wystąpień") + 
  ggtitle("Calanus finmarchicus gat. 2") +
  theme(plot.title = element_text(hjust = 0.5))
grid.arrange(p_cfin1, p_cfin2, ncol = 2, nrow = 1)
## Warning: Removed 1581 rows containing non-finite values (stat_bin).
## Warning: Removed 1536 rows containing non-finite values (stat_bin).

Komentarz: rozklady zbliżone do prawostronnie skośnego. Dla Calanus finmarchicus gat. 1 warto usunąć wartości odstające, które prawdopodobnie są błędnie zebranymi danymi. Poniżej prezentacja porpawionego rozkładu.

cfin1ToRepleace <- which(data$cfin1 > 20)
for (i in cfin1ToRepleace){
  data[i, "cfin1"] <- NA
}
data$cfin1 <- na.interpolation(data$cfin1)
## Warning: na.interpolation will replaced by na_interpolation.
##            Functionality stays the same.
##            The new function name better fits modern R code style guidelines.
##            Please adjust your code accordingly.
p_cfin1 <- ggplot(data, aes(cfin1)) +
  geom_histogram(binwidth = 1.0) + 
  xlab("Zagęszczenie planktonu") +
  ylab("Liczba wystąpień") + ggtitle("Poprawione: Calanus finmarchicus gat. 1") + 
  theme(plot.title = element_text(hjust = 0.5))
plot(p_cfin1)

p_chel1 <- ggplot(data, aes(chel1)) +
  geom_histogram(binwidth = 1.0) + 
  xlab("Zagęszczenie planktonu") +
  ylab("Liczba wystąpień") +
  ggtitle("Calanus helgolandicus gat. 1") +
  theme(plot.title = element_text(hjust = 0.5))
p_chel2 <- ggplot(data, aes(chel2)) +
  geom_histogram(binwidth = 1.0) +
  xlab("Zagęszczenie planktonu") +  
  ylab("Liczba wystąpień") + 
  ggtitle("Calanus helgolandicus gat. 2") + 
  theme(plot.title = element_text(hjust = 0.5))
grid.arrange(p_chel1, p_chel2, ncol = 2, nrow = 1)
## Warning: Removed 1555 rows containing non-finite values (stat_bin).
## Warning: Removed 1556 rows containing non-finite values (stat_bin).

Komentarz: rozklady zbliżone do prawostronnie skośnego. Nie ma potrzeby zmian.

p_lcop1 <- ggplot(data, aes(x=lcop1)) +
  geom_histogram(binwidth = 1.0) +
  xlab("Zagęszczenie planktonu") +
  ylab("Liczba wystąpień") + 
  ggtitle("Widłonogi gat. 1") +
  theme(plot.title = element_text(hjust = 0.5))
p_lcop2 <- ggplot(data, aes(x=lcop2)) + 
  geom_histogram(binwidth = 1.0) +  
  xlab("Zagęszczenie planktonu") +  
  ylab("Liczba wystąpień") + 
  ggtitle("Widłonogi gat. 2") + 
  theme(plot.title = element_text(hjust = 0.5))
grid.arrange(p_lcop1, p_lcop2, ncol = 2, nrow = 1)
## Warning: Removed 1653 rows containing non-finite values (stat_bin).
## Warning: Removed 1591 rows containing non-finite values (stat_bin).

Komentarz: rozklady zbliżone do prawostronnie skośnego. Dla Widłonogów gat. 1 warto usunąć wartości odstające, które prawdopodobnie są błędnie zebranymi danymi. Poniżej prezentacja poprawionego rozkładu.

lcop1ToRepleace <- which(data$cfin1 > 90)
for (j in lcop1ToRepleace){
  data[i, "lcop1"] <- NA
}
data$lcop1 <- na.interpolation(data$lcop1)
## Warning: na.interpolation will replaced by na_interpolation.
##            Functionality stays the same.
##            The new function name better fits modern R code style guidelines.
##            Please adjust your code accordingly.
p_lcop1 <- ggplot(data, aes(x=lcop1)) +
  geom_histogram(binwidth = 1.0) +
  xlab("Zagęszczenie planktonu") +
  ylab("Liczba wystąpień") + 
  ggtitle("Widłonogi gat. 1") +
  theme(plot.title = element_text(hjust = 0.5))
plot(p_lcop1)

Dane dotyczące liczby śledzi

p_fbar <- ggplot(data, aes(fbar)) +
  geom_histogram(binwidth = 0.05) +
  xlab("Ułamek pozostawionego narybku") +
  ylab("Liczba wystąpień") +
  ggtitle("Natężenie połowów w regionie") +
  theme(plot.title = element_text(hjust = 0.5))
p_cumf <- ggplot(data, aes(cumf)) + geom_histogram(binwidth = 0.02) +
  xlab("Ułamek pozostawionego narybku")+
  ylab("Liczba wystąpień") + ggtitle("Łączne roczne natężenie połowów") +
  theme(plot.title = element_text(hjust = 0.5))
grid.arrange(p_fbar, p_cumf, ncol = 2, nrow = 1)

Komentarz: Natężenia połowów mają rozkład wielomodalny. Nie ma potrzeby zmian.

p_recr <- ggplot(data, aes(recr)) +
  geom_histogram(binwidth = 50000.0) +
  xlab("Liczba śledzi")+
  ylab("Liczba wystąpień") + ggtitle("Roczny narybek") +
  theme(plot.title = element_text(hjust = 0.5))
p_totaln <- ggplot(data, aes(totaln)) + geom_histogram(binwidth = 50000.0) + 
  xlab("Liczba śledzi")+
  ylab("Liczba wystąpień") + ggtitle("Łączna liczba złowionych ryb") +
  theme(plot.title = element_text(hjust = 0.5))
grid.arrange(p_recr, p_cumf, ncol = 2, nrow = 1)

Komentarz: Dane liczby śledzi maja rozklad bardziej równomierny niż dane dotyczące zagęszczenia planktonu. Nie ma potrzeby zmian.

Warunki przyrodnicze

p_sst <- ggplot(data, aes(sst)) +
  geom_histogram(binwidth = 0.1) + 
  xlab("Temperatura [°C]") + 
  ylab("Liczba wystąpień") + 
  ggtitle("Temperatura przy powierzchni wody") +
  theme(plot.title = element_text(hjust=0.5))
p_sal <- ggplot(data, aes(sal)) + 
  geom_histogram(binwidth = 0.01) + 
  xlab("Poziom zasolenia [Knudsen ppt]") + 
  ylab("Liczba wystąpień") +
  ggtitle("Zasolenie wody") + 
  theme(plot.title=element_text(hjust=0.5))
p_xmonth <- ggplot(data, aes(xmonth)) +
  geom_histogram(binwidth = 1.0) +
  xlab("Numer miesiąca") +
  ylab("Liczba wystąpień") + 
  ggtitle("Miesiąc połowu") + 
  theme(plot.title=element_text(hjust=0.5))
p_nao <- ggplot(data, aes(nao)) +
  geom_histogram(binwidth = 0.2) +
  xlab("Oscylacja [mb]") + 
  ylab("Liczba wystąpień") +
  ggtitle("Oscylacja północnoatlantycka") +
  theme(plot.title=element_text(hjust=0.5))
grid.arrange(p_sst, p_sal, p_xmonth, p_nao, ncol = 2, nrow = 2)
## Warning: Removed 1584 rows containing non-finite values (stat_bin).

Komentarz: - Najczęściej odnotowaną temperaturą wody było 13.6° oraz głównie temperatury wyższe, zapewne przez główne zbieranie danych w okresie letnim. - Zasolenie wody koncentruje się głównie w przedziale 35.5 - 35.55 oraz zawiera dużo wartości skrajnych, prawdopodobnie z powodu dopływu rzek

Wniosek: Zbiór ma dużo wartości odstających, ale grafiki rozkładów wyraźnie wskazują, że ich usunięcie jest zbyt ryzykowne i nie ma ku temu wskazań. Zostały więc usunięte prawie nic nie znaczące, drobne odstępstwa, wyraźnie wskazujące na błędy pomiarowe.

Oczyszczenie braków

completeRowsVector <- complete.cases(data)
completeRows <- data[completeRowsVector, ]
completeRowsCount <- nrow(completeRows)
allRowsCount <- nrow(data)
percentOfCompleteRows <- round(completeRowsCount/allRowsCount * 100, 2)
percentOfIncompleteRows <- 100.0 - percentOfCompleteRows

Zbiór zawiera 45223 kompletnych wierszy ze 52582 wszystkich, co stanowi 86%. Więc 14% to dane niekompletne, co stanowi dość dużą wartość. Uzupełnione zostaną średnią wartością danej kolumny zbioru.

for(i in 1:ncol(data)){
  data[is.na(data[,i]), i] <- mean(data[,i], na.rm = TRUE)
}
completeRowsVector <- complete.cases(data)
completeRows <- data[completeRowsVector, ]
completeRowsCount <- nrow(completeRows)
allRowsCount <- nrow(data)
percentOfCompleteRows <- round(completeRowsCount/allRowsCount * 100, 2)

Zbiór zawiera teraz 100% kompletnych wierszy.

Analiza

Macierz korelacji

Poniżej przedstawiono macierz korelacji.

corrplot(cor(data), tl.col="black")

Komentarz: żaden z atrybutów nie wykazuje wysokiego współczynnika korelacji w stosunku do atrybutu decyzyjnego length. Najwyższa pozytywna korelacja występuje dla następujących par:
– ‘zagęszczenie widłonogów gat. 1 (lcop1)’ oraz ‘zagęszczenie Calanus helgolandicus gat. 1 (chel1)’,
– ‘zagęszczenie widłonogów gat. 2 (lcop2)’ oraz ‘zagęszczenie Calanus helgolandicus gat. 2 (chel2)’
– ‘łączne roczne natężenie połowów w regionie (cumf)’ oraz ‘natężenie połowów w regionie (fbar)’. Najwyższa negatywna korelacja występuje dla pary ‘łączna liczba ryb złowionych w ramach połowu (totaln)’ oraz ‘łączne roczne natężenie połowów w regionie (cumf)’.

Szczegółowa prezentacja korelacji

p_lcop1_chel1 <- ggplot(data, aes(x=lcop1, y=chel1)) + 
  geom_point() + geom_smooth(method=lm) + 
  annotate("text", x = 30, y = 87.25, label = c(paste("wsp. korelacji =", round(cor(data$lcop1, data$chel1),2))))
p_lcop2_chel2 <- ggplot(data, aes(x=lcop2, y=chel2)) + 
  geom_point() + geom_smooth(method=lm) +
  annotate("text", x = 25, y = 50, label = c(paste("wsp. korelacji =", round(cor(data$lcop2, data$chel2),2))))
p_cumf_fbar   <- ggplot(data, aes(x=cumf, y=fbar)) + 
  geom_point() + 
  geom_smooth(method=lm) + annotate("text", x = 0.15, y = 0.7, label = c(paste("wsp. korelacji =", round(cor(data$cumf, data$fbar),2))))
p_totaln_cumf <- ggplot(data, aes(x=totaln, y=cumf)) + 
  geom_point() +
  geom_smooth(method=lm) + annotate("text", x = 800000, y = 0.34,
  label = c(paste("wsp. korelacji =", round(cor(data$totaln, data$cumf),2))))
grid.arrange(p_lcop1_chel1 , p_lcop2_chel2, p_cumf_fbar, p_totaln_cumf, ncol = 2, nrow = 2, top="Wykresy korelacji")

Potwierdzono w ten sposób wysoką korelację pomiędzy tymi parami.

Zmiana w czasie

data_sample <- sample_n(data, 500)
q <- ggplot(data_sample, aes(id, length)) + 
  geom_jitter() + 
  geom_smooth(se = FALSE, color="green") + 
  geom_vline(xintercept = 17000, colour="darkgray", linetype = "longdash", size=1) + 
  ggtitle('Zmiana długości złowionego śledzia') +
  theme_bw()
ggplotly(q)
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Podział zbioru

Podział zbioru danych na zbiór treningowy i testowy w stosunku 8:2.

dataPartition <- createDataPartition(y=data$length, p=.8, list=FALSE)
trainSet <- data[dataPartition, ]
testSet <- data[-dataPartition, ]
trainSetPercent <- round(dim(trainSet) / nrow(data) * 100, 2)
testSetPercent <- round(dim(testSet) / nrow(data) * 100, 2)

Zbiór uczący zawiera 42067, 16 elementów, co stanowi 80, 0.03% całości.
Zbiór testowy zawiera 10515, 16 elementów, co stanowi 20, 0.03% całości.

Trenowanie

Do znalezienia regresora długości śledzi wykorzystano algorytm regresji liniowej. Podczas uczenia używamy jest użyta technika walidacji krzyżowej z podziałem zbioru treningowego na 10 części.

trainingControl <- trainControl(
  method = "repeatedcv",
  number = 10,
  repeats = 10
)
model <- train(
  length ~ .,
  data = as.matrix(trainSet),
  method = "lm",
  na.action = na.omit,
  trControl = trainingControl,
  preProcess = c("scale", "center")
)
model
## Linear Regression 
## 
## 42067 samples
##    15 predictor
## 
## Pre-processing: scaled (15), centered (15) 
## Resampling: Cross-Validated (10 fold, repeated 10 times) 
## Summary of sample sizes: 37861, 37860, 37861, 37861, 37862, 37860, ... 
## Resampling results:
## 
##   RMSE      Rsquared   MAE     
##   1.334903  0.3499612  1.054243
## 
## Tuning parameter 'intercept' was held constant at a value of TRUE

Ocena modelu

Do porównania jakości wyliczonego regresora jest użyty regresor średniej wartości śledzia na podstawie wszystkich oczyszczonych danych.

testPred <- predict(model, testSet)
postResample(pred = testPred, obs = testSet$length)
##      RMSE  Rsquared       MAE 
## 1.3124438 0.3610831 1.0353972
postResample(pred = mean(testSet$length), obs = testSet$length)
##     RMSE Rsquared      MAE 
## 1.641788       NA 1.332978

Komentarz: wyuczony regresor jest zauważalnie lepszy (wniosek na podstawie wartości RMSE).

Ważność atrybutów

Ważność cech w regresorze jest wartością wynikową obliczeń istotną z punktu widzenia analizy przyczyn spadku rozmiaru śledzia.

ggplot(varImp(model)) +
  ggtitle("Ważność cech w regresorze")

Wnioski: najbardziej znaczące atrybuty to
– (fbar) natężenie połowów w regionie [ułamek pozostawionego narybku]
– (cumf) łączne roczne natężenie połowów w regionie [ułamek pozostawionego narybku]
– (sst) temperatura przy powierzchni wody [°C]

fbar_plot <- ggplot(data, aes_string(x="id", y="fbar")) +
            geom_point(alpha = 0.02) +
            geom_smooth() +
            ggtitle(paste("Zmiana atrybutu fbar w kolejnych połowach"))
print(fbar_plot)

cumf_plot <- ggplot(data, aes_string(x="id", y="cumf")) +
            geom_point(alpha = 0.02) +
            geom_smooth() +
            ggtitle(paste("Zmiana atrybutu cumf w kolejnych połowach"))
print(cumf_plot)

sst_plot <- ggplot(data, aes_string(x="id", y="sst")) +
            geom_point(alpha = 0.02) +
            geom_smooth() +
            ggtitle(paste("Zmiana atrybutu sst w kolejnych połowach"))
print(sst_plot)