Skip to content

Commit dc1a50d

Browse files
LHMarshallLHMarshall
authored
Merge pull request #83 from DistanceDevelopment/CRAN-1.0.3-rem-SP
Cran 1.0.3 rem sp
2 parents bdf539e + ee2f797 commit dc1a50d

14 files changed

Lines changed: 218 additions & 196 deletions

‎DESCRIPTION‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -5,10 +5,10 @@ Imports:
55
mrds,
66
Distance,
77
sf,
8-
sp,
98
ggplot2,
9+
purrr,
10+
dplyr,
1011
mgcv,
11-
rgeos,
1212
methods,
1313
rstudioapi,
1414
gridExtra,
@@ -23,7 +23,7 @@ Suggests:
2323
VignetteBuilder: knitr
2424
Type: Package
2525
Title: Distance Sampling Simulations
26-
Version: 1.0.2.9000
26+
Version: 1.0.3
2727
Authors@R: c(
2828
person("Laura", "Marshall", email = "lhm@st-and.ac.uk", role = c("aut", "cre")),
2929
person("Thomas", "Len", email = "len.thomas@st-andrews.ac.uk", role = "ctb"))
@@ -48,7 +48,7 @@ Language: en-GB
4848
URL: https://github.com/DistanceDevelopment/dsims
4949
BugReports: https://github.com/DistanceDevelopment/dsims/issues
5050
Encoding: UTF-8
51-
RoxygenNote: 7.2.1
51+
RoxygenNote: 7.2.3
5252
Collate:
5353
'AICc.R'
5454
'generic.functions.R'

‎NAMESPACE‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,8 @@ importClassesFrom(dssd,Line.Transect)
3737
importClassesFrom(dssd,Point.Transect)
3838
importClassesFrom(dssd,Region)
3939
importFrom(Distance,ds)
40+
importFrom(dplyr,full_join)
41+
importFrom(dplyr,left_join)
4042
importFrom(dssd,generate.transects)
4143
importFrom(dssd,make.design)
4244
importFrom(dssd,make.region)
@@ -79,22 +81,21 @@ importFrom(parallel,detectCores)
7981
importFrom(parallel,makeCluster)
8082
importFrom(parallel,parLapply)
8183
importFrom(parallel,stopCluster)
82-
importFrom(rgeos,gIntersects)
84+
importFrom(purrr,reduce)
8385
importFrom(rlang,.data)
8486
importFrom(rstudioapi,versionInfo)
8587
importFrom(sf,as_Spatial)
8688
importFrom(sf,st_area)
8789
importFrom(sf,st_as_sf)
8890
importFrom(sf,st_buffer)
91+
importFrom(sf,st_coordinates)
8992
importFrom(sf,st_crs)
93+
importFrom(sf,st_drop_geometry)
9094
importFrom(sf,st_intersection)
9195
importFrom(sf,st_length)
9296
importFrom(sf,st_make_grid)
9397
importFrom(sf,st_sf)
9498
importFrom(sf,st_sfc)
95-
importFrom(sp,Polygon)
96-
importFrom(sp,Polygons)
97-
importFrom(sp,SpatialPolygons)
9899
importFrom(stats,AIC)
99100
importFrom(stats,BIC)
100101
importFrom(stats,density)

‎NEWS‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,10 @@ dsims 1.0.3
33

44
Bug Fixes
55

6-
* Simulations were crashing if there were zero detections - now fixed and warnings displayed instead.
6+
* Simulations were crashing if there were zero detections - now fixed and warnings displayed instead. Issue #77
7+
* Errors were also occuring when there were no individuals generated in a stratum, now fixed. Issue #80
8+
* Detections are no longer permitted across stratum boundaries - this was causing errors due to NA area values in the data. This is inline with expected protocols on surveys. Issue #81
9+
* Remove dependence on sp and rgeos. Issue #42
710

811
dsims 1.0.2
912
-------------------

