diff --git a/.Rbuildignore b/.Rbuildignore index 0bdc2e7..a02ef1a 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,3 +10,4 @@ ^\testing ^\.git$ ^testing$ +^\.github$ diff --git a/.Rhistory b/.Rhistory index 2afd501..311d923 100644 --- a/.Rhistory +++ b/.Rhistory @@ -1,512 +1,512 @@ -rbind(wolves[[1]],wolves[[2]]) -rm(list=ls()) -library(sf) -#library(sp) -library(move) -library(osmdata) -library(mapview) -library(devtools) -library(units) -library(dplyr) -#devtools::install_github('jedalong/wildlifeHI') -#library(wildlifeHI) -devtools::load_all('D:/RPackages/wildlifeHI/wildlifeHI/') -# #Hebblewhite Alberta-BC Wolves (Movebank ID 209824313) -wolves <- move("D:/RPackages/wildlifeHI/Hebblewhite Alberta-BC Wolves.csv") -x_wolf <- hi_by_trackId(wolves[[1:10]],fun="hi_crossing") -?round -rm(list=ls()) -library(sf) -#library(sp) -library(move) -library(osmdata) -library(mapview) -library(devtools) -library(units) -library(dplyr) -#devtools::install_github('jedalong/wildlifeHI') -#library(wildlifeHI) -devtools::load_all('D:/RPackages/wildlifeHI/wildlifeHI/') -# #Hebblewhite Alberta-BC Wolves (Movebank ID 209824313) -wolves <- move("D:/RPackages/wildlifeHI/Hebblewhite Alberta-BC Wolves.csv") -x_wolf <- hi_by_trackId(wolves[[1:10]],fun="hi_crossing") -table(x_wolf$crossing_value) -x_wolf_sf <- hi_by_trackId(wolves[[1:10]],fun="hi_crossing_loc",crs_code=32611) -rm(list=ls()) -library(sf) -#library(sp) -library(move) -library(osmdata) -library(mapview) -library(devtools) -library(units) -library(dplyr) -#devtools::install_github('jedalong/wildlifeHI') -#library(wildlifeHI) -devtools::load_all('D:/RPackages/wildlifeHI/wildlifeHI/') -# data("fishers") -# # Save an object to a file -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -#Full Fishers dataset -#fishers <- move("D:/RPackages/wildlifeHI/Martes pennanti LaPoint New York.csv") -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -# #Hebblewhite Alberta-BC Wolves (Movebank ID 209824313) -wolves <- move("D:/RPackages/wildlifeHI/Hebblewhite Alberta-BC Wolves.csv") -# #wolves <- wolves[[1:14]] #use only B*** individuals -# sa -x_wolf_sf <- hi_by_trackId(wolves[[1:10]],fun="hi_crossing_loc",crs_code=32611) -mapview(x_wolf_sf['trackId']) -table(x_wolf_sf$value) -road_sub <- subset(x_wolf_sf, value %in% c('primary','secondary','tertiary')) -mapview(road_sub'trackId']) -mapview(road_sub['trackId']) -road_sf <- hi_by_trackId(wolves,fun="hi_crossing_loc",crs_code=32611, -key='highway',value=c('primary','secondary')) -trackId(wolves) -move <- wolves[['B087']] -plot(move) -road_sf <- hi_by_trackId(wolves[[10:15]],fun="hi_crossing_loc",crs_code=32611, -key='highway',value=c('primary','secondary')) -move -trackId(mvoe) -trackId(move) -trackId(MoveStack(move)) -trackId(moveStack(move)) -tz <- attr(timestamps(move),'tzone') -#check input data type -if (class(move) != 'MoveStack'){ -if (class(move) == 'Move'){ -move <- moveStack(move, forceTz=tz) #fix this timestamp to correct time zone -} else { -print('Input Data not of class MoveStack. Returning NULL.') -return(NULL) -} +library(lmerTest) +library(MuMIn) +library(tidyr) +library(car) +library(corrplot) +library(fmsb) +library(ggrepel) +library(scales) +user = "matth" +allTrails = as.data.frame(t(read.csv(sprintf("C:\\Users\\%s\\OneDrive - The University of Western Ontario\\DataMaster\\Regression\\AllTrailsSummaryParksParkAttendancePopLess100K.csv", user), header=TRUE, row.names = "Name"))) +flickr = as.data.frame(t(read.csv(sprintf("C:\\Users\\%s\\OneDrive - The University of Western Ontario\\DataMaster\\Regression\\PUD_JustParksWithOfficialCount3.csv", user), header = TRUE, row.names = "Year"))) +strava = as.data.frame(t(read.csv(sprintf("C:\\Users\\%s\\OneDrive - The University of Western Ontario\\DataMaster\\Regression\\SUD_JustParksWithOfficialCount.csv", user), header= TRUE, row.names = c("sum","sum_intensity")))) +officialCounts = as.data.frame(t(read.csv(sprintf("C:\\Users\\%s\\OneDrive - The University of Western Ontario\\DataMaster\\Regression\\parksAttendance2001_2023_3.csv", user), header = TRUE, row.names = "Place"))) +officialCounts$Names <- row.names(officialCounts) +officialCounts$Names <- gsub("\\.", " ", officialCounts$Names) +row.names(officialCounts) <- officialCounts$Names +telusCounts = as.data.frame(read.csv(sprintf("C:\\Users\\%s\\OneDrive - The University of Western Ontario\\DataMaster\\Telus\\unique\\TelusCounts_19_22_0.csv", user), header = TRUE, row.names = "Place", check.names = FALSE)) +allData = as.data.frame(read.csv(sprintf("C:\\Users\\%s\\OneDrive - The University of Western Ontario\\DataMaster\\Regression\\regressionFileUpdateFeb2024.csv", user), header=TRUE, row.names = "Name", check.names = FALSE)) +allData$Names <- row.names(allData) +add_suffix_to_integer_columns <- function(df, suffix) { +col_names <- names(df) +int_cols <- sapply(df, is.integer) +col_names[int_cols] <- paste0(col_names[int_cols], suffix) +names(df) <- col_names +return(df) } -osmdata <- hi_get_osm(move,key='highway',value=c('primary','secondary')) -osmdata -#convert move to sf -sf_pt <- st_as_sf(move) -#grab projection of data -data_crs <- st_crs(move) -crs_code = 32611 -#grab projection of data -data_crs <- st_crs(move) -osmdata <- st_transform(osmdata,crs=crs_code) -# Create linestrings -sf_ln <- internal_hi_move2line(move) |> -st_transform(crs=crs_code) -#get locations of crossings (lines/poly boundaries) -#Check reverse ordering if slow... -suppressWarnings(sf_int <- st_intersection(sf_ln,osmdata)) -sf_int -mapview(sf_int) -rm(list=ls()) -library(sf) -#library(sp) -library(move) -library(osmdata) -library(mapview) -library(devtools) -library(units) -library(dplyr) -#devtools::install_github('jedalong/wildlifeHI') -#library(wildlifeHI) -devtools::load_all('D:/RPackages/wildlifeHI/wildlifeHI/') -# data("fishers") -# # Save an object to a file -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -#Full Fishers dataset -#fishers <- move("D:/RPackages/wildlifeHI/Martes pennanti LaPoint New York.csv") -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -# #Hebblewhite Alberta-BC Wolves (Movebank ID 209824313) -wolves <- move("D:/RPackages/wildlifeHI/Hebblewhite Alberta-BC Wolves.csv") -# #wolves <- wolves[[1:14]] #use only B*** individuals -# saveRDS(wolves, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/wolves.rds") +officialCounts <- add_suffix_to_integer_columns(officialCounts, ".PCC") +#creates a column for each of the 'unique' datasets summarised so it is daily unique visits for the whole year each year from telus +telus19 <- read.csv("C:/Users/matth/OneDrive - The University of Western Ontario/DataMaster/Telus/daily2019.csv") +telus20 <- read.csv("C:/Users/matth/OneDrive - The University of Western Ontario/DataMaster/Telus/daily2020.csv") +telus21 <- read.csv("C:/Users/matth/OneDrive - The University of Western Ontario/DataMaster/Telus/daily2021.csv") +telus22 <- read.csv("C:/Users/matth/OneDrive - The University of Western Ontario/DataMaster/Telus/daily2022.csv") +telus23 <- read.csv("C:/Users/matth/OneDrive - The University of Western Ontario/DataMaster/Telus/daily2023.csv") +telus19_summary <- telus19 %>% group_by(input_geoid) %>% summarise('2019.yearly_unique_count' = sum(as.numeric(count))) +telus20_summary <- telus20 %>% group_by(input_geoid) %>% summarise('2020.yearly_unique_count' = sum(as.numeric(count))) +telus21_summary <- telus21 %>% group_by(input_geoid) %>% summarise('2021.yearly_unique_count' = sum(as.numeric(count))) +telus22_summary <- telus22 %>% group_by(input_geoid) %>% summarise('2022.yearly_unique_count' = sum(as.numeric(count))) +telus23_summary <- telus23 %>% group_by(input_geoid) %>% summarise('2023.yearly_unique_count' = sum(as.numeric(count))) +merged_telus <- merge(telus19_summary, telus20_summary, by = "input_geoid", all = TRUE) +merged_telus <- merge(merged_telus, telus21_summary, by = "input_geoid", all = TRUE) +merged_telus <- merge(merged_telus, telus22_summary, by = "input_geoid", all = TRUE) +merged_telus <- merge(merged_telus, telus23_summary, by = "input_geoid", all = TRUE) +telus_pairing <- read.csv("C:/Users/matth/OneDrive - The University of Western Ontario/DataMaster/Regression/parkTowerPairing.csv", row.names = 'X') +merged_telus <- merge(merged_telus, telus_pairing, by.x="input_geoid", by.y = "geoid") +merged_df <- merge(allData, officialCounts, by = "Names", all = TRUE) +merged_df <- merge(merged_df, merged_telus, by="Names", all=TRUE) +long_data <- gather(merged_df, key, value, -"sum", -"sum_intensity", -"SumCompletionsAllTrails", -"CountOfLines", -"Names", -'NEAR_FID', -'NEAR_DIST', -'Join_Count', -'telus_coun', -'PostPatchO', -'Shape_Leng', -'Shape_Area', -'Var.2', -"completionsPerTrail", -"input_geoid") +long_data <- separate(long_data, key, into = c("year", "variable"), sep = "\\.") +long_data <- spread(long_data, variable, value) +long_data$year <- as.numeric(long_data$year) +long_data_flickr <- long_data[!is.na(long_data$PUD),] %>% .[.$PUD != 0, ] %>% .[!is.na(.$PCC),] %>% .[.$PCC != 0,] +long_data_flickr_summarized_mean <- long_data %>% .[!is.na(.$PCC),] %>% group_by(Names) %>% summarise(PUD = mean(PUD), PCC = mean(PCC)) +long_data_flickr_summarized_sum <- long_data %>% .[!is.na(.$PCC),] %>% group_by(Names) %>% summarise(PUD = sum(PUD), PCC = sum(PCC)) +#long_data_flickr <- long_data[!is.na(long_data$PCC),] %>% .[.$PCC != 0,] +# long_data_allTrails <- long_data[!is.na(long_data$completionsPerTrail),] %>% subset(., select = -c(Names)) %>% .[.$completionsPerTrail != 0, ] %>% .[!is.na(.$PCC),] %>% .[.$PCC != 0,] +long_data_allTrails <- long_data %>% .[.$year == 2022,] %>% .[!is.na(.$completionsPerTrail),]%>% .[.$completionsPerTrail != 0, ] %>% .[!is.na(.$PCC),] %>% .[.$PCC != 0,] +long_data_allTrails_summarized <- long_data_allTrails %>% group_by(Names) %>% summarise(completionsPerTrail = mean(completionsPerTrail), PCC = mean(PCC)) +#long_data_allTrails <- long_data[!is.na(long_data$PCC),] %>% .[.$PCC != 0,] +# long_data_strava <- long_data[!is.na(long_data$sum_intensity),] %>% subset(., select = -c(Names)) %>% .[.$sum_intensity != 0, ] %>% .[!is.na(.$PCC),] %>% .[.$PCC != 0,] +#long_data_strava <- long_data[!is.na(long_data$sum_intensity),] %>% .[.$sum_intensity != 0, ] %>% .[!is.na(.$PCC),] %>% .[.$PCC != 0,] +long_data_strava <- long_data %>% .[.$year == 2022,] %>% .[!is.na(.$PCC),] %>% .[.$PCC != 0,] +long_data_strava_summarized <- long_data_strava %>% group_by(Names) %>% summarise(sum_intensity = mean(sum_intensity), PCC = mean(PCC)) +long_data_summarized <- merge(long_data_strava_summarized, long_data_allTrails_summarized, by="Names") %>% merge(., long_data_flickr_summarized_sum) +long_data_summarized$PCC.t <- (long_data_summarized$PCC.x + long_data_summarized$PCC.y + long_data_summarized$PCC)/3 +long_data_allTrails_strava_summarized <- merge(long_data_strava_summarized, long_data_allTrails_summarized, by="Names") +long_data_allTrails_strava_summarized$PCC <- (long_data_allTrails_strava_summarized$PCC.x + long_data_allTrails_strava_summarized$PCC.y)/2 +# long_data_no_name_column <- subset(long_data, select = -c(Names)) +long_data_years_with_telus <- long_data[!is.na(long_data$yearly_unique_count),] +long_data_telus <- long_data_years_with_telus[!is.na(long_data_years_with_telus$PCC),] %>% .[.$PCC != 0,] %>% .[.$yearly_unique_count != 0,] #%>% .[.$Names != "Fathom.Five.National.Marine.Park",] %>% .[.$Names != "Banff.National.Park",] %>% .[.$location == 2,] +head(long_data) +# allTrails$Names <- rownames(allTrails) +# flickr$Names <- rownames(flickr) +# strava$Names <- rownames(strava) +# officialCounts$Names <- rownames(officialCounts) +# telusCounts$Names <- rownames(officialCounts) # -road_sf <- hi_by_trackId(wolves[[10:15]],fun="hi_crossing_loc",crs_code=32611, -key='highway',value=c('primary','secondary')) -road_sf <- hi_by_trackId(wolves[[10:15]],fun="hi_crossing_loc",crs_code=32611, -key='highway',value=c('primary','secondary')) -move <- wolves[[14]] -a <- st_as_sf(move) -b <- rbind(a,NULL) -a <- hi_crossing_loc(wolves[[14]], crs_code=32611, key='highway',value=c('primary','secondary')) -a -b <- hi_crossing_loc(wolves[[15]], crs_code=32611, key='highway',value=c('primary','secondary')) -b -class(b) -d <- hi_crossing_loc(wolves[[16]], crs_code=32611, key='highway',value=c('primary','secondary')) -d -e <- hi_crossing_loc(wolves[[17]], crs_code=32611, key='highway',value=c('primary','secondary')) -e -rbind(a,b,d,e) -rm(list=ls()) -library(sf) -#library(sp) -library(move) -library(osmdata) -library(mapview) -library(devtools) -library(units) -library(dplyr) -#devtools::install_github('jedalong/wildlifeHI') -#library(wildlifeHI) -devtools::load_all('D:/RPackages/wildlifeHI/wildlifeHI/') -# data("fishers") -# # Save an object to a file -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -#Full Fishers dataset -#fishers <- move("D:/RPackages/wildlifeHI/Martes pennanti LaPoint New York.csv") -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -# #Hebblewhite Alberta-BC Wolves (Movebank ID 209824313) -wolves <- move("D:/RPackages/wildlifeHI/Hebblewhite Alberta-BC Wolves.csv") -# #wolves <- wolves[[1:14]] #use only B*** individuals +# merged_df <- merge(officialCounts, flickr, by = "Names", all = TRUE, suffixes = c(".PCC",".PUD")) +# df <- merge(strava, telusCounts, by = "Names", all = TRUE) +# merged_df <- merge(merged_df, df, by = "Names", all = TRUE) +# merged_df <- merge(merged_df, allTrails, by = "Names", all = TRUE) # -road_sf <- hi_by_trackId(wolves[[12:17]],fun="hi_crossing_loc",crs_code=32611, -key='highway',value=c('primary','secondary')) -e <- hi_crossing_loc(wolves[[13]], crs_code=32611, key='highway',value=c('primary','secondary')) -e -rm(list=ls()) -library(sf) -#library(sp) -library(move) -library(osmdata) -library(mapview) -library(devtools) -library(units) -library(dplyr) -#devtools::install_github('jedalong/wildlifeHI') -#library(wildlifeHI) -devtools::load_all('D:/RPackages/wildlifeHI/wildlifeHI/') -# data("fishers") -# # Save an object to a file -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -#Full Fishers dataset -#fishers <- move("D:/RPackages/wildlifeHI/Martes pennanti LaPoint New York.csv") -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -# #Hebblewhite Alberta-BC Wolves (Movebank ID 209824313) -wolves <- move("D:/RPackages/wildlifeHI/Hebblewhite Alberta-BC Wolves.csv") -# #wolves <- wolves[[1:14]] #use only B*** individuals -# sav -road_sf <- hi_by_trackId(wolves[[12:17]],fun="hi_crossing_loc",crs_code=32611, -key='highway',value=c('primary','secondary')) -rm(list=ls()) -library(sf) -#library(sp) -library(move) -library(osmdata) -library(mapview) -library(devtools) -library(units) -library(dplyr) -#devtools::install_github('jedalong/wildlifeHI') -#library(wildlifeHI) -devtools::load_all('D:/RPackages/wildlifeHI/wildlifeHI/') -# data("fishers") -# # Save an object to a file -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -#Full Fishers dataset -#fishers <- move("D:/RPackages/wildlifeHI/Martes pennanti LaPoint New York.csv") -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -# #Hebblewhite Alberta-BC Wolves (Movebank ID 209824313) -wolves <- move("D:/RPackages/wildlifeHI/Hebblewhite Alberta-BC Wolves.csv") -# #wolves <- wolves[[1:14]] #use only B*** individuals -# saveRDS(wolves, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/wolves.rds") +# # Define custom colors and shapes +# custom_colors <- c("#E41A1C", "#377EB8", "#4DAF4A", "#FF7F00", "#FFFF33", "#A65628", "#000000") +# custom_shapes <- c('square','circle','triangle','diamond','cross') # You can customize the shapes based on your preference +# custom_colors <- c("A", "B", "C", "D", "E", "F", "G") +# custom_shapes <- c('1','2','3','4') # -road_sf <- hi_by_trackId(wolves[[12:17]],fun="hi_crossing_loc",crs_code=32611, -key='highway',value=c('primary','secondary')) -View(road_sf) -d <- hi_crossing_loc(wolves[[17]], crs_code=32611, key='highway',value=c('primary','secondary')) -d -rbind(e,a,b,d) -e <- hi_crossing_loc(wolves[[13]], crs_code=32611, key='highway',value=c('primary','secondary')) -rbind(e,a,b,d) -g <- hi_crossing_loc(wolves[[12]], crs_code=32611, key='highway',value=c('primary','secondary')) -e <- hi_crossing_loc(wolves[[13]], crs_code=32611, key='highway',value=c('primary','secondary')) -a <- hi_crossing_loc(wolves[[14]], crs_code=32611, key='highway',value=c('primary','secondary')) -b <- hi_crossing_loc(wolves[[15]], crs_code=32611, key='highway',value=c('primary','secondary')) -d <- hi_crossing_loc(wolves[[17]], crs_code=32611, key='highway',value=c('primary','secondary')) -f <- hi_crossing_loc(wolves[[16]], crs_code=32611, key='highway',value=c('primary','secondary')) -rbind(a,b,d,e,f,g,) -rbind(a,b,d,e,f,g) -mapview(road_sf['trackId']) -aa <- rbind(a,b) -aa <- rbind(aa,d) -aa <- rbind(aa,e) -aa <- rbind(aa,f) -aa <- rbind(aa,g) -road_sf <- hi_by_trackId(wolves,fun="hi_crossing_loc",crs_code=32611, -key='highway',value=c('primary','secondary')) -warnings() -View(road_sf) -mapview(road_sf['trackId']) -str(road_sf) -st_crs(road_sf) -st_bbox(road_sf) -wolves_buf <- hi_by_trackId(wolves,fun='hi_buffer',r = 50, crs_code=32611, -key='highway',value=c('primary','secondary')) -f <- hi_buffer(wolves[[1]], crs_code=32611, r = 50, -key='highway',value=c('primary','secondary')) -move <- wolves[[1]] -tz <- attr(timestamps(move),'tzone') -#check input data type -if (class(move) != 'MoveStack'){ -if (class(move) == 'Move'){ -move <- moveStack(move, forceTz=tz) #fix this timestamp to correct time zone -} else { -print('Input Data not of class MoveStack. Returning NULL.') -return(NULL) -} -} -#save original CRS -data_crs <- st_crs(move) -osmdata <- hi_get_osm(move,key='highway',value=c('primary','secondary')) -crs_code = 32611 -osmdata <- st_transform(osmdata,crs=crs_code) -#Create buffer -buf <- st_buffer(osmdata,r) |> -st_union() -r = 50 -#Create buffer -buf <- st_buffer(osmdata,r) |> -st_union() -mapview(buf) -# Create linestrings need to fix to do by ID -sf_ln <- internal_hi_move2line(move) |> -st_transform(crs=crs_code) -## There is something about ordering that really matters in terms of these functions: -## https://github.com/r-spatial/sf/issues/1261 -#with <- st_within(sf_ln,buf,sparse=FALSE) #THIS IS SLOW!! -with <- st_contains(buf,sf_ln,sparse=FALSE) -#into <- st_intersects(sf_ln,buf,sparse=FALSE) #This is slow also -into <- st_intersects(buf,sf_ln,sparse=FALSE) -wiht -with -into -buf_code <- rep(NA,nrow(sf_ln)) -buf_code[into] <- 'intersects' -buf_code[with] <- 'within' -i_int <- which(buf_code == 'intersects') -suppressWarnings(ln_pt <- st_cast(sf_ln[i_int,],'POINT')) -pt_int <- st_intersects(buf,ln_pt,sparse=FALSE) -pt_int -ln_pt -i_int -into -sum(into) -sum(with) -#into <- st_intersects(sf_ln,buf,sparse=FALSE) #This is slow also -into <- st_intersects(sf_ln,buf,sparse=FALSE) -into -sum(into) -mapview(sf_ln) + mapview(buf) -rm(list=ls()) -library(sf) -#library(sp) -library(move) -library(osmdata) -library(mapview) -library(devtools) -library(units) -library(dplyr) -#devtools::install_github('jedalong/wildlifeHI') -#library(wildlifeHI) -devtools::load_all('D:/RPackages/wildlifeHI/wildlifeHI/') -# data("fishers") -# # Save an object to a file -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -#Full Fishers dataset -#fishers <- move("D:/RPackages/wildlifeHI/Martes pennanti LaPoint New York.csv") -# saveRDS(fishers, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/fishers.rds") -# #Hebblewhite Alberta-BC Wolves (Movebank ID 209824313) -wolves <- move("D:/RPackages/wildlifeHI/Hebblewhite Alberta-BC Wolves.csv") -# #wolves <- wolves[[1:14]] #use only B*** individuals -# saveRDS(wolves, file = "D://RPackages/MoveApps/hi_nearest_distance/data/raw/wolves.rds") +# # Create a mapping between set_id and color/shape +# set_mapping <- data.frame( +# Names = unique(merged_df$Names), +# color = rep(custom_colors, length.out = length(unique(merged_df$Names))), +# shape = rep(custom_shapes, length.out = length(unique(merged_df$Names))) +# ) +# set_mapping$grouped <- paste(set_mapping$color, set_mapping$shape, sep="") +# # Merge the mapping with the original data +# merged_df <- merge(merged_df, set_mapping, by = "Names") +# +# # +# # rownames(merged_df) <- merged_df$RowNames +# # merged_df$RowNames <- NULL +banff = subset(long_data, Names == "Banff National Park", select = -c(Names)) +state1 <- c(rep(c(rep("N", 7), rep("Y", 7)), 2)) +year <- rep(c(2003:2009), 4) +group1 <- c(rep("C", 14), rep("E", 14)) +group2 <- paste(state1, group1, sep = "") +beta <- c(0.16,0.15,0.08,0.08,0.18,0.48,0.14,0.19,0.00,0.00,0.04,0.08,0.27,0.03,0.11,0.12,0.09,0.09,0.10,0.19,0.16,0.00,0.11,0.07,0.08,0.09,0.19,0.10) +lcl <- c(0.13,0.12,0.05,0.05,0.12,0.35,0.06,0.13,0.00,0.00,0.01,0.04,0.20,0.00,0.09,0.09,0.06,0.06,0.07,0.15,0.11,0.00,0.07,0.03,0.05,0.06,0.15,0.06) +ucl <- c(0.20,0.20,0.13,0.14,0.27,0.61,0.28,0.27,0.00,1.00,0.16,0.16,0.36,0.82,0.14,0.15,0.13,0.13,0.15,0.23,0.21,0.00,0.15,0.14,0.12,0.12,0.23,0.16) +data <- data.frame(state1,year,group1,group2,beta,lcl,ucl) +pd <- position_dodge(.65) +ggplot(data = data,aes(x= year, y = beta, colour = group2, shape = group2)) + +geom_point(position = pd, size = 4) + +geom_errorbar(aes(ymin = lcl, ymax = ucl), colour = "black", width = 0.5, position = pd) + +scale_colour_manual(name = "Treatment & State", +labels = c("Control, Non-F", "Control, Flwr", "Exclosure, Non-F", "Exclosure, Flwr"), +values = c("blue", "red", "blue", "red")) + +scale_shape_manual(name = "Treatment & State", +labels = c("Control, Non-F", "Control, Flwr", "Exclosure, Non-F", "Exclosure, Flwr"), +values = c(19, 19, 17, 17)) +# Sample data +set.seed(42) +data <- data.frame( +x = rnorm(27), +y = rnorm(27), +set_id = sample(1:28, 27, replace = FALSE), +legend_entry = paste("X:", round(rnorm(27), 2)) +) +# Define custom colors and shapes +custom_colors <- c("#E41A1C", "#377EB8", "#4DAF4A", "#FF7F00", "#FFFF33", "#A65628", "#000000") +custom_shapes <- c('square','circle','triangle','diamond','cross') # You can customize the shapes based on your preference +custom_colors <- c("A", "B", "C", "D", "E", "F", "G") +custom_shapes <- c('1','2','3','4') +# Create a mapping between set_id and color/shape +set_mapping <- data.frame( +set_id = unique(data$set_id), +color = rep(custom_colors, length.out = length(unique(data$set_id))), +shape = rep(custom_shapes, length.out = length(unique(data$set_id))), +legend_entry = unique(data$set_id) +) +set_mapping$grouped <- paste(set_mapping$color, set_mapping$shape, sep="") +# Merge the mapping with the original data +data <- merge(data, set_mapping, by = "set_id") +# Create a ggplot with points colored and shaped by set_id +ggplot(data = data, aes(x, y, col = grouped, shape = grouped)) + +geom_point(size = 3) + +#geom_text_repel(aes(label = set_mapping$grouped), show.legend = TRUE, force = 5) + # Add text labels +scale_color_manual(name = "legend", +labels = data$grouped, +values = c("#E41A1C", "#E41A1C", "#E41A1C", "#E41A1C", "#377EB8", "#377EB8", "#377EB8", "#377EB8", "#4DAF4A", "#4DAF4A", "#4DAF4A", "#4DAF4A", "#FF7F00", "#FF7F00", "#FF7F00", "#FF7F00", "#FFFF33","#FFFF33","#FFFF33","#FFFF33", "#A65628","#A65628","#A65628","#A65628", "#000000", "#000000", "#000000")) + +scale_shape_manual(name = "legend", +labels = data$grouped, +values = c('square','circle','triangle','diamond','square','circle','triangle', 'diamond','square','circle','triangle','diamond','square','circle','triangle','diamond','square','circle', 'triangle','diamond','square','circle','triangle','diamond','square','circle','triangle')) + +theme_minimal() +# library(grid) +# library(gridGraphics) +# legend <- cowplot::get_legend(flickr_plot) +# grid.newpage() +# png(sprintf("C:\\Users\\%s\\OneDrive - The University of Western Ontario\\DataMaster\\Regression\\legend.png", user), width = 1600, height =1200, units = 'px') +# grid.draw(legend) +# dev.off() +data_table = long_data_flickr_summarized_sum +data_table$normFlickr <- data_table$PUD/max(data_table$PUD) +#c1 <- cor(data_table) +#(c1, method = "number",number.cex=0.75) +# m1 = lmer((as.numeric(PCC))~as.numeric(PUD) + (1|Names), data=data_table) +# r.squaredGLMM(m1) +# m2 = lmer(log(as.numeric(PCC))~log(as.numeric(PUD)) + (1|Names), data = data_table) +# #summary(m2) +# cat("Log:", r.squaredGLMM(m2), "\n") # -f <- hi_buffer(wolves[[1]], crs_code=32611, r = 50, -key='highway',value=c('primary','secondary')) -f -wolves_buf <- hi_by_trackId(wolves,fun='hi_buffer',r = 100, crs_code=32611, -key='highway',value=c('primary','secondary')) -table(trackId(wolevs_buf),wolves_buf$buf_code) -table(trackId(wolves_buf),wolves_buf$buf_code) -library(raster) -r1 <- raster('D:/MapComparison/sing whales.tif') -r1 <- raster('D:/MapComparison/singlewhales.tif') -plot(r1) -r1 <- raster('D:/MapComparison/shapefiles/single2nm.tif') -plot(r1) -r2 <- raster('D:/MapComparison/shapefiles/groups2nm.tif') -plotr2 -plot(r2) -#CREATE README FILE for GITHUB -# Make sure the working directory is in the package -setwd('D:/RPackages/wildlifeHI/wildlifeHI/') -# EDIT README FILE TO HEARTS CONTENT -knitr::knit(input="README.rmd", output = "README.md") -#update documentation -devtools::document() -#Check Spelling -devtools::spell_check() -# EDIT README FILE TO HEARTS CONTENT -knitr::knit(input="README.rmd", output = "README.md") -#update documentation -devtools::document() -#Check Spelling -devtools::spell_check() -# EDIT README FILE TO HEARTS CONTENT -knitr::knit(input="README.rmd", output = "README.md") -#update documentation -devtools::document() -#Check Spelling -devtools::spell_check() -devtools::build() -#test on Local machine using devtools -devtools::release_checks() -devtools::check() -devtools::build() -#test on Local machine using devtools -devtools::release_checks() -devtools::check() -?devtools::use_build_ignore -?inherits -?group_by -library(move) -data(fishers) -inherits(fishers,'MoveStack') -inherits(fishers,'Move') -a <- fishers[[1]] -inherits(fishers,'Move') -inherits(fishers,'MoveStack') -!inherits(fishers,'MoveStack') -?subset -df <- data.frame(fishers) -df -df2 <- subset(df, select = -"timestamp") -df2 <- subset(df, select = -c("timestamp")) -df2 <- df[,-"timestamp"] -df2 <- df[,-c("timestamp")] -#update documentation -devtools::document() -#update documentation -devtools::document() -#Check Spelling -devtools::spell_check() -devtools::build() -#test on Local machine using devtools -devtools::release_checks() -devtools::check() -#If more files need to be ignored use: -devtools::use_build_ignore() -#If more files need to be ignored use: -usethis::use_build_ignore() -?use_build_ignore -#If more files need to be ignored use: -usethis::use_build_ignore("[.].png$",escape=FALSE) -usethis::use_build_ignore("[.].Rmd$",escape=FALSE) -?.data -?.data -#update documentation -devtools::document() -#Check Spelling -devtools::spell_check() -devtools::build() -#test on Local machine using devtools -devtools::release_checks() -devtools::check() -df -df2 <- df[,'utm.zone'] -df2 -df2 <- df[,-'utm.zone'] -devtools::build() -#test on Local machine using devtools -devtools::release_checks() -devtools::check() -df2 <- df |> -select(-.data$timestamps) |> -select(-.data$utm.zone) -df2 <- df |> -+ dplyr::select(-.data$timestamps) |> -+ dplyr::select(-.data$utm.zone) -df2 <- df |> -dplyr::select(-.data$timestamps) |> -dplyr::select(-.data$utm.zone) -df2 <- df |> -dplyr::select(-"timestamps") |> -dplyr::select(-"utm.zone") -head(df) -df2 <- df |> -dplyr::select(-"timestamp") |> -dplyr::select(-"utm.zone") -df2 -df |> group_by("eobs.status") |> summarize() -df |> dplyr::group_by("eobs.status") |> dplyr::summarize() -summary(df) -df |> dplyr::group_by("utm.zone") |> dplyr::summarize(m=mean(utm.northing)) -df |> dplyr::group_by(.data$utm.zone) |> dplyr::summarize(m=mean(utm.northing)) -#update documentation -devtools::document() -#Check Spelling -devtools::spell_check() -devtools::build() -#test on Local machine using devtools -devtools::release_checks() -devtools::check() -devtools::build() -devtools::check() -#Check windows release version -devtools::check_win_release() -devtools::check() -devtools::check() -#Testing building on Rhub (windows server and two Linux versions) -devtools::check_rhub() -#Testing building on Rhub (windows server and two Linux versions) -devtools::check_rhub() -devtools::build() -#test on Local machine using devtools -devtools::release_checks() -devtools::check() -#test on Local machine using devtools -devtools::release_checks() -devtools::check() -#Testing building on Rhub (windows server and two Linux versions) -devtools::check_rhub() -#update documentation -devtools::document() -devtools::build() -#Check windows release version -devtools::check_win_release() -devtools::check_mac_release() -#test building on win-builder development version -devtools::check_win_devel() -################## -## input/output ## adjust! -################## -## Provided testing datasets in `./data/raw`: -## for own data: file saved as a .rds containing a object of class MoveStack -inputFileName = "./data/raw/wolves.rds" -## optionally change the output file name -unlink("./data/output/", recursive = TRUE) # delete "output" folder if it exists, to have a clean start for every run -dir.create("./data/output/") # create a new output folder -outputFileName = "./data/output/output.rds" -########################## -## Arguments/parameters ## adjust! -########################## -# There is no need to define the parameter "data", as the input data will be automatically assigned to it. -# The name of the field in the vector must be exactly the same as in the r function signature -# Example: -# rFunction = function(data, username, department) -# The parameter must look like: -# args[["username"]] = "my_username" -# args[["department"]] = "my_department" -args <- list() # if your function has no arguments, this line still needs to be active -# Add all your arguments of your r-function here -args[["key"]] = "highway" -args[["value"]] = "primary" -args[["geom"]] = "line" -args[["crs_code"]] = 32618 -############################## -## source, setup & simulate ## leave as is! -############################## -# this file is the home of your app code and will be bundled into the final app on MoveApps -source("RFunction.R") +# m2 = lmer(sqrt(as.numeric(PCC))~sqrt(as.numeric(PUD)) + (1|Names), data = data_table) +# cat("Sqrt:", r.squaredGLMM(m2), "\n") +m1 = lm((as.numeric(PCC))~as.numeric(PUD), data=data_table) +cat("Norm:", summary(m1)$adj.r.squared, "\n") +m1 = lm(log(as.numeric(PCC))~log(as.numeric(PUD)), data=data_table) +cat("Log:", summary(m1)$adj.r.squared, "\n") +m1 = lm(sqrt(as.numeric(PCC))~sqrt(as.numeric(PUD)), data=data_table) +cat("Sqrt:", summary(m1)$adj.r.squared, "\n") +flickr_plot_bw <- ggplot(data = data_table, aes(x = (log(PUD)), y = (log(PCC))))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = y ~ x, color = "blue") + +# Add a linear regression line +#geom_label(data = subset(data_table, Names == "Prince Edward Island National Park"), aes(label = Names)) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Photo User Day per Year", y = "Log Transformed Parks Canada Official Visitor Count") + +#change this from none to bottom to produce a legend and then run the code chunk above this one to render it into a png file +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))+ +scale_y_continuous(breaks = seq(0, ceiling(max(log(data_table$PCC))), by = 1))+ +guides(color = guide_legend(nrow=9))#+ +# scale_x_continuous(trans='log') + +# scale_y_continuous(labels = scales::label_number(), trans='log') #+ +#coord_trans(x="log", y="log") +flickr_plot_bw +#ggsave("C:/Users/mketchin/OneDrive - The University of Western Ontario/Thesis/PaperOne/figure_flickr_plot_bw.png", plot = flickr_plot_bw, scale = 2) +data_table = long_data_allTrails_summarized +#data_table$normAllTrails <- data_table$completionsPerTrail/max(data_table$completionsPerTrail) +m2 = lm(PCC~(completionsPerTrail), data=data_table) +summary(m2) +r.squaredGLMM(m2) +m2 = lm(log(PCC)~log(completionsPerTrail), data = data_table) +summary(m2) +#cat("Log:", r.squaredGLMM(m2), "\n") +m2 = lm(sqrt(PCC)~sqrt(completionsPerTrail), data = data_table) +summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +allTrails_plot_bw <- ggplot(data = data_table, aes(x = log(as.numeric(completionsPerTrail)), y = log(as.numeric(PCC))))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = y ~ x, color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Banff National Park"), aes(log(completionsPerTrail), log(PCC), label = Names)) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed AllTrails Completions", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))+ +guides(color = guide_legend(nrow=9))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log')# + +#coord_trans(x="log", y="log") +allTrails_plot_bw +#ggsave("C:/Users/mketchin/OneDrive - The University of Western Ontario/Thesis/PaperOne/figure_alltrails_plot_bw.png", plot = allTrails_plot_bw, scale = 2) +data_table <- long_data_strava_summarized +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(sum_intensity), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm(log(PCC)~log(sum_intensity), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +m2 = lm(sqrt(PCC)~sqrt(sum_intensity), data = data_table) +summary(m2) +cat("Sqrt:", r.squaredGLMM(m2), "\n") +strava_plot_bw <- ggplot(data = data_table, aes(x = log(sum_intensity), y = log(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Strava Intensity Sum", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +strava_plot_bw +#ggsave("C:/Users/mketchin/OneDrive - The University of Western Ontario/Thesis/PaperOne/figure_strava_plot_bw.png", plot = strava_plot_bw, scale = 2) +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm(log(PCC)~log(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +summary(m2) +cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = log(yearly_unique_count), y = log(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm(log(PCC)~log(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +#m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +#summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = log(yearly_unique_count), y = log(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +print(coef(m2)[2]) +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm(log(PCC)~log(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +#m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +#summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = log(yearly_unique_count), y = log(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +#print(coef(m2)[2]) +print(coef(m2)[2]) +print(coef(m2)[1]) +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm(log(PCC)~log(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +#m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +#summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = log(yearly_unique_count), y = log(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +#print(coef(m2)[1]) +print(coef(m2)) +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm((PCC)~(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +#m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +#summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = log(yearly_unique_count), y = log(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +print(coef(m2)) +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm((PCC)~(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +#m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +#summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = (yearly_unique_count), y = (PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +print(coef(m2)) +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm((PCC)~(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +#m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +#summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = log(yearly_unique_count), y = log(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +print(coef(m2)) +?log +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm((PCC)~(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +#m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +#summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = log10(yearly_unique_count), y = log10(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +print(coef(m2)) +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm(log10(PCC)~log10(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +#m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +#summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = log10(yearly_unique_count), y = log10(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +print(coef(m2)) +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm(log(PCC)~log(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +#m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +#summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = log(yearly_unique_count), y = log(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +print(coef(m2)) +data_table <- long_data_telus +#data_table$normStrava <- data_table$sum_intensity/max(data_table$sum_intensity) +m3 = lm(PCC~(yearly_unique_count), data = data_table) +summary(m3) +r.squaredGLMM(m3) +m2 = lm((PCC)~(yearly_unique_count), data = data_table) +summary(m2) +cat("Log:", r.squaredGLMM(m2), "\n") +#m2 = lm(sqrt(PCC)~sqrt(yearly_unique_count), data = data_table) +#summary(m2) +#cat("Sqrt:", r.squaredGLMM(m2), "\n") +telus_plot_bw <- ggplot(data = data_table, aes(x = log(yearly_unique_count), y = log(PCC)))+#, col = grouped, shape = grouped)) + +geom_point(size = 2) + # Add scatterplot points +geom_smooth(method = "lm", formula = (y) ~ poly(x, 1), color = "blue") + # Add a linear regression line +#geom_label(data = subset(data_table, Names == "Mount Revelstoke National Park"), aes(log(sum_intensity), log(PCC), label = paste0(Names))) + # this allows a data label so I can understand what things are in this. +labs(title = "", x = "Log Transformed Telus Yearly Unique", y = "Log Transformed Parks Canada Official Visitor Count") + +theme(legend.position = 'none', plot.title = element_text(hjust = 0.5, size = 22), legend.text=element_text(size=24), axis.title = element_text(size=18), axis.text.x = element_text(size = 12), axis.text.y = element_text(size = 12))#+ +#ylim(0, max(log(data_table$PCC)))+ +#xlim(0, max(log(data_table$sum_intensity)))#+ +#scale_x_continuous(trans='log') + +#scale_y_continuous(labels = scales::label_number(), trans='log') + +#coord_trans(x="log", y="log") +telus_plot_bw +print(coef(m2)) +library(devtools) +load_all() +setwd("C:\\Users\\matth\\rPackage\\wildlifeHI") +load_all() +hi_recreation() diff --git a/.github/.gitignore b/.github/.gitignore new file mode 100644 index 0000000..2d19fc7 --- /dev/null +++ b/.github/.gitignore @@ -0,0 +1 @@ +*.html diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..14159b7 --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,50 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [main, master] + pull_request: + branches: [main, master] + +name: R-CMD-check + +jobs: + R-CMD-check: + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + + strategy: + fail-fast: false + matrix: + config: + - {os: macos-latest, r: 'release'} + - {os: windows-latest, r: 'release'} + - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} + - {os: ubuntu-latest, r: 'release'} + - {os: ubuntu-latest, r: 'oldrel-1'} + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check + + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' diff --git a/R/aaa.R b/R/aaa.R new file mode 100644 index 0000000..67ece63 --- /dev/null +++ b/R/aaa.R @@ -0,0 +1,4 @@ + +#managing environments in hi_recreation to minimize load times in subsequent runs +the <- new.env(parent = emptyenv()) +the$first_time <- TRUE diff --git a/R/hi_recreation_init_conda_helper.R b/R/hi_recreation_init_conda_helper.R index 49c1abf..1b24b21 100644 --- a/R/hi_recreation_init_conda_helper.R +++ b/R/hi_recreation_init_conda_helper.R @@ -56,8 +56,3 @@ hi_recreation_init_conda_helper <- function(env_name = "wild_hi_recreation") { reticulate::use_condaenv(env_name, required = TRUE) return(env_name) } - -#### MATT CHECK THAT THIS SHOULD BE HERE!?!?!? THIS WONT WORK IN A PACKAGE FORMAT? -#set a state -the <- new.env(parent = emptyenv()) -the$first_time <- TRUE