← Back to branch summary

~ubuntu-branches/debian/sid/simpleitk/sid

« back to all changes in this revision

Viewing changes to Testing/Unit/RImageSlicingTests.R

  • Committer: Package Import Robot
  • Author(s): Ghislain Antony Vaillant
  • Date: 2017-11-02 08:49:18 UTC
  • Revision ID: package-import@ubuntu.com-20171102084918-7hs09ih668xq87ej
Tags: upstream-1.0.1
Import upstream version 1.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
Testing/Unit/RImageSlicingTests.R
 
1
## Test image slicing operators. They need to conform to rules that are slightly
 
2
## different to those for R matrices.
 
3
##
 
4
## These rules are: spacing needs to be uniform per dimension
 
5
## i.e. im[c(1,2,11),] is not accepted
 
6
## This means that creating reflected images isn't possible
 
7
## with slicing - use slicing + Tile.
 
8
## Dropping dimensions is the default, but SimpleITK does not
 
9
## support 1D images. The slicing operator will issue a warning if
 
10
## this is attempted.
 
11
##
 
12
## The bracket operator used for slicing now constructs calls to Slice and Extract,
 
13
## rather than using special C routines. This means that the operation is multithreaded
 
14
## and preserves spacing, origin and direction.
 
15
library(SimpleITK)
 
16
slicingOperatorUnitSpacingTest<- function()
 
17
{
 
18
    ## Cropping test - unit spacing
 
19
    im <- Image(15,15,"sitkFloat64")
 
20
    im$SetSpacing(c(0.3,0.6))
 
21
    t <- 0.4
 
22
    ct <- cos(t)
 
23
    st <- sin(t)
 
24
    im$SetDirection(c(ct,-st,st,ct))
 
25
 
 
26
    e1 <- im[2:10,3:5]
 
27
 
 
28
    ef <- ExtractImageFilter()
 
29
    ef$SetSize(c(9,3))
 
30
    ef$SetIndex(c(1,2))
 
31
    e2 <- ef$Execute(im)
 
32
 
 
33
    ## meta-data for slicing operator should match the metadata for the extract
 
34
    ## filter which we know to be correct.
 
35
    if(!all(e1$GetOrigin() == e2$GetOrigin()))
 
36
    {
 
37
        cat("slicing operator failed, origins don't match")
 
38
        quit(save="no", status=1)
 
39
    }
 
40
    if(!all(e1$GetSpacing() == e2$GetSpacing()))
 
41
    {
 
42
        cat("slicing operator failed, spacings don't match")
 
43
        quit(save="no", status=1)
 
44
    }
 
45
    if(!all(e1$GetDirection() == e2$GetDirection()))
 
46
    {
 
47
        cat("slicing operator failed, directions don't match")
 
48
        quit(save="no", status=1)
 
49
    }
 
50
}
 
51
 
 
52
 
 
53
dirToMat <- function(im)
 
54
{
 
55
    ## produce an R formatted direction matrix
 
56
    d1 <- im$GetDirection()
 
57
    dim(d1) <- c(2,2)
 
58
    d1 <- t(d1)
 
59
    return(d1)
 
60
}
 
61
slicingOperatorNegativeSpacingTest<- function()
 
62
{
 
63
    ## Cropping test - unit spacing
 
64
    im <- Image(15,15,"sitkFloat64")
 
65
    im$SetSpacing(c(0.3,0.6))
 
66
    t <- 0.4
 
67
    ct <- cos(t)
 
68
    st <- sin(t)
 
69
    im$SetDirection(c(ct,-st,st,ct))
 
70
 
 
71
    e1 <- im[2:10,5:3]
 
72
 
 
73
 
 
74
    ## meta-data for slicing operator should match the metadata for the extract
 
75
    ## filter which we know to be correct.
 
76
    if(!all(e1$GetOrigin() == im$TransformIndexToPhysicalPoint(c(1,4))))
 
77
    {
 
78
        cat("slicing operator failed, origins don't match")
 
79
        quit(save="no", status=1)
 
80
    }
 
81
    d1 <- dirToMat(im)
 
82
    d2 <- dirToMat(e1)
 
83
    ## reversed the second dimension, so d2[,2] == -d1[,2]
 
84
    ## negate the second column and compare to original
 
85
    d2[,2] <- -d2[,2]
 
86
    if(!all(d1 == d2))
 
87
    {
 
88
        cat("slicing operator failed, directions incorrect")
 
89
        quit(save="no", status=1)
 
90
    }
 
91
}
 
