Skip to content

Commit a6da79e

Browse files
olivroyolivroy
committed
Tidyup test_zm_range.R
1 parent f6b87a3 commit a6da79e

File tree

1 file changed

+117
-100
lines changed

1 file changed

+117
-100
lines changed

‎tests/testthat/test_zm_range.R‎

Lines changed: 117 additions & 100 deletions
Original file line numberDiff line numberDiff line change
@@ -1,83 +1,90 @@
1-
2-
test_that("sf::st_z_range and sf::st_z_range returns correct value from sfg objects", {
3-
4-
pt <- sf::st_point( x = c(0,1,3,3))
5-
expect_true( all( sf::st_z_range( pt ) == c(3,3) ) )
6-
expect_true( all( sf::st_z_range( pt ) == sf::st_z_range( pt ) ) )
7-
8-
mp <- sf::st_multipoint( x = matrix(c(0,1,1,1,0,2,5,5), ncol = 4, byrow = T))
9-
expect_true( all( sf::st_z_range( mp ) == c(1,5) ) )
10-
expect_true( all( sf::st_z_range( mp ) == sf::st_z_range( mp ) ) )
11-
12-
ls <- sf::st_linestring(x = matrix(c(0,1,1,1,0,2,5,5,0,3,10,10), ncol = 4, byrow = T))
13-
expect_true( all( sf::st_z_range( ls ) == c(1,10) ) )
14-
expect_true( all( sf::st_z_range( ls ) == sf::st_z_range( ls ) ) )
15-
16-
mls <- sf::st_multilinestring(x = list(ls, matrix(c(0,1,5,5,0,1,-1,-1), ncol = 4, byrow = T)))
17-
expect_true( all( sf::st_z_range( mls ) == c(-1, 10 ) ) )
18-
expect_true( all( sf::st_z_range( mls ) == sf::st_z_range( mls ) ) )
19-
20-
pl <- sf::st_polygon(x = list(matrix(c(0,0,1,1,0,1,2,2,1,1,3,3,1,0,4,4,0,0,1,1), ncol = 4, byrow = T)))
21-
expect_true( all( sf::st_z_range( pl ) == c(1, 4)))
22-
expect_true( all( sf::st_z_range( pl ) == sf::st_z_range( pl ) ) )
23-
24-
mpl <- sf::st_multipolygon(x = list(pl, sf::st_polygon( x = list( matrix(c(0,0,10,10,0,-1,9,9,-1,-1,-10,-10,-1,0,-5,-5,0,0,10,10), ncol = 4, byrow = T) ) ) ) )
25-
expect_true( all( sf::st_z_range( mpl ) == c(-10, 10) ) )
26-
expect_true( all( sf::st_z_range( mpl ) == sf::st_z_range( mpl ) ) )
27-
28-
gc <- sf::st_geometrycollection(x = list(pt, mp))
29-
expect_true( all( sf::st_z_range( gc ) == c(1, 5) ) )
30-
expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) )
31-
32-
gc <- sf::st_geometrycollection(x = list(ls, pl))
33-
expect_true( all( sf::st_z_range( gc ) == c(1, 10) ) )
34-
expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) )
35-
36-
gc <- sf::st_geometrycollection(x = list(pt, mpl))
37-
expect_true( all( sf::st_z_range( gc ) == c(-10, 10) ) )
38-
expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) )
39-
1+
# Expect the z range, strip attributes to only compare values.
2+
expect_st_z_range <- function(object, expected) {
3+
expect_equal(unclass(st_z_range(object)), expected, check.attributes = FALSE)
4+
}
5+
6+
test_that("st_z_range and st_z_range returns correct value from sfg objects", {
7+
8+
pt <- st_point(x = c(0,1,3,3))
9+
10+
expect_st_z_range(pt, c(3,3))
11+
expect_equal(st_z_range(pt), st_z_range(pt))
12+
13+
mp <- st_multipoint(x = matrix(c(0,1,1,1,0,2,5,5), ncol = 4, byrow = TRUE))
14+
expect_st_z_range(mp, c(1, 5))
15+
expect_equal(st_z_range(mp), st_z_range(mp))
16+
17+
ls <- st_linestring(x = matrix(c(0,1,1,1,0,2,5,5,0,3,10,10), ncol = 4, byrow = TRUE))
18+
expect_st_z_range(ls, c(1, 10))
19+
expect_equal(st_z_range(ls), st_z_range(ls))
20+
21+
mls <- st_multilinestring(x = list(ls, matrix(c(0,1,5,5,0,1,-1,-1), ncol = 4, byrow = TRUE)))
22+
expect_st_z_range(mls, c(-1, 10))
23+
expect_equal(st_z_range(mls), st_z_range(mls))
24+
25+
pl <- st_polygon(x = list(matrix(c(0,0,1,1,0,1,2,2,1,1,3,3,1,0,4,4,0,0,1,1), ncol = 4, byrow = T)))
26+
expect_st_z_range(pl, c(1, 4))
27+
expect_equal(st_z_range(pl), st_z_range(pl))
28+
29+
mpl <- st_multipolygon(
30+
x = list(pl, st_polygon(
31+
x = list(matrix(c(0,0,10,10,0,-1,9,9,-1,-1,-10,-10,-1,0,-5,-5,0,0,10,10),
32+
ncol = 4, byrow = TRUE))))
33+
)
34+
expect_st_z_range(mpl, c(-10, 10))
35+
expect_equal(st_z_range(mpl), st_z_range(mpl))
36+
37+
gc <- st_geometrycollection(x = list(pt, mp))
38+
expect_st_z_range(gc, c(1, 5))
39+
expect_equal(st_z_range(gc), st_z_range(gc))
40+
41+
gc <- st_geometrycollection(x = list(ls, pl))
42+
expect_st_z_range(gc, c(1, 10))
43+
expect_equal(st_z_range(gc), st_z_range(gc))
44+
45+
gc <- st_geometrycollection(x = list(pt, mpl))
46+
expect_st_z_range(gc, c(-10, 10))
47+
expect_equal(st_z_range(gc), st_z_range(gc))
4048
})
4149