‎R/Population.R‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -104,8 +104,7 @@ setMethod(
104104
sf.region <- y@region
105105
# Turn population into sf object
106106
pop.df <- x@population
107-
pts <- sp::SpatialPoints(data.frame(x = pop.df$x, y = pop.df$y))
108-
pts.sf <- sf::st_as_sf(pts)
107+
pts.sf <- sf::st_as_sf(pop.df, coords = c("x", "y"))
109108
sf::st_crs(pts.sf) <- sf::st_crs(sf.region)
110109

111110
ggplot.obj <- ggplot() + theme_bw() +

‎R/Survey.LT.R‎

Lines changed: 50 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -49,45 +49,62 @@ setValidity("Survey.LT",
4949
#' @rdname run.survey-methods
5050
#' @param region an object of class Region.
5151
#' @export
52+
#' @importFrom dplyr left_join
5253
setMethod(
5354
f="run.survey",
5455
signature="Survey.LT",
5556
definition=function(object, region = NULL){
56-
population <- object@population
57-
line.transect <- object@transect
58-
# Find possible detection distances
59-
poss.distances <- calc.perp.dists(population, line.transect)
60-
# Store them in the object
61-
if(!is.null(poss.distances$distance)){
62-
object@dists.in.covered <- poss.distances$distance
63-
}
64-
# Simulate detections
65-
dist.data <- simulate.detections(poss.distances, object@population@detectability)
66-
# Check if there are any detections
67-
if(nrow(dist.data) == 0){
68-
return(object)
69-
}
70-
# Get the covariate names
71-
all.col.names <- names(object@population@population)
72-
cov.param.names <- all.col.names[!all.col.names %in% c("object", "x", "y", "Region.Label", "Sample.Label", "scale.param", "shape.param", "individual")]
73-
dist.data <- dist.data[,c("object", "individual", "Region.Label", "Sample.Label", "distance", "x", "y", cov.param.names)]
74-
# Add in the transect lengths
75-
sample.table <- data.frame(Region.Label = line.transect@samplers$strata,
76-
Sample.Label = line.transect@samplers$transect,
77-
Effort = sf::st_length(line.transect@samplers))
78-
# If the region is supplied then add in the survey region Area
79-
if(!is.null(region)){
80-
region.table <- data.frame(Region.Label = region@strata.name,
81-
Area = region@area)
82-
sample.table <- dplyr::left_join(sample.table, region.table, by = "Region.Label")
83-
}
84-
dist.data <- dplyr::full_join(dist.data, sample.table, by = c("Sample.Label", "Region.Label"))
85-
# Order by transect id
86-
index <- order(dist.data$Sample.Label)
87-
dist.data <- dist.data[index,]
88-
object@dist.data <- dist.data
57+
# To allow debugging via breakpoints
58+
object <- run.survey.body.LT(object, region)
8959
return(object)
9060
}
9161
)
9262

63+
run.survey.body.LT <- function(object, region){
64+
population <- object@population
65+
line.transect <- object@transect
66+
# Find possible detection distances
67+
poss.distances <- calc.perp.dists(population, line.transect)
68+
# Store them in the object
69+
if(!is.null(poss.distances$distance)){
70+
object@dists.in.covered <- poss.distances$distance
71+
}
72+
# Simulate detections
73+
dist.data <- simulate.detections(poss.distances, object@population@detectability)
74+
# Check if there are any detections
75+
if(nrow(dist.data) == 0){
76+
return(object)
77+
}
78+
# Get the covariate names
79+
all.col.names <- names(object@population@population)
80+
cov.param.names <- all.col.names[!all.col.names %in% c("object", "x", "y", "Region.Label", "Sample.Label", "scale.param", "shape.param", "individual")]
81+
dist.data <- dist.data[,c("object", "individual", "Region.Label", "Sample.Label", "distance", "x", "y", cov.param.names)]
82+
# Add in the transect lengths
83+
sample.table <- data.frame(Region.Label = line.transect@samplers$strata,
84+
Sample.Label = line.transect@samplers$transect,
85+
Effort = sf::st_length(line.transect@samplers))
86+
# If the region is supplied then add in the survey region Area
87+
if(!is.null(region)){
88+
region.table <- data.frame(Region.Label = region@strata.name,
89+
Area = region@area)
90+
sample.table <- dplyr::left_join(sample.table, region.table, by = "Region.Label")
91+
}
92+
# Rename Region.Label to obs.Region.Label
93+
index <- which(names(dist.data) == "Region.Label")
94+
names(dist.data)[index] <- "obs.Region.Label"
95+
# Only join by sampler ID
96+
dist.data <- dplyr::full_join(dist.data, sample.table, by = c("Sample.Label"))
97+
# Check if any Region.Labels and obs.Region.Label don't match (detections across stratum boundaries)
98+
index <- which(dist.data$obs.Region.Label != dist.data$Region.Label)
99+
if(length(index) > 0){
100+
# Remove any detections across stratum boundaries
101+
dist.data <- dist.data[-index,]
102+
}
103+
# Order by transect id
104+
index <- order(dist.data$Sample.Label)
105+
dist.data <- dist.data[index,]
106+
object@dist.data <- dist.data
107+
return(object)
108+
}
109+
93110

‎R/Survey.PT.R‎

Lines changed: 50 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -48,45 +48,62 @@ setValidity("Survey.PT",
4848

4949
#' @rdname run.survey-methods
5050
#' @export
51+
#' @importFrom dplyr left_join full_join
5152
setMethod(
5253
f="run.survey",
5354
signature="Survey.PT",
5455
definition=function(object, region = NULL){
55-
population <- object@population
56-
point.transect <- object@transect
57-
# Find possible detection distances
58-
poss.distances <- calc.rad.dists(population, point.transect)
59-
if(!is.null(poss.distances$distance)){
60-
object@dists.in.covered <- poss.distances$distance
61-
}
62-
# Simulate detections
63-
dist.data <- simulate.detections(poss.distances, object@population@detectability)
64-
# Check if there are any detections
65-
if(nrow(dist.data) == 0){
66-
return(object)
67-
}
68-
# Get the covariate names
69-
all.col.names <- names(object@population@population)
70-
cov.param.names <- all.col.names[!all.col.names %in% c("object", "x", "y", "Region.Label", "Sample.Label", "scale.param", "shape.param", "individual")]
71-
dist.data <- dist.data[,c("object", "individual", "Region.Label", "Sample.Label", "distance", "x", "y", cov.param.names)]
72-
# Add in the transect lengths
73-
sample.table <- data.frame(Region.Label = point.transect@samplers$strata,
74-
Sample.Label = point.transect@samplers$transect,
75-
Effort = rep(1,length(point.transect@samplers$transect)))
76-
# If the region is supplied then add in the survey region Area
77-
if(!is.null(region)){
78-
region.table <- data.frame(Region.Label = region@strata.name,
79-
Area = region@area)
80-
sample.table <- dplyr::left_join(sample.table, region.table, by = "Region.Label")
81-
}
82-
dist.data <- dplyr::full_join(dist.data, sample.table, by = c("Sample.Label", "Region.Label"))
83-
# Order by transect id
84-
index <- order(dist.data$Sample.Label)
85-
dist.data <- dist.data[index,]
86-
object@dist.data <- dist.data
87-
object@dists.in.covered <- poss.distances$distance
56+
# To allow debugging via breakpoints
57+
object <- run.survey.body.PT(object, region)
8858
return(object)
8959
}
9060
)
9161

62+
run.survey.body.PT <- function(object, region){
63+
population <- object@population
64+
point.transect <- object@transect
65+
# Find possible detection distances
66+
poss.distances <- calc.rad.dists(population, point.transect)
67+
if(!is.null(poss.distances$distance)){
68+
object@dists.in.covered <- poss.distances$distance
69+
}
70+
# Simulate detections
71+
dist.data <- simulate.detections(poss.distances, object@population@detectability)
72+
# Check if there are any detections
73+
if(nrow(dist.data) == 0){
74+
return(object)
75+
}
76+
# Get the covariate names
77+
all.col.names <- names(object@population@population)
78+
cov.param.names <- all.col.names[!all.col.names %in% c("object", "x", "y", "Region.Label", "Sample.Label", "scale.param", "shape.param", "individual")]
79+
dist.data <- dist.data[,c("object", "individual", "Region.Label", "Sample.Label", "distance", "x", "y", cov.param.names)]
80+
# Add in the transect lengths
81+
sample.table <- data.frame(Region.Label = point.transect@samplers$strata,
82+
Sample.Label = point.transect@samplers$transect,
83+
Effort = rep(1,length(point.transect@samplers$transect)))
84+
# If the region is supplied then add in the survey region Area
85+
if(!is.null(region)){
86+
region.table <- data.frame(Region.Label = region@strata.name,
87+
Area = region@area)
88+
sample.table <- dplyr::left_join(sample.table, region.table, by = "Region.Label")
89+
}
90+
# Rename Region.Label to obs.Region.Label
91+
index <- which(names(dist.data) == "Region.Label")
92+
names(dist.data)[index] <- "obs.Region.Label"
93+
# Only join by sampler ID
94+
dist.data <- dplyr::full_join(dist.data, sample.table, by = c("Sample.Label"))
95+
# Check if any Region.Labels and obs.Region.Label don't match (detections across stratum boundaries)
96+
index <- which(dist.data$obs.Region.Label != dist.data$Region.Label)
97+
if(length(index) > 0){
98+
# Remove any detections across stratum boundaries
99+
dist.data <- dist.data[-index,]
100+
}
101+
# Order by transect id
102+
index <- order(dist.data$Sample.Label)
103+
dist.data <- dist.data[index,]
104+
object@dist.data <- dist.data
105+
return(object)
106+
}
107+
108+
92109

‎R/Survey.R‎

Lines changed: 6 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -59,9 +59,9 @@ setMethod(
5959
return(p[[1]])
6060
}
6161

62+
# Turn population into sf object
6263
pop.df <- x@population@population
63-
pts <- sp::SpatialPoints(data.frame(x = pop.df$x, y = pop.df$y))
64-
pts.sf <- sf::st_as_sf(pts)
64+
pts.sf <- sf::st_as_sf(pop.df, coords = c("x", "y"))
6565
sf::st_crs(pts.sf) <- sf::st_crs(sf.region)
6666

6767
p[[2]] <- ggplot() + theme_void() +
@@ -75,8 +75,7 @@ setMethod(
7575

7676
distdata <- na.omit(x@dist.data)
7777
if(nrow(distdata) > 0){
78-
pts2 <- sp::SpatialPoints(data.frame(x = distdata$x, y = distdata$y))
79-
detect.sf <- sf::st_as_sf(pts2)
78+
detect.sf <- sf::st_as_sf(distdata, coords = c("x", "y"))
8079
sf::st_crs(detect.sf) <- sf::st_crs(sf.region)
8180

8281
p[[3]] <- ggplot() + theme_void() +
@@ -164,15 +163,14 @@ setMethod(
164163
transects <- x@transect@samplers
165164
covered.areas <- x@transect@cov.area.polys
166165
# Population
166+
# Turn population into sf object
167167
pop.df <- x@population@population
168-
pts <- sp::SpatialPoints(data.frame(x = pop.df$x, y = pop.df$y))
169-
pts.sf <- sf::st_as_sf(pts)
168+
pts.sf <- sf::st_as_sf(pop.df, coords = c("x", "y"))
170169
sf::st_crs(pts.sf) <- sf::st_crs(transects)
171170
# Detections
172171
distdata <- na.omit(x@dist.data)
173172
if(nrow(distdata) > 0){
174-
pts2 <- sp::SpatialPoints(data.frame(x = distdata$x, y = distdata$y))
175-
detect.sf <- sf::st_as_sf(pts2)
173+
detect.sf <- sf::st_as_sf(distdata, coords = c("x", "y"))
176174
sf::st_crs(detect.sf) <- sf::st_crs(transects)
177175

178176
p[[1]] <- ggplot() + theme_void() +

0 commit comments

Comments
 (0)