tests/testthat/testthat_AgeComparisons.R
In droglenc/FSA: Simple Fisheries Stock Assessment Methods
## Test Messages ----
test_that("ageBias() messages",{
expect_error(ageBias(otolithC+scaleC~finrayC,data=WhitefishLC),
"more than one variable on the LHS")
expect_error(ageBias(otolithC~scaleC+finrayC,data=WhitefishLC),
"must have only one RHS")
suppressWarnings(ab1 <- ageBias(scaleC~otolithC,data=WhitefishLC))
expect_error(summary(ab1,what="derek"),
"should be one of")
expect_error(summary(ab1,what="McNemar",cont.corr="derek"),
"should be one of")
expect_error(plot(ab1,xvals="derek"),
"should be one of")
expect_error(plotAB(ab1,what="derek"),
"should be one of")
})
test_that("agePrecision() messages",{
expect_error(agePrecision(~otolithC,data=WhitefishLC),
"compare at least two sets of ages")
expect_error(agePrecision(~otolithC+as.character(scaleC),data=WhitefishLC),
"must be numeric")
ap1 <- agePrecision(~otolithC+scaleC,data=WhitefishLC)
expect_error(summary(ap1,what="agreement"),
"should be one of")
expect_error(summary(ap1,what="absolute",trunc.diff=0),
"must be positive")
expect_error(summary(ap1,what="absolute",trunc.diff=-2),
"must be positive")
})
## Test Output Types ----
test_that("ageBias() summary() output titles",{
suppressWarnings(ab1 <- ageBias(scaleC~otolithC,data=WhitefishLC))
tmp <- capture.output( summary(ab1) )
expect_true(any(grepl("Sample size in the age agreement table",tmp)))
expect_true(any(grepl("Summary of scaleC by otolithC",tmp)))
expect_true(any(grepl("Summary of scaleC-otolithC by otolithC",tmp)))
expect_true(any(grepl("Raw agreement table",tmp)))
expect_true(any(grepl("(square)",tmp)))
expect_true(any(grepl("Age agreement table symmetry test results",tmp)))
tmp <- capture.output( summary(ab1,flip.table=TRUE) )
expect_true(any(grepl("Sample size in the age agreement table",tmp)))
expect_true(any(grepl("Summary of scaleC by otolithC",tmp)))
expect_true(any(grepl("Summary of scaleC-otolithC by otolithC",tmp)))
expect_true(any(grepl("Raw agreement table",tmp)))
expect_true(any(grepl("flipped",tmp)))
expect_true(any(grepl("Age agreement table symmetry test results",tmp)))
tmp <- capture.output( summary(ab1,what="n") )
expect_true(any(grepl("Sample size in the age agreement table",tmp)))
tmp <- capture.output( summary(ab1,what=c("n","bias")) )
expect_true(any(grepl("Sample size in the age agreement table",tmp)))
expect_true(any(grepl("Summary of scaleC by otolithC",tmp)))
})
test_that("agePrecision() summary() output titles",{
ap1 <- agePrecision(~otolithC+scaleC,data=WhitefishLC)
tmp <- capture.output( summary(ap1) )
expect_true(any(grepl("Precision summary statistics",tmp)))
expect_true(any(grepl("Percentage of fish by absolute differences in ages",tmp)))
expect_true(any(grepl("Percentage of fish by differences in ages",tmp)))
expect_true(any(grepl("Intermediate calculations for each individual",tmp)))
tmp <- capture.output( summary(ap1,percent=FALSE) )
expect_true(any(grepl("Precision summary statistics",tmp)))
expect_true(any(grepl("Frequency of fish by absolute differences in ages",tmp)))
expect_true(any(grepl("Frequency of fish by differences in ages",tmp)))
expect_true(any(grepl("Intermediate calculations for each individual",tmp)))
tmp <- capture.output( summary(ap1,what=c("precision","absolute")) )
expect_true(any(grepl("Precision summary statistics",tmp)))
expect_true(any(grepl("Percentage of fish by absolute differences in ages",tmp)))
})
test_that("agePrecision() types and specifics",{
ap1 <- agePrecision(~otolithC+scaleC,data=WhitefishLC)
expect_is(ap1,"agePrec")
expect_equal(names(ap1),c("detail","rawdiff","absdiff","ASD","ACV","ACV2",
"AAD","APE","APE2","AD","PercAgree","R","n","validn"))
expect_is(ap1$detail,"data.frame")
expect_equal(names(ap1$detail),
c("otolithC","scaleC","mean","median","mode",
"SD","CV","CV2","AD","PE","PE2","D"))
expect_is(ap1$rawdiff,"table")
expect_is(ap1$absdiff,"table")
ap2 <- agePrecision(~otolithC+finrayC+scaleC,data=WhitefishLC)
expect_is(ap2,"agePrec")
expect_equal(names(ap2),c("detail","rawdiff","absdiff","ASD","ACV","ACV2",
"AAD","APE","APE2","AD","PercAgree","R","n","validn"))
expect_is(ap2$detail,"data.frame")
expect_equal(names(ap2$detail),
c("otolithC","finrayC","scaleC","mean","median","mode",
"SD","CV","CV2","AD","PE","PE2","D"))
expect_is(ap2$rawdiff,"table")
expect_is(ap2$absdiff,"table")
})
## Validate Results ----
test_that("ageBias() symmetry tests match results in Evans and Hoenig (2008)",{
######## Create Evans & Hoenig (2008) X, Y, and Z matrices and check
######## against the results in table 1.
X.dat <- data.frame(ageR=c(2,2,2,2,2,2,2,2),
ageC=c(1,1,1,1,3,3,3,3))
suppressWarnings(X <- ageBias(ageR~ageC,data=X.dat))
junk <- capture.output( Xsum <- summary(X,what="symmetry") )
expect_equal(Xsum[Xsum$symTest=="McNemar","df"], 1)
expect_equal(Xsum[Xsum$symTest=="McNemar","chi.sq"], 0)
expect_equal(round(Xsum[Xsum$symTest=="McNemar","p"],4), 1.0000)
## note that Evans & Hoenigs (2008) show a df=2 for this case, but compare2()
## in the fishmethods package, which was written by Hoenig, shows df=1. I,
## therefore, tested against df=1.
expect_equal(Xsum[Xsum$symTest=="EvansHoenig","df"], 1)
expect_equal(Xsum[Xsum$symTest=="EvansHoenig","chi.sq"], 0)
expect_equal(round(Xsum[Xsum$symTest=="EvansHoenig","p"],4), 1.0000)
expect_equal(Xsum[Xsum$symTest=="Bowker","df"], 2)
expect_equal(Xsum[Xsum$symTest=="Bowker","chi.sq"], 8)
expect_equal(round(Xsum[Xsum$symTest=="Bowker","p"],4), 0.0183)
Y.dat <- data.frame(ageR=c(1,1,1,2,2,2),
ageC=c(2,2,3,3,3,3))
suppressWarnings(Y <- ageBias(ageR~ageC,data=Y.dat))
junk <- capture.output( Ysum <- summary(Y,what="symmetry") )
expect_equal(Ysum[Ysum$symTest=="McNemar","df"], 1)
expect_equal(Ysum[Ysum$symTest=="McNemar","chi.sq"], 6)
expect_equal(round(Ysum[Ysum$symTest=="McNemar","p"],4), 0.0143)
expect_equal(Ysum[Ysum$symTest=="EvansHoenig","df"], 2)
expect_equal(Ysum[Ysum$symTest=="EvansHoenig","chi.sq"], 6)
expect_equal(round(Ysum[Ysum$symTest=="EvansHoenig","p"],4), 0.0498)
expect_equal(Ysum[Ysum$symTest=="Bowker","df"], 3)
expect_equal(Ysum[Ysum$symTest=="Bowker","chi.sq"], 6)
expect_equal(round(Ysum[Ysum$symTest=="Bowker","p"],4), 0.1116)
Z.dat <- data.frame(ageR=c(1,1,1,2,2,2,3),
ageC=c(2,2,2,3,3,3,1))
suppressWarnings(Z <- ageBias(ageR~ageC,data=Z.dat))
junk <- capture.output( Zsum <- summary(Z,what="symmetry") )
expect_equal(Zsum[Zsum$symTest=="McNemar","df"], 1)
expect_equal(round(Zsum[Zsum$symTest=="McNemar","chi.sq"],2), 3.57)
expect_equal(round(Zsum[Zsum$symTest=="McNemar","p"],4), 0.0588)
expect_equal(Zsum[Zsum$symTest=="EvansHoenig","df"], 2)
expect_equal(Zsum[Zsum$symTest=="EvansHoenig","chi.sq"], 7)
expect_equal(round(Zsum[Zsum$symTest=="EvansHoenig","p"],4), 0.0302)
expect_equal(Zsum[Zsum$symTest=="Bowker","df"], 3)
expect_equal(Zsum[Zsum$symTest=="Bowker","chi.sq"], 7)
expect_equal(round(Zsum[Zsum$symTest=="Bowker","p"],4), 0.0719)
})
test_that("test ageBias() against compare2() with AlewifeLH data",{
if (require(FSAdata) & require(fishmethods)) {
data(AlewifeLH,package="FSAdata")
ab2 <- compare2(AlewifeLH,barplot=FALSE)
## no continuity correction
suppressWarnings(ab1 <- ageBias(scales~otoliths,data=AlewifeLH,
ref.lab="Otolith Age",nref.lab="Scale Age"))
junk <- capture.output( ab1sum <- summary(ab1) )
expect_equal(ab1sum[ab1sum$symTest=="McNemar","chi.sq"], ab2$McNemar$Chisq)
expect_equal(ab1sum[ab1sum$symTest=="McNemar","p"], ab2$McNemar$pvalue)
expect_equal(ab1sum[ab1sum$symTest=="EvansHoenig","chi.sq"],
ab2$Evans_Hoenig$Chisq)
expect_equal(ab1sum[ab1sum$symTest=="EvansHoenig","p"],
ab2$Evans_Hoenig$pvalue)
expect_equal(ab1sum[ab1sum$symTest=="EvansHoenig","df"],
ab2$Evans_Hoenig$df)
## Yates continuity correction
junk <- capture.output( ab1sum2 <- summary(ab1,what="McNemar",
cont.corr="Yates") )
expect_equal(ab1sum2[1,"chi.sq"], ab2$McNemar_continuity_correction$Chisq)
expect_equal(ab1sum2[1,"p"], ab2$McNemar_continuity_correction$pvalue)
## Edwards continuity correction
ab3 <- compare2(AlewifeLH,correct="Edwards",barplot=FALSE)
junk <- capture.output( ab1sum3 <- summary(ab1,what="McNemar",
cont.corr="Edwards") )
expect_equal(ab1sum3[1,"chi.sq"], ab3$McNemar_continuity_correction$Chisq)
expect_equal(ab1sum3[1,"p"], ab3$McNemar_continuity_correction$pvalue)
}
})
test_that("ageBias() compared to http://www.nefsc.noaa.gov/fbp/age-prec/ calculations for AlewifeLH data",{
if (require(FSAdata)) {
data(AlewifeLH,package="FSAdata")
suppressWarnings(ab1 <- ageBias(scales~otoliths,data=AlewifeLH,
ref.lab="Otolith Age",nref.lab="Scale Age"))
expect_equal(ab1$bias$n, c(2,18,20,13,18,10,8,7,5,1,2))
## the fbp result is actually 4.62 for age-6
expect_equal(round(ab1$bias$mean,2), c(0.00,1.11,2.20,2.85,3.78,4.20,
4.62,5.00,4.80,6.00,6.00))
}
})
test_that("agePrecision() gives correct precision values -- First Example",{
ap1 <- agePrecision(~otolithC+scaleC,data=WhitefishLC)
expect_equal(ap1$n, 151)
expect_equal(ap1$R, 2)
expect_equal(length(ap1$rawdiff), 17)
expect_equal(length(ap1$absdiff), 14)
expect_equal(round(ap1$APE,5), 14.92923)
expect_equal(round(ap1$ACV,5), 21.11312)
expect_equal(round(ap1$PercAgree,5), 19.86755)
})
test_that("agePrecision() gives correct precision values -- Second Example",{
ap2 <- agePrecision(~otolithC+finrayC+scaleC,data=WhitefishLC)
expect_equal(ap2$n, 151)
expect_equal(ap2$R, 3)
expect_equal(dim(ap2$absdiff), c(3,15))
expect_equal(dim(ap2$rawdiff), c(3,19))
expect_equal(round(ap2$APE,5), 16.1851)
expect_equal(round(ap2$ACV,5), 21.76877)
expect_equal(round(ap2$PercAgree,5), 12.58278)
## testing truncation of absolute differences
# with multiple pairs of structures
junk <- capture.output( sum1 <- summary(ap2,what="absolute") )
expect_equal(dim(sum1), c(3,15))
junk <- capture.output( sum2 <- summary(ap2,what="absolute",trunc.diff=4) )
expect_equal(dim(sum2), c(3,5))
expect_equal(sum1[,1:4],sum2[,1:4])
expect_equal(rowSums(sum1[,5:15]),sum2[,5])
# with one pair of structures
ap2 <- agePrecision(~otolithC+finrayC,data=WhitefishLC)
junk <- capture.output( sum1 <- summary(ap2,what="absolute") )
expect_equal(dim(sum1),15)
junk <- capture.output( sum2 <- summary(ap2,what="absolute",trunc.diff=4) )
expect_equal(dim(sum2),5)
expect_equal(sum1[1:4],sum2[1:4])
expect_equivalent(sum(sum1[5:15]),sum2[5])
})
test_that("agePrecision() compared to http://www.nefsc.noaa.gov/fbp/age-prec/ calculations for AlewifeLH data",{
if (require(FSAdata)) {
data(AlewifeLH,package="FSAdata")
ap3 <- agePrecision(~otoliths+scales,data=AlewifeLH)
expect_equal(ap3$n, 104)
expect_equal(ap3$R, 2)
expect_equal(round(ap3$ACV,2), 12.54)
expect_equal(round(ap3$PercAgree,1), 58.7)
}
})
test_that("agePrecision() differences for simple data",{
tmp <- data.frame(age1=c(1,1,1,1,2,2),
age2=c(1,1,2,2,2,3))
ap4 <- agePrecision(~age1+age2,data=tmp)
expect_equal(ap4$n, 6)
expect_equal(ap4$R, 2)
expect_equal(names(ap4$rawdiff), c("-1","0"))
expect_equal(as.numeric(ap4$rawdiff), c(3,3))
expect_equal(names(ap4$absdiff), c("0","1"))
expect_equal(as.numeric(ap4$absdiff), c(3,3))
tmp2 <- ap4$detail
expect_equal(tmp2$mode,c(1,1,NA,NA,2,NA))
expect_equal(tmp2$mean,as.vector(rowMeans(tmp[,1:2])))
expect_equal(tmp2$mean,tmp2$median)
})
test_that("agePrecision() differences for simple data with NA values",{
tmp <- data.frame(age1=c(1,1,1,1,2,2,2,2,3,3,3,3),
age2=c(1,1,2,2,2,2,3,3,3,3,4,4),
age3=c(1,1,2,NA,2,2,3,NA,3,3,4,NA),
age4=c(1,1,2,NA,2,2,3,NA,3,3,4,NA),
age5=c(NA,1,2,2,NA,2,3,3,NA,3,4,4))
ap12 <- agePrecision(~age1+age2,data=tmp)
expect_equal(ap12$PercAgree,50)
ap13 <- agePrecision(~age1+age3,data=tmp)
expect_equal(round(ap13$PercAgree,4),66.6667)
ap14 <- agePrecision(~age1+age4,data=tmp)
expect_equal(round(ap14$PercAgree,4),66.6667)
ap15 <- agePrecision(~age1+age5,data=tmp)
expect_equal(round(ap15$PercAgree,4),33.3333)
ap23 <- agePrecision(~age2+age3,data=tmp)
expect_equal(ap23$PercAgree,100)
ap24 <- agePrecision(~age2+age4,data=tmp)
expect_equal(ap24$PercAgree,100)
ap25 <- agePrecision(~age2+age5,data=tmp)
expect_equal(ap25$PercAgree,100)
ap34 <- agePrecision(~age3+age4,data=tmp)
expect_equal(ap34$PercAgree,100)
ap35 <- agePrecision(~age3+age5,data=tmp)
expect_equal(ap35$PercAgree,100)
ap45 <- agePrecision(~age4+age5,data=tmp)
expect_equal(ap45$PercAgree,100)
ap123 <- agePrecision(~age1+age2+age3,data=tmp)
expect_equal(round(ap123$PercAgree,4),66.6667)
expect_equal(ap123$detail$mode,c(1,1,2,NA,2,2,3,NA,3,3,4,NA))
ap125 <- agePrecision(~age1+age2+age5,data=tmp)
expect_equal(round(ap125$PercAgree,4),33.3333)
ap135 <- agePrecision(~age1+age3+age5,data=tmp)
expect_equal(round(ap135$PercAgree,4),50.0000)
})
droglenc/FSA documentation built on Aug. 30, 2023, 12:51 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
## Test Messages ----
test_that("ageBias() messages",{
expect_error(ageBias(otolithC+scaleC~finrayC,data=WhitefishLC),
"more than one variable on the LHS")
expect_error(ageBias(otolithC~scaleC+finrayC,data=WhitefishLC),
"must have only one RHS")
suppressWarnings(ab1 <- ageBias(scaleC~otolithC,data=WhitefishLC))
expect_error(summary(ab1,what="derek"),
"should be one of")
expect_error(summary(ab1,what="McNemar",cont.corr="derek"),
"should be one of")
expect_error(plot(ab1,xvals="derek"),
"should be one of")
expect_error(plotAB(ab1,what="derek"),
"should be one of")
})
test_that("agePrecision() messages",{
expect_error(agePrecision(~otolithC,data=WhitefishLC),
"compare at least two sets of ages")
expect_error(agePrecision(~otolithC+as.character(scaleC),data=WhitefishLC),
"must be numeric")
ap1 <- agePrecision(~otolithC+scaleC,data=WhitefishLC)
expect_error(summary(ap1,what="agreement"),
"should be one of")
expect_error(summary(ap1,what="absolute",trunc.diff=0),
"must be positive")
expect_error(summary(ap1,what="absolute",trunc.diff=-2),
"must be positive")
})
## Test Output Types ----
test_that("ageBias() summary() output titles",{
suppressWarnings(ab1 <- ageBias(scaleC~otolithC,data=WhitefishLC))
tmp <- capture.output( summary(ab1) )
expect_true(any(grepl("Sample size in the age agreement table",tmp)))
expect_true(any(grepl("Summary of scaleC by otolithC",tmp)))
expect_true(any(grepl("Summary of scaleC-otolithC by otolithC",tmp)))
expect_true(any(grepl("Raw agreement table",tmp)))
expect_true(any(grepl("(square)",tmp)))
expect_true(any(grepl("Age agreement table symmetry test results",tmp)))
tmp <- capture.output( summary(ab1,flip.table=TRUE) )
expect_true(any(grepl("Sample size in the age agreement table",tmp)))
expect_true(any(grepl("Summary of scaleC by otolithC",tmp)))
expect_true(any(grepl("Summary of scaleC-otolithC by otolithC",tmp)))
expect_true(any(grepl("Raw agreement table",tmp)))
expect_true(any(grepl("flipped",tmp)))
expect_true(any(grepl("Age agreement table symmetry test results",tmp)))
tmp <- capture.output( summary(ab1,what="n") )
expect_true(any(grepl("Sample size in the age agreement table",tmp)))
tmp <- capture.output( summary(ab1,what=c("n","bias")) )
expect_true(any(grepl("Sample size in the age agreement table",tmp)))
expect_true(any(grepl("Summary of scaleC by otolithC",tmp)))
})
test_that("agePrecision() summary() output titles",{
ap1 <- agePrecision(~otolithC+scaleC,data=WhitefishLC)
tmp <- capture.output( summary(ap1) )
expect_true(any(grepl("Precision summary statistics",tmp)))
expect_true(any(grepl("Percentage of fish by absolute differences in ages",tmp)))
expect_true(any(grepl("Percentage of fish by differences in ages",tmp)))
expect_true(any(grepl("Intermediate calculations for each individual",tmp)))
tmp <- capture.output( summary(ap1,percent=FALSE) )
expect_true(any(grepl("Precision summary statistics",tmp)))
expect_true(any(grepl("Frequency of fish by absolute differences in ages",tmp)))
expect_true(any(grepl("Frequency of fish by differences in ages",tmp)))
expect_true(any(grepl("Intermediate calculations for each individual",tmp)))
tmp <- capture.output( summary(ap1,what=c("precision","absolute")) )
expect_true(any(grepl("Precision summary statistics",tmp)))
expect_true(any(grepl("Percentage of fish by absolute differences in ages",tmp)))
})
test_that("agePrecision() types and specifics",{
ap1 <- agePrecision(~otolithC+scaleC,data=WhitefishLC)
expect_is(ap1,"agePrec")
expect_equal(names(ap1),c("detail","rawdiff","absdiff","ASD","ACV","ACV2",
"AAD","APE","APE2","AD","PercAgree","R","n","validn"))
expect_is(ap1$detail,"data.frame")
expect_equal(names(ap1$detail),
c("otolithC","scaleC","mean","median","mode",
"SD","CV","CV2","AD","PE","PE2","D"))
expect_is(ap1$rawdiff,"table")
expect_is(ap1$absdiff,"table")
ap2 <- agePrecision(~otolithC+finrayC+scaleC,data=WhitefishLC)
expect_is(ap2,"agePrec")
expect_equal(names(ap2),c("detail","rawdiff","absdiff","ASD","ACV","ACV2",
"AAD","APE","APE2","AD","PercAgree","R","n","validn"))
expect_is(ap2$detail,"data.frame")
expect_equal(names(ap2$detail),
c("otolithC","finrayC","scaleC","mean","median","mode",
"SD","CV","CV2","AD","PE","PE2","D"))
expect_is(ap2$rawdiff,"table")
expect_is(ap2$absdiff,"table")
})
## Validate Results ----
test_that("ageBias() symmetry tests match results in Evans and Hoenig (2008)",{
######## Create Evans & Hoenig (2008) X, Y, and Z matrices and check
######## against the results in table 1.
X.dat <- data.frame(ageR=c(2,2,2,2,2,2,2,2),
ageC=c(1,1,1,1,3,3,3,3))
suppressWarnings(X <- ageBias(ageR~ageC,data=X.dat))
junk <- capture.output( Xsum <- summary(X,what="symmetry") )
expect_equal(Xsum[Xsum$symTest=="McNemar","df"], 1)
expect_equal(Xsum[Xsum$symTest=="McNemar","chi.sq"], 0)
expect_equal(round(Xsum[Xsum$symTest=="McNemar","p"],4), 1.0000)
## note that Evans & Hoenigs (2008) show a df=2 for this case, but compare2()
## in the fishmethods package, which was written by Hoenig, shows df=1. I,
## therefore, tested against df=1.
expect_equal(Xsum[Xsum$symTest=="EvansHoenig","df"], 1)
expect_equal(Xsum[Xsum$symTest=="EvansHoenig","chi.sq"], 0)
expect_equal(round(Xsum[Xsum$symTest=="EvansHoenig","p"],4), 1.0000)
expect_equal(Xsum[Xsum$symTest=="Bowker","df"], 2)
expect_equal(Xsum[Xsum$symTest=="Bowker","chi.sq"], 8)
expect_equal(round(Xsum[Xsum$symTest=="Bowker","p"],4), 0.0183)
Y.dat <- data.frame(ageR=c(1,1,1,2,2,2),
ageC=c(2,2,3,3,3,3))
suppressWarnings(Y <- ageBias(ageR~ageC,data=Y.dat))
junk <- capture.output( Ysum <- summary(Y,what="symmetry") )
expect_equal(Ysum[Ysum$symTest=="McNemar","df"], 1)
expect_equal(Ysum[Ysum$symTest=="McNemar","chi.sq"], 6)
expect_equal(round(Ysum[Ysum$symTest=="McNemar","p"],4), 0.0143)
expect_equal(Ysum[Ysum$symTest=="EvansHoenig","df"], 2)
expect_equal(Ysum[Ysum$symTest=="EvansHoenig","chi.sq"], 6)
expect_equal(round(Ysum[Ysum$symTest=="EvansHoenig","p"],4), 0.0498)
expect_equal(Ysum[Ysum$symTest=="Bowker","df"], 3)
expect_equal(Ysum[Ysum$symTest=="Bowker","chi.sq"], 6)
expect_equal(round(Ysum[Ysum$symTest=="Bowker","p"],4), 0.1116)
Z.dat <- data.frame(ageR=c(1,1,1,2,2,2,3),
ageC=c(2,2,2,3,3,3,1))
suppressWarnings(Z <- ageBias(ageR~ageC,data=Z.dat))
junk <- capture.output( Zsum <- summary(Z,what="symmetry") )
expect_equal(Zsum[Zsum$symTest=="McNemar","df"], 1)
expect_equal(round(Zsum[Zsum$symTest=="McNemar","chi.sq"],2), 3.57)
expect_equal(round(Zsum[Zsum$symTest=="McNemar","p"],4), 0.0588)
expect_equal(Zsum[Zsum$symTest=="EvansHoenig","df"], 2)
expect_equal(Zsum[Zsum$symTest=="EvansHoenig","chi.sq"], 7)
expect_equal(round(Zsum[Zsum$symTest=="EvansHoenig","p"],4), 0.0302)
expect_equal(Zsum[Zsum$symTest=="Bowker","df"], 3)
expect_equal(Zsum[Zsum$symTest=="Bowker","chi.sq"], 7)
expect_equal(round(Zsum[Zsum$symTest=="Bowker","p"],4), 0.0719)
})
test_that("test ageBias() against compare2() with AlewifeLH data",{
if (require(FSAdata) & require(fishmethods)) {
data(AlewifeLH,package="FSAdata")
ab2 <- compare2(AlewifeLH,barplot=FALSE)
## no continuity correction
suppressWarnings(ab1 <- ageBias(scales~otoliths,data=AlewifeLH,
ref.lab="Otolith Age",nref.lab="Scale Age"))
junk <- capture.output( ab1sum <- summary(ab1) )
expect_equal(ab1sum[ab1sum$symTest=="McNemar","chi.sq"], ab2$McNemar$Chisq)
expect_equal(ab1sum[ab1sum$symTest=="McNemar","p"], ab2$McNemar$pvalue)
expect_equal(ab1sum[ab1sum$symTest=="EvansHoenig","chi.sq"],
ab2$Evans_Hoenig$Chisq)
expect_equal(ab1sum[ab1sum$symTest=="EvansHoenig","p"],
ab2$Evans_Hoenig$pvalue)
expect_equal(ab1sum[ab1sum$symTest=="EvansHoenig","df"],
ab2$Evans_Hoenig$df)
## Yates continuity correction
junk <- capture.output( ab1sum2 <- summary(ab1,what="McNemar",
cont.corr="Yates") )
expect_equal(ab1sum2[1,"chi.sq"], ab2$McNemar_continuity_correction$Chisq)
expect_equal(ab1sum2[1,"p"], ab2$McNemar_continuity_correction$pvalue)
## Edwards continuity correction
ab3 <- compare2(AlewifeLH,correct="Edwards",barplot=FALSE)
junk <- capture.output( ab1sum3 <- summary(ab1,what="McNemar",
cont.corr="Edwards") )
expect_equal(ab1sum3[1,"chi.sq"], ab3$McNemar_continuity_correction$Chisq)
expect_equal(ab1sum3[1,"p"], ab3$McNemar_continuity_correction$pvalue)
}
})
test_that("ageBias() compared to http://www.nefsc.noaa.gov/fbp/age-prec/ calculations for AlewifeLH data",{
if (require(FSAdata)) {
data(AlewifeLH,package="FSAdata")
suppressWarnings(ab1 <- ageBias(scales~otoliths,data=AlewifeLH,
ref.lab="Otolith Age",nref.lab="Scale Age"))
expect_equal(ab1$bias$n, c(2,18,20,13,18,10,8,7,5,1,2))
## the fbp result is actually 4.62 for age-6
expect_equal(round(ab1$bias$mean,2), c(0.00,1.11,2.20,2.85,3.78,4.20,
4.62,5.00,4.80,6.00,6.00))
}
})
test_that("agePrecision() gives correct precision values -- First Example",{
ap1 <- agePrecision(~otolithC+scaleC,data=WhitefishLC)
expect_equal(ap1$n, 151)
expect_equal(ap1$R, 2)
expect_equal(length(ap1$rawdiff), 17)
expect_equal(length(ap1$absdiff), 14)
expect_equal(round(ap1$APE,5), 14.92923)
expect_equal(round(ap1$ACV,5), 21.11312)
expect_equal(round(ap1$PercAgree,5), 19.86755)
})
test_that("agePrecision() gives correct precision values -- Second Example",{
ap2 <- agePrecision(~otolithC+finrayC+scaleC,data=WhitefishLC)
expect_equal(ap2$n, 151)
expect_equal(ap2$R, 3)
expect_equal(dim(ap2$absdiff), c(3,15))
expect_equal(dim(ap2$rawdiff), c(3,19))
expect_equal(round(ap2$APE,5), 16.1851)
expect_equal(round(ap2$ACV,5), 21.76877)
expect_equal(round(ap2$PercAgree,5), 12.58278)
## testing truncation of absolute differences
# with multiple pairs of structures
junk <- capture.output( sum1 <- summary(ap2,what="absolute") )
expect_equal(dim(sum1), c(3,15))
junk <- capture.output( sum2 <- summary(ap2,what="absolute",trunc.diff=4) )
expect_equal(dim(sum2), c(3,5))
expect_equal(sum1[,1:4],sum2[,1:4])
expect_equal(rowSums(sum1[,5:15]),sum2[,5])
# with one pair of structures
ap2 <- agePrecision(~otolithC+finrayC,data=WhitefishLC)
junk <- capture.output( sum1 <- summary(ap2,what="absolute") )
expect_equal(dim(sum1),15)
junk <- capture.output( sum2 <- summary(ap2,what="absolute",trunc.diff=4) )
expect_equal(dim(sum2),5)
expect_equal(sum1[1:4],sum2[1:4])
expect_equivalent(sum(sum1[5:15]),sum2[5])
})
test_that("agePrecision() compared to http://www.nefsc.noaa.gov/fbp/age-prec/ calculations for AlewifeLH data",{
if (require(FSAdata)) {
data(AlewifeLH,package="FSAdata")
ap3 <- agePrecision(~otoliths+scales,data=AlewifeLH)
expect_equal(ap3$n, 104)
expect_equal(ap3$R, 2)
expect_equal(round(ap3$ACV,2), 12.54)
expect_equal(round(ap3$PercAgree,1), 58.7)
}
})
test_that("agePrecision() differences for simple data",{
tmp <- data.frame(age1=c(1,1,1,1,2,2),
age2=c(1,1,2,2,2,3))
ap4 <- agePrecision(~age1+age2,data=tmp)
expect_equal(ap4$n, 6)
expect_equal(ap4$R, 2)
expect_equal(names(ap4$rawdiff), c("-1","0"))
expect_equal(as.numeric(ap4$rawdiff), c(3,3))
expect_equal(names(ap4$absdiff), c("0","1"))
expect_equal(as.numeric(ap4$absdiff), c(3,3))
tmp2 <- ap4$detail
expect_equal(tmp2$mode,c(1,1,NA,NA,2,NA))
expect_equal(tmp2$mean,as.vector(rowMeans(tmp[,1:2])))
expect_equal(tmp2$mean,tmp2$median)
})
test_that("agePrecision() differences for simple data with NA values",{
tmp <- data.frame(age1=c(1,1,1,1,2,2,2,2,3,3,3,3),
age2=c(1,1,2,2,2,2,3,3,3,3,4,4),
age3=c(1,1,2,NA,2,2,3,NA,3,3,4,NA),
age4=c(1,1,2,NA,2,2,3,NA,3,3,4,NA),
age5=c(NA,1,2,2,NA,2,3,3,NA,3,4,4))
ap12 <- agePrecision(~age1+age2,data=tmp)
expect_equal(ap12$PercAgree,50)
ap13 <- agePrecision(~age1+age3,data=tmp)
expect_equal(round(ap13$PercAgree,4),66.6667)
ap14 <- agePrecision(~age1+age4,data=tmp)
expect_equal(round(ap14$PercAgree,4),66.6667)
ap15 <- agePrecision(~age1+age5,data=tmp)
expect_equal(round(ap15$PercAgree,4),33.3333)
ap23 <- agePrecision(~age2+age3,data=tmp)
expect_equal(ap23$PercAgree,100)
ap24 <- agePrecision(~age2+age4,data=tmp)
expect_equal(ap24$PercAgree,100)
ap25 <- agePrecision(~age2+age5,data=tmp)
expect_equal(ap25$PercAgree,100)
ap34 <- agePrecision(~age3+age4,data=tmp)
expect_equal(ap34$PercAgree,100)
ap35 <- agePrecision(~age3+age5,data=tmp)
expect_equal(ap35$PercAgree,100)
ap45 <- agePrecision(~age4+age5,data=tmp)
expect_equal(ap45$PercAgree,100)
ap123 <- agePrecision(~age1+age2+age3,data=tmp)
expect_equal(round(ap123$PercAgree,4),66.6667)
expect_equal(ap123$detail$mode,c(1,1,2,NA,2,2,3,NA,3,3,4,NA))
ap125 <- agePrecision(~age1+age2+age5,data=tmp)
expect_equal(round(ap125$PercAgree,4),33.3333)
ap135 <- agePrecision(~age1+age3+age5,data=tmp)
expect_equal(round(ap135$PercAgree,4),50.0000)
})
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.