4250

4351
test_that("sf::st_z_range and sf::st_z_range returns correct value from sfc objects", {
52+
pt <- st_sfc(st_point( x = c(0,1,3,3)))
53+
# expect_equal(attr( pt, "zbox" ), c(3, 3)) # FIXME: now NULL
54+
expect_st_z_range(pt, c(3, 3))
55+
expect_equal(st_z_range(pt), st_z_range(pt))
4456

45-
pt <- sf::st_sfc( sf::st_point( x = c(0,1,3,3)))
46-
expect_true( all( attr( pt, "zbox" ) == c(3,3) ) )
47-
expect_true( all( sf::st_z_range( pt ) == c(3,3) ) )
48-
expect_true( all( sf::st_z_range( pt ) == sf::st_z_range( pt ) ) )
57+
mp <- st_sfc(st_multipoint( x = matrix(c(0,1,1,1,0,2,5,5), ncol = 4, byrow = TRUE)))
58+
expect_st_z_range(mp, c(1, 5))
59+
expect_equal(st_z_range(mp), st_z_range(mp))
4960

50-
mp <- sf::st_sfc( sf::st_multipoint( x = matrix(c(0,1,1,1,0,2,5,5), ncol = 4, byrow = T)))
51-
expect_true( all( sf::st_z_range( mp ) == c(1,5) ) )
52-
expect_true( all( sf::st_z_range( mp ) == sf::st_z_range( mp ) ) )
61+
ls <- st_sfc(st_linestring(x = matrix(c(0,1,1,1,0,2,5,5,0,3,10,10), ncol = 4, byrow = TRUE)))
62+
expect_st_z_range(ls, c(1, 10))
63+
expect_equal(st_z_range(ls), st_z_range(ls))
5364

54-
ls <- sf::st_sfc( sf::st_linestring(x = matrix(c(0,1,1,1,0,2,5,5,0,3,10,10), ncol = 4, byrow = T)))
55-
expect_true( all( sf::st_z_range( ls ) == c(1,10) ) )
56-
expect_true( all( sf::st_z_range( ls ) == sf::st_z_range( ls ) ) )
65+
mls <- st_sfc(st_multilinestring(x = list(ls[[1]], matrix(c(0,1,5,5,0,1,-1,-1), ncol = 4, byrow = TRUE))))
66+
expect_st_z_range(mls, c(-1, 10))
67+
expect_equal(st_z_range(mls), st_z_range(mls))
5768

58-
mls <- sf::st_sfc( sf::st_multilinestring(x = list(ls[[1]], matrix(c(0,1,5,5,0,1,-1,-1), ncol = 4, byrow = T))))
59-
expect_true( all( sf::st_z_range( mls ) == c(-1, 10 ) ) )
60-
expect_true( all( sf::st_z_range( mls ) == sf::st_z_range( mls ) ) )
69+
pl <- st_sfc(st_polygon(x = list(matrix(c(0,0,1,1,0,1,2,2,1,1,3,3,1,0,4,4,0,0,1,1), ncol = 4, byrow = TRUE))))
70+
expect_st_z_range(pl, c(1, 4))
71+
expect_equal(st_z_range(pl), st_z_range(pl))
6172

62-
pl <- sf::st_sfc( sf::st_polygon(x = list(matrix(c(0,0,1,1,0,1,2,2,1,1,3,3,1,0,4,4,0,0,1,1), ncol = 4, byrow = T))))
63-
expect_true( all( sf::st_z_range( pl ) == c(1, 4)))
64-
expect_true( all( sf::st_z_range( pl ) == sf::st_z_range( pl ) ) )
73+
mpl <- st_sfc(st_multipolygon(x = list(pl[[1]], st_polygon( x = list( matrix(c(0,0,10,10,0,-1,9,9,-1,-1,-10,-10,-1,0,-5,-5,0,0,10,10), ncol = 4, byrow = TRUE))))))
74+
expect_st_z_range(mpl, c(-10, 10))
75+
expect_equal(st_z_range(mpl), st_z_range(mpl))
6576

66-
mpl <- sf::st_sfc( sf::st_multipolygon(x = list(pl[[1]], sf::st_polygon( x = list( matrix(c(0,0,10,10,0,-1,9,9,-1,-1,-10,-10,-1,0,-5,-5,0,0,10,10), ncol = 4, byrow = T) ) ) ) ))
67-
expect_true( all( sf::st_z_range( mpl ) == c(-10, 10) ) )
68-
expect_true( all( sf::st_z_range( mpl ) == sf::st_z_range( mpl ) ) )
77+
gc <- st_sfc(st_geometrycollection(x = list(pt[[1]], mp[[1]])))
78+
expect_st_z_range(gc, c(1, 5))
79+
expect_equal(st_z_range(gc), st_z_range(gc))
6980

70-
gc <- sf::st_sfc( sf::st_geometrycollection(x = list(pt[[1]], mp[[1]])))
71-
expect_true( all( sf::st_z_range( gc ) == c(1, 5) ) )
72-
expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) )
81+
gc <- st_sfc(st_geometrycollection(x = list(ls[[1]], pl[[1]])))
82+
expect_st_z_range(gc, c(1, 10))
83+
expect_equal(st_z_range(gc), st_z_range(gc))
7384

