In the face of escalating climate change, the Arctic region is undergoing significant environmental upheaval, directly impacting the habitat of the polar bear, a species emblematic of this area. This project aims to explore the nuanced interaction between the habitat utilization of polar bears and the evolving conditions in the Arctic. Utilizing GPS data, we aim to map the current distribution of polar bears, establishing a baseline for understanding their habitat preferences and the ongoing research efforts dedicated to their study. Our analysis proceeds to examine the complex interplay between the dietary habits of polar bears and the amount of time they spend in open water. Preliminary results from statistical models suggest a significant impact of the melting season on the bears’ diet, indicating dietary shifts as sea ice recedes and they adapt to more aquatic hunting environments. Further, we delve into the dynamic relationship between sea ice coverage and polar bear movements over time. This aspect of our research aims to highlight the bears’ adaptation strategies and habitat preferences in response to sea ice fluctuations. Expanding our scope, we assess the broader effects of climate change on Arctic ecosystems, focusing on temperature fluctuations and ice melt patterns in key polar bear habitats, such as those in Alaska. This comprehensive examination seeks to elucidate the consequences of climate change on the availability and suitability of habitats for polar bears, providing a holistic view of the challenges they face.
2 Introduction
2.1 Overview and motivation
As the Arctic confronts rapid shifts in sea ice patterns and temperature due to climate change, critical habitats essential for polar bear survival are directly affected. Motivated by the urgent need to address the profound impact of climate change on Arctic ecosystems, this project is committed to a thorough understanding of polar bear habitat utilization, the correlation between their movements and changing sea ice conditions, and the broader consequences of these environmental changes. Our research combines rigorous data analysis with the immediacy of the climate crisis, aiming to contribute to wildlife conservation dialogue and support policies safeguarding the Arctic’s iconic species.
2.2 Research questions
How has climate change impacted polar bear movement patterns and habitat utilization as depicted by GPS data?
Can polar bear movement patterns be predicted using GPS data?
Is there a link between the diet of polar bears and the number of days they spend in open water?
3 Data
3.1 Data Source
Our primary data for understanding bear demography and the interrelationship between ‘Ursus maritimus’ (polar bears) and ‘Pusa hispida’ (ringed seals) comes from the Living Planet Index (LPI), which focuses on population dynamics around the world. Despite the difficulties associated with the consistency of the data, this dataset is essential for the continuation of our research.
To track polar bear movements over time, we rely on a dataset collected by the US Geological Survey ([USGS])(https://www.usgs.gov/about/about-us/who-we-are). This data set provides detailed information on polar bear locations.
Data Description
Code
tibble(Variables=c("BearID_rsf", "DateTimeUTC_rsf", "latitude_rsf", "longitude_rsf", "season", "Many variables finally not used" ),Meaning =c("Unique ID per observation", " Date and time of the observation in Coordinated Universal Time (UTC)", "Latitude coordinate of the bear's location at the time of the observation", "Longitude coordinate of the bear's location at the time of the observation", "Time of year when the observation was made", "..."))%>%kable()%>%kable_styling(bootstrap_options =c("striped", "hover", "condensed", "responsive"))
Variables
Meaning
BearID_rsf
Unique ID per observation
DateTimeUTC_rsf
Date and time of the observation in Coordinated Universal Time (UTC)
latitude_rsf
Latitude coordinate of the bear's location at the time of the observation
longitude_rsf
Longitude coordinate of the bear's location at the time of the observation
season
Time of year when the observation was made
Many variables finally not used
...
Temperature data covering the period from 1993 to 2023 on the Beaufort Sea coast is gathered from the PELLY ISLAND weather station, the most advanced station.
Data Description
Code
tibble(Variables=c("Date", "TAVG..Degrees.Fahrenheit.", "TMAX..Degrees.Fahrenheit.", "TMIN..Degrees.Fahrenheit.", "Many others variables finally not used" ),Meaning =c("Date", "Average temperature in degrees Fahrenheit", "Maximum temperature in degrees Fahrenheit", "Minimum temeperature in degrees Fahrenheit", "..."))%>%kable()%>%kable_styling(bootstrap_options =c("striped", "hover", "condensed", "responsive"))
Variables
Meaning
Date
Date
TAVG..Degrees.Fahrenheit.
Average temperature in degrees Fahrenheit
TMAX..Degrees.Fahrenheit.
Maximum temperature in degrees Fahrenheit
TMIN..Degrees.Fahrenheit.
Minimum temeperature in degrees Fahrenheit
Many others variables finally not used
...
Sea ice coverage data, offering a detailed graphical representation of ice extent and relying on precise visible imagery data, is sourced from the MASIE-NH (Multisensor Analyzed Sea Ice Extent – Northern Hemisphere).
Data Description
Code
tibble(Variables =c("yyyyddd", "Beaufort_Sea" , "Many others variables finally not used" ),Meaning=c ("Date of the observation", "Daily 4km sea ice component in the region of Beaufort Sea", "..."))%>%kable()%>%kable_styling(bootstrap_options =c("striped", "hover", "condensed", "responsive"))
Variables
Meaning
yyyyddd
Date of the observation
Beaufort_Sea
Daily 4km sea ice component in the region of Beaufort Sea
Many others variables finally not used
...
Additional data from Aerial Master, covering the locations of polar bears in Alaska from 1979 to 2011 and from 2015 to 2017, will be merged for comprehensive analysis.
Data Description
Code
tibble(Variables =c("ID", "GMT_Minus8_DateTime", "ArcLat", "Arclong", "Many others variables finally not used"), Meaning =c("Unique ID per observation", "Date and time of the observation", "Latitude", "Longitude", "...")) %>%kable("html") %>%kable_styling(bootstrap_options =c("striped", "hover", "condensed", "responsive"))
Variables
Meaning
ID
Unique ID per observation
GMT_Minus8_DateTime
Date and time of the observation
ArcLat
Latitude
Arclong
Longitude
Many others variables finally not used
...
Lastly, insights into the diets of polar bears in the Beaufort Sea, crucial for exploring dietary trends and their ecological implications, are provided by a dataset from USGS.
Data Description
Code
tibble(Variables =c("BearID","Year","Capture.date","Ageclass", "Sex", "OW_50pcrt","Meltseason","Bearded_seal","Ringed_seal","Beluga_whale","Bowhead_whale","Seabird_nestling"), Meaning =c("Unique observation per bear","Year of the capture","Date of the capture", "The stage of maturity of the polar bear","The sex of the polar bear", "Number of days covered in open water","Number of days of the meltseason in the corresponding year","Percentage of bearded seal eaten in the corresponding period","Percentage of ringed seal eaten in the corresponding period","Percentage of beluga whale eaten in the corresponding period","Percentage of bowhead sealed eaten in the corresponding period","Percentage of seabird nestling eaten in the corresponding period"))%>%kable()%>%kable_styling(bootstrap_options =c("striped", "hover", "condensed", "responsive"))
Variables
Meaning
BearID
Unique observation per bear
Year
Year of the capture
Capture.date
Date of the capture
Ageclass
The stage of maturity of the polar bear
Sex
The sex of the polar bear
OW_50pcrt
Number of days covered in open water
Meltseason
Number of days of the meltseason in the corresponding year
Bearded_seal
Percentage of bearded seal eaten in the corresponding period
Ringed_seal
Percentage of ringed seal eaten in the corresponding period
Beluga_whale
Percentage of beluga whale eaten in the corresponding period
Bowhead_whale
Percentage of bowhead sealed eaten in the corresponding period
Seabird_nestling
Percentage of seabird nestling eaten in the corresponding period
3.2 Data Cleanup
At this stage, we are taking care of our different data sets, and are oragnising them into several tables that will help us to answer our research questions individually.
3.2.1 Living Planet Database
We start by defining the year columns and convert them to numeric, then we calculate the annual sum for each species. We then calculate a 5-year cumulative sum for each species, and prepare the data for plotting. We also calculate the moving average for the plot data. Then we convert all columns with names starting with ‘X’ followed by 4 digits to numeric, and replace non-numeric values in these columns with NA. We calculate the sum of values in columns starting with ‘X’, select only relevant columns for mapping, and plot the global distribution of polar bears.
Code
year_columns <-paste0("X", 1970:2020)ursus_data <-apply(data1[data1$Binomial =="Ursus maritimus", year_columns], 2, as.numeric)pusa_data <-apply(data2[data2$Binomial =="Pusa hispida", year_columns], 2, as.numeric)ursus_annual_sum <-colSums(ursus_data, na.rm =TRUE)pusa_annual_sum <-colSums(pusa_data, na.rm =TRUE)# Function to calculate the cumulative sum over 5-year periodscalculate_5yr_cumulative_sum <-function(annual_sum) { cum_sum_5yr <-numeric(length(annual_sum))for (i in1:length(annual_sum)) { start_index <-max(1, i -4) cum_sum_5yr[i] <-sum(annual_sum[start_index:i]) }return(cum_sum_5yr)}ursus_cum_sum_5yr <-calculate_5yr_cumulative_sum(ursus_annual_sum)pusa_cum_sum_5yr <-calculate_5yr_cumulative_sum(pusa_annual_sum)years <-1970:2020ursus_plot_data <-data.frame(Year = years, Cumulative_Sum_5yr = ursus_cum_sum_5yr)pusa_plot_data <-data.frame(Year = years, Cumulative_Sum_5yr = pusa_cum_sum_5yr)ursus_plot_data$Moving_Avg <-rollmean(ursus_plot_data$Cumulative_Sum_5yr, 10, fill =NA, align ="right")pusa_plot_data$Moving_Avg <-rollmean(pusa_plot_data$Cumulative_Sum_5yr, 10, fill =NA, align ="right")polar_bears<- data1x_cols <-grep("^X\\d{4}$", names(polar_bears))polar_bears[, x_cols] <-lapply(polar_bears[, x_cols], function(x) {suppressWarnings(as.numeric(as.character(x)))})polar_bears[, x_cols][!sapply(polar_bears[, x_cols], is.numeric)] <-NApolar_bears$Totalpolarbears <-rowSums(polar_bears[, x_cols], na.rm =TRUE)polar_bears[, x_cols][!sapply(polar_bears[, x_cols], is.numeric)] <-NApolar_bears$Totalpolarbears <-rowSums(polar_bears[, x_cols], na.rm =TRUE)polar_bears_map <- polar_bears[, c("Latitude", "Longitude", "Totalpolarbears")]min_lat <-60max_lat <-90min_lon <--180max_lon <-180polar_bears_filtered <-filter(polar_bears, Latitude >= min_lat & Latitude <= max_lat & Longitude >= min_lon & Longitude <= max_lon)polar_bears_filtered2 <- polar_bears_filtered %>%mutate(MarkerColor =ifelse(Totalpolarbears >=10000, "blue", "red"))scale_factor <-0.005
3.2.2 Aerial Master Database
Here’s how we’re going to proceed for our Aerial Master (AM) table. We start to calculate the number of missing values for each column in the AM data set, then we identify the columns with more than 200,000 missing values, and decide to remove them from the data set. For better clarity, we rename the columns in the data set. Then we calculate the proportion of missing values for each column in the AM data set, and create a data frame with column names and proportions of missing values, by sorting the data frame by the proportion of missing values in descending order.
We create a bar chart to visualize the proportion of missing values for each column:
Code
gg1 <-ggplot(df, aes(x = colonne, y = part_nulles, text =paste("Column:", colonne, "<br>:Share of zero values:", scales::percent(round(part_nulles, 2))))) +geom_bar(stat ="identity", fill ="steelblue", width =0.8) +labs(title ="As we can see, many columns have quite a lot of missing data ",x ="Columns",y ="Share of zero values per column") +scale_y_continuous(labels =percent_format()) +coord_flip() +geom_text(aes(label = scales::percent(round(part_nulles, 2))), hjust =-0.1, vjust =0.5, size =1.8) +theme(axis.text.y =element_text(size =4))ggplotly(gg1, tooltip ="text")
Due to the significant amount of missing data, only location data is retained. Other columns are binary variables representing parameters of little interest or with too many missing values. We then calculate the proportion of missing values for each column in the final data set, and we remove rows with missing values from it. Then we separate the “Datetime” column into individual components (month, day, year, hour, minute, second, period), and select relevant columns for further analysis.
Again, we create a bar chart to visualize the number of observations per year.
Code
AM_fin2_ <- AM_fin2 %>%group_by(year) %>%summarise(count =n()) %>%ungroup()AM_fin2_$tooltip <-paste("Year:", AM_fin2_$year, "<br>Number of Observations:", AM_fin2_$count)p <-ggplot(data = AM_fin2_, aes(x = year, y = count)) +geom_bar(stat ="identity", aes(text = tooltip), fill ="steelblue") +labs(title ="Number of observations per year", x ="Year", y ="") +theme_minimal()ggplotly(p, tooltip ="text")
We combine the filtered data from the two final data sets into a single data frame.
Code
df_merged <-rbind(AM_fin, AM_fin2)df_merged <- df_merged[df_merged$Latitude !=0& df_merged$Longitude !=0,]# Utilisation de file.path() pour construire le cheminiconPath <-file.path("photo", "polarBear.png")# Création de l'icône avec le chemin compatible multiplateformeicon <-makeIcon(iconUrl = iconPath, iconWidth =35, iconHeight =35)
For the third data set about the diets of polar bears in Beaufort, there is fast no data cleaning.
We began by extracting the essential information, such as each bear’s identifier, date and geographical coordinates. This data was then converted into standardised formats to ensure the consistency and accuracy of the analysis. A crucial aspect of our processing was data cleaning, where we eliminated incomplete records to ensure the reliability of our study. After organising the data by bear identifier and date, we calculated the distance traveled between successive bear points using Haversine’s formula. As a result, the first GPS broadcast for each bear does not have a value in the distance column calculated in this way. This method provides us with valuable insights into the movement patterns of bears. This approach created a coherent and detailed data set, essential for our behavioural analysis of bear movements in their natural habitat.
nb_obs <-read_csv(here::here("Report/données/ours_clean.csv"))# Convertir la date en format Date et extraire l'annéenb_obs$date <-as.Date(nb_obs$date)nb_obs$year <-format(nb_obs$date, "%Y")# Calculer le nombre d'observations par annéeobservations_par_an <- nb_obs %>%group_by(year) %>%summarise(NumberPointGPS =n())# Créer un graphiquegraph_nb_obs <-ggplot(observations_par_an, aes(x = year, y = NumberPointGPS, fill = NumberPointGPS)) +geom_bar(stat ="identity") +theme_minimal() +scale_fill_gradient(low ="blue", high ="red") +labs(title ="Number of polar bear GPS relvets by year",x ="Year",y ="Number of GPS points") +theme(axis.text.x =element_text(angle =90, hjust =1)) # Rotation des étiquettes# Convertir en graphique interactifgraph_nb_obs_interactif <-ggplotly(graph_nb_obs, tooltip =c("x", "y"))# Afficher le graphiquegraph_nb_obs_interactif
3.2.4 Temperatures Data Base
In order to clean this data set, we converted the temperatures from Fahrenheit to Celsius, an international standard that makes them easier to understand and compare. The next step was to merge the maximum and minimum temperature data based on date to get a consistent overview. Finally, we calculated the daily average temperature, which provides a more balanced and meaningful perspective of weather conditions. To simplify and clarify our results, we chose to keep only the mean temperature data, eliminating the maximum and minimum temperature columns. This process provided an accurate and easily interpretable overview of climate trends on Pelly Island.
To refine our analysis of the Beaufort Sea, we first filtered the data, discarding information relating to other maritime regions. Next, we converted the date format from ‘yyyyyddd’ to a standard format, facilitating temporal analyses. These data preparations are crucial to ensuring the accuracy and relevance of our future analyses.
From this data set, we assigned the nearest mean temperature date to each polar bear GPS point. In order to do this, we scanned each polar bear observation, calculated the difference in days between that observation and the dates of the temperature readings, and selected the temperature corresponding to the closest date. This process made it possible to precisely link the climatic conditions to the specific positions of the bears.
Code
ours_clean$Closest_Avg_Temperature <-numeric(nrow(ours_clean))for (i in1:nrow(ours_clean)) {# Calculate the difference in days differences <-abs(difftime(temp_beaufort$Date, ours_clean$date[i], units ="days"))# Find the minimum difference index closest_idx <-which.min(differences)# Assign the nearest average temperature ours_clean$Closest_Avg_Temperature[i] <- temp_beaufort$Average_Temperature[closest_idx]}ours_clean <-arrange(ours_clean, bearid)ours_clean <- ours_clean %>%arrange(bearid, date)bear_periods <- ours_clean %>%group_by(bearid) %>%summarise(start_date =min(date), end_date =max(date))count_active_bears <-function(date, periods) {sum(periods$start_date <= date & periods$end_date >= date)}unique_dates <-unique(ours_clean$date)count_bears_per_date <-sapply(unique_dates, function(date) count_active_bears(date, bear_periods))count_bears_df <-data.frame(date = unique_dates, Count_Bears = count_bears_per_date)ours_clean <-merge(ours_clean, count_bears_df, by ="date")
3.2.7 Data Set Regression for Travel Forecasts
We load the data set we have been working on in the Analysis section. We will need it to be able to predict bear movement in the future.
We use a methodical approach to develop and evaluate predictive models of latitude and longitude. We began by dividing our selected data set into two distinct sets: one for training and one for testing, ensuring reproducibility through a fixed seed parameter. This division ensured that models would be trained on a subset of the data and tested on a separate set, not used during training, for an unbiased assessment of their performance.
We then trained two separate models using the random forest algorithm, one to predict latitude and the other for longitude, excluding longitude and latitude respectively from the predictor variables to avoid redundancy. After training, we used the models to predict latitude and longitude values on the test set.
The performance of the models was evaluated by calculating the root mean square error (RMSE) for the latitude and longitude predictions. The results showed an RMSE of 1.2227 for latitude and 13.4141 for longitude. By quantifying the mean difference between predicted and actual values, these RMSE measurements revealed that the latitude model was relatively accurate, while the longitude model had a greater margin of error.
We extend our study to include predictions over the next five years. Using the latest date in our data set as a starting point, we have generated a sequence of future dates. To these dates, we used a function to associate the relevant mean temperature and ice extent data for the Beaufort Sea, taking care to fill in any gaps with the median of the available temperatures, to maintain data consistency.
We then enriched the future data by assigning bear identifiers (BearIDs) to each GPS point, simulating the tracking of 20 different bears. This step allowed us to contextualize our predictions within a more realistic framework, reflecting the potential diversity of bear movements in the future.
Using the random forest models, we had previously trained, we predicted the geographical positions (latitude and longitude) for each combination of BearID and future date. These predictions, based on anticipated environmental conditions, were compiled into a new dataset, providing a prospective view of possible polar bear movements in the face of future climate and environmental change. This work represents a significant advance in our understanding of polar bear dynamics and their potential adaptation to changes in their habitat.
Code
data$date <-as.Date(data$date)data$year <-year(data$date)data$month <-month(data$date)data$day <-day(data$date)data_selected <- data %>%select(latitude, longitude, year, month, day, Closest_Avg_Temperature, Beaufort_Sea, date)data_selected <-na.omit(data_selected)# Division des données en ensemble d'entraînement et de testset.seed(123) # Pour la reproductibilitéindices <-sample(1:nrow(data_selected), size =0.8*nrow(data_selected))train_data <- data_selected[indices, ]test_data <- data_selected[-indices, ]# Entraînement du modèle pour la latitudemodel_latitude <-randomForest(latitude ~ ., data = train_data[, -2]) # Entraînement du modèle pour la longitudemodel_longitude <-randomForest(longitude ~ ., data = train_data[, -1]) predictions_latitude <-predict(model_latitude, test_data)predictions_longitude <-predict(model_longitude, test_data)rmse_latitude <-sqrt(mean((predictions_latitude - test_data$latitude)^2))rmse_longitude <-sqrt(mean((predictions_longitude - test_data$longitude)^2))print(paste("RMSE Latitude:", rmse_latitude))#> [1] "RMSE Latitude: 1.2227392145361"print(paste("RMSE Longitude:", rmse_longitude))#> [1] "RMSE Longitude: 13.4141324335172"last_date <-max(data_selected$date)future_dates <-seq(from = last_date +1, by ="day", length.out =5*365)future_data <-data.frame(date = future_dates,Closest_Avg_Temperature = temp_beaufort$Average_Temperature[match(future_dates, temp_beaufort$date)],Beaufort_Sea = glace_beaufort$Beaufort_Sea[match(future_dates, glace_beaufort$date)],year =year(future_dates),month =month(future_dates),day =day(future_dates))nombre_ours <-20bear_id_start <-301total_days <-length(future_dates)future_data$BearID <-rep(bear_id_start:(bear_id_start + nombre_ours -1), times =ceiling(total_days / nombre_ours))[1:total_days]predicted_latitude <-predict(model_latitude, future_data)predicted_longitude <-predict(model_longitude, future_data)predictions <-data.frame(BearID = future_data$BearID, date = future_dates, latitude = predicted_latitude, longitude = predicted_longitude)predictions <-na.omit(predictions)
4 Exploratory Data Analysis
The two following graphs show cumulative trends over 5 years for two distinct species: the ringed seal (Pusa hispida) and the polar bear (Ursus maritimus), respectively. The first trend, represented by a green line, shows the cumulative sum over 5 years of seal counts. This shows how the total number of seals and bears observed has evolved over a rolling 5-year period. The second trend, a dotted red line, represents a moving average. This average smoothes out annual variations to give a better idea of the general trend over the long term. It is important to note that our data set no longer contains data from 2010 onwards, which explains the decline.
In light of recent data, predominantly sourced from the American continent, there is growing concern over the declining population of Polar Bears (Ursus maritimus). This trend warrants a closer examination of the origins of our data. To gain a clearer understanding of these patterns, we will delve into the geographic source of this information. Such an approach is crucial, as it allows us to pinpoint specific regions contributing most significantly to the data set.
On the following map, we identify the locations from which the majority of our polar bear sightings are reported. Given the essential nature of these data for understanding the state of polar bear populations, identifying the main source regions is a step that helped us greatly in subsequently guaranteeing the robustness of our results.
From this graph, we will identify the locations from which the majority of our polar bear sightings are reported. Given the essential nature of these data for understanding the state of polar bear populations, identifying the main source regions is a step that helped us greatly in subsequently guaranteeing the robustness of our results.
In order to address our research questions, we decided to focus on Alaska, as it is the region that provides the best amount of data.
4.1 How has climate change impacted polar bear movement patterns and habitat utilization as depicted by GPS data?
In this initial phase, we have gathered the essential data to analyze the movement of polar bears and the impacts of climate change. We selected temperature readings from various meteorological stations in the Beaufort Sea as our primary indicator. Additionally, we have investigated the trends in ice cover and its temporal fluctuations. The process of processing, merging, and analyzing disparate data sets presents a significant challenge. Currently, our statistical analysis primarily considers temperature changes as the key factor in explaining the migration patterns of polar bears.
Code
couleurs_saisons <-c("Spring"="#89A45E", "Summer"="#7FC6BC", "Autumn"="#D17A22", "Winter"="#5A7D9A")# Déterminer les années uniques dans les donnéesunique_years <-unique(year(ymd(temp_beaufort_graph$date)))# Fonction pour générer un graphique par saison et annéegenerate_plot <-function(season, year) { data_filtered <- temp_beaufort_graph %>%filter(season == season, year(ymd(date)) == year) %>%mutate(Average_Temperature =round(Average_Temperature *2) /2) couleur_ligne <- couleurs_saisons[season]ggplot(data_filtered, aes(x = date, y = Average_Temperature, group = season)) +geom_line(color = couleur_ligne, alpha =0.7) +geom_point(color = couleur_ligne, size =1, alpha =0.7) +theme_minimal() +labs(title =paste("Temperature in the Beaufort Sea: ", season, " ", year),x ="Date",y ="Temperature (°C)")}# Générer et sauvegarder les graphiques en tant que fichiers HTML pour chaque combinaison saison-annéefor (season innames(couleurs_saisons)) {for (year in unique_years) { plotly_plot <-ggplotly(generate_plot(season, year)) html_file <-paste0("plot_", season, "_", year, ".html") htmlwidgets::saveWidget(plotly_plot, file = html_file) }}
Here you can see data on the location of polar bears in 1979. The interest is not in the number of data, as we have seen from the graph of the number of sightings that these data are inconsistent and tend to increase as the years go by. The interest lies rather in the general location of all these data. So here we see that polar bears tended to live in northern Alaska in 1979.
The locations of polar bears in 1990 are shown here. Compared with 1979, we can observe a westward shift in the average location of the bears. However, they still remain in northern Alaska.
Data for 2015 are shown here. Compared with 1990, there has been a clear westward shift in location data. Some bears remain in the north, but it is interesting to note that some bears also live in the far west of Alaska, but no longer in the north.
To represent the movements of polar bears within our data set, we needed to generate a trend for the average distance these mammals travel each day. We calculated the total distance traveled by each bear per day and per year. Next, we determined the daily average of this distance for each bear per year. Finally, we calculated the overall average of these daily averages for all the bears, year by year, in order to identify a general trend in the distances traveled by polar bears over time. These results are shown in the following interactive graph, and you can select a specific year by double-clicking on it. As explained in the graph (graph number on the number of GPS points per year) we have a wide disparity in our data depending on the year. Despite this, a trend in the daily distance traveled by polar bears can be seen in the graph. There has been a downward trend in this distance over the last 15 years.
Code
plot_distance <- ours_clean# Convertir la colonne date en type date et extraire l'annéeplot_distance$date <-as.Date(plot_distance$date)plot_distance$year <-year(plot_distance$date)# Calculer la distance totale parcourue par jour pour chaque ours dans chaque annéedistance_journaliere_par_annee <- plot_distance %>%group_by(bearid, date, year) %>%summarize(distance_totale =sum(Distance, na.rm =TRUE))# Calculer la moyenne quotidienne pour chaque ours par annéemoyenne_quotidienne_par_ours_par_annee <- distance_journaliere_par_annee %>%group_by(bearid, year) %>%summarize(jours_uniques =n(),distance_annuelle =sum(distance_totale, na.rm =TRUE),moyenne_quotidienne = distance_annuelle / jours_uniques )# Calculer la moyenne globale quotidienne pour chaque année sur tous les oursmoyenne_globale_quotidienne_par_annee <- moyenne_quotidienne_par_ours_par_annee %>%group_by(year) %>%summarize(moyenne_globale =mean(moyenne_quotidienne, na.rm =TRUE))# Créer un histogramme avec ggplotgraph_distance <-ggplot(moyenne_globale_quotidienne_par_annee, aes(x = year, y = moyenne_globale, fill =as.factor(year), text = moyenne_globale)) +geom_bar(stat ="identity") +scale_fill_viridis_d() +theme_minimal() +labs(fill ="Year", x ="Year", y ="Average weekly distance in metres", title ="Average weekly distance travelled per year")# Convertir le graphique ggplot en un graphique plotly interactif# 'text' spécifie les informations à afficher dans l'info-bullep_plotly_distance_ours <-ggplotly(graph_distance, tooltip ="text")# Afficher le graphiquep_plotly_distance_ours
In addition to temperature and ice cover in the Beaufort Sea, we want to add another variable to our data set. It seems important to us to reflect the number of active polar bears (i.e. transmitting GPS data) present in our data set on a date T. This is why we have created a “Bear Counter” function, which associates the number of active polar bears with each GPS point. This allows us to adjust our data set in anticipation of our analysis. The following graph shows this function and thus the evolution of the number of active polar bears in the study over the years. Here again we can see that our data is fairly heterogeneous from year to year. This reinforces our idea of increasing our understanding of the data set to develop a rigorous statistical analysis.
Code
plot_nb_ours <- ours_cleanplot_nb_ours$date <-as.Date(plot_nb_ours$date)plot_nb_ours$year <-year(plot_nb_ours$date)# Calculer la moyenne du nombre d'ours actifs par année et arrondir à l'entier supérieurmoyenne_ours_par_annee <- plot_nb_ours %>%group_by(year) %>%summarize(moyenne_ours =ceiling(mean(Count_Bears, na.rm =TRUE)))# Créer un graphique avec ggplotgraph_ours_v1 <-ggplot(moyenne_ours_par_annee, aes(x = year, y = moyenne_ours, group =1)) +geom_line() +scale_y_continuous(limits =c(0, 50)) +# Fixer les limites de l'axe Y si nécessairetheme_minimal() +labs(x ="Year", y ="Number of bears studied per year", title ="Number of bear observations")# Animer le graphiquenb_ours_anime <- graph_ours_v1 +transition_reveal(year)# Enregistrer l'animationanim_save("/Users/zoedardare/Documents/Master Management/Data science in BA/Quarto polar bears_files/Data Ugo/animation_moyenne_ours.gif", animation = nb_ours_anime)# Afficher l'animationanimate(nb_ours_anime)
We have been able to separate the temperatures into 4 seasons over the years. We then notice a very strong seasonality through the average temperatures. What’s more, we don’t specifically see an increase or decrease in these temperatures over time.
To represent the average ice cover in the Beaufort Sea, we have also chosen to divide it up by season. In the following graph, you can double-click on a season to isolate it from the others. As with temperature, there is a strong seasonal effect on the surface area (in km2) of ice in the Beaufort Sea. In addition, there is a tendency for this to decrease over the years.
Code
# Fonction pour déterminer la saison#getSeason <- function(date) {# month <- as.numeric(format(date, "%m"))# if (month %in% c(3, 4, 5)) {# return("Spring")# } else if (month %in% c(6, 7, 8)) {# return("Summer")# } else if (month %in% c(9, 10, 11)) {# return("Fall")# } else {# return("Winter")# }#}# Ajouter la colonne saison#glace_beaufort_graph <- glace_beaufort %>%# mutate(season = sapply(date, getSeason))#couleurs_saisons <- c("Spring" = "#89A45E", # "Summer" = "#7FC6BC", # "Fall" = "#D17A22", # "Winter" = "#5A7D9A")# Création du graphique ggplot#graph_beaufort <- ggplot(glace_beaufort_graph, aes(x = date, y = Beaufort_Sea, color = season)) +# geom_line() +# scale_color_manual(values = couleurs_saisons) +# theme_minimal() +# labs(title = "Extent of Beaufort Sea ice by year and season",# x = "Year",# y = "Extent of ice (km²)")# Conversion en graphique interactif avec plotly#graph_beaufort_interactif <- ggplotly(graph_beaufort)# Afficher le graphique#graph_beaufort_interactif
4.2 Can movement patterns of polar bears be predicted using GPS data?
Code Visualization
We can then plot the movements of each polar bear in our Beaufort Sea study on a map. What’s more, each GPS point is characterised by its year and the distance the polar bear has traveled since its last GPS fix. As the GPS points are not homogeneous depending on the BearID and the year, the track between the points is not the real trajectory of the polar bear selected. It presents the general idea of the journey made. For greater accuracy, it would be necessary to increase the number of GPS readings over time.
4.4 Is there a link between the diet of polar bears and the number of days they spend in open water?
Code Visualization
To answer this question, we use the database about the diet of polar bears on days spent in open water.
We create a scatterplot to visualize the relationship between the days in covered water and the ringed eaten by the polar bears.
Code
p_basic <-ggplot(pb, aes(x = days_in_cov_water, y = Perc_ringed_eaten)) +geom_point() +ggtitle("No clear relation between days in cover water and ringed seal consumed") +xlab("Number of days in water in melt season") +ylab("Ringed seal consumed in the during the previous year")theme(plot.title =element_text(size =12)) # Ajustez la taille ici#> List of 1#> $ plot.title:List of 11#> ..$ family : NULL#> ..$ face : NULL#> ..$ colour : NULL#> ..$ size : num 12#> ..$ hjust : NULL#> ..$ vjust : NULL#> ..$ angle : NULL#> ..$ lineheight : NULL#> ..$ margin : NULL#> ..$ debug : NULL#> ..$ inherit.blank: logi FALSE#> ..- attr(*, "class")= chr [1:2] "element_text" "element"#> - attr(*, "class")= chr [1:2] "theme" "gg"#> - attr(*, "complete")= logi FALSE#> - attr(*, "validate")= logi TRUEp_basics <-ggplotly(p_basic)p_basics
The following graph shows the percentage of animals eaten.
Code
attach(pb)data <-data.frame(labels =c("Ringed seals", "Bearded seals", "Seabirds", "Bowhead whales", "Belugas"),values =c(mean(Perc_ringed_eaten), mean(Perc_bearded_eaten),mean(Perc_seabird_eaten), mean(Perc_bowhead_eaten),mean(Perc_beluga_eaten)))ordered_data <- data %>%arrange(desc(values))# Create the bar chartordered_data$values_rounded <-round(ordered_data$values, 2)ordered_data$tooltip <-paste("Specy:", ordered_data$labels, "<br>Proportion:", ordered_data$values_rounded,"%")gg <-ggplot(ordered_data, aes(x = labels, y = values, text = tooltip)) +geom_bar(stat ="identity", width =0.75, fill =c("lightblue", "darkblue", "lightyellow", "skyblue", "blue")) +labs(title ="Ringed seals is the favourite food for polar bears", x ="Species eaten", y ="Proportion (%)")ggplotly(gg, tooltip ="text")
5 Analysis
5.1 A decreasing polar bear population
We can see that the location of bears changes over time. As previously stated, an analysis based on the number of data points is of little relevance, as the bears were not specified in the data, and we can imagine an improvement in the methods and means put in place to obtain these measurements over time. What we can analyse, however, is the gradual shift towards the west in the measurements taken. We can imagine that as a result of global warming, bears are tending to seek out colder regions, and that while northern Alaska fulfilled this condition in the 80s and 90s, they now have to move to the even colder west of the country to find conditions that are conducive to their survival.
We can observe that the seals’ numbers oscillate yet show an overarching increase, which hints at their adaptability to environmental shifts—a resilience that might be bolstered by conservation measures. However, data irregularities, such as inconsistent collection frequencies and varying methodologies, could be obscuring the true narrative of these trends. These factors remind us to interpret the data cautiously.
Anyhow polar bears present a different story. The data, primarily from the American continent, indicate a concerning decrease in their population. The retreating Arctic ice is a clear signal of the climate crisis, stripping away the habitat crucial for the bears’ hunting and breeding. The data’s geographical limitations warrant a cautious approach to generalizing these findings across the glob.
From our study, we can observe that the decline in the number of polar bears is markedly more significant than the one of their primary prey, the seals. This pattern suggests a hypothesis: faced with an invisible enemy and the only predator of polar bears – climate change – these bears are in a dire situation. The warming climate leads to the ice in the bay forming later and melting earlier each year, which may abbreviate the seal hunting season to such an extent that polar bears may not have sufficient time to accumulate the fat reserves needed to survive their summer fast. The breeding cycle of the females could be disrupted, threatening the continuity of the species.
5.2 Impact of climate change on polar bear movement patterns and habitat utilization depicted by GPS data
Code
# Ajouter des variables saisonnières basées sur le moisours_clean <- ours_clean %>%mutate(date =ymd(date),month =month(date),season =case_when( month %in%c(12, 1, 2) ~"Winter", month %in%c(3, 4, 5) ~"Spring", month %in%c(6, 7, 8) ~"Summer", month %in%c(9, 10, 11) ~"Autumn",TRUE~NA_character_ ))# Convertir la saison en variable factorielleours_clean$season <-as.factor(ours_clean$season)# Régression linéairemodel <-lm(Distance ~ Closest_Avg_Temperature + Count_Bears + latitude + longitude + season, data = ours_clean)# Résumé du modèlesum_mod<-summary(model)# Conversion de la sortie de summary en data framecoef_df1 <-as.data.frame(sum_mod$coefficients)# Utilisation de formattable pour afficher le résuméformattable(coef_df1)
Estimate
Std. Error
t value
Pr(>|t|)
(Intercept)
-15704.36
2148.12
-7.311
2.66e-13
Closest_Avg_Temperature
-218.36
4.03
-54.149
0.00e+00
Count_Bears
98.31
4.69
20.982
1.16e-97
latitude
277.32
28.59
9.699
3.07e-22
longitude
4.61
3.24
1.422
1.55e-01
seasonSpring
-4241.47
147.27
-28.801
4.17e-182
seasonSummer
39.89
149.27
0.267
7.89e-01
seasonWinter
-3645.02
195.35
-18.659
1.20e-77
Code
# Convertir 'yyyyddd' en 'YYYY-MM-DD'glace_beaufort$date <-as.Date(paste0(substr(glace_beaufort$yyyyddd, 1, 4), "-01-01")) + (as.numeric(substr(glace_beaufort$yyyyddd, 5, 7)) -1)# Fusionner les datasets sur la base de la datedataset_regression <-left_join(ours_clean, glace_beaufort, by ="date")# Filtrer pour ne garder que les données à partir de 2006dataset_regression <-filter(dataset_regression, year(date) >=2006)# Régression linéaire sur le déplacement des oursmodel <-lm(Distance ~ Closest_Avg_Temperature + Count_Bears + Beaufort_Sea, data = dataset_regression)# Résumé du modèlesum_mod2<-summary(model)# Conversion de la sortie de summary en data framecoef_df2 <-as.data.frame(sum_mod2$coefficients)# Utilisation de formattable pour afficher le résuméformattable(coef_df2)
We identify a potential multicollinearity issue between OW_15prct and the days in covered water due to high correlation, therefore we choose to retain the days in covered water for further analysis.
Here we see the link between the different variables in the data set. There is no clear link between the variables, except between “OW_15pcrt” and “days_in_covered_water”. However, due to the multicollinearity between these variables, OW_15prct was subsequently removed from the analysis. We can see a link, which will prove interesting later on, between days spent in open water and meltseason.
For further analysis, we select a subset of variables, and create a scatterplot matrix for the selected variables.
Code
pb_cor_multi <- pb %>%select(Days_water = days_in_cov_water, Meltseason,Bearded = Perc_bearded_eaten,Ringed = Perc_ringed_eaten,Beluga = Perc_beluga_eaten,Bowhead = Perc_bowhead_eaten,Seabird = Perc_seabird_eaten )p <-ggpairs(pb_cor_multi, title="There are some significant correlations between the type of food eaten by polar bears") p <- p +theme(axis.text.y =element_text(size =6),axis.text.y.right =element_text(size =0.8))p_interactive <-ggplotly(p, layout =list(autosize = T, height =900)) # Hauteur en pixelsp_interactive
We fitted a simple linear regression model with the days in covered water as the dependent variable and we summarized the results of the simple linear regression model. We also fitted a multiple linear regression model with the days in covered water as the dependent variable, the melt season, and the percentage of bearded eaten by the bears as independent variables.
Then we were able to calculate the variance inflation factors (VIFs) for the multiple linear regression model:
No problems were detected, as the coefficients were well below 5.
We fit a multiple linear regression model with the days in covered water as the dependent variable and all other variables as independent variables.
Code
mod2 <-lm(pb_cor_multi$Days_water~Meltseason+pb_cor_multi$Bearded+pb_cor_multi$Ringed+pb_cor_multi$Beluga+ pb_cor_multi$Bowhead+pb_cor_multi$Seabird)sum_mod3<-summary(mod2)# Conversion de la sortie de summary en data framecoef_df3 <-as.data.frame(sum_mod3$coefficients)# Utilisation de formattable pour afficher le résuméformattable(coef_df3)
The R-Square is not very good. Relating to the variance inflation factor of the first model, considering all the parameters is a problem. The melt season seems to be interesting, and 1-2 other variables of food. We take the AIC model to find the best model:
The better model seems to consider the melt season and the number of bearded sealed, but not the three other variables.
Code
mod_fin <-lm(pb_cor_multi$Days_water~Meltseason+pb_cor_multi$Bearded)summary(mod_fin)#> #> Call:#> lm(formula = pb_cor_multi$Days_water ~ Meltseason + pb_cor_multi$Bearded)#> #> Residuals:#> Min 1Q Median 3Q Max #> -21.11 -12.22 2.24 6.30 30.85 #> #> Coefficients:#> Estimate Std. Error t value Pr(>|t|) #> (Intercept) 81.7938 4.7567 17.20 <2e-16 ***#> Meltseason 0.3085 0.0318 9.69 <2e-16 ***#> pb_cor_multi$Bearded 0.0580 0.0254 2.28 0.023 * #> ---#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#> #> Residual standard error: 13.2 on 502 degrees of freedom#> Multiple R-squared: 0.169, Adjusted R-squared: 0.166 #> F-statistic: 51.1 on 2 and 502 DF, p-value: <2e-16
The coefficients are significant, but the model is badly predicted… We try with a simple linear regression, only with the melt season.
Code
mod_simp <-lm(pb_cor_multi$Days_water~Meltseason)summary(mod_simp)#> #> Call:#> lm(formula = pb_cor_multi$Days_water ~ Meltseason)#> #> Residuals:#> Min 1Q Median 3Q Max #> -16.81 -13.43 2.31 5.45 29.64 #> #> Coefficients:#> Estimate Std. Error t value Pr(>|t|) #> (Intercept) 82.3690 4.7699 17.3 <2e-16 ***#> Meltseason 0.3129 0.0319 9.8 <2e-16 ***#> ---#> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1#> #> Residual standard error: 13.2 on 503 degrees of freedom#> Multiple R-squared: 0.16, Adjusted R-squared: 0.159 #> F-statistic: 96.1 on 1 and 503 DF, p-value: <2e-16
We can represent the data as a linear regression.
Code
p_regr <-ggplot(pb_cor_multi, aes(x = Meltseason, y = days_in_cov_water)) +geom_point() +stat_smooth(method ="lm", col ="red") +ggtitle("We see a small positive link, but with variability")p_reg <-ggplotly(p_regr)p_reg
The R-Squared is fast the same, but this model is simpler. But we can also keep the final model, with a link with the food for polar bears. We can have a look on the variances, with the analysis of variances (anova):
qqPlot(mod_simp$residuals, distribution ="norm")#> [1] 13 31mean(mod_simp$residuals)#> [1] -1.48e-15detach(pb)
They are fast equal to zero, so we cannot reject that the residues are normally distributed.
6 Conclusion
The comprehensive study on the impact of climate change on Arctic ecosystems, particularly focusing on polar bears, reveals significant findings and implications. Our investigation, driven by the urgent need to understand the effects of environmental shifts in the Arctic, combines extensive data analysis with predictive modeling to paint a detailed picture of the current and future state of polar bear populations and their habitats.
Key Findings
Declining Polar Bear Population: The data indicates a notable decline in polar bear numbers, particularly in regions like Alaska. This trend is alarming and points to the broader implications of shrinking sea ice and changing climatic conditions in the Arctic. The contrast with the ringed seals’ population trends, which show some resilience, underscores the unique challenges faced by polar bears.
Movement Patterns and Habitat Utilization: Our analysis of GPS data and environmental factors such as temperature and sea ice coverage reveals that polar bears’ movement patterns are intricately linked to these variables. The decreasing distances traveled by bears over the years suggest adaptations to the rapidly changing environment. Our predictive models, while indicating some level of accuracy, also highlight the complexity of these movement patterns.
Diet and Open Water Days: The relationship between the polar bears’ diet and the time they spend in open water is complex. Our statistical models suggest a connection, albeit not a straightforward one, between these factors. The impact of the melting season on bears’ dietary habits is evident but requires further exploration for conclusive insights.
Implications and Future Directions
The findings underscore the urgency for targeted conservation efforts aimed at preserving polar bear habitats, particularly in light of the diminishing sea ice cover in the Arctic. The insights gleaned from this study can inform policymakers and conservationists in formulating strategies that address the specific needs of polar bears, considering the broader context of climate change. Continued monitoring and research are vital to deepen our understanding of polar bears’ adaptation strategies to the changing environment. Future studies should aim to integrate more variables, such as human activities and their impact on bear habitats. Also, data on the location of bears in Alaska could be cross-referenced with changes in temperatures in different regions and the number of animals counted over time.
Concluding Remarks
In conclusion, this study highlights the profound impact of climate change on Arctic ecosystems, particularly on polar bears. The changing patterns in sea ice coverage and temperature regimes are not just altering the physical landscape but are also reshaping the life cycles and survival strategies of these iconic species. Our findings, while offering significant insights, also open the door for further research and action in the realm of wildlife conservation and climate change mitigation.
