## ----include = FALSE---------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.align = "center" ) ## ----eval = FALSE------------------------------------------------------------- # devtools::install_github("GR3602/wpeR") ## ----setup-------------------------------------------------------------------- library(wpeR) ## ----------------------------------------------------------------------------- sampledata <- check_sampledata( Sample = wolf_samples$Sample, Date = wolf_samples$Date, AnimalRef = wolf_samples$AnimalRef, GeneticSex = wolf_samples$GeneticSex, lat = wolf_samples$lat, lng = wolf_samples$lng, SType = wolf_samples$SType ) ## ----------------------------------------------------------------------------- head(sampledata) ## ----------------------------------------------------------------------------- path <- paste0(system.file("extdata", package = "wpeR"), "/wpeR_samplePed") ped_colony <- get_colony( colony_project_path = path, sampledata = wolf_samples ) tail(ped_colony) ## ----------------------------------------------------------------------------- ped <- data.frame( OffspringID = c( "M273P", "M20AM", "M2757", "M2ALK", "M2ETE", "M2EUJ", "MSV00E", "MSV018", "MSV05L", "MSV0M6", "MSV0T4", "MSV0T7", "MSV0TJ", "MSV0UL" ), FatherID = c( NA, NA, "M20AM", "M20AM", "M20AM", "M20AM", "M20AM", "M20AM", "M20AM", "M20AM", "M20AM", "M20AM", "M20AM", "M20AM" ), MotherID = c( NA, NA, "M273P", "M273P", "M273P", "M273P", "M273P", "M273P", "M273P", "M273P", "M273P", "M273P", "M273P", "M273P" ) ) get_ped( ped = ped, sampledata = wolf_samples ) ## ----------------------------------------------------------------------------- library(kinship2) ped_ks2 <- get_colony(path, wolf_samples, out = "kinship2") ped_ks2 <- ped_ks2[!(ped_ks2$dadid %in% "M2AM8"),] ped_ks2 <- pedigree( ped_ks2$id, ped_ks2$dadid, ped_ks2$momid, ped_ks2$sex ) ## ----fig.width=7, fig.height=4------------------------------------------------ plot(ped_ks2, symbolsize = 1.5, cex = 0.4) ## ----------------------------------------------------------------------------- animal_ts <- anim_timespan( individual_id = wolf_samples$AnimalRef, sample_date = wolf_samples$Date, sample_type = wolf_samples$SType, dead = c("Tissue") ) head(animal_ts) ## ----------------------------------------------------------------------------- sampledata <- merge(wolf_samples, animal_ts, by.x = "AnimalRef", by.y = "ID", all.x = TRUE ) head(sampledata) ## ----------------------------------------------------------------------------- ped_org <- org_fams(ped = ped_colony, sampledata = sampledata, output = "ped") tail(ped_org) ## ----------------------------------------------------------------------------- fams_org <- org_fams(ped = ped_colony, sampledata = sampledata, output = "fams") head(fams_org) ## ----------------------------------------------------------------------------- pt <- plot_table( plot_fams = "all", all_fams = fams_org, ped = ped_org, sampledata = sampledata, deadSample = c("Tissue") ) head(pt) ## ----------------------------------------------------------------------------- nrow(sampledata) == nrow(pt) ## ----ped_satplot legend, echo=FALSE------------------------------------------- library(ggplot2) ggplot()+ #FEMALE SAMPLES annotate("text",label = "Female samples", x = 1.75, y=4, hjust = 0 )+ geom_line(aes(x = c(1,1.5), y = c(4,4)),alpha = 0.5, color = "red")+ geom_point(aes(x = c(1,1.5), y = c(4,4)), size = 1, color = "red")+ #MALE SAMPLES annotate("text",label = "Male samples", x = 1.75, y=3.75, hjust = 0 )+ geom_line(aes(x = c(1,1.5), y = c(3.75,3.75)),alpha = 0.5, color = "blue")+ geom_point(aes(x = c(1,1.5), y = c(3.75,3.75)), size = 1, color = "blue")+ #REPRODUCTIVE ANIMAL annotate("text",label = "Reproductive animal - this family", x = 1.75, y=3.5, hjust = 0 )+ geom_point(aes(x = c(1,1.5), y =c(3.5, 3.5)), shape=0, size = 3, color = "red")+ geom_point(aes(x = c(1.5), y =c(3.5)), size = 1, color = "blue")+ geom_point(aes(x = c(1), y =c(3.5)), size = 1, color = "red")+ #POLYGAMOUS ANIMAL annotate("text",label = "Polygamous animal", x = 1.75, y=3.25, hjust = 0 )+ geom_point(aes(x = c(1,1.5), y =c(3.25, 3.25)), shape=5, size = 2, color = "purple")+ geom_point(aes(x = c(1.5), y =c(3.25)), size = 1, color = "blue")+ geom_point(aes(x = c(1), y =c(3.25)), size = 1, color = "red")+ #REPRODUCTIVE ANIMAL - LATER annotate("text",label = "Reproductive animal - later family", x = 1.75, y=3, hjust = 0 )+ geom_point(aes(x = c(1,1.5), y =c(3,3)), shape=1, size = 3, color = "green")+ geom_point(aes(x = c(1.5), y =c(3)), size = 1, color = "blue")+ geom_point(aes(x = c(1), y =c(3)), size = 1, color = "red")+ #DEAD annotate("text",label = "Mortality sample", x = 1.75, y=2.75, hjust = 0 )+ geom_point(aes(x = c(1,1.5), y =c(2.75,2.75)), shape=4, size = 3, color = "black")+ geom_point(aes(x = c(1.5), y =c(2.75)), size = 1, color = "blue")+ geom_point(aes(x = c(1), y =c(2.75)), size = 1, color = "red")+ #SEPARATORS annotate("text",label = "Family separator", x = 1.75, y=2.5, hjust = 0 )+ geom_line(aes(x = c(1,1.5), y = c(2.5,2.5)), linetype = "dashed", linewidth = 0.3)+ annotate("text",label = "Half-sib group separator", x = 1.75, y=2.25, hjust = 0 )+ geom_line(aes(x = c(1,1.5), y = c(2.25,2.25)), color = "yellow", linewidth = 1)+ theme_void()+ xlim(c(1,5)) ## ----fig.width=6.5, fig.height=4---------------------------------------------- pt <- plot_table( plot_fams = 4, all_fams = fams_org, ped = ped_org, sampledata = sampledata, deadSample = c("Tissue", "Decomposing Tissue", "Blood") ) sp <- ped_satplot(pt) sp ## ----fig.width=6.5, fig.height=6---------------------------------------------- pt <- plot_table( plot_fams = c(1,4), all_fams = fams_org, ped = ped_org, sampledata = sampledata, deadSample = c("Tissue", "Decomposing Tissue", "Blood") ) sp <- ped_satplot(pt) sp ## ----fig.width=6.5, fig.height=10--------------------------------------------- pt <- plot_table( plot_fams = c(1:5), all_fams = fams_org, ped = ped_org, sampledata = sampledata, deadSample = c("Tissue", "Decomposing Tissue", "Blood") ) sp <- ped_satplot(pt) sp ## ----------------------------------------------------------------------------- pt <- plot_table( plot_fams = 1, all_fams = fams_org, ped = ped_org, sampledata = sampledata, deadSample = c("Tissue", "Decomposing Tissue", "Blood") ) ps <- ped_spatial(pt) summary(ps) ## ----------------------------------------------------------------------------- fullsibdata <- read.csv(paste0(path,".FullSibDyad")) ps <- ped_spatial(pt, fullsibdata = fullsibdata) summary(ps) ## ----eval = FALSE------------------------------------------------------------- # ps_tl <- ped_spatial( # plottable = pt, # time.limits = c(as.Date("2017-01-01"), as.Date("2018-01-01")), # time.limit.rep = TRUE, # time.limit.offspring = TRUE, # time.limit.moves = TRUE # ) # # ## ----------------------------------------------------------------------------- pt <- plot_table( plot_fams = 1, all_fams = fams_org, ped = ped_org, sampledata = sampledata, deadSample = c("Tissue", "Decomposing Tissue", "Blood") ) ps <- ped_spatial(pt) ps.tl <- ped_spatial( plottable = pt, time.limits = c(as.Date("2017-01-01"), as.Date("2018-01-01")), time.limit.rep = TRUE, time.limit.offspring = TRUE, time.limit.moves = TRUE ) ## ----echo=FALSE, fig.width=6.5, fig.height=4---------------------------------- sp <- ped_satplot(pt) sp + geom_rect(aes(xmin = as.Date("2017-01-01"), xmax = as.Date("2018-01-01"), ymin = 0, ymax = 12.5), fill = "transparent", color = "orange", linetype = "dotted", linewidth = 0.5) ## ----ggplot legend, echo=FALSE, fig.cap = "Legend explaining symbols used for spatial pedigree representation."---- library(ggplot2) library(ggforce) ggplot()+ xlim(0.5,5)+ theme_void()+ #POINTS annotate("text",label = "Points", x = 0.5, y = 5.25, hjust = 0, size = 4 )+ #momRef/dadRef annotate("text",label = "Mother/father reference sample", x = 1.75, y = 5, hjust = 0 )+ geom_point(aes(x = c(1, 1.5), y = c(5,5)), color = "black", size = 6)+ geom_point(aes(x = 1, y = 5) , color = "#b7484b", size = 5)+ geom_point(aes(x = 1.5, y = 5) , color = "#1f78b4", size = 5)+ geom_point(aes(x = c(1, 1.5), y = c(5,5)), color = "white", size = 3)+ #momMovPt annotate("text", label = "Mother/father other samples", x = 1.75, y = 4.75, hjust = 0)+ geom_point(aes(x = 1, y = 4.75) , color = "#b7484b", size = 2.5, alpha = 0.5)+ #dadMovPt geom_point(aes(x = 1.5, y = 4.75) , color = "#1f78b4", size = 2.5, alpha = 0.5)+ #offsprRefs annotate("text", label = "Offspring reference sample", x = 1.75, y = 4.5, hjust = 0)+ geom_point(aes(x = 1, y = 4.5), shape = 18, color = "#b7484b", size = 6)+ geom_point(aes(x = 1.5, y = 4.5), shape = 18, color = "#1f78b4", size = 6)+ geom_point(aes(x = c(1,1.5), y = 4.5), shape = 18, color = "#ff7f00", size = 3)+ #offsporMovPt annotate("text", label = "Offspring other samples", x = 1.75, y = 4.25, hjust = 0)+ geom_point(aes(x = 1, y = 4.25), color = "#b7484b", size = 4)+ geom_point(aes(x = 1.5, y = 4.25), color = "#1f78b4", size = 4)+ geom_point(aes(x = c(1,1.5), y = 4.25), color = "black", size = 2) + #LINES annotate("text",label = "Lines", x = 0.5, y = 4, hjust = 0, size = 4 )+ #matLn annotate("text", label = "Maternity line", x = 1.75, y = 3.75, hjust = 0)+ geom_segment(aes(x = 1, xend = 1.5, y = 3.75, yend = 3.75), linewidth = 1, color = "#b7484b", arrow = arrow(length = unit(0.3, "cm")))+ #patLn annotate("text", label = "Paternity line", x = 1.75, y = 3.5, hjust = 0)+ geom_segment(aes(x = 1, xend = 1.5, y = 3.5, yend = 3.5), linewidth = 1, color = "#1f78b4", arrow = arrow(length = unit(0.3, "cm")))+ #momMovLn annotate("text", label = "Mother movement line", x = 1.75, y = 3.25, hjust = 0)+ geom_line(aes(x = c(1,1.5), y = c(3.25,3.25)),alpha = 0.5, color = "#b7484b")+ #dadMovLn annotate("text", label = "Father movement line", x = 1.75, y = 3, hjust = 0)+ geom_line(aes(x = c(1,1.5), y = c(3,3)),alpha = 0.5, color = "#1f78b4")+ #offsprMvolLn annotate("text", label = "Offspring movement line", x = 1.75, y = 2.75, hjust = 0)+ geom_line(aes(x = c(1,1.5), y = c(2.75,2.75)),alpha = 0.5, color = "#ff7f00")+ #LABELS annotate("text",label = "Labels", x = 0.5, y = 2.5, hjust = 0, size = 4 )+ #Reference annotate("text", label = "Mother/father/offspring reference", x = 1.75, y = 2.25, hjust = 0)+ #Mother Ref geom_ellipse(aes(x0 = 1, y0 = 2.25, a = 0.07, b = 0.05, angle = 0), fill = "#b7484b", color = "#b7484b", alpha = 0.5 )+ #FatherRef geom_ellipse(aes(x0 = 1.25, y0 = 2.25, a = 0.07, b = 0.05, angle = 0), fill = "#1f78b4", color = "#1f78b4", alpha = 0.5 )+ #Offspring Ref geom_ellipse(aes(x0 = 1.5, y0 = 2.25, a = 0.07, b = 0.05, angle = 0), fill = "#ff7f00", color = "#ff7f00", alpha = 0.5 )+ #Movement offspring annotate("text", label = "Offspring reference for other samples", x = 1.75, y = 2, hjust = 0)+ geom_ellipse(aes(x0 = 1, y0 = 2, a = 0.07, b = 0.05, angle = 0), fill = "white", color = "black", alpha = 0.5 )+ #Date annotate("text", label = "Sample collection date", x = 1.75, y = 1.75, hjust = 0)+ annotate("text",label = "YYYY-MM-DD", x = 1, y=1.75, size = 3, hjust = 0.27, alpha = 0.6 ) ## ----ggplot map examples, include=FALSE--------------------------------------- library(ggplot2) library(basemaps) library(gridExtra) library(sf) library(ggrepel) library(dplyr) ps.t<-lapply(ps, function(x) st_transform(x, crs = st_crs(3857))) ps.tl.t<-lapply(ps.tl, function(x) st_transform(x, crs = st_crs(3857))) ext <- st_bbox(c(ps.t$motherRpoints$geometry, ps.t$fatherRpoints$geometry, ps.t$offspringRpoints$geometry, ps.t$motherMovePoints$geometry, ps.t$fatherMovePoints$geometry)) ext1000 <- ext+c(-1000, -1000, 1000, 1000) p.marg.l <-c(0,-0.3,0,0) p.marg.r <- c(0,0,0,-0.3) bm <- ggplot() + basemap_gglayer(ext1000, map_service = "carto", map_type = "light") + scale_fill_identity() #table for labels ped.ref.labels <- bind_rows( mutate(ps.t$motherRpoints, group = "mother", fill = "#b7484b", size = 2), mutate(ps.t$fatherRpoints, group = "father", fill = "#1f78b4", size = 2), mutate(ps.t$offspringRpoints, group = "offspring", fill = "#ff7f00", size = 1.5)) ped.ref.labels <- cbind(ped.ref.labels, st_coordinates(ped.ref.labels)) ped.ref2.labels <- bind_rows( mutate(ps.tl.t$motherRpoints, group = "mother", fill = "#b7484b", size = 2), mutate(ps.tl.t$fatherRpoints, group = "father", fill = "#1f78b4", size = 2), mutate(ps.tl.t$offspringRpoints, group = "offspring", fill = "#ff7f00", size = 1.5)) ped.ref2.labels <- cbind(ped.ref2.labels, st_coordinates(ped.ref2.labels)) par.mov.labels = bind_rows( mutate(ps.t$motherRpoints, label = AnimalRef, fill = "#b7484b", size = 2, alpha = 0.6, label.size = 0.25), mutate(ps.t$fatherRpoints, label = AnimalRef, fill = "#1f78b4", size = 2, alpha = 0.6, label.size = 0.25), mutate(ps.t$motherMovePoints, label = as.character(Date), fill = NA, size = 1.5, alpha = 0.4, label.size = 0), mutate(ps.t$fatherMovePoints, label = as.character(Date), fill = NA, size = 1.5, alpha = 0.4, label.size = 0) ) par.mov.labels = cbind(par.mov.labels, st_coordinates(par.mov.labels)) par.mov2.labels = bind_rows( mutate(ps.tl.t$motherRpoints, label = AnimalRef, fill = "#b7484b", size = 2, alpha = 0.6, label.size = 0.25), mutate(ps.tl.t$fatherRpoints, label = AnimalRef, fill = "#1f78b4", size = 2, alpha = 0.6, label.size = 0.25), mutate(ps.tl.t$motherMovePoints, label = as.character(Date), fill = NA, size = 1.5, alpha = 0.4, label.size = 0), mutate(ps.tl.t$fatherMovePoints, label = as.character(Date), fill = NA, size = 1.5, alpha = 0.4, label.size = 0) ) par.mov2.labels = cbind(par.mov2.labels, st_coordinates(par.mov2.labels)) offs.mov.labels = bind_rows( mutate(ps.t$offspringRpoints, label = AnimalRef, fill = "#ff7f00", size = 1.5, alpha = 0.6, label.size = 0.25), mutate(ps.t$offspringMovePoints, label = AnimalRef, fill = "white", size = 1.5, alpha = 0.3, label.size = 0.25), mutate(ps.t$offspringMovePoints, label = as.character(Date), fill = NA, size = 1.5, alpha = 0.4, label.size = 0) ) offs.mov.labels = cbind(offs.mov.labels, st_coordinates(offs.mov.labels)) offs.mov2.labels = bind_rows( mutate(ps.tl.t$offspringRpoints, label = AnimalRef, fill = "#ff7f00", size = 1.5, alpha = 0.6, label.size = 0.25), mutate(ps.tl.t$offspringMovePoints, label = AnimalRef, fill = "white", size = 1.5, alpha = 0.3, label.size = 0.25), mutate(ps.tl.t$offspringMovePoints, label = as.character(Date), fill = NA, size = 1.5, alpha = 0.4, label.size = 0) ) offs.mov2.labels = cbind(offs.mov2.labels, st_coordinates(offs.mov2.labels)) ped.ref<-bm+ #plotting sf geom_sf(data = ps.t$maternityLines, color = "#b7484b", linewidth = 0.3 )+ geom_sf(data = ps.t$paternityLines, color = "#1f78b4", linewidth = 0.3 )+ geom_sf(data = ps.t$motherRpoints$geometry, color = "#b7484b", size = 3, shape = 21, stroke = 2)+ geom_sf(data = ps.t$fatherRpoints$geometry, color = "#1f78b4", size = 3, shape = 21, stroke = 2)+ geom_sf(data = ps.t$offspringRpoints, aes(color = GeneticSex) , fill = "#ff7f00", size = 1, shape = 23, stroke = 1)+ #adding labels geom_label_repel(data = ped.ref.labels, aes(x = X, y= Y, label = AnimalRef, fill = fill), size = ped.ref.labels$size, alpha = 0.6)+ #style scale_color_manual(values = c("#b7484b", "#1f78b4"), labels = c("F", "M"))+ theme_void() + theme(legend.position = "none", plot.margin=unit(p.marg.l, "cm")) ped.ref2<-bm+ #plotting sf geom_sf(data = ps.tl.t$maternityLines, color = "#b7484b", linewidth = 0.3 )+ geom_sf(data = ps.tl.t$paternityLines, color = "#1f78b4", linewidth = 0.3 )+ geom_sf(data = ps.tl.t$motherRpoints$geometry, color = "#b7484b", size = 3, shape = 21, stroke = 2)+ geom_sf(data = ps.tl.t$fatherRpoints$geometry, color = "#1f78b4", size = 3, shape = 21, stroke = 2)+ geom_sf(data = ps.tl.t$offspringRpoints, aes(color = GeneticSex) , fill = "#ff7f00", size = 1, shape = 23, stroke = 1)+ #adding labels geom_label_repel(data = ped.ref2.labels, aes(x = X, y= Y, label = AnimalRef, fill = fill), size = ped.ref2.labels$size, alpha = 0.6)+ #style scale_color_manual(values = c("#b7484b", "#1f78b4"), labels = c("F", "M"))+ theme_void(base_size = 3) + theme(legend.position = "none", plot.margin=unit(p.marg.r, "cm")) par.mov <-bm+ geom_sf(data = ps.t$motherMoveLines, color = "#b7484b", linewidth = 0.3, alpha = 0.4)+ geom_sf(data = ps.t$fatherMoveLines, color = "#1f78b4", linewidth = 0.3, alpha = 0.4)+ geom_sf(data = ps.t$motherRpoints$geometry, color = "#b7484b", size = 3, shape = 21, stroke = 2)+ geom_sf(data = ps.t$motherMovePoints, color = "#b7484b", size = 2, shape = 16, alpha = 0.5 )+ geom_label_repel(data = par.mov.labels, aes(x = X, y = Y, label = label, fill = fill,), size = par.mov.labels$size, alpha = par.mov.labels$alpha, label.size = 0)+ geom_sf(data = ps.t$fatherRpoints$geometry, color = "#1f78b4", size = 3, shape = 21, stroke = 2)+ geom_sf(data = ps.t$fatherMovePoints, color = "#1f78b4", size = 2, shape = 16, alpha = 0.5 )+ theme_void() + theme(legend.position = "none", plot.margin=unit(p.marg.l, "cm")) par.mov2 <-bm+ geom_sf(data = ps.tl.t$motherMoveLines, color = "#b7484b", linewidth = 0.3, alpha = 0.4)+ geom_sf(data = ps.tl.t$fatherMoveLines, color = "#1f78b4", linewidth = 0.3, alpha = 0.4)+ geom_sf(data = ps.tl.t$motherRpoints$geometry, color = "#b7484b", size = 3, shape = 21, stroke = 2)+ geom_sf(data = ps.tl.t$motherMovePoints, color = "#b7484b", size = 2, shape = 16, alpha = 0.5 )+ geom_label_repel(data = par.mov2.labels, aes(x = X, y = Y, label = label, fill = fill,), size = par.mov2.labels$size, alpha = par.mov2.labels$alpha, label.size = 0)+ geom_sf(data = ps.tl.t$fatherRpoints$geometry, color = "#1f78b4", size = 3, shape = 21, stroke = 2)+ geom_sf(data = ps.tl.t$fatherMovePoints, color = "#1f78b4", size = 2, shape = 16, alpha = 0.5 )+ theme_void() + theme(legend.position = "none", plot.margin=unit(p.marg.r, "cm")) ext2 <- st_bbox(c(ps.t$motherRpoints$geometry, ps.t$fatherRpoints$geometry, ps.t$offspringRpoints$geometry, ps.t$motherMovePoints$geometry, ps.t$fatherMovePoints$geometry, ps.t$offspringMovePoints$geometry)) ext21000 <- ext2+c(-1000, -1000, 1000, 1000) bm <- ggplot() + basemap_gglayer(ext21000, map_service = "carto", map_type = "light_no_labels") + scale_fill_identity() offs.mov <- bm+ geom_sf(data = ps.t$offspringMoveLines[-c(1),], color = "#ff7f00", linewidth = 0.3, alpha = 0.4)+ geom_sf(data = ps.t$offspringMovePoints, aes(color = GeneticSex), shape = 21, fill = "black", stroke = 1)+ geom_sf(data = ps.t$offspringRpoints, aes(color = GeneticSex) , fill = "#ff7f00", size = 1, shape = 23, stroke = 1)+ geom_label_repel(data = offs.mov.labels, aes(x = X, y = Y, label = label, fill = fill,), size = offs.mov.labels$size, alpha = offs.mov.labels$alpha, label.size = 0, max.overlaps = 30)+ scale_color_manual(values = c("#b7484b", "#1f78b4"), labels = c("F", "M"))+ theme_void() + theme(legend.position = "none", plot.margin=unit(p.marg.l, "cm")) ext3 <- st_bbox(c(ps.tl.t$motherRpoints$geometry, ps.tl.t$fatherRpoints$geometry, ps.tl.t$offspringRpoints$geometry, ps.tl.t$motherMovePoints$geometry, ps.tl.t$fatherMovePoints$geometry, ps.tl.t$offspringMovePoints$geometry)) ext31000 <- ext3+c(-1000, -1000, 1000, 1000) bm <- ggplot() + basemap_gglayer(ext31000, map_service = "carto", map_type = "light_no_labels") + scale_fill_identity() offs.mov2 <- bm+ geom_sf(data = ps.tl.t$offspringMoveLines[-c(1),], color = "#ff7f00", linewidth = 0.3, alpha = 0.4)+ geom_sf(data = ps.tl.t$offspringMovePoints, aes(color = GeneticSex), shape = 21, fill = "black", stroke = 1)+ geom_sf(data = ps.tl.t$offspringRpoints, aes(color = GeneticSex) , fill = "#ff7f00", size = 1, shape = 23, stroke = 1)+ geom_label_repel(data = offs.mov2.labels, aes(x = X, y = Y, label = label, fill = fill,), size = offs.mov2.labels$size, alpha = offs.mov2.labels$alpha, label.size = 0)+ scale_color_manual(values = c("#b7484b", "#1f78b4"), labels = c("F", "M"))+ theme_void() + theme(legend.position = "none", plot.margin=unit(p.marg.r, "cm")) ## ----fig.width=7, out.width="100%", fig.asp=0.5, dpi=300, echo=FALSE, message=FALSE, warning=FALSE---- grid.arrange(arrangeGrob(ped.ref, top = "a)"),arrangeGrob(ped.ref2, top = "b)"), ncol = 2) ## ----fig.width=7, out.width="100%", fig.asp=0.5, dpi=300, echo=FALSE, message=FALSE, warning=FALSE---- grid.arrange(par.mov,par.mov2, ncol = 2) ## ----fig.width=7, out.width="100%", fig.asp=0.7, dpi=300, echo=FALSE, message=FALSE, warning=FALSE---- grid.arrange(offs.mov,offs.mov2, ncol = 2) ## ----------------------------------------------------------------------------- library(leaflet) library(leaflet.providers) pt <- plot_table(plot_fams = c(1:5), fams_org, ped_org, sampledata, deadSample = c("Tissue", "Decomposing Tissue", "Blood")) ps <- ped_spatial(pt, time.limits = c(as.Date("2020-07-01"), as.Date("2021-06-30")), time.limit.rep = TRUE, time.limit.offspring = TRUE, time.limit.moves = TRUE) ## ----out.width = '100%', fig.asp=1.5, echo=FALSE------------------------------ leaflet() |> addTiles() |> addProviderTiles(providers$CartoDB.PositronNoLabels)|> #FATHER REFERENCE addCircleMarkers(data=ps$fatherRpoints, #clusterOptions = markerClusterOptions(), label = ~AnimalRef, popup = ~paste( "Sex:", GeneticSex, "
"), labelOptions = labelOptions(noHide = TRUE, textOnly = TRUE, textsize = "10px", offset=c(12,12,12,12), style = list("color" = "#1f78b4")), radius=5, color = "#1f78b4", fillColor = "#1f78b4", group = "Father Reference")|> #FATHER MOVEMENT addCircleMarkers(data=ps$fatherMovePoints, #clusterOptions = markerClusterOptions(), label = ~AnimalRef, popup = ~paste( "Sex:", GeneticSex, "
"), labelOptions = labelOptions(noHide = TRUE, textOnly = TRUE, textsize = "10px", offset=c(12,12,12,12), style = list("color" = "black")), radius=2, opacity = 0.5, color = "#1f78b4", fillColor = "#1f78b4", group = "Father Movemet")|> #MOTHER REFERENCE addCircleMarkers(data=ps$motherRpoints, #clusterOptions = markerClusterOptions(), label = ~AnimalRef, popup = ~paste( "Sex:", GeneticSex, "
"), labelOptions = labelOptions(noHide = TRUE, textOnly = TRUE, textsize = "10px", offset=c(12,12,12,12), style = list("color" = "#b7484b")), radius=5, color = "#b7484b", fillColor = "#b7484b", group = "Mother Reference") |> #MOTHER MOVEMENT addCircleMarkers(data=ps$motherMovePoints, #clusterOptions = markerClusterOptions(), label = ~AnimalRef, popup = ~paste( "Sex:", GeneticSex, "
"), labelOptions = labelOptions(noHide = TRUE, textOnly = TRUE, textsize = "10px", offset=c(12,12,12,12), style = list("color" = "black")), radius=2, opacity = 0.5, color = "#b7484b", fillColor = "#b7484b", group = "Mother Movement")|> #OFFSPRING REFERENCE addCircleMarkers(data=ps$offspringRpoints, #clusterOptions = markerClusterOptions(), label = ~AnimalRef, popup = ~paste( "Sex:", GeneticSex, "
" ), labelOptions = labelOptions(noHide = FALSE, textOnly = TRUE, opacity = 0.5, textsize = "3px", offset=c(12,12,12,12), style = list("color" = "gray")), radius=3, color = "orange", fillColor = "orange", group = "Offspring Reference")|> #OFFSPRING MOVEMENT addCircleMarkers(data=ps$offspringMovePoints, #clusterOptions = markerClusterOptions(), label = ~AnimalRef, popup = ~paste( "Sex:", GeneticSex, "
" ), labelOptions = labelOptions(noHide = F, textOnly = TRUE, opacity = 0.5, textsize = "3px", offset=c(12,12,12,12), style = list("color" = "gray")), radius=1, color = "black", fillColor = "black", group = "Offspring Movement")|> addPolylines(data = ps$maternityLines, stroke = TRUE, weight = 1.5, color = "#b7484b", opacity = 1, group = "Maternity") |> addPolylines(data = ps$paternityLines, stroke = TRUE, weight = 1.5, color = "#1f78b4", opacity = 1, group = "Paternity") |> addPolylines(data = ps$fatherMoveLines, stroke = TRUE, weight = 0.5, color = "#1f78b4", opacity = 0.4, group = "Father Movement Line") |> addPolylines(data = ps$offspringMoveLines, stroke = TRUE, weight = 0.5, color = "black", opacity = 0.4, group = "Offspring Movement Line")|> addLayersControl( overlayGroups = c("Father Reference", "Father Movemet", "Mother Reference", "Mother Movement", "Offspring Reference", "Offspring Movement", "Maternity", "Paternity", "Father Movement Line", "Mother Movement Line", "Offspring Movement Line"), options = layersControlOptions(collapsed = FALSE)) |> hideGroup(c("Father Movemet", "Mother Movement", "Offspring Movement", "Maternity", "Paternity", "Father Movement Line", "Mother Movement Line", "Offspring Movement Line")) ## ----eval = FALSE------------------------------------------------------------- # pt <- plot_table( # plot_fams = 1 # all_fams = fams_org, # ped = ped_org, # sampledata = sampledata, # deadSample = c("Tissue", "Decomposing Tissue", "Blood") # ) # # ps <- ped_spatial( # plottable = pt, # output = "gis", # path = "/folder/where/GIS/files/shuld/be/saved/" # ) ## ----------------------------------------------------------------------------- seasons <- data.frame( start = c( as.Date("2017-01-01"), as.Date("2018-01-01"), as.Date("2019-01-01") ), end = c( as.Date("2017-12-31"), as.Date("2018-12-31"), as.Date("2019-12-31") ) ) dyn_mat <- dyn_matrix( animal_id = wolf_samples$AnimalRef, capture_date = wolf_samples$Date, start_dates = seasons$start, end_dates = seasons$end ) dyn_mat ## ----------------------------------------------------------------------------- unname(dyn_mat) ## ----------------------------------------------------------------------------- nbtw_seasons( animal_id = wolf_samples$AnimalRef, capture_date = wolf_samples$Date, season1_start = as.Date("2017-01-01"), season1_end = as.Date("2017-12-31"), season2_start = as.Date("2018-01-01"), season2_end = as.Date("2018-12-31") )