92
 
 
93
slicingPositionChecks <- function()
 
94
{
 
95
    x<-rep(1:10, rep(12, 10))
 
96
    dim(x) <- c(12, 10)
 
97
    x[5:9, 6:9] <- 21
 
98
    xim <- as.image(x)
 
99
 
 
100
    row3 <- as.array(xim[,3,drop=FALSE])
 
101
    if (!(all(row3 == 3))) {
 
102
        cat("Incorrect pixel values - should be all 3\n")
 
103
        quit(save="no", status=1)
 
104
 
 
105
    }
 
106
 
 
107
    b <- as.array(xim[5:9, 6:9])
 
108
    if (!all(b==21)) {
 
109
        cat("Failed block extract - voxels should have value 21\n")
 
110
        quit(save="no", status=1)
 
111
    }
 
112
}
 
113
slicingOperatorWarningsErrors <- function()
 
114
{
 
115
    im <- Image(15,15,"sitkFloat64")
 
116
 
 
117
    ## this should issue a warning
 
118
    msg <- list()
 
119
    try(msg <- tools::assertWarning(im[1, 2:3]), silent=TRUE)
 
120
    if (length(msg) == 0) {
 
121
        cat("Slicing operator should have issued a warning, but did not.\n")
 
122
        quit(save="no", status=1)
 
123
    }
 
124
    ## Turning drop off - no warning
 
125
    msg <- list()
 
126
    try(msg <- tools::assertCondition(im[1, 2:3, ,drop=FALSE]), silent=TRUE)
 
127
    if (length(msg) != 0) {
 
128
        cat("Slicing operator issued a warning/error, but should not.\n")
 
129
        quit(save="no", status=1)
 
130
    }
 
131
 
 
132
    ## Irregular spacing - should issue an error
 
133
    msg <- list()
 
134
    try(msg <- tools::assertError(im[c(1,2, 4), 2:3]), silent=TRUE)
 
135
    if (length(msg) == 0) {
 
136
        cat("Slicing operator should have issued an error, but did not.\n")
 
137
        quit(save="no", status=1)
 
138
    }
 
139
}
 
140
 
 
141
slicingSyntaxTrials <- function()
 
