## ----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")
)