74-
gc <- sf::st_sfc( sf::st_geometrycollection(x = list(ls[[1]], pl[[1]])))
75-
expect_true( all( sf::st_z_range( gc ) == c(1, 10) ) )
76-
expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) )
77-
78-
gc <- sf::st_sfc( sf::st_geometrycollection(x = list(pt[[1]], mpl[[1]])))
79-
expect_true( all( sf::st_z_range( gc ) == c(-10, 10) ) )
80-
expect_true( all( sf::st_z_range( gc ) == sf::st_z_range( gc ) ) )
85+
gc <- st_sfc(st_geometrycollection(x = list(pt[[1]], mpl[[1]])))
86+
expect_st_z_range(gc, c(-10, 10))
87+
expect_equal(st_z_range(gc), st_z_range(gc))
8188

8289
})
8390

@@ -87,34 +94,40 @@ test_that("zmrange works on more compliated examples", {
8794
m <- matrix(rnorm(300), ncol = 3)
8895
expected <- c(min(m[,3]), max(m[,3]))
8996

90-
ls <- sf::st_linestring(x = m )
91-
expect_true( all( sf::st_z_range(ls) == expected ) )
92-
93-
ls <- sf::st_sfc( ls )
94-
expect_true( all( sf::st_z_range(ls) == expected ) )
95-
expect_true( all( attr(ls, "z_range") == expected ) )
96-
97-
ls <- sf::st_sf( geometry = ls )
98-
expect_true( all( sf::st_z_range(ls) == expected ) )
99-
expect_true( all( attr(ls$geometry, "z_range") == expected ) )
100-
97+
ls <- st_linestring(x = m)
98+
expect_st_z_range(ls, expected)
99+
100+
ls <- st_sfc(ls)
101+
expect_st_z_range(ls, expected)
102+
expect_equal(
103+
unclass(attr(ls, "z_range")),
104+
expected,
105+
check.attributes = FALSE
106+
)
107+
108+
ls <- st_sf(geometry = ls)
109+
expect_st_z_range(ls, expected)
110+
expect_equal(
111+
unclass(attr(ls$geometry, "z_range")),
112+
expected,
113+
check.attributes = FALSE
114+
)
101115
n <- 100
102116
lst <- list()
103117
min_z <- numeric(n)
104118
max_z <- numeric(n)
105119

106120
set.seed(123)
107121

108-
for(i in 1:n) {
109-
m <- matrix(rnorm(sample(seq(3,300,by=3), size = 1)), ncol = 3)
122+
for(i in seq_along(n)) {
123+
m <- matrix(rnorm(sample(seq(3,300, by = 3), size = 1)), ncol = 3)
110124
min_z[i] <- min(m[,3])
111125
max_z[i] <- max(m[,3])
112-
lst[[i]] <- sf::st_linestring( m )
126+
lst[[i]] <- st_linestring(m)
113127
}
114128

115-
sfc <- sf::st_sfc( lst )
116-
117-
expect_true( all (sf::st_z_range( sfc ) == c(min(min_z), max(max_z)) ) )
129+
sfc <- st_sfc(lst)
130+
expect_st_z_range(sfc, c(min(min_z), max(max_z)))
118131

119132
})
120133

@@ -127,35 +140,39 @@ test_that("transform includes zm in output", {
127140
sfc = st_sfc(p1, p2, crs = 4326)
128141

129142
res <- st_transform(sfc, 3857)
130-
expect_true( "z_range" %in% names( attributes(res) ) )
131-
expect_equal( sf::st_z_range(res[[1]]), sf::st_z_range(sfc[[1]]) )
143+
expect_contains(names(attributes(res)), "z_range")
144+
expect_equal(st_z_range(res[[1]]), st_z_range(sfc[[1]]))
132145

133146
p1 = st_point(c(7,52,52,7))
134147
p2 = st_point(c(-30,20,20,-30))
135148
sfc = st_sfc(p1, p2, crs = 4326)
136149

137150
res <- st_transform(sfc, 3857)
138-
expect_true( "z_range" %in% names( attributes(res) ) )
139-
expect_equal( sf::st_z_range(res[[1]]), sf::st_z_range(sfc[[1]]) )
140-
expect_true( "m_range" %in% names( attributes(res) ) )
141-
expect_equal( sf::st_m_range(res[[1]]), sf::st_m_range(sfc[[1]]) )
151+
expect_contains(names(attributes(res)), c("z_range", "m_range"))
152+
expect_equal(st_z_range(res[[1]]), st_z_range(sfc[[1]]))
153+
expect_equal(st_m_range(res[[1]]), st_m_range(sfc[[1]]))
142154

143155
})
144156

145157

146158
test_that("XYM-only objects correctly calculate M (and not Z)", {
147-
skip_if_not(sf_extSoftVersion()["GDAL"] > "2.1.0")
159+
skip_if(sf_extSoftVersion()[["GDAL"]] <= "2.1.0")
148160

149-
sf_m <- sf::st_read(system.file("/shape/storms_xyzm.shp", package = "sf"), quiet = TRUE)
150-
m <- sf::st_coordinates( sf_m )
161+
sf_m <- st_read(system.file("/shape/storms_xyzm.shp", package = "sf"), quiet = TRUE)
162+
m <- st_coordinates(sf_m)
151163

152-
mmin <- min( m[, 3] ); mmax <- max( m[, 3] )
153-
expect_true( all( sf::st_m_range( sf_m ) == c(mmin, mmax) ) )
164+
mmin <- min(m[, 3])
165+
mmax <- max(m[, 3])
166+
expect_equal(unclass(st_m_range(sf_m)), c(mmin, mmax), check.attributes = FALSE)
154167

155-
sf_z <- sf::st_read(system.file("/shape/storms_xyz.shp", package = "sf"), quiet = TRUE)
168+
sf_z <- st_read(system.file("/shape/storms_xyz.shp", package = "sf"), quiet = TRUE)
156169

157-
expect_true( all( sf::st_m_range( sf_m ) == sf::st_z_range( sf_z ) ) )
170+
expect_equal(
171+
unclass(st_m_range(sf_m)),
172+
unclass(st_z_range(sf_z)),
173+
check.attributes = FALSE
174+
)
158175

159-
expect_null(sf::st_z_range(sf_m))
160-
expect_null(sf::st_m_range(sf_z))
176+
expect_null(st_z_range(sf_m))
177+
expect_null(st_m_range(sf_z))
161178
})

0 commit comments

Comments
 (0)