-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathNiche_Modeling_Markdown.Rmd
3259 lines (2709 loc) · 179 KB
/
Niche_Modeling_Markdown.Rmd
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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
---
title: "<center> Ecological Niche Modeling for Kryptolebias marmoratus and Projecting Future Habitat Suitability <center>"
author: "<center> Anthony Snead <center><br>"
date: "<center> _`r Sys.Date()`_ <center>"
output:
html_document:
code_folding: show
df_print: paged
theme: yeti
highlight: tango
toc: yes
toc_float:
collapsed: false
smooth_scroll: false
number_sections: true
pdf_document:
fig_caption: yes
toc: yes
---
```{r, Markdown-Setup, include=FALSE}
library(rmarkdown)
library(tinytex)
library(knitr)
knitr::opts_chunk$set(eval = FALSE, echo=TRUE, warning=FALSE, message=FALSE)
knitr.duplicate.label = "allow"
```
## Introduction
The following code was used to complete all niche modeling and analysis. The code is broken down into sections based on the analysis and the time period. Furthermore, comments are included to explain the code for future user. Upon reflection, the code could be easily distilled by creating functions that could be applied to a list of data/objects. However, we do not wish to change the code as this is the original code used for the manuscript.
## R packages used
A variety of R packages was used for this analysis. All graphics and data wrangling were handled using the [tidyverse suite of packages](https://www.tidyverse.org/), cowplot, and ggpattern; however small table formatting and small graphic edits were done with external software including the Microsoft office suit and adobe creative cloud. All packages used are available from the Comprehensive R Archive Network (CRAN) or Github.
```{r, Libraries}
library(tidyverse)
#for general data manipulation
library(dplyr)
#for general data manipulation
library(ggpattern)
#for using patterns in ggplot
library(broom)
#used to tidy the multinomial logistic regression outputs
library(cowplot)
#used to combine ggplot graphs
library(ENMeval)
#used for maxent modeling
library(rJava)
#to use the java application of Maxent
library(dismo)
#to project and retrieve response curves
library(raster)
#used for raster analysis
library(rgdal)
#an extension of raster to import geotiffs
library(qpcR)
# to calculate the AICw of the filtered models
library(nnet)
#to run the multinomial logistic regressions
library(sf)
#to deal with spatial objects
```
## Enviromental Data
### Preprocessing
Current environmental data was downloaded from [WorldClim 2.1](https://www.worldclim.org/data/worldclim21.html) and [MARSPEC](http://marspec.weebly.com/modern-data.html). Future data was downloaded from [WorldClim 2.1](https://www.worldclim.org/data/v1.4/cmip5.html) and [BioOracle](https://www.bio-oracle.org/). All preprocessing of environmental data was conducted using the GIU software programs ArcGIS Pro and SAGA (System for Automate Geoscientific Analyses) described in the methods section of the publication. Therefore, the subsequent R code begins with correlation analysis and environmental data importing.
### Correlation
After converting environmental rasters to point data in ArcGIS Pro, the data was exported and combined in one table. The table was used to compute Pearson's R correlation. The correlation coefficients were used to make filtering decisions and split create two variable sets to be model independently.The first chunk of code is an exploratory analysis used to investigate correlation coefficients; however this analysis was not used to specify variable sets.
```{r, Exploritory-Correlation-Analysis}
variable_table <- read.csv("C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Current_Vars_Table.csv", header = TRUE)
#read in a table composed of environmental data exported from ArcGIS Pro.
variable_table<- variable_table[,2:ncol(variable_table)]
#remove pointid column so that only the environmental variables are left
var_correlations <- cor(variable_table, method = "pearson")
#compute Pearson's correlation matrix
write.csv(var_correlations, "C:/Users/antho/OneDrive - The University of Alabama/Niche_Modeling_Rivulus/R code/Maxent_Rivulus_Climate_Change/correlatoin_matrix.csv")
#write the entire correlation matrix to a csv for inclusion in the supplementary material
Highly_Cor <- var_correlations %>%
#create data frame of highly correlated variables
as.table() %>%
#make it a table
as.data.frame() %>%
#convert to data frame
subset(Var1 != Var2 & abs(Freq) >= 0.9) %>%
#subset so that I am not sub-setting self comparisons and the absolute value of the correlation is >= .9
filter(!duplicated(paste0(pmax(as.character(Var1), as.character(Var2)), pmin(as.character(Var1), as.character(Var2)))))
#keep only unique variables with no self comparisons, as.character because Var1 and Var2 are factors
#Highly_Cor is a table of pair wise correlations that are greater than 0.9.
Highly_Cor_Var1_Count <- Highly_Cor %>%
#create Var 1 count
dplyr::select(Var1)
#select only var1
Highly_Cor_Var2_Count <- Highly_Cor %>%
#create var 2 count
dplyr::select(Var2) %>%
#select only var2
rename(Var1 = Var2)
#rename var 2 var 1 for rbind
Highly_Cor_Count <- rbind(Highly_Cor_Var1_Count, Highly_Cor_Var2_Count) %>%
#bind both counts above by Var 1 column
group_by(Var1) %>%
#group by var 1
summarise(no_rows = length(Var1))
#counts the number of occurrence of each variable
#High_Cor_Count is a count of how time each variable is in a highly correlated pair. This helps you identify which variable would have the greatest impact on the number of highly correlated pair if it were removed
```
The next code chunk is the analysis to determine the Biologically informed variable set. You can find a detailed explanation of criteria used to select variables for the Biologically informed data set in the supplementary information.
```{r, Correlation-Analysis-to-Create-the-Biologically-Informed-Variable-Set}
Var_filtered_Biological<- variable_table %>% dplyr::select(!Temp_Seasonality & !Annual_Mean_Temp & !Precip_Driest_M & !Temp_Annual_Range & !Min_Temp_Coldest_M & !Mean_SST & !Annual_Range_SST & !Mean_Annual_SSS & !Precip_Seasonality & !Annual_Range_SSS)
#removes highly correlated variables that do not have a strong biological rational for their inclusion
var_correlations_filtered_Biological<- cor(Var_filtered_Biological, method = "pearson")
#compute Pearson's correlation matrix
Highly_Cor_filtered_Biological<- var_correlations_filtered_Biological %>%
#create data frame of highly correlated variables
as.table() %>%
#make it a table
as.data.frame() %>%
#convert to data frame
subset(Var1 != Var2 & abs(Freq) >= 0.9) %>%
#subset so that I am not sub-setting self comparisons and the absolute value of the correlation is >= .9
filter(!duplicated(paste0(pmax(as.character(Var1), as.character(Var2)), pmin(as.character(Var1), as.character(Var2)))))
#keep only unique variables with no self comparisons, as.character because Var1 and Var2 are factors
Highly_Cor_Var1_filtered_Biological <- Highly_Cor_filtered_Biological %>%
#create Var 1 count
group_by(Var1)
#select only var1
Highly_Cor_Var2_filtered_Biological<- Highly_Cor_filtered_Biological %>%
#create var 2 count
dplyr::select(Var2) %>%
#select only var2
rename(Var1 = Var2)
#rename var 2 var 1 for rbind
Highly_Cor_Count_filtered_Biological<- rbind(Highly_Cor_Var1_filtered_Biological, Highly_Cor_Var2_filtered_Biological) %>%
#bind both counts above by Var 1 column
group_by(Var1) %>%
#group by var 1
summarise(no_rows = length(Var1))
#counts the number of occurrence of each variable
### The above code is the same as the first chunk mentioned above and utilized to examine correlations after variables with weak biological rationales and high correlations were excluded
```
The code chunk gets the range, standard deviation, and mean for each variable.
```{r, Retained Variable Stats}
Summary_Stats <- Var_filtered_Biological %>%
tidyr::gather(., factor_key = TRUE) %>%
group_by(key) %>%
summarise(mean = mean(value), sd = sd(value), max = max(value), min = min(value))
```
The next code chunk is the analysis to determine the Pearson variable set.In the Pearson variable set one variables from each pair with a correlation coefficient above 0.9 was removed. The variable removed was done so based on the biology of our study species. A complete description of variable filtering can be found in the supplementary information.
```{r, Correlation-Analysis-to-Create-the-Pearson-Variable-Set}
Var_filtered_Pearson<- variable_table %>% dplyr::select(!Temp_Seasonality & !Annual_Mean_Temp & !Precip_Driest_M & !Temp_Annual_Range & !Min_Temp_Coldest_M & !Mean_SST & !Annual_Range_SST & !Mean_Annual_SSS & !Precip_Seasonality & !Annual_Range_SSS & !Precip_Coldest_Q & !Precip_Warmest_Q & !Mean_Temp_Coldest_Q & !Mean_Temp_Warmest_Q)
#removes highly correlated variables that do not have a strong biological rational for their inclusion
var_correlations_filtered_Pearson<- cor(Var_filtered_Pearson, method = "pearson")
#compute Pearson's correlation matrix
Highly_Cor_filtered_Pearson<- var_correlations_filtered_Pearson %>%
#create data frame of highly correlated variables
as.table() %>%
#make it a table
as.data.frame() %>%
#convert to data frame
subset(Var1 != Var2 & abs(Freq) >= 0.9) %>%
#subset so that I am not sub-setting self comparisons and the absolute value of the correlation is >= .9
filter(!duplicated(paste0(pmax(as.character(Var1), as.character(Var2)), pmin(as.character(Var1), as.character(Var2)))))
#keep only unique variables with no self comparisons, as.character because Var1 and Var2 are factors
Highly_Cor_Var1_filtered_Pearson <- Highly_Cor_filtered_Pearson %>%
#create Var 1 count
group_by(Var1)
#select only var1
Highly_Cor_Var2_filtered_Pearson<- Highly_Cor_filtered_Pearson %>%
#create var 2 count
dplyr::select(Var2) %>%
#select only var2
rename(Var1 = Var2)
#rename var 2 var 1 for rbind
Highly_Cor_Count_filtered_Pearson<- rbind(Highly_Cor_Var1_filtered_Pearson, Highly_Cor_Var2_filtered_Pearson) %>%
#bind both counts above by Var 1 column
group_by(Var1) %>%
#group by var 1
summarise(no_rows = length(Var1))
#counts the number of occurrence of each variable
#The above code does the same analysis as the first exploratory analysis but for the Pearson variable set which removes one correlate from all highly correlated pairs.
```
## Maxent Modeling
The following section outlines the Maxent modeling. It includes both importing the data and running models for both variable set.
### Importing Data
The following code imports the data into raster stack items for subsequent modeling.
```{r, Importing-Rasters}
files_Biological <- list.files( path = "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Data_Model_Development/Biological", full.names = TRUE )
#gets a list of the files for an automated raster import (Biologically Informed). All files must be in the same folder.
files_Pearson<- list.files( path = "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Data_Model_Development/Pearson", full.names = TRUE )
#gets a list of the files for an automated raster import (Pearson). All files must be in the same folder.
envs_biological <- stack(files_Biological)
#load the Biologically Informed variable set in a raster stack
envs_Pearson <- stack(files_Pearson)
#load the Pearson variable set in a raster stack
```
The stack objects will be used to run all subsequent models.
### Creating Objects for Maxent modeling
The code creates the occurrence objects, background points object, and the block partition for my modeling.
```{r, Creating-Maxent-Objects}
occs <- read.csv("C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Rivulus_Occurrence .csv", header = TRUE) %>%
#import the points of occurrences
dplyr::rename(x = Longitude , y = Latitude)
occs.sp <- SpatialPoints(occs)
#convert occs to .sp
BG_R <- raster("C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Data_Model_Development/BG_R.tif")
#import the background sampling extent
bg <- dismo::randomPoints(BG_R , n = 10000)
# Randomly sample 10,000 background points from one background extent raster (only one per cell without replacement).
blocks <- get.block(occs.sp, bg)
#get geographically blocked partitioning
```
### Running Maxent
The following code utilizes the java application of Maxent to test a range of regularization multiplier and feature classes for both variable sets.
```{r, Maxent-Modeling}
.jinit(classpath = NULL,
parameters = getOption("java.parameters"),
silent = FALSE, force.init = FALSE)
#initialize R java to use the Maxent java application. You must have Maxent java application in the correct folder to utilize this.
model_bio <- ENMevaluate(occ=occs.sp, env=envs_biological, bg.coords=bg, method='block', RMvalues=c(.5, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5), fc=c("L", "LQ", "Q", "LQH", "LH", "QH", "H"), algorithm='maxent.jar')
#runs models at each rm value and each feature class for the biologically informed variable set
model_Pearson <- ENMevaluate(occ=occs.sp, env=envs_Pearson, bg.coords=bg, method='block', RMvalues=c(.5, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5), fc=c("L", "LQ", "Q", "LQH", "LH", "QH", "H"), algorithm='maxent.jar')
#runs models at each rm value and each feature class for the Pearson variable set
```
### Results and Model Averaging
##### Biologically Informed
The following code is only for the Biologically informed variable set.
###### Model Evaluation
This code retrieves to model results table and recalculating the AICcw for the filtered models. It then saves each model that was retained to an object.
```{r, Bio Model Evaluation}
model_results_bio <- as.data.frame(model_bio@results) %>%
#converts the results to a data frame
filter(avg.test.AUC >= .6 & !is.na(AICc)) %>%
#filters out NAs and test AUC below .65
arrange(AICc)
#orders in ascending order by AICc
AICc_vector_bio <- as.vector(model_results_bio$AICc)
#creates a vector of the AICcs of the filtered data set
AICw_bio <- akaike.weights(AICc_vector_bio)
#calculates the AICw from the AIcc vector of the filtered data set
model_results_bio <- model_results_bio%>%
#overwrite model_results_bio
dplyr::select(-w.AIC) %>%
#drops the current w.AIC
mutate(wAICc = AICw_bio$weights)
#adds the new AIC weights based on the filtered model set the the results table
AIC1_bio <- model_bio@models[[which(model_bio@results$settings=="LQ_1")]]
#get the lowest AICc model
AIC2_bio <- model_bio@models[[which(model_bio@results$settings == "Q_0.5")]]
#gets second lowest AICc model
AUC_bio <- model_bio@models[[which(model_bio@results$settings == "H_1.5")]]
#gets highest AUC model
OR10_bio <- model_bio@models[[which(model_bio@results$settings == "H_2")]]
#gets lowest OR10 model
Biological_model_Results_csv <- model_results_bio %>%
add_row(settings = "AICc_Avg",
avg.test.AUC = (((model_results_bio[1,5] * model_results_bio[1,16]) + (model_results_bio[2,5] * model_results_bio[2,16]))/ (model_results_bio[1,16] + model_results_bio[2,16])),
avg.diff.AUC = (((model_results_bio[1,7] * model_results_bio[1,16]) + (model_results_bio[2,7] * model_results_bio[2,16]))/ (model_results_bio[1,16] + model_results_bio[2,16])),
avg.test.orMTP = (((model_results_bio[1,9] * model_results_bio[1,16]) + (model_results_bio[2,9] * model_results_bio[2,16]))/ (model_results_bio[1,16] + model_results_bio[2,16])),
avg.test.or10pct = (((model_results_bio[1,11] * model_results_bio[1,16]) + (model_results_bio[2,11] * model_results_bio[2,16]))/ (model_results_bio[1,16] + model_results_bio[2,16]))) %>%
dplyr::select(-features, - rm,-train.AUC, -var.test.AUC, - var.diff.AUC, -var.test.orMTP, - var.test.or10pct)
#calculate averaged model statistics
write.csv(Biological_model_Results_csv, "C:/Users/antho/OneDrive - The University of Alabama/Niche_Modeling_Rivulus/R code/Maxent_Rivulus_Climate_Change/Biological_model_results.csv")
#write the model results to a csv
```
###### Model Averaging and Map Conversion
This code chunk first converts the models to cloglog outputs using dismo. We also implement a natural model averaging approach on the outputs of the AICc models to get the model averaged output.
```{r, Bio Suitability-Maps}
AIC_1_cloglog_bio <- dismo::predict(AIC1_bio, envs_biological, args= "outputformat=cloglog")
#convert the model to cloglog
AIC_2_cloglog_bio <- dismo::predict(AIC2_bio, envs_biological, args= "outputformat=cloglog" )
#convert the model to cloglog
AIC_AVG_cloglog_bio <- ((AIC_1_cloglog_bio * model_results_bio[1,16]) + (AIC_2_cloglog_bio * model_results_bio[2,16])) / (model_results_bio[1,16] + model_results_bio[2,16])
#model average the outputs
AUC_cloglog_bio <- dismo::predict(AUC_bio, envs_biological, args= "outputformat=cloglog" )
#convert the model to cloglog
OR10_cloglog_bio <- dismo::predict(OR10_bio, envs_biological, args= "outputformat=cloglog" )
#convert the model to cloglog
```
###### Variable Importance
The following code is used to create a table of the percent contribution of each variable fore all Biologically informed models.
```{r, Bio Percent-Contribution}
AIC1_bio_var_importance <- var.importance(AIC1_bio) %>%
#gets the percent contribution and the permutation importance
dplyr::select(-permutation.importance) %>%
#remove permutation.importance as it is not very informative with correlated variables
arrange(-percent.contribution) %>%
#arranges by percent contribution in descending order
rename(AIC1 = percent.contribution )
AIC2_bio_var_importance<- var.importance(AIC2_bio) %>%
#gets the percent contribution and the permutation importance
dplyr::select(-permutation.importance) %>%
#remove permutation.importance as it is not very informative with correlated variables
arrange(-percent.contribution) %>%
#arranges by percent contribution in descending order
rename(AIC2 = percent.contribution )
AUC_bio_var_importance<- var.importance(AUC_bio) %>%
#gets the percent contribution and the permutation importance
dplyr::select(-permutation.importance) %>%
#remove permutation.importance as it is not very informative with correlated variables
arrange(-percent.contribution) %>%
#arranges by percent contribution in descending order
rename(AUC = percent.contribution )
OR10_bio_var_importance<- var.importance(OR10_bio) %>%
#gets the percent contribution and the permutation importance
dplyr::select(-permutation.importance) %>%
#remove permutation.importance as it is not very informative with correlated variables
arrange(-percent.contribution) %>%
#arranges by percent contribution in descending order
rename(OR10 = percent.contribution )
Var_Importance_Bio_Table <- full_join(AIC1_bio_var_importance, AIC2_bio_var_importance, by = "variable") %>%
full_join(., AUC_bio_var_importance, by = "variable") %>%
full_join(., OR10_bio_var_importance, by = "variable") %>%
mutate(AIC_Avg = (((AIC1* model_results_bio[1,16]) + (AIC2 * model_results_bio[2,16])) / (model_results_bio[1,16] + model_results_bio[2,16]))) %>%
arrange(-AIC_Avg) %>%
rename(Variable = variable) %>%
rename( "AIC Avg" = AIC_Avg) %>%
mutate(Variable = recode(Variable,
"SSS_S_M" = "Sea Surface Salinity of the Saltiest Month",
"P_D_Q" = "Precipitation of the Driest Quarter",
"Isotherm" = "Isothermality",
"Mean_D_R" = "Mean Diurnal Range",
"P_We_M" = "Precipitation of the Wettest Month",
"P_We_Q" = "Precipitation of the Wettest Quarter",
"SSS_F_M" = "Sea Surface Salinity of the Freshest Month",
"SST_Wa_M" = "Sea Surface Temperature of the Warmest Month",
"Max_T_Wa_M" = "Maximum Temperature of the Warmest Month",
"Annual_P" = "Annual Precipitation",
"Avg_T_D_Q" = "Mean Temperature of the Driest Quarter",
"Avg_T_We_Q" = "Mean Temperature of the Wettest Quarter",
"SST_C_M" = "Sea Surface Temperature of the Coldest Month",
"Avg_T_Wa_Q" = "Mean Temperature of the Warmest Quarter",
"P_Wa_Q" = "Precipitation of the Warmest Quarter",
"SST_Wa_M" = "Sea Surface Temperature of the Warmest Month",
"Avg_T_C_Q" = "Mean Temperature of the Coldest Quarter",
"P_C_Q" = "Precipitation of the Coldest Quarter"))
#creates a combined table of variable importance to be exported to a csv
write.csv(Var_Importance_Bio_Table, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Var_Importance_Bio.csv")
#export variable importance
```
#### Pearson Variable Set
The following code is only for the Pearson set.
###### Model Evaluation
This code retrieves to model results table and recalculate the AICc weights for the filtered models. It then saves each model that was retained to an object.
```{r, Pearson Model-Evaluation}
model_results_Pearson <- as.data.frame(model_Pearson@results) %>%
#converts the results to a data frame
filter(avg.test.AUC >= .6 & !is.na(AICc)) %>%
#filters out NAs and test AUC below .65
arrange(AICc)
#orders in ascending order by AICc
AICc_vector_Pearson <- as.vector(model_results_Pearson$AICc)
#creates a vector of the AICcs of the filtered data set
AICw_Pearson <- akaike.weights(AICc_vector_Pearson)
#calculates the AICw from the AIcc vector of the filtered data set
model_results_Pearson <- model_results_Pearson%>%
#overwrite model_results
dplyr::select(-w.AIC) %>%
#drops the current w.AIC
mutate(wAICc = AICw_Pearson$weights)
#adds the new AIC weights based on the filtered model set the the results table
AIC1_Pearson <- model_Pearson@models[[which(model_Pearson@results$settings=="H_3.5")]]
#get the lowest AICc model
AIC2_Pearson <- model_Pearson@models[[which(model_Pearson@results$settings == "H_4.5")]]
#get the 2nd lowest AICc model
AIC3_Pearson <- model_Pearson@models[[which(model_Pearson@results$settings == "H_5")]]
#get the 3rd lowest AICc model
OR10_Pearson <- model_Pearson@models[[which(model_Pearson@results$settings == "H_2")]]
#get the lowest OR10 model
Pearson_model_csv <- model_results_Pearson %>%
add_row(settings = "AICc_Avg",
avg.test.AUC = (((model_results_Pearson[1,5] * model_results_Pearson[1,16]) + (model_results_Pearson[2,5] * model_results_Pearson[2,16]) + (model_results_Pearson[3,5] * model_results_Pearson[3,16]))/ (model_results_Pearson[1,16] + model_results_Pearson[2,16] + model_results_Pearson[3,16])),
avg.diff.AUC = (((model_results_Pearson[1,7] * model_results_Pearson[1,16]) + (model_results_Pearson[2,7] * model_results_Pearson[2,16]) +(model_results_Pearson[3,7] * model_results_Pearson[3,16]))/ (model_results_Pearson[1,16] + model_results_Pearson[2,16] + model_results_Pearson[3,16])),
avg.test.orMTP = (((model_results_Pearson[1,9] * model_results_Pearson[1,16]) + (model_results_Pearson[2,9] * model_results_Pearson[2,16]) + (model_results_Pearson[3,5] * model_results_Pearson[3,9]))/ (model_results_Pearson[1,16] + model_results_Pearson[2,16] + model_results_Pearson[3,16])),
avg.test.or10pct = (((model_results_Pearson[1,11] * model_results_Pearson[1,16]) + (model_results_Pearson[2,11] * model_results_Pearson[2,16]) + (model_results_Pearson[3,11] * model_results_Pearson[3,16]))/ (model_results_Pearson[1,16] + model_results_Pearson[2,16] + model_results_Pearson[3,16]))) %>%
dplyr::select(-features, - rm,-train.AUC, -var.test.AUC, - var.diff.AUC, -var.test.orMTP, - var.test.or10pct)
#calculate averaged model statistics
write.csv(Pearson_model_csv, "C:/Users/antho/OneDrive - The University of Alabama/Niche_Modeling_Rivulus/R code/Maxent_Rivulus_Climate_Change/Pearson_model_Strict_results.csv")
#writes the full model results to a csv
```
###### Model Averaging and Export
This code chunk first converts the models to cloglog outputs using dismo. We also implement a natural model averaging approach on the outputs of the AICc models to get the model averaged output.
```{r, Pearson Suitability-Maps}
AIC1_cloglog_Pearson <- dismo::predict(AIC1_Pearson, envs_Pearson, args= "outputformat=cloglog")
#convert the model to cloglog
AIC2_cloglog_Pearson <- dismo::predict(AIC2_Pearson, envs_Pearson, args= "outputformat=cloglog" )
#convert the model to cloglog
AIC3_cloglog_Pearson <- dismo::predict(AIC3_Pearson, envs_Pearson, args= "outputformat=cloglog" )
#convert the model to cloglog
AIC_AVG_cloglog_Pearson <- ((AIC1_cloglog_Pearson * model_results_Pearson[1,16]) + (AIC2_cloglog_Pearson * model_results_Pearson[2,16]) + (AIC3_cloglog_Pearson * model_results_Pearson[3,16])) / (model_results_Pearson[1,16] + model_results_Pearson[2,16] + model_results_Pearson[3,16])
#create the model averaged output
OR10_cloglog_Pearson <- dismo::predict(OR10_Pearson, envs_Pearson, args= "outputformat=cloglog" )
#convert the model to cloglog
```
###### Variable Importance
The following code is used to create a table of the percent contribution of each variable fore all Pearson models.
```{r, Pearson Percent-Contribution}
AIC1_Pearson_var_importance <- var.importance(AIC1_Pearson) %>%
#gets the percent contribution and the permutation importance
dplyr::select(-permutation.importance) %>%
#get rid of permutation.importance
arrange(-percent.contribution) %>%
#arranges by percent contribution in descending order
rename(AIC1 = percent.contribution )
AIC2_Pearson_var_importance<- var.importance(AIC2_Pearson) %>%
#gets the percent contribution and the permutation importance
dplyr::select(-permutation.importance) %>%
#get rid of permutation.importance
arrange(-percent.contribution) %>%
#arranges by percent contribution in descending order
rename(AIC2 = percent.contribution )
AIC3_Pearson_var_importance<- var.importance(AIC3_Pearson) %>%
#gets the percent contribution and the permutation importance
dplyr::select(-permutation.importance) %>%
#get rid of permutation.importance
arrange(-percent.contribution) %>%
#arranges by percent contribution in descending order
rename(AIC3 = percent.contribution )
OR10_Pearson_var_importance<- var.importance(OR10_Pearson) %>%
#gets the percent contribution and the permutation importance
dplyr::select(-permutation.importance) %>%
#get rid of permutation.importance
arrange(-percent.contribution) %>%
#arranges by percent contribution in descending order
rename(OR10 = percent.contribution )
Var_Importance_Pearson_Table <- full_join(AIC1_Pearson_var_importance, AIC2_Pearson_var_importance, by = "variable") %>%
full_join(., AIC3_Pearson_var_importance, by = "variable") %>%
full_join(., OR10_Pearson_var_importance, by = "variable") %>%
mutate(AIC_Avg = ((AIC1 * model_results_Pearson[1,16]) + (AIC2 * model_results_Pearson[2,16]) + (AIC3 * model_results_Pearson[3,16]) / (model_results_Pearson[1,16] + model_results_Pearson[2,16] + model_results_Pearson[3,16]))) %>%
arrange(-AIC_Avg) %>%
rename("AIC Avg" = AIC_Avg) %>%
rename(Variable = variable) %>%
mutate(Variable = recode(Variable,
"SSS_S_M" = "Sea Surface Salinity of the Saltiest Month",
"P_D_Q" = "Precipitation of the Driest Quarter",
"Isotherm" = "Isothermality",
"Mean_D_R" = "Mean Diurnal Range",
"P_We_M" = "Precipitation of the Wettest Month",
"P_We_Q" = "Precipitation of the Wettest Quarter",
"SSS_F_M" = "Sea Surface Salinity of the Freshest Month",
"SST_Wa_M" = "Sea Surface Temperature of the Warmest Month",
"Max_T_Wa_M" = "Maximum Temperature of the Warmest Month",
"Annual_P" = "Annual Precipitation",
"Avg_T_D_Q" = "Mean Temperature of the Driest Quarter",
"Avg_T_We_Q" = "Mean Temperature of the Wettest Quarter",
"SST_C_M" = "Sea Surface Temperature of the Coldest Month"))
#create table of variable importance for export
write.csv(Var_Importance_Pearson_Table, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Var_Importance_Pearson.csv")
#export variable importance
```
#### Additional VIF Modeling
The following code is to conduct an VIF model for comparison of variable selection metrics using variance inflation factor (VIF) to select variables thereby offering a complementary analysis to Pearson's r.
##### VIF Variable Selection
We first use a function to remove variable that high high multicolinearity using VIF. The function conducts a stepwise process whereby the variable with the highest VIF is removed until all variables remaining have a VIF less than the designated threshold (5).
```{r, VIF Variable Selection}
vif_func<-function(in_frame,thresh=10,trace=T,...){
library(fmsb)
if(any(!'data.frame' %in% class(in_frame))) in_frame<-data.frame(in_frame)
#get initial vif value for all comparisons of variables
vif_init<-NULL
var_names <- names(in_frame)
for(val in var_names){
regressors <- var_names[-which(var_names == val)]
form <- paste(regressors, collapse = '+')
form_in <- formula(paste(val, '~', form))
vif_init<-rbind(vif_init, c(val, VIF(lm(form_in, data = in_frame, ...))))
}
vif_max<-max(as.numeric(vif_init[,2]), na.rm = TRUE)
if(vif_max < thresh){
if(trace==T){ #print output of each iteration
prmatrix(vif_init,collab=c('var','vif'),rowlab=rep('',nrow(vif_init)),quote=F)
cat('\n')
cat(paste('All variables have VIF < ', thresh,', max VIF ',round(vif_max,2), sep=''),'\n\n')
}
return(var_names)
}
else{
in_dat<-in_frame
#backwards selection of explanatory variables, stops when all VIF values are below 'thresh'
while(vif_max >= thresh){
vif_vals<-NULL
var_names <- names(in_dat)
for(val in var_names){
regressors <- var_names[-which(var_names == val)]
form <- paste(regressors, collapse = '+')
form_in <- formula(paste(val, '~', form))
vif_add<-VIF(lm(form_in, data = in_dat, ...))
vif_vals<-rbind(vif_vals,c(val,vif_add))
}
max_row<-which(vif_vals[,2] == max(as.numeric(vif_vals[,2]), na.rm = TRUE))[1]
vif_max<-as.numeric(vif_vals[max_row,2])
if(vif_max<thresh) break
if(trace==T){ #print output of each iteration
prmatrix(vif_vals,collab=c('var','vif'),rowlab=rep('',nrow(vif_vals)),quote=F)
cat('\n')
cat('removed: ',vif_vals[max_row,1],vif_max,'\n\n')
flush.console()
}
in_dat<-in_dat[,!names(in_dat) %in% vif_vals[max_row,1]]
}
return(names(in_dat))
}
}
Variables_VIF <- vif_func(in_frame=variable_table,thresh=5,trace=T)
#get the variables with VIF less than 5 for exploratory modeling.
```
##### VIF Data Preparation
Similar to above, we get a raster stack of the variables selected by a stepwise VIF variable selection conducted above.
```{r, VIF Data Prep}
files_VIF <- list.files(path = "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Data_Model_Development/VIF", full.names = TRUE )
#gets a list of the files for the automated raster import (VIF) All files must be in the same folder.
envs_VIF <- stack(files_VIF)
#load the Pearson variable set in a raster stack
```
##### VIF Data Modeling
Here we run maxent for the VIF variables similair to the biologically informed and Pearson variable set.
```{r, VIF Maxent}
model_VIF <- ENMevaluate(occ=occs.sp, env=envs_VIF, bg.coords=bg, method='block', RMvalues=c(.5, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5), fc=c("L", "LQ", "Q", "LQH", "LH", "QH", "H"), algorithm='maxent.jar')
#runs models at each rm value and each feature class for the VIF variable set
```
##### VIF Model Evaluation
We evalute the model simialar to the other two variable sets. However, these are supplementary results considering the VIF filtering did not improve model fit above Pearson filtering.
```{r, VIF Model Evaluation}
model_results_VIF <- as.data.frame(model_VIF@results) %>%
#converts the results to a data frame
filter(avg.test.AUC >= .6 & !is.na(AICc)) %>%
#filters out NAs and test AUC below .65
arrange(AICc)
#orders in ascending order by AICc
AICc_vector_VIF <- as.vector(model_results_VIF$AICc)
#creates a vector of the AICcs of the filtered data set
AICw_VIF <- akaike.weights(AICc_vector_VIF)
#calculates the AICw from the AIcc vector of the filtered data set
model_results_VIF <- model_results_VIF%>%
#overwrite model_results_VIF
dplyr::select(-w.AIC) %>%
#drops the current w.AIC
mutate(wAICc = AICw_VIF$weights)
#adds the new AIC weights based on the filtered model set the the results table
VIF_model_Results_csv <- model_results_VIF %>%
add_row(settings = "AICc_Avg",
avg.test.AUC = (((model_results_VIF[1,5] * model_results_VIF[1,16]) + (model_results_VIF[2,5] * model_results_VIF[2,16]))/ (model_results_VIF[1,16] + model_results_VIF[2,16])),
avg.diff.AUC = (((model_results_VIF[1,7] * model_results_VIF[1,16]) + (model_results_VIF[2,7] * model_results_VIF[2,16]))/ (model_results_VIF[1,16] + model_results_VIF[2,16])),
avg.test.orMTP = (((model_results_VIF[1,9] * model_results_VIF[1,16]) + (model_results_VIF[2,9] * model_results_VIF[2,16]))/ (model_results_VIF[1,16] + model_results_VIF[2,16])),
avg.test.or10pct = (((model_results_VIF[1,11] * model_results_VIF[1,16]) + (model_results_VIF[2,11] * model_results_VIF[2,16]))/ (model_results_VIF[1,16] + model_results_VIF[2,16]))) %>%
dplyr::select(-features, - rm,-train.AUC, -var.test.AUC, - var.diff.AUC, -var.test.orMTP, - var.test.or10pct)
#calculate averaged model statistics
write.csv(VIF_model_Results_csv, "C:/Users/antho/OneDrive - The University of Alabama/Niche_Modeling_Rivulus/R code/Maxent_Rivulus_Climate_Change/VIF_model_results.csv")
#write the model results to a csv
```
### Future Prediction
The following code projects models onto future environmental conditions. Each code chunk is a different climate change scenario. The general layout begins with importing the climate data and matching spatial extent if necessary. Then, I project the models used to create the averaged model onto the new data. Finally, I calculate the model averaged output.
#### Importing Future Enviromental Data
```{r, Importing-Future-Data-RCP-2.6}
# Rasters were on slightly different extents. The extent sizes did not affect the raster cell alignment. Therefore, the rasters were coerced into the same extent.
files_rcp_26_extent1 <- list.files( path = "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/RCP26_2050_Coastal_Tiff_For_R/Just_Tiffs/Same_Extents", full.names = TRUE )
# import the file names for raster stack
RCP26_1 <- stack(files_rcp_26_extent1)
#make raster stack
files_rcp_26_extent2 <- list.files( path = "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/RCP26_2050_Coastal_Tiff_For_R/Just_Tiffs/Same_Extent_2", full.names = TRUE )
# import the file names for raster stack
RCP26_2 <- stack(files_rcp_26_extent2)
#make raster stack
RCP26_2_ex <- raster::alignExtent(RCP26_2, RCP26_1)
#create extent object to crop to.
RCP26_1 <- raster::crop(RCP26_1, RCP26_2_ex)
#had to make the RCP26_2 data set extent align with RCP26_1
RCP_26 <- stack(RCP26_1, RCP26_2)
#stack the final RCP26 with the same extent
#### Biologically Informed
```
```{r, Importing-Future-Data-RCP-4.5}
# Rasters were on slightly different extents. The extent sizes did not affect the raster cell alignment. Therefore, the rasters were coerced into the same extent.
RCP_45_files_1 <- list.files( path = "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/RCP45_2050_Coastal_Tiff_For_R/Maxent_Files/Same_Extent_1", full.names = TRUE )
# import the file names for raster stack
RCP_45_files_2 <- list.files( path = "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/RCP45_2050_Coastal_Tiff_For_R/Maxent_Files/Same_Extent_2", full.names = TRUE )
# import the file names for raster stack
RCP_45_env_1 <- stack(RCP_45_files_1)
#make raster stack
RCP_45_env_2 <- stack(RCP_45_files_2)
#make raster stack
RCP45_2_ex <- raster::alignExtent(RCP_45_env_1, RCP_45_env_2)
#create extent object
RCP_45_env_2 <- raster::crop(RCP_45_env_2, RCP_45_env_1)
#crop to smaller extent
RCP_45 <- stack(RCP_45_env_1, RCP_45_env_2)
#stack RCP 45 environmental Data
```
```{r, Importing-Future-Data-RCP-6.0}
RCP_60_files <- list.files (path = "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/RCP60_2050_Coastal_Tiffs_For_R/Maxent", full.names = TRUE)
# import the file names for raster stack
#all RCP 60 were on the same extent so no need to crop
RCP_60_env <- stack(RCP_60_files)
#make raster stack
```
```{r, Importing-Future-Data-RCP-8.5}
RCP_85_files <- list.files( path = "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/RCP85 2050 Coastal For Maxent/Maxent", full.names = TRUE )
# import the file names for raster stack
#all RCP 8.5 were on the same extent so no need to crop
RCP_85_env <- stack(RCP_85_files)
#make raster stack
```
#### Biologically Informed
The following sections predict future suitability for all retained Biologically informed models. Each chunk is a different climate change scenario.
```{r, Bio RCP-2.6}
RCP_26_AIC1_bio <- dismo::predict(AIC1_bio, RCP_26, args= "outputformat=cloglog")
#project the lowest AIC model on to future climate data.
RCP_26_AIC2_bio <- dismo::predict(AIC2_bio, RCP_26, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP26_AIC_AVG_cloglog_bio <- ((RCP_26_AIC1_bio * model_results_bio[1,16]) + (RCP_26_AIC2_bio * model_results_bio[2,16])) / (model_results_bio[1,16] + model_results_bio[2,16])
#model average results to create RCP 2.6 predictions
```
```{r, Bio RCP-4.5}
RCP_45_AIC1_bio <- dismo::predict(AIC1_bio, RCP_45, args= "outputformat=cloglog")
#project the lowest AIC model on to future climate data.
RCP_45_AIC2_bio <- dismo::predict(AIC2_bio, RCP_45, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP45_AIC_AVG_cloglog_bio <- ((RCP_45_AIC1_bio * model_results_bio[1,16]) + (RCP_45_AIC2_bio * model_results_bio[2,16])) / (model_results_bio[1,16] + model_results_bio[2,16])
#model average results to create RCP 4.5 predictions
```
```{r, Bio RCP-6.0}
RCP_60_AIC1_bio <- dismo::predict(AIC1_bio, RCP_60_env, args= "outputformat=cloglog")
#project the lowest AIC model on to future climate data.
RCP_60_AIC2_bio <- dismo::predict(AIC2_bio, RCP_60_env, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP60_AIC_AVG_cloglog_bio <- ((RCP_60_AIC1_bio * model_results_bio[1,16]) + (RCP_60_AIC2_bio * model_results_bio[2,16])) / (model_results_bio[1,16] + model_results_bio[2,16])
#model average results to create RCP 6.0 predictions
```
```{r, Bio RCP-8.5}
RCP_85_AIC1_bio <- dismo::predict(AIC1_bio, RCP_85_env, args= "outputformat=cloglog")
#project the lowest AIC model on to future climate data.
RCP_85_AIC2_bio <- dismo::predict(AIC2_bio, RCP_85_env, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP85_AIC_AVG_cloglog_bio <- ((RCP_85_AIC1_bio * model_results_bio[1,16]) + (RCP_85_AIC2_bio * model_results_bio[2,16])) / (model_results_bio[1,16] + model_results_bio[2,16])
#model average results to create RCP 8.5 predictions
```
The following code ensures that all maps are on the same extent for downstream analysis.
```{r, Bio Match-Extents}
Future_exents <- raster::alignExtent(RCP26_AIC_AVG_cloglog_bio, AIC_AVG_cloglog_bio)
#create extent for all future model rasters
AIC_AVG_cloglog_bio_2 <- raster::crop(AIC_AVG_cloglog_bio, Future_exents)
#crop Current AIC AVG map to future extents
RCP45_AIC_AVG_cloglog_bio <- raster::crop(RCP45_AIC_AVG_cloglog_bio, Future_exents)
#crop RCP 4.5 output to future extents
RCP60_AIC_AVG_cloglog_bio <- raster::crop(RCP60_AIC_AVG_cloglog_bio, Future_exents)
#crop RCP 6.0 output to future extents
RCP85_AIC_AVG_cloglog_bio <- raster::crop(RCP85_AIC_AVG_cloglog_bio, Future_exents)
#crop RCP 8.5 output to future extents
```
The following code write all the files as geotiffs for visualization in ArcGIS Pro.
```{r, Bio Write-Geotiffs}
writeRaster(AIC_AVG_cloglog_bio_2, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Habitat Suitibility Maps from R/Biological_AIC_Avg_Cloglog.tif", format = "GTiff")
#write geotiff for visualization in ArcGIS Pro
writeRaster(RCP26_AIC_AVG_cloglog_bio, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Habitat Suitibility Maps from R/Biological_AIC_Avg_RCP_26_Cloglog.tif" )
#write geotiff for visualization in ArcGIS Pro
writeRaster(RCP45_AIC_AVG_cloglog_bio, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Habitat Suitibility Maps from R/Biological_AIC_Avg_RCP_45_Cloglog.tif" )
#write geotiff for visualization in ArcGIS Pro
writeRaster(RCP60_AIC_AVG_cloglog_bio, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Habitat Suitibility Maps from R/Biological_AIC_Avg_RCP_60_Cloglog.tif" )
#write geotiff for visualization in ArcGIS Pro
writeRaster(RCP85_AIC_AVG_cloglog_bio, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Habitat Suitibility Maps from R/Biological_AIC_Avg_RCP_85_Cloglog.tif" )
#write geotiff for visualization in ArcGIS Pro
```
#### Pearson
The following sections predict future suitability for all retained Pearson models. Each chunk is a different climate change scenario.
```{r, Pearson RCP-2.6}
RCP_26_AIC1_Pearson <- dismo::predict(AIC1_Pearson, RCP_26, args= "outputformat=cloglog")
#project the lowest AIC model on to future climate data
RCP_26_AIC2_Peason <- dismo::predict(AIC2_Pearson, RCP_26, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP_26_AIC3_Pearson <- dismo::predict(AIC3_Pearson, RCP_26, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP26_AIC_AVG_cloglog_Pearson <- ((RCP_26_AIC1_Pearson * model_results_Pearson[1,16]) + (RCP_26_AIC2_Peason * model_results_Pearson[2,16]) + (RCP_26_AIC3_Pearson * model_results_Pearson[3,16])) / (model_results_Pearson[1,16] + model_results_Pearson[2,16] + model_results_Pearson[3,16])
#average the outputs for averaged model
```
```{r, Pearson RCP-4.5}
RCP_45_AIC1_Pearson <- dismo::predict(AIC1_Pearson, RCP_45, args= "outputformat=cloglog")
#project the lowest AIC model on to future climate data.
RCP_45_AIC2_Pearson <- dismo::predict(AIC2_Pearson, RCP_45, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP_45_AIC3_Pearson <- dismo::predict(AIC3_Pearson, RCP_45, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP45_AIC_AVG_cloglog_Pearson <- ((RCP_45_AIC1_Pearson * model_results_Pearson[1,16]) + (RCP_45_AIC2_Pearson * model_results_Pearson[2,16]) + (RCP_45_AIC3_Pearson * model_results_Pearson[3,16])) / (model_results_Pearson[1,16] + model_results_Pearson[2,16] + model_results_Pearson[3,16])
```
```{r, Pearson RCP-6.0}
RCP_60_AIC1_Pearson <- dismo::predict(AIC1_Pearson, RCP_60_env, args= "outputformat=cloglog")
#project the lowest AIC model on to future climate data.
RCP_60_AIC2_Pearson <- dismo::predict(AIC2_Pearson, RCP_60_env, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP_60_AIC3_Pearson <- dismo::predict(AIC3_Pearson, RCP_60_env, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP60_AIC_AVG_cloglog_Pearson <- ((RCP_60_AIC1_Pearson * model_results_Pearson[1,16]) + (RCP_60_AIC2_Pearson * model_results_Pearson[2,16]) + (RCP_60_AIC3_Pearson * model_results_Pearson[3,16])) / (model_results_Pearson[1,16] + model_results_Pearson[2,16] + model_results_Pearson[3,16])
```
```{r, Pearson RCP-8.5}
RCP_85_AIC1_Pearson <- dismo::predict(AIC1_Pearson, RCP_85_env, args= "outputformat=cloglog")
#project the lowest AIC model on to future climate data.
RCP_85_AIC2_Pearson <- dismo::predict(AIC2_Pearson, RCP_85_env, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP_85_AIC3_Pearson <- dismo::predict(AIC3_Pearson, RCP_85_env, args= "outputformat=cloglog")
#project the 2nd lowest AIC model on to future climate data
RCP85_AIC_AVG_cloglog_Pearson <- ((RCP_85_AIC1_Pearson * model_results_Pearson[1,16]) + (RCP_85_AIC2_Pearson * model_results_Pearson[2,16]) + (RCP_85_AIC3_Pearson * model_results_Pearson[3,16])) / (model_results_Pearson[1,16] + model_results_Pearson[2,16] + model_results_Pearson[3,16])
```
The following code write all the files as geotiffs for visualization in ArcGIS Pro.
```{r, Pearson Write-Geotiffs}
AIC_AVG_cloglog_Pearson_2 <- raster::crop(AIC_AVG_cloglog_Pearson, Future_exents)
RCP45_AIC_AVG_cloglog_Pearson <- raster::crop(RCP45_AIC_AVG_cloglog_Pearson, Future_exents)
RCP60_AIC_AVG_cloglog_Pearson <- raster::crop(RCP60_AIC_AVG_cloglog_Pearson, Future_exents)
RCP85_AIC_AVG_cloglog_Pearson <- raster::crop(RCP_85_AIC3_Pearson, Future_exents)
#the above four lines of code is just getting all the outputs to be the same spatial extent. The extents are just slightly off. The slight extent difference did not affect the grid alignment.
writeRaster(AIC_AVG_cloglog_Pearson_2, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Habitat Suitibility Maps from R/Pearson_AIC_Avg_Cloglog.tif", format = "GTiff")
#write raster for ArcGIS Pro visualization
writeRaster(RCP26_AIC_AVG_cloglog_Pearson, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Habitat Suitibility Maps from R/Pearson_AIC_Avg_RCP_26_Cloglog.tif", format = "GTiff")
#write raster for ArcGIS Pro visualization
writeRaster(RCP45_AIC_AVG_cloglog_Pearson, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Habitat Suitibility Maps from R/Pearson_AIC_Avg_RCP_45_Cloglog.tif", format = "GTiff")
#write raster for ArcGIS Pro visualization
writeRaster(RCP60_AIC_AVG_cloglog_Pearson, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Habitat Suitibility Maps from R/Pearson_AIC_Avg_RCP_60_Cloglog.tif", format = "GTiff")
#write raster for ArcGIS Pro visualization
writeRaster(RCP85_AIC_AVG_cloglog_Pearson, "C:/Users/antho/Desktop/ARCGIS/Projects/ENM_Rivulus/R_Folder/Habitat Suitibility Maps from R/Pearson_AIC_Avg_RCP_85_Cloglog.tif", format = "GTiff")
```
### Niche Overlap
This code calculated Schoener's D between all maps (current and future).
```{r, Niche-Overlap}
AIC_1_cloglog_bio_2 <- raster::crop(AIC_1_cloglog_bio, Future_exents)
AIC_2_cloglog_bio_2 <- raster::crop(AIC_2_cloglog_bio, Future_exents)
AUC_cloglog_bio_2 <- raster::crop(AUC_cloglog_bio, Future_exents)
OR10_cloglog_bio_2 <- raster::crop(OR10_cloglog_bio, Future_exents)
AIC1_cloglog_Pearson_2 <- raster::crop(AIC1_cloglog_Pearson, Future_exents)
AIC2_cloglog_Pearson_2 <- raster::crop(AIC2_cloglog_Pearson, Future_exents)
AIC3_cloglog_Pearson_2 <- raster::crop(AIC3_cloglog_Pearson, Future_exents)
OR10_cloglog_Pearson_2 <- raster::crop(OR10_cloglog_Pearson, Future_exents)
#get all the Rasters on the same extent
All_Current_Future_Model_Raster_Stack <- stack(AIC_1_cloglog_bio_2, AIC_2_cloglog_bio_2, AUC_cloglog_bio_2, OR10_cloglog_bio_2, AIC_AVG_cloglog_bio_2, AIC1_cloglog_Pearson_2, AIC2_cloglog_Pearson_2, AIC3_cloglog_Pearson_2, OR10_cloglog_Pearson_2, AIC_AVG_cloglog_Pearson_2, RCP26_AIC_AVG_cloglog_bio, RCP45_AIC_AVG_cloglog_bio, RCP60_AIC_AVG_cloglog_bio, RCP85_AIC_AVG_cloglog_bio, RCP26_AIC_AVG_cloglog_Pearson, RCP45_AIC_AVG_cloglog_Pearson, RCP60_AIC_AVG_cloglog_Pearson, RCP85_AIC_AVG_cloglog_Pearson )
#create one raster stack with all model outputs
D_statistics_All_Current_Future <- calc.niche.overlap(All_Current_Future_Model_Raster_Stack)
#compute niche overlap
rownames(D_statistics_All_Current_Future) <- c("AIC1_Bio", "AIC2_Bio", "AUC_Bio", "OR10_Bio","AIC_Avg_Bio", "AIC1_Strict", "AIC2_Strict", "AIC3_Strict","OR1_Strict", "AIC_Avg_Strict", "RCP26_Bio", "RCP45_Bio", "RCP60_Bio", "RCP85_Bio", "RCP26_Strict", "RCP45_Strict", "RCP60_Strict", "RCP85_Bio")
colnames(D_statistics_All_Current_Future) <- c("AIC1_Bio", "AIC2_Bio", "AUC_Bio", "OR10_Bio","AIC_Avg_Bio", "AIC1_Strict", "AIC2_Strict", "AIC3_Strict","OR1_Strict", "AIC_Avg_Strict", "RCP26_Bio", "RCP45_Bio", "RCP60_Bio", "RCP85_Bio", "RCP26_Strict", "RCP45_Strict", "RCP60_Strict", "RCP85_Strict")
#change the names of the columns and rows.
D_statistics_All_Current_Future_Matrix_Sym <- Matrix::forceSymmetric(D_statistics_All_Current_Future,uplo="L")
D_statistics_All_Current_Future_Matrix_Sym[is.na(D_statistics_All_Current_Future_Matrix_Sym)] <-1
#makes the matrix symmetric
D_statistics_All_Current_Future_Table <- D_statistics_All_Current_Future %>%
as.table() %>%
as.data.frame() %>%
drop_na()
#creates a pairwise table for easy exploration
```
***
## Habitat Suitability Change
The following code chunks first classify habitat based on habitat suitability scores before calculating if the suitability classification increased, decreased, or remained unchanged.The table is then used to run a multinomial logistic regression to evaluate if region is a significant predictor of transition. The data sets used were created by converting habitat suitability maps as point data and assigning each point a region using the criteria in the methods section. The points were then exported and combined to create the final tables.
### Biologically Informed
```{r, Bio Multinomial-Regression}
Keys <- sf::st_sf(sf::st_sfc((sf::st_polygon(list(Keys = cbind(x = c(-80.233737, -80.088813, -80.182135, -81.191639, -82.421915, -82.025516,
-81.543536, -81.134018, -80.973724, -80.788178, -80.714619, -80.673021, -80.624591, -80.53566, -80.54115, -80.503821, -80.477075, -80.42038, -80.369877, -80.345193, -80.274359, -80.233737),
y = c(25.588852, 25.585558, 25.146396, 24.278309, 24.487718, 24.722605, 24.828004, 24.85655, 24.825808, 24.882899, 24.904858, 24.964025, 24.972928, 25.045389, 25.083816, 25.114557, 25.161526, 25.171648, 25.248502, 25.310211, 25.373663, 25.588852
)))))))
# this creates a polygon around the keys
Biological_Logistic_DF <- as.data.frame(RCP60_AIC_AVG_cloglog_bio, xy = TRUE) %>%
dplyr::mutate(Scenario = "RCP60") %>%
bind_rows(as.data.frame(RCP85_AIC_AVG_cloglog_bio, xy = TRUE) %>%
dplyr::mutate(Scenario = "RCP85")) %>%
bind_rows(as.data.frame(RCP45_AIC_AVG_cloglog_bio, xy = TRUE) %>%
dplyr::mutate(Scenario = "RCP45")) %>%
bind_rows(as.data.frame(RCP26_AIC_AVG_cloglog_bio, xy = TRUE) %>%
dplyr::mutate(Scenario = "RCP26"))%>%
bind_rows(as.data.frame(AIC_AVG_cloglog_bio, xy = TRUE) %>%
dplyr::mutate(Scenario = "Current")) %>%
drop_na() %>%
#makes on large data frame with all of the suitability scores for each model
sf::st_as_sf(x = ., coords = c("x", "y")) %>%
#makes it an sf object
cbind(sf::st_coordinates(.)) %>%
#binds the coordinates as columns
dplyr::rename(x = X, y = Y) %>%
#rename the coordinates