Матричное моделирование популяции Heracleum mantegazzianum в условиях инвазионного ареала
Моделирование сценариев управления численностью популяции H. mantegazzianum
Используем матрицу для стабильной популяции H. mantegazzianum
mat_stable <- read.table("data/matrix_no_v6-v7.tsv", sep="\t", dec=",",
head=T)
mat_stable <- as.matrix(mat_stable)
print(as.table(mat_stable), zero.print='.')## v1 v2 v3 v4 v5 v6 g
## A . . . . . . 173.000
## B 0.037 . . . . . .
## C . 0.839 . . . . .
## D . . 0.832 . . . .
## E . . . 0.705 . . .
## F . . . . 0.762 . .
## G . 0.008 0.053 0.162 0.066 0.022 .Вычислим ее собственное число и собственные вектора
library("popdemo")
lambda <- eigs(mat_stable, what="lambda")
lambda <- round(lambda, 3)
ss <- eigs(mat_stable, what="ss")
ss <- round(ss ,3)
rv <- eigs(mat_stable, what="rv")
rv <- round(rv, 3)Относительная скорость роста популяции (собственное число): λ = 1.058
Соотношение возрастных групп (v1…v6, g): ss = 0.896, 0.031, 0.025, 0.02, 0.013, 0.009, 0.005
Репродуктивная значимость возрастных групп (v1…v6, g): rv = 0.227, 6.503, 7.846, 7.61, 2.876, 0.773, 37.183
Симулируем уничтожение только генеративных особей
Симулируем разные негативные воздействия на популяцию. Начнем с уничтожения генеративных растений с разной степенью тщательности. Зададим начальный вектор зададим с соотношением особей, характерным для сформированной моновидовой заросли на площади 1000 м2.
start.vector <- c(173, 6, 5, 4, 3, 2, 1)
start.vector <- start.vector * 1000Теперь стартовый вектор содржит следующие количества растений разных возрастных групп (v1, v2, v3, v4, v5, v6, g):
Внедряем 100 % уничтожение генеративных с первого шага.
ftГруппа | Кол-во |
|---|---|
age_groups | start.vector |
v1 | 173,000 |
v2 | 6,000 |
v3 | 5,000 |
v4 | 4,000 |
v5 | 3,000 |
v6 | 2,000 |
g | 1,000 |
n = 15 # Количество лет (вегетационных сезонов)
# rslt_mat - это матрица, которая будет содержать результаты изменения
# исходной матрицы в течение n лет.
# Фактически это вектор, содержащий количеcтво особей в каждой из возрастных
# групп
# Исходно приравняем нашу матрицу к стартовому вектору
rslt_mat <- as.matrix(start.vector)
# Теперь создадим цикл, который будет повторять умножение rslt_mat
# на проекционную матрицу n раз.
# На первом шаге мы виртуально уничтожим все генеративные особи
# Следите за руками
# Исходная матрица
rslt_mat## [,1]
## [1,] 173000
## [2,] 6000
## [3,] 5000
## [4,] 4000
## [5,] 3000
## [6,] 2000
## [7,] 1000# Вот эта команда приравняет число генеративных растений нулю:
rslt_mat[7,1] <- 0
# Полюбуемся на результат:
rslt_mat## [,1]
## [1,] 173000
## [2,] 6000
## [3,] 5000
## [4,] 4000
## [5,] 3000
## [6,] 2000
## [7,] 0# Вот эта команда производит умножение текущей матрицы на проекционную матрицу,
# переводя матрицу в состояние на шаге (году) y = n + 1:
y = 1
mat_stable %*% rslt_mat[,y]## [,1]
## [1,] 0
## [2,] 6401
## [3,] 5034
## [4,] 4160
## [5,] 2820
## [6,] 2286
## [7,] 1203# Ниже привожу сам цикл, который реализует ежегодное 100 % уничтожение
# генеративных растений
n = 15
rslt_mat <- as.matrix(start.vector)
for(y in 1:n){
rslt_mat[7,y] <- 0
cur_vector <- mat_stable %*% rslt_mat[,y]
rslt_mat <- cbind(rslt_mat, cur_vector)
}Посмотрим, что осталось от популяции спустя 15 лет (строки - возрастные группы, стобцы - годы):
rslt_mat## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11]
## [1,] 173000 0 0.000 0.000 0.000 0.000 0 0 0 0 0
## [2,] 6000 6401 0.000 0.000 0.000 0.000 0 0 0 0 0
## [3,] 5000 5034 5370.439 0.000 0.000 0.000 0 0 0 0 0
## [4,] 4000 4160 4188.288 4468.205 0.000 0.000 0 0 0 0 0
## [5,] 3000 2820 2932.800 2952.743 3150.085 0.000 0 0 0 0 0
## [6,] 2000 2286 2148.840 2234.794 2249.990 2400.365 0 0 0 0 0
## [7,] 0 0 0.000 0.000 0.000 0.000 0 0 0 0 0
## [,12] [,13] [,14] [,15] [,16]
## [1,] 0 0 0 0 0
## [2,] 0 0 0 0 0
## [3,] 0 0 0 0 0
## [4,] 0 0 0 0 0
## [5,] 0 0 0 0 0
## [6,] 0 0 0 0 0
## [7,] 0 0 0 0 0Подведем итоги. На какой год сумма особей всех групп станет равно 0?
simulated_m <- as.data.frame(t(rslt_mat))
colnames(simulated_m) <- c('v1', 'v2', 'v3', 'v4', 'v5', 'v6', 'g')
sum_all_stages <-
simulated_m %>%
mutate(sumVar = rowSums(.[1:7]))
yr <- as.numeric(rownames(sum_all_stages))
sum_all_stages <- cbind.data.frame(yr, sum_all_stages$sumVar)
colnames(sum_all_stages) <- c('yr', 'N')
ggplot(sum_all_stages, aes(x = yr, y = N)) +
geom_line() +
geom_point()+
labs(
x = "годы",
y = "Размер популяции, особей"
) +
theme_linedraw(
base_family = "Times New Roman",
base_size = 18,
)
Внедряем 99 % уничтожение генеративных с первого шага.
Точнее, ежегодно уничтожаем от 99% до 100% генеративных особей случайно kill_qual_options - вектор, содержащий долю генеративных особей, выживших давших потомство
kill_qual_options <- c(0.01, 0.01)
# kill_qual_options <- seq(0, 0.2, 0.01)
n = 100
rslt_mat <- as.matrix(start.vector)
for(y in 1:n) {
kq <- sample(kill_qual_options,1)
rslt_mat[7,y] <- rslt_mat[7,y] * kq
cur_vector <- mat_stable%*% rslt_mat[,y]
rslt_mat <- cbind(rslt_mat, cur_vector)
s_a <- sum(cur_vector)
if(s_a < 1){break}
y = y + 1
}Подведем итоги сценария “Уничтожаем ежегодно от 99% до 100% генеративных особей”
simulated_m <- as.data.frame(t(rslt_mat))
colnames(simulated_m) <- c('v1', 'v2', 'v3', 'v4', 'v5', 'v6', 'g')
sum_all_stages <-
simulated_m %>%
mutate(sumVar = rowSums(.[1:7]))
yr <- as.numeric(rownames(sum_all_stages))
sum_all_stages <- cbind.data.frame(yr, sum_all_stages$sumVar)
colnames(sum_all_stages) <- c('yr', 'N')
ggplot(sum_all_stages, aes(x = yr, y = N)) +
geom_line() +
geom_point() +
labs(
x = "годы",
y = "Размер популяции, особей"
) +
theme_linedraw(
base_family = "Times New Roman",
base_size = 18,
)
Построим зависимость: сколько лет уйдет на уничтожение популяции в зависимости от качества (тщательности) уничтожения генеративных растений
start.vector <- c(173, 6, 5, 4, 3, 2, 1)
start.vector <- start.vector * 1000
kill_qual_options <- seq(0, 0.5, 0.01)
for(kq in kill_qual_options){
n = 150
rslt_mat <- as.matrix(start.vector)
for(y in 1:n) {
rslt_mat[7,y] <- rslt_mat[7,y] * kq
cur_vector <- mat_stable%*% rslt_mat[,y]
rslt_mat <- cbind(rslt_mat, cur_vector)
s_a <- sum(cur_vector)
if(s_a < 1){break}
}
if(kq == 0){
years_to_kill_all <- y
}
else{
years_to_kill_all <- append(years_to_kill_all, y)
}
}
sim_res <- cbind.data.frame(kill_qual_options, years_to_kill_all)
ggplot(sim_res, aes(x = kill_qual_options, y = years_to_kill_all)) +
geom_line(size = 2) +
geom_point(size = 4) +
labs(
x = "Доля выживших генеративных растений",
y = "Количество лет"
) +
theme_linedraw(
base_family = "Times New Roman",
base_size = 18,
)## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
#