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.
TODO
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
W celu zapewnienia powtarzalności wyników dla uruchamianego wielokrotnie ustawiono ziarno (ang. seed) na wartość 13.
set.seed(13)
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 |
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.
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, ...
pander(summary(data))
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 |
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 |
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 |
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.
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).
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.
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)
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.
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.
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.
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.
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 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.
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
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ść 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)