142
{
 
143
    im2 <- Image(15,15,"sitkFloat64")
 
144
    im3 <- Image(15,15, 15, "sitkFloat64")
 
145
 
 
146
    ## slicing requires all dimensions to be included - these should produce an
 
147
    ## error
 
148
    msg <- list()
 
149
    try(msg <- tools::assertError(im3[1:2, 2:3]), silent=TRUE)
 
150
    if (length(msg) == 0) {
 
151
        cat("Slicing operator should have issued an error, but did not.\n")
 
152
        quit(save="no", status=1)
 
153
    }
 
154
 
 
155
    msg <- list()
 
156
    try(msg <- tools::assertError(im3[1, 2:3,drop=TRUE]), silent=TRUE)
 
157
    if (length(msg) == 0) {
 
158
        cat("Slicing operator should have issued an error, but did not.\n")
 
159
        quit(save="no", status=1)
 
160
    }
 
161
    ## this should be OK
 
162
    msg <- list()
 
163
    try(msg <- tools::assertCondition(im3[1:2, 2:3,]), silent=TRUE)
 
164
    if (length(msg) != 0) {
 
165
        cat("Slicing issued an error/warning, but should not.\n")
 
166
        quit(save="no", status=1)
 
167
    }
 
168
    msg <- list()
 
169
    try(msg <- tools::assertCondition(im3[1:2, 2:3,,drop=FALSE]), silent=TRUE)
 
170
    if (length(msg) != 0) {
 
171
        cat("Slicing issued an error/warning, but should not.\n")
 
172
        quit(save="no", status=1)
 
173
    }
 
174
    ## this should be OK
 
175
    msg <- list()
 
176
    try(msg <- tools::assertCondition(im3[1:2, ,2:3,]), silent=TRUE)
 
177
    if (length(msg) != 0) {
 
178
        cat("Slicing issued an error/warning, but should not.\n")
 
179
        quit(save="no", status=1)
 
180
    }
 
181
 
 
182
    ## dropping tests
 
183
    j<-im3[,,3,drop=FALSE]
 
184
    if (any(j$GetSize() != c(15, 15, 1))) {
 
185
        cat("Image slicing error - incorrect dimensions returned\n")
 
186
        cat("Expected [15, 15, 1] - got [", j$GetSize(), "]\n")
 
187
        quit(save="no", status=1)
 
188
    }
 
189
    j<-im3[,,3,drop=TRUE]
 
190
    if (any(j$GetSize() != c(15, 15))) {
 
191
        cat("Image slicing error - incorrect dimensions returned\n")
 
192
        cat("Expected [15, 15] - got [", j$GetSize(), "]\n")
 
193
        quit(save="no", status=1)
 
194
    }
 
195
    ## logical indexing, with variables
 
196
    xidx <- (1:im3$GetWidth()) > 5
 
197
    msg <- list()
 
198
    try(msg <- tools::assertCondition(im3[xidx, ,2:3]), silent=TRUE)
 
199
    if (length(msg) != 0) {
 
200
        cat("Slicing using logical issued an error/warning, but should not.\n")
 
201
        quit(save="no", status=1)
 
202
    }
 
203
}
 
204
 
 
205
slicingZeroIndexTrials <- function()
 
206
{
 
207
    ## various forms of indexes are illegal because we can't support
 
208
    ## an "empty" image in the way R supports an "empty" array
 
209
    im3 <- Image(15,15, 15, "sitkFloat64")
 
210
 
 
211
    ## error caused by calling with c()
 
212
    msg <- list()
 
213
    try(msg <- tools::assertError(im3[c(), 2:3,]), silent=TRUE)
 
214
    if (length(msg) == 0) {
 
215
        cat("Slicing operator should have issued an error, but did not.\n")
 
216
        quit(save="no", status=1)
 
217
    }
 
218
    ## check the 3rd dimension, which is handled differently to the first 2
 
219
    msg <- list()
 
220
    try(msg <- tools::assertError(im3[2:3, 2:3, c()]), silent=TRUE)
 
221
    if (length(msg) == 0) {
 
222
        cat("Slicing operator should have issued an error, but did not.\n")
 
223
        quit(save="no", status=1)
 
224
    }
 
225
    ## check 0
 
226
    msg <- list()
 
227
    try(msg <- tools::assertError(im3[2:3, 0, 2:3]), silent=TRUE)
 
228
    if (length(msg) == 0) {
 
229
        cat("Slicing operator should have issued an error, but did not.\n")
 
230
        quit(save="no", status=1)
 
231
    }
 
232
    msg <- list()
 
233
    try(msg <- tools::assertError(im3[2:3, 2:3, 0]), silent=TRUE)
 
234
    if (length(msg) == 0) {
 
235
        cat("Slicing operator should have issued an error, but did not.\n")
 
236
        quit(save="no", status=1)
 
237
    }
 
238
 
 
239
 
 
240
}
 
241
slicingOperatorUnitSpacingTest()
 
242
slicingOperatorNegativeSpacingTest()
 
243
slicingPositionChecks()
 
244
slicingSyntaxTrials()
 
245
slicingZeroIndexTrials()