Last updated on 2022-02-19 07:53:27 CET.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 0.1-17 | 8.53 | 91.86 | 100.39 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 0.1-17 | 7.23 | 81.30 | 88.53 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 0.1-17 | 123.53 | ERROR | |||
| r-devel-linux-x86_64-fedora-gcc | 0.1-17 | 110.35 | ERROR | |||
| r-devel-windows-x86_64-new-UL | 0.1-17 | 29.00 | 111.00 | 140.00 | ERROR | |
| r-devel-windows-x86_64-new-TK | 0.1-17 | ERROR | ||||
| r-patched-linux-x86_64 | 0.1-17 | 7.42 | 86.16 | 93.58 | NOTE | |
| r-release-linux-x86_64 | 0.1-17 | 8.38 | 84.94 | 93.32 | NOTE | |
| r-release-macos-arm64 | 0.1-17 | OK | ||||
| r-release-macos-x86_64 | 0.1-17 | OK | ||||
| r-release-windows-ix86+x86_64 | 0.1-17 | 18.00 | 96.00 | 114.00 | OK | |
| r-oldrel-macos-x86_64 | 0.1-17 | OK | ||||
| r-oldrel-windows-ix86+x86_64 | 0.1-17 | 19.00 | 102.00 | 121.00 | OK |
Version: 0.1-17
Check: package dependencies
Result: NOTE
Package suggested but not available for checking: 'RSVGTipsDevice'
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc, r-devel-windows-x86_64-new-UL, r-devel-windows-x86_64-new-TK, r-patched-linux-x86_64, r-release-linux-x86_64
Version: 0.1-17
Check: tests
Result: ERROR
Running 'testthat.R' [5s/6s]
Running 'xBalanceTests2.R' [3s/3s]
Running the tests in 'tests/xBalanceTests2.R' failed.
Complete output:
> ###These are tests of the basic function of xBalance under some
> ###restricted sitations and using functions that hew closely to the
> ###expressions in Hansen and Bowers 2008. For example, with only
> ###binary treatment. The idea here to show that the math in that
> ###article is equivalent to the output from xBalance.
>
> require("RItools")
Loading required package: RItools
Loading required package: SparseM
Attaching package: 'SparseM'
The following object is masked from 'package:base':
backsolve
>
> data(nuclearplants)
>
> s2.fn<-function(x){sum((x-mean(x))^2)/(length(x)-1)} ##same as sd(x)
> h.fn<-function(n,m){(m*(n-m))/n}
>
> var1<-function(x,m){ ##var(d)
+ h<-h.fn(n=length(x),m=m)
+ (1/h)*s2.fn(x)
+ }
>
> var2<-function(x,m){ ##var(Z'x) (i.e. var of the sum statistic)
+ h<-h.fn(n=length(x),m=m)
+ (h)*s2.fn(x)
+ }
>
> #####First just looking at the unstratified calculations
> xb1a<-xBalance(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n,
+ strata=list(nostrat=NULL),
+ data=nuclearplants,
+ report=c("adj.means","adj.mean.diffs","adj.mean.diffs.null.sd","std.diffs","z.scores","p.values"))
>
> ##print(xb1a,digits=4)
>
> testxb1a<-t(sapply(nuclearplants[,dimnames(xb1a$results)$vars],function(thevar){
+ myssn<-with(nuclearplants,sum((pr-mean(pr))*thevar))
+ myadjdiff<-myssn/h.fn(m=sum(nuclearplants$pr),n=length(nuclearplants$pr))
+ mynullvar1<-var1(x=thevar,m=sum(nuclearplants$pr))
+ myz<-myadjdiff/sqrt(mynullvar1)
+ return(c(adj.diff=myadjdiff,adj.diff.null.sd=sqrt(mynullvar1),z=myz))
+ }))
>
> ##print(testxb1a,digits=4)
>
> all.equal(xb1a$results[,c("adj.diff","adj.diff.null.sd","z"),"nostrat"],testxb1a,check.attributes = FALSE)
[1] TRUE
>
> ###Now with strata.
> xb2<-xBalance(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n,
+ strata=list(pt=~pt),
+ data=nuclearplants,
+ report=c("all"))
>
>
> test2.fn<-function(zz,mm,ss){
+ ##Some notes on xBalanceEngine
+ ##dv = h/(n-1)
+ ##unsplit(tapply(zz,ss,function(z){h.fn(m=sum(z),n=length(z))/(length(z)-1)}),ss) ##h/(n-1)
+ ##tmat*tmat = squared mean deviations
+ ##sapply(split(data.frame(mm),ss),function(x){sapply(x,function(var){(var-mean(var))^2})})
+ ##so dv*tmat*tmat=(h/(n-1))*(x_i-\bar(x))^2=h*s^2
+
+ myssn<-apply(mm,2,function(x){sum((zz-unsplit(tapply(zz,ss,mean),ss))*x)})
+
+ hs<-tapply(zz,ss,function(z){h.fn(m=sum(z),n=length(z))})
+ mywtsum<-sum(hs)
+
+ myadjdiff<-myssn/mywtsum
+
+ s2s<-sapply(data.frame(mm),function(x){sapply(split(x,ss),function(var){var(var)})})
+
+ myssvar<-apply(s2s,2,function(s2){sum(hs*s2)})
+ mynullsd2<-apply(s2s,2,function(s2){sqrt((1/(sum(hs)^2))*sum(hs*s2))}) ##from StatSci eq 6
+ mynullsd1<-sqrt(myssvar*(1/mywtsum)^2) ##with (1/h)
+
+ stopifnot(all.equal(mynullsd1,mynullsd2,check.attributes=FALSE))
+
+ ##If numbers of treated and controls are the same for all blocks:
+ if( length(unique(ss))>1 & all(diff(hs)==0) ){
+ mynullsd3<-apply(s2s,2,function(s2){sqrt((1/(length(hs)))^2*sum((1/hs)*s2))}) ##(1/B^2)*\sum_{b=1}^B (1/h) s2
+ stopifnot(all.equal(mynullsd3,mynullsd2))
+
+ ##For fun, the version ignoring the stratification.
+ m<-sum(zz)
+ n<-length(zz)
+ h<-(m*(n-m))/n
+ mynullsd.nostrat<-sqrt((1/h)*apply(mm,2,var))
+
+ }
+ ##For pairs
+ if((length(unique(ss))>1 & all(table(ss)==2)) & all(diff(hs)==0)){
+ mys2s.pairs<-sapply(data.frame(mm),function(x){sapply(split(x,ss),function(var){sum((var-mean(var))^2)})})
+ mynullsd4<-apply(s2s,2,function(s2){sqrt((2/(length(s2)^2))*sum(s2))}) ##(1/B^2)*\sum_{b=1}^B (1/h) s2 = (2/B^2)\sum_{b=1}^B \sum_{i=1}^2 s2
+ stopifnot(all.equal(mynullsd4,mynullsd2))
+ }
+ myz2<-myadjdiff/mynullsd2
+ myz3<-myadjdiff/mynullsd1
+ myz1<-myssn/sqrt(myssvar)
+
+ stopifnot(all.equal(myz1,myz2,myz3,check.attributes=FALSE))
+
+ return(cbind(adj.diff=myadjdiff,adj.diff.null.sd=mynullsd2,z=myz2))
+ }
>
> mymm<-model.matrix(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n-1,data=nuclearplants)
>
> test2.fn(zz=nuclearplants$pr,mm=mymm,ss=nuclearplants$pt)
Error in all.equal.numeric(myz1, myz2, myz3, check.attributes = FALSE) :
length(tolerance) == 1L is not TRUE
Calls: test2.fn ... stopifnot -> all.equal -> all.equal.numeric -> stopifnot
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 0.1-17
Check: tests
Result: ERROR
Running ‘testthat.R’ [4s/7s]
Running ‘xBalanceTests2.R’ [3s/4s]
Running the tests in ‘tests/xBalanceTests2.R’ failed.
Complete output:
> ###These are tests of the basic function of xBalance under some
> ###restricted sitations and using functions that hew closely to the
> ###expressions in Hansen and Bowers 2008. For example, with only
> ###binary treatment. The idea here to show that the math in that
> ###article is equivalent to the output from xBalance.
>
> require("RItools")
Loading required package: RItools
Loading required package: SparseM
Attaching package: 'SparseM'
The following object is masked from 'package:base':
backsolve
>
> data(nuclearplants)
>
> s2.fn<-function(x){sum((x-mean(x))^2)/(length(x)-1)} ##same as sd(x)
> h.fn<-function(n,m){(m*(n-m))/n}
>
> var1<-function(x,m){ ##var(d)
+ h<-h.fn(n=length(x),m=m)
+ (1/h)*s2.fn(x)
+ }
>
> var2<-function(x,m){ ##var(Z'x) (i.e. var of the sum statistic)
+ h<-h.fn(n=length(x),m=m)
+ (h)*s2.fn(x)
+ }
>
> #####First just looking at the unstratified calculations
> xb1a<-xBalance(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n,
+ strata=list(nostrat=NULL),
+ data=nuclearplants,
+ report=c("adj.means","adj.mean.diffs","adj.mean.diffs.null.sd","std.diffs","z.scores","p.values"))
>
> ##print(xb1a,digits=4)
>
> testxb1a<-t(sapply(nuclearplants[,dimnames(xb1a$results)$vars],function(thevar){
+ myssn<-with(nuclearplants,sum((pr-mean(pr))*thevar))
+ myadjdiff<-myssn/h.fn(m=sum(nuclearplants$pr),n=length(nuclearplants$pr))
+ mynullvar1<-var1(x=thevar,m=sum(nuclearplants$pr))
+ myz<-myadjdiff/sqrt(mynullvar1)
+ return(c(adj.diff=myadjdiff,adj.diff.null.sd=sqrt(mynullvar1),z=myz))
+ }))
>
> ##print(testxb1a,digits=4)
>
> all.equal(xb1a$results[,c("adj.diff","adj.diff.null.sd","z"),"nostrat"],testxb1a,check.attributes = FALSE)
[1] TRUE
>
> ###Now with strata.
> xb2<-xBalance(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n,
+ strata=list(pt=~pt),
+ data=nuclearplants,
+ report=c("all"))
>
>
> test2.fn<-function(zz,mm,ss){
+ ##Some notes on xBalanceEngine
+ ##dv = h/(n-1)
+ ##unsplit(tapply(zz,ss,function(z){h.fn(m=sum(z),n=length(z))/(length(z)-1)}),ss) ##h/(n-1)
+ ##tmat*tmat = squared mean deviations
+ ##sapply(split(data.frame(mm),ss),function(x){sapply(x,function(var){(var-mean(var))^2})})
+ ##so dv*tmat*tmat=(h/(n-1))*(x_i-\bar(x))^2=h*s^2
+
+ myssn<-apply(mm,2,function(x){sum((zz-unsplit(tapply(zz,ss,mean),ss))*x)})
+
+ hs<-tapply(zz,ss,function(z){h.fn(m=sum(z),n=length(z))})
+ mywtsum<-sum(hs)
+
+ myadjdiff<-myssn/mywtsum
+
+ s2s<-sapply(data.frame(mm),function(x){sapply(split(x,ss),function(var){var(var)})})
+
+ myssvar<-apply(s2s,2,function(s2){sum(hs*s2)})
+ mynullsd2<-apply(s2s,2,function(s2){sqrt((1/(sum(hs)^2))*sum(hs*s2))}) ##from StatSci eq 6
+ mynullsd1<-sqrt(myssvar*(1/mywtsum)^2) ##with (1/h)
+
+ stopifnot(all.equal(mynullsd1,mynullsd2,check.attributes=FALSE))
+
+ ##If numbers of treated and controls are the same for all blocks:
+ if( length(unique(ss))>1 & all(diff(hs)==0) ){
+ mynullsd3<-apply(s2s,2,function(s2){sqrt((1/(length(hs)))^2*sum((1/hs)*s2))}) ##(1/B^2)*\sum_{b=1}^B (1/h) s2
+ stopifnot(all.equal(mynullsd3,mynullsd2))
+
+ ##For fun, the version ignoring the stratification.
+ m<-sum(zz)
+ n<-length(zz)
+ h<-(m*(n-m))/n
+ mynullsd.nostrat<-sqrt((1/h)*apply(mm,2,var))
+
+ }
+ ##For pairs
+ if((length(unique(ss))>1 & all(table(ss)==2)) & all(diff(hs)==0)){
+ mys2s.pairs<-sapply(data.frame(mm),function(x){sapply(split(x,ss),function(var){sum((var-mean(var))^2)})})
+ mynullsd4<-apply(s2s,2,function(s2){sqrt((2/(length(s2)^2))*sum(s2))}) ##(1/B^2)*\sum_{b=1}^B (1/h) s2 = (2/B^2)\sum_{b=1}^B \sum_{i=1}^2 s2
+ stopifnot(all.equal(mynullsd4,mynullsd2))
+ }
+ myz2<-myadjdiff/mynullsd2
+ myz3<-myadjdiff/mynullsd1
+ myz1<-myssn/sqrt(myssvar)
+
+ stopifnot(all.equal(myz1,myz2,myz3,check.attributes=FALSE))
+
+ return(cbind(adj.diff=myadjdiff,adj.diff.null.sd=mynullsd2,z=myz2))
+ }
>
> mymm<-model.matrix(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n-1,data=nuclearplants)
>
> test2.fn(zz=nuclearplants$pr,mm=mymm,ss=nuclearplants$pt)
Error in all.equal.numeric(myz1, myz2, myz3, check.attributes = FALSE) :
length(tolerance) == 1L is not TRUE
Calls: test2.fn ... stopifnot -> all.equal -> all.equal.numeric -> stopifnot
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 0.1-17
Check: tests
Result: ERROR
Running ‘testthat.R’
Running ‘xBalanceTests2.R’
Running the tests in ‘tests/xBalanceTests2.R’ failed.
Complete output:
> ###These are tests of the basic function of xBalance under some
> ###restricted sitations and using functions that hew closely to the
> ###expressions in Hansen and Bowers 2008. For example, with only
> ###binary treatment. The idea here to show that the math in that
> ###article is equivalent to the output from xBalance.
>
> require("RItools")
Loading required package: RItools
Loading required package: SparseM
Attaching package: 'SparseM'
The following object is masked from 'package:base':
backsolve
>
> data(nuclearplants)
>
> s2.fn<-function(x){sum((x-mean(x))^2)/(length(x)-1)} ##same as sd(x)
> h.fn<-function(n,m){(m*(n-m))/n}
>
> var1<-function(x,m){ ##var(d)
+ h<-h.fn(n=length(x),m=m)
+ (1/h)*s2.fn(x)
+ }
>
> var2<-function(x,m){ ##var(Z'x) (i.e. var of the sum statistic)
+ h<-h.fn(n=length(x),m=m)
+ (h)*s2.fn(x)
+ }
>
> #####First just looking at the unstratified calculations
> xb1a<-xBalance(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n,
+ strata=list(nostrat=NULL),
+ data=nuclearplants,
+ report=c("adj.means","adj.mean.diffs","adj.mean.diffs.null.sd","std.diffs","z.scores","p.values"))
>
> ##print(xb1a,digits=4)
>
> testxb1a<-t(sapply(nuclearplants[,dimnames(xb1a$results)$vars],function(thevar){
+ myssn<-with(nuclearplants,sum((pr-mean(pr))*thevar))
+ myadjdiff<-myssn/h.fn(m=sum(nuclearplants$pr),n=length(nuclearplants$pr))
+ mynullvar1<-var1(x=thevar,m=sum(nuclearplants$pr))
+ myz<-myadjdiff/sqrt(mynullvar1)
+ return(c(adj.diff=myadjdiff,adj.diff.null.sd=sqrt(mynullvar1),z=myz))
+ }))
>
> ##print(testxb1a,digits=4)
>
> all.equal(xb1a$results[,c("adj.diff","adj.diff.null.sd","z"),"nostrat"],testxb1a,check.attributes = FALSE)
[1] TRUE
>
> ###Now with strata.
> xb2<-xBalance(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n,
+ strata=list(pt=~pt),
+ data=nuclearplants,
+ report=c("all"))
>
>
> test2.fn<-function(zz,mm,ss){
+ ##Some notes on xBalanceEngine
+ ##dv = h/(n-1)
+ ##unsplit(tapply(zz,ss,function(z){h.fn(m=sum(z),n=length(z))/(length(z)-1)}),ss) ##h/(n-1)
+ ##tmat*tmat = squared mean deviations
+ ##sapply(split(data.frame(mm),ss),function(x){sapply(x,function(var){(var-mean(var))^2})})
+ ##so dv*tmat*tmat=(h/(n-1))*(x_i-\bar(x))^2=h*s^2
+
+ myssn<-apply(mm,2,function(x){sum((zz-unsplit(tapply(zz,ss,mean),ss))*x)})
+
+ hs<-tapply(zz,ss,function(z){h.fn(m=sum(z),n=length(z))})
+ mywtsum<-sum(hs)
+
+ myadjdiff<-myssn/mywtsum
+
+ s2s<-sapply(data.frame(mm),function(x){sapply(split(x,ss),function(var){var(var)})})
+
+ myssvar<-apply(s2s,2,function(s2){sum(hs*s2)})
+ mynullsd2<-apply(s2s,2,function(s2){sqrt((1/(sum(hs)^2))*sum(hs*s2))}) ##from StatSci eq 6
+ mynullsd1<-sqrt(myssvar*(1/mywtsum)^2) ##with (1/h)
+
+ stopifnot(all.equal(mynullsd1,mynullsd2,check.attributes=FALSE))
+
+ ##If numbers of treated and controls are the same for all blocks:
+ if( length(unique(ss))>1 & all(diff(hs)==0) ){
+ mynullsd3<-apply(s2s,2,function(s2){sqrt((1/(length(hs)))^2*sum((1/hs)*s2))}) ##(1/B^2)*\sum_{b=1}^B (1/h) s2
+ stopifnot(all.equal(mynullsd3,mynullsd2))
+
+ ##For fun, the version ignoring the stratification.
+ m<-sum(zz)
+ n<-length(zz)
+ h<-(m*(n-m))/n
+ mynullsd.nostrat<-sqrt((1/h)*apply(mm,2,var))
+
+ }
+ ##For pairs
+ if((length(unique(ss))>1 & all(table(ss)==2)) & all(diff(hs)==0)){
+ mys2s.pairs<-sapply(data.frame(mm),function(x){sapply(split(x,ss),function(var){sum((var-mean(var))^2)})})
+ mynullsd4<-apply(s2s,2,function(s2){sqrt((2/(length(s2)^2))*sum(s2))}) ##(1/B^2)*\sum_{b=1}^B (1/h) s2 = (2/B^2)\sum_{b=1}^B \sum_{i=1}^2 s2
+ stopifnot(all.equal(mynullsd4,mynullsd2))
+ }
+ myz2<-myadjdiff/mynullsd2
+ myz3<-myadjdiff/mynullsd1
+ myz1<-myssn/sqrt(myssvar)
+
+ stopifnot(all.equal(myz1,myz2,myz3,check.attributes=FALSE))
+
+ return(cbind(adj.diff=myadjdiff,adj.diff.null.sd=mynullsd2,z=myz2))
+ }
>
> mymm<-model.matrix(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n-1,data=nuclearplants)
>
> test2.fn(zz=nuclearplants$pr,mm=mymm,ss=nuclearplants$pt)
Error in all.equal.numeric(myz1, myz2, myz3, check.attributes = FALSE) :
length(tolerance) == 1L is not TRUE
Calls: test2.fn ... stopifnot -> all.equal -> all.equal.numeric -> stopifnot
Execution halted
Flavors: r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc, r-devel-windows-x86_64-new-TK
Version: 0.1-17
Check: tests
Result: ERROR
Running 'testthat.R' [5s]
Running 'xBalanceTests2.R' [3s]
Running the tests in 'tests/xBalanceTests2.R' failed.
Complete output:
> ###These are tests of the basic function of xBalance under some
> ###restricted sitations and using functions that hew closely to the
> ###expressions in Hansen and Bowers 2008. For example, with only
> ###binary treatment. The idea here to show that the math in that
> ###article is equivalent to the output from xBalance.
>
> require("RItools")
Loading required package: RItools
Loading required package: SparseM
Attaching package: 'SparseM'
The following object is masked from 'package:base':
backsolve
>
> data(nuclearplants)
>
> s2.fn<-function(x){sum((x-mean(x))^2)/(length(x)-1)} ##same as sd(x)
> h.fn<-function(n,m){(m*(n-m))/n}
>
> var1<-function(x,m){ ##var(d)
+ h<-h.fn(n=length(x),m=m)
+ (1/h)*s2.fn(x)
+ }
>
> var2<-function(x,m){ ##var(Z'x) (i.e. var of the sum statistic)
+ h<-h.fn(n=length(x),m=m)
+ (h)*s2.fn(x)
+ }
>
> #####First just looking at the unstratified calculations
> xb1a<-xBalance(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n,
+ strata=list(nostrat=NULL),
+ data=nuclearplants,
+ report=c("adj.means","adj.mean.diffs","adj.mean.diffs.null.sd","std.diffs","z.scores","p.values"))
>
> ##print(xb1a,digits=4)
>
> testxb1a<-t(sapply(nuclearplants[,dimnames(xb1a$results)$vars],function(thevar){
+ myssn<-with(nuclearplants,sum((pr-mean(pr))*thevar))
+ myadjdiff<-myssn/h.fn(m=sum(nuclearplants$pr),n=length(nuclearplants$pr))
+ mynullvar1<-var1(x=thevar,m=sum(nuclearplants$pr))
+ myz<-myadjdiff/sqrt(mynullvar1)
+ return(c(adj.diff=myadjdiff,adj.diff.null.sd=sqrt(mynullvar1),z=myz))
+ }))
>
> ##print(testxb1a,digits=4)
>
> all.equal(xb1a$results[,c("adj.diff","adj.diff.null.sd","z"),"nostrat"],testxb1a,check.attributes = FALSE)
[1] TRUE
>
> ###Now with strata.
> xb2<-xBalance(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n,
+ strata=list(pt=~pt),
+ data=nuclearplants,
+ report=c("all"))
>
>
> test2.fn<-function(zz,mm,ss){
+ ##Some notes on xBalanceEngine
+ ##dv = h/(n-1)
+ ##unsplit(tapply(zz,ss,function(z){h.fn(m=sum(z),n=length(z))/(length(z)-1)}),ss) ##h/(n-1)
+ ##tmat*tmat = squared mean deviations
+ ##sapply(split(data.frame(mm),ss),function(x){sapply(x,function(var){(var-mean(var))^2})})
+ ##so dv*tmat*tmat=(h/(n-1))*(x_i-\bar(x))^2=h*s^2
+
+ myssn<-apply(mm,2,function(x){sum((zz-unsplit(tapply(zz,ss,mean),ss))*x)})
+
+ hs<-tapply(zz,ss,function(z){h.fn(m=sum(z),n=length(z))})
+ mywtsum<-sum(hs)
+
+ myadjdiff<-myssn/mywtsum
+
+ s2s<-sapply(data.frame(mm),function(x){sapply(split(x,ss),function(var){var(var)})})
+
+ myssvar<-apply(s2s,2,function(s2){sum(hs*s2)})
+ mynullsd2<-apply(s2s,2,function(s2){sqrt((1/(sum(hs)^2))*sum(hs*s2))}) ##from StatSci eq 6
+ mynullsd1<-sqrt(myssvar*(1/mywtsum)^2) ##with (1/h)
+
+ stopifnot(all.equal(mynullsd1,mynullsd2,check.attributes=FALSE))
+
+ ##If numbers of treated and controls are the same for all blocks:
+ if( length(unique(ss))>1 & all(diff(hs)==0) ){
+ mynullsd3<-apply(s2s,2,function(s2){sqrt((1/(length(hs)))^2*sum((1/hs)*s2))}) ##(1/B^2)*\sum_{b=1}^B (1/h) s2
+ stopifnot(all.equal(mynullsd3,mynullsd2))
+
+ ##For fun, the version ignoring the stratification.
+ m<-sum(zz)
+ n<-length(zz)
+ h<-(m*(n-m))/n
+ mynullsd.nostrat<-sqrt((1/h)*apply(mm,2,var))
+
+ }
+ ##For pairs
+ if((length(unique(ss))>1 & all(table(ss)==2)) & all(diff(hs)==0)){
+ mys2s.pairs<-sapply(data.frame(mm),function(x){sapply(split(x,ss),function(var){sum((var-mean(var))^2)})})
+ mynullsd4<-apply(s2s,2,function(s2){sqrt((2/(length(s2)^2))*sum(s2))}) ##(1/B^2)*\sum_{b=1}^B (1/h) s2 = (2/B^2)\sum_{b=1}^B \sum_{i=1}^2 s2
+ stopifnot(all.equal(mynullsd4,mynullsd2))
+ }
+ myz2<-myadjdiff/mynullsd2
+ myz3<-myadjdiff/mynullsd1
+ myz1<-myssn/sqrt(myssvar)
+
+ stopifnot(all.equal(myz1,myz2,myz3,check.attributes=FALSE))
+
+ return(cbind(adj.diff=myadjdiff,adj.diff.null.sd=mynullsd2,z=myz2))
+ }
>
> mymm<-model.matrix(pr~ date+ t1 + t2 + cap + ne + ct + bw + cum.n-1,data=nuclearplants)
>
> test2.fn(zz=nuclearplants$pr,mm=mymm,ss=nuclearplants$pt)
Error in all.equal.numeric(myz1, myz2, myz3, check.attributes = FALSE) :
length(tolerance) == 1L is not TRUE
Calls: test2.fn ... stopifnot -> all.equal -> all.equal.numeric -> stopifnot
Execution halted
Flavor: r-devel-windows-x86_64-new-UL