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

Spadek długości śledzi jest zależny głównie od zwiększonego natężenia połowów oraz temperatury przy powierzchni wody.

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

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)