LarvaDistModels/09c_BFT_IncreasingConfidence.R at main · ric325/LarvaDistModels · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
# DESCRIPTION: Increasing confidence of seasonal species distribution maps

# Load preliminaries
source("09a_BFT_Data.R") # Load BFT data
model <- readRDS(here::here(model_dir, paste(species, "model.rds", sep = "_"))) # load model

# Making sure train and test data sets have the fitted predictions
preds <- gbm::predict.gbm(model, test, n.trees = model$gbm.call$best.trees, type = "response")
train_tmp <- train %>%
  dplyr::mutate(model = model$fitted)
test_tmp <- test %>%
  dplyr::mutate(model = preds)
limits = c(0, 1)

#### January-March ####
# Associate seasonal grids with the 10x10 grid
full_grid <- associateGrids(`grid_BFT_jan-mar`, grid_100)

# Create seasonal map
gg_obj <- create_speciesMap(train_tmp, # training object with model column (fitted values)
                            test_tmp, # testing object with model column (predictions)
                            "jan-mar", # season
                            BFT_predict_season1, # rest of the ocean cells
                            model, # BRT model
                            `grid_BFT_jan-mar` # grid of species for specific season
)

# Filtering 10x10 grid cells that have at least 5% of its area as sampling points
gg_filt <- restrictThreshold(full_grid,
                             gg_obj,
                             5)
saveRDS(object = gg_filt, file = here::here(preds_dir, paste(species, "jan-mar.rds", sep = "_"))) # save predictions
# gg_filt <- readRDS(here::here(preds_dir, paste(species, "jan-mar.rds", sep = "_")))

# Plot model removing 10x10 areas with lower confidence
gg <- plotConfidence(gg_filt, full_grid, limits)
ggsave(plot = gg, filename = here::here(figure_dir, paste(species, "jan-mar", "highconf.png", sep = "_")), width = 14, height = 5, dpi = 600)

# Plot the longitude and latitude bar plots
bps <- plotLonLat(gg_filt, full_grid)
ggsave(plot = bps$longitude, filename = here::here(figure_dir, paste(species, "longitude", "jan-mar.png", sep = "_")), width = 7, height = 0.5, dpi = 600)
ggsave(plot = bps$latitude, filename = here::here(figure_dir, paste(species, "latitude", "jan-mar.png", sep = "_")), width = 5, height = 1, dpi = 600)

#### April-June ####
# Associate seasonal grids with the 10x10 grid
full_grid <- associateGrids(`grid_BFT_apr-jun`, grid_100)

# Create seasonal map
gg_obj <- create_speciesMap(train_tmp, # training object with model column (fitted values)
                            test_tmp, # testing object with model column (predictions)
                            "apr-jun", # season
                            BFT_predict_season2, # rest of the ocean cells
                            model, # BRT model
                            `grid_BFT_apr-jun` # grid of species for specific season
)

# Filtering 10x10 grid cells that have at least 5% of its area as sampling points
gg_filt <- restrictThreshold(full_grid,
                             gg_obj,
                             5)
saveRDS(object = gg_filt, file = here::here(preds_dir, paste(species, "apr-jun.rds", sep = "_"))) # save predictions
# gg_filt <- readRDS(here::here(preds_dir, paste(species, "jan-mar.rds", sep = "_")))

# Plot model removing 10x10 areas with lower confidence
gg <- plotConfidence(gg_filt, full_grid, limits)
ggsave(plot = gg, filename = here::here(figure_dir, paste(species, "apr-jun", "highconf.png", sep = "_")), width = 14, height = 5, dpi = 600)

# Plot the longitude and latitude bar plots
bps <- plotLonLat(gg_filt, full_grid)
ggsave(plot = bps$longitude, filename = here::here(figure_dir, paste(species, "longitude", "apr-jun.png", sep = "_")), width = 7, height = 0.5, dpi = 600)
ggsave(plot = bps$latitude, filename = here::here(figure_dir, paste(species, "latitude", "apr-jun.png", sep = "_")), width = 5, height = 1, dpi = 600)

#### July-September ####
# Associate seasonal grids with the 10x10 grid
full_grid <- associateGrids(`grid_BFT_jul-sept`, grid_100)

# Create seasonal map
gg_obj <- create_speciesMap(train_tmp, # training object with model column (fitted values)
                            test_tmp, # testing object with model column (predictions)
                            "jul-sept", # season
                            BFT_predict_season3, # rest of the ocean cells
                            model, # BRT model
                            `grid_BFT_jul-sept` # grid of species for specific season
)

# Filtering 10x10 grid cells that have at least 5% of its area as sampling points
gg_filt <- restrictThreshold(full_grid,
                             gg_obj,
                             5)
saveRDS(object = gg_filt, file = here::here(preds_dir, paste(species, "jul-sept.rds", sep = "_"))) # save predictions
# gg_filt <- readRDS(here::here(preds_dir, paste(species, "jul-sept.rds", sep = "_")))

# Plot model removing 10x10 areas with lower confidence
gg <- plotConfidence(gg_filt, full_grid, limits)
ggsave(plot = gg, filename = here::here(figure_dir, paste(species, "jul-sept", "highconf.png", sep = "_")), width = 14, height = 5, dpi = 600)

# Plot the longitude and latitude bar plots
bps <- plotLonLat(gg_filt, full_grid)
ggsave(plot = bps$longitude, filename = here::here(figure_dir, paste(species, "longitude", "jul-sept.png", sep = "_")), width = 7, height = 0.5, dpi = 600)
ggsave(plot = bps$latitude, filename = here::here(figure_dir, paste(species, "latitude", "jul-sept.png", sep = "_")), width = 5, height = 1, dpi = 600)

#### October-December ####
# Associate seasonal grids with the 10x10 grid
full_grid <- associateGrids(`grid_BFT_oct-dec`, grid_100)

# Create seasonal map
gg_obj <- create_speciesMap(train_tmp, # training object with model column (fitted values)
                            test_tmp, # testing object with model column (predictions)
                            "oct-dec", # season
                            BFT_predict_season4, # rest of the ocean cells
                            model, # BRT model
                            `grid_BFT_oct-dec` # grid of species for specific season
)

# Filtering 10x10 grid cells that have at least 10% of its area as sampling points
gg_filt <- restrictThreshold(full_grid,
                             gg_obj,
                             5)
saveRDS(object = gg_filt, file = here::here(preds_dir, paste(species, "oct-dec.rds", sep = "_"))) # save predictions
# gg_filt <- readRDS(here::here(preds_dir, paste(species, "oct-dec.rds", sep = "_")))

# Plot model removing 10x10 areas with lower confidence
gg <- plotConfidence(gg_filt, full_grid, limits)
ggsave(plot = gg, filename = here::here(figure_dir, paste(species, "oct-dec", "highconf.png", sep = "_")), width = 14, height = 5, dpi = 600)

# Plot the longitude and latitude bar plots
bps <- plotLonLat(gg_filt, full_grid)
ggsave(plot = bps$longitude, filename = here::here(figure_dir, paste(species, "longitude", "oct-dec.png", sep = "_")), width = 7, height = 0.5, dpi = 600)
ggsave(plot = bps$latitude, filename = here::here(figure_dir, paste(species, "latitude", "oct-dec.png", sep = "_")), width = 5, height = 1, dpi = 600)