Tries to do the correct STAPLE algorithm (binary/multi-class) for the type of input (array/matrix/list of images/filenames of images)
staple(x, ..., set_orient = FALSE)
# S3 method for default
staple(x, ..., set_orient = FALSE)
# S3 method for list
staple(x, ..., set_orient = FALSE)
# S3 method for character
staple(x, ..., set_orient = FALSE)
# S3 method for array
staple(x, ..., set_orient = FALSE)| x | a nxr matrix where there are n raters and r elements rated,
a list of images, or a character vector. Note, |
|---|---|
| ... | Options for STAPLE, see |
| set_orient | Should the orientation be set to the same if x is a
set of images, including |
n = 5
r = 1000
sens = c(0.8, 0.9, 0.8, 0.5, 0.8)
spec = c(0.9, 0.75, 0.99, 0.98, 0.92)
suppressWarnings(RNGversion("3.5.0"))
set.seed(20171120)
n_1 = 200
n_0 = r - n_1
truth = c(rep(0, n_0), rep(1, n_1))
pred_1 = rbinom(n = n, size = n_1, prob = sens)
pred_0 = rbinom(n = n, size = n_0, prob = spec)
pred_0 = sapply(pred_0, function(n) {
sample(c(rep(0, n), rep(1, n_0 -n)))
})
pred_1 = sapply(pred_1, function(n) {
sample(c(rep(1, n), rep(0, n_1 -n)))
})
pred = rbind(pred_0, pred_1)
true_sens = colMeans(pred[ truth == 1, ])
true_spec = colMeans(1-pred[ truth == 0, ])
x = t(pred)
staple_out = staple(x)
#> There are 2 levels present
#> Removing elements where all raters agree
#> Making multiple, matrices. Hot-one encode
#> iter: 25, diff: 2.54356378182052e-08
#> iter: 50, diff: 2.99760216648792e-15
#> Convergence!
print(staple_out$sensitivity)
#> [1] 0.7815939 0.8958683 0.7605141 0.4644834 0.7652393
if (is.matrix(staple_out$sensitivity)) {
staple_out$sensitivity = staple_out$sensitivity[, "1"]
}
testthat::expect_equal(staple_out$sensitivity,
c(0.781593858553476, 0.895868301462594,
0.760514086161722, 0.464483444340873,
0.765239314719065))
staple_out_prior = staple(x, prior = rep(0.5, r))
#> There are 2 levels present
#> Removing elements where all raters agree
#> Making multiple, matrices. Hot-one encode
#> iter: 25, diff: 7.73711779115116e-05
#> iter: 50, diff: 5.96097783356342e-08
#> iter: 75, diff: 4.54487558698702e-11
#> iter: 100, diff: 3.46389583683049e-14
#> Convergence!
if (is.matrix(staple_out_prior$sensitivity)) {
staple_out_prior$sensitivity = staple_out_prior$sensitivity[, "1"]
}
testthat::expect_equal(staple_out_prior$sensitivity,
c(0.683572080864211, 0.821556768891859,
0.619166852992802, 0.389409921992467, 0.67042085955546))
res_bin = staple_bin_mat(x, prior = rep(0.5, 1000))
#> iter: 1, diff: 0.465231160212495
#> iter: 10, diff: 0.00518796579186032
#> iter: 20, diff: 0.000319714014913819
#> iter: 30, diff: 1.85314590984698e-05
#> iter: 40, diff: 1.0525804566841e-06
#> iter: 50, diff: 5.96097783356342e-08
#> iter: 60, diff: 3.37452188414744e-09
#> iter: 70, diff: 1.91023197260165e-10
#> iter: 80, diff: 1.08131281706392e-11
#> iter: 90, diff: 6.11954931173386e-13
#> iter: 100, diff: 3.48610029732299e-14
#> iter: 110, diff: 1.88737914186277e-15
#> Convergence!
testthat::expect_equal(staple_out_prior$sensitivity,
res_bin$sensitivity)
n = 5
r = 1000
x = lapply(seq(n), function(i) {
x = rbinom(n = r, size = 1, prob = 0.5)
array(x, dim = c(10,10, 10))
})
mat = sapply(x, c)
staple_out = staple_bin_img(x, set_orient = FALSE)
#> Reshaping images
#> Running STAPLE for binary matrix
#> iter: 1, diff: 0.33810549683701
#> iter: 10, diff: 0.000420478677933045
#> iter: 20, diff: 1.84523641814094e-05
#> iter: 30, diff: 9.04592971084917e-07
#> iter: 40, diff: 4.67754142086108e-08
#> iter: 50, diff: 2.48293940963151e-09
#> iter: 60, diff: 1.33460908990912e-10
#> iter: 70, diff: 7.21600557085367e-12
#> iter: 80, diff: 3.91242593877905e-13
#> iter: 90, diff: 2.1316282072803e-14
#> iter: 100, diff: 1.22124532708767e-15
#> Convergence!
#> Creating output probability image/array
#> Creating output prior image/array
#> Creating label image (probability >= 0.5)
res_mat = staple(t(mat))
#> There are 2 levels present
#> Removing elements where all raters agree
#> Making multiple, matrices. Hot-one encode
#> iter: 25, diff: 4.04835189660169e-06
#> iter: 50, diff: 2.48293952065382e-09
#> iter: 75, diff: 1.67976743625786e-12
#> iter: 100, diff: 1.22124532708767e-15
#> Convergence!
if (is.matrix(res_mat$sensitivity)) {
res_mat$sensitivity = res_mat$sensitivity[, "1"]
}
testthat::expect_equal(staple_out$sensitivity, res_mat$sensitivity)