(*:Mathematica:: V2.1 *) (*:Context: "extestev`" *) (*Title: evaluating multiple tests*) (*Summary: diagnostic test *) (*Keywords: missing data, true positive rate *) (*Requirements: "clm`" *) (*History:1993 Stuart G. Baker *) Clear[extestev,createx1,createx2a,createconfig2,extestev, createratio,createratioall,createratiobasic, createrationame]; y=Transpose[{{151,84, 23,143, 41,93, 12,165, 1,1, 0,5, 1,11, 0,9, 14,12,7,7, 17,86,132,773}}]; createytest[]:= Module[{y11,y12,y21,y22,w11,w12,w21,w22,c}, y11a={{30},{10}}; y11b={{40},{20}}; y12a={{80},{10}}; y12b={{20},{20}}; y21a={{10},{70}}; y21b={{30},{50}}; y22a={{60},{20}}; y22b={{50},{60}}; w11a=y11a; w11b=2 y11b; w12a= 2 y12a; w12b= y12b; w21a= 3 y21a; w21b= 2 y21b; w22a= y22a; w22b= y22b; w11= w11a + w11b; w12= w12a + w12b; w21= w21a + w21b; w22= w22a + w22b; y11=Transpose[{Flatten @ Hcat[y11a,y11b]}]; y12=Transpose[{Flatten @ Hcat[y12a,y12b]}]; y21=Transpose[{Flatten @ Hcat[y21a,y21b]}]; y22=Transpose[{Flatten @ Hcat[y22a,y22b]}]; w11=Transpose[{Flatten @ Hcat[w11a,w11b]}]; w12=Transpose[{Flatten @ Hcat[w12a,w12b]}]; w21=Transpose[{Flatten @ Hcat[w21a,w21b]}]; w22=Transpose[{Flatten @ Hcat[w22a,w22b]}]; yc=Vcat[y11,y12,y21,y22,w11,w12,w21,w22]; c=BlockDiag[Id[16],Id[8] ~Dir~ J[1,2]]; ytest=c.yc; Return[{ytest,yc}]] {ytest,yc}=createytest[]; mod0={"s,e,p","sep"}; mod1={"s,e,p","ep,sp,se"}; mod2={"s,e,p","sp,se"}; (*selected*) mod3={"s,e,p","ep,se"}; mod4={"s,e,p","ep,sp"}; mod5={"s,e,p","sp,e"}; mod6={"s,e,p","ep,s"}; mod7={"s,e,p","se,p"}; mod10={"s,e,p","sep,d"}; mod11={"s,e,p","ep,sp,se,d"}; mod12={"s,e,p","sp,se,d"}; mod13={"s,e,p","ep,se,d"}; mod14={"s,e,p","ep,sp,d"}; mod15={"s,e,p","sp,e,d"}; mod16={"s,e,p","ep,s,d"}; mod17={"s,e,p","se,p,d"}; mod21={"e,p","sp,se"}; mod22={"s,p","sp,se"}; mod23={"s,e","sp,se"}; mod31={"e,p","sp,se,d"}; mod32={"s,p","sp,se,d"}; mod33={"s,e","sp,se,d"}; mod41={"se,p","sp,se"}; mod42={"s,ep","sp,se"}; mod43={"sp,e","sp,se"}; mod51={"s,e,p","e,p,d"}; mod52={"s,e,p","ep,d"}; mod61={"s,e,p","e,p"}; mod62={"s,e,p","ep"}; mod71={"sep","e,p,d"}; mod72={"sep","ep,d"}; mod81={"sep","e,p"}; mod82={"sep","ep"}; mod92={"sp,se","sp,se"}; mod93={"sep","sd"}; mod94={"sep","sed"}; mod={mod0,mod1,mod2,mod3,mod4,mod5,mod6,mod7, mod10,mod11,mod12,mod13,mod14,mod15,mod16,mod17, mod21,mod22,mod23, mod31,mod32,mod33, mod41,mod42,mod43, mod51,mod52, mod61,mod62, mod71,mod72, mod81,mod82,mod92,mod93,mod94,mod95}; extestev[y_,modelname_]:= Module[{q1,w1,g1,h1,z1,x1, func1,m1,dim1,config1, q2,w2,g2,h2,z2,x2, func2,m2,x2a, n,q,w,g,h,z,x,func,arg, components,mstepfunc,msteparg, rmata,rmatb, parametername,rationame,dim2,config2, c,model,ratio,name}, (*model 1 *) q1=Identity; w1=J[32,1,0]; g1=Id[16] ~Vcat~ Id[16]; h1=(#2)&; z1=J[16,1,0]; dim1={2,2,2,2}; config1=createx1[modelname]; x1=CategoricalDesignMatrix[dim1,config1]; func1=NIPF; m1=Transpose[g1]; arg1={m1,dim1,config1}; (*model 2: nonresponse model, i.e., pr(r|y) *) q2=Identity; w2=J[32,1,0]; g2=Id[32]; h2=#2 #1 - Log[1+Exp[#2]]&; z2=Dir[{{1},{0}},J[16,1]]; x2a=createx2a[modelname]; x2=J[2,1] ~Dir~ x2a; func2=NLR; m2left=Id[16] ~Dir~ {{1},{0}}; m2right=Id[16] ~Dir~ {{0},{1}}; m2=m2left ~Hcat~ m2right; arg2={m2,x2a}; (*combination*) n={1}; q={q1,q2}; w={w1,w2}; g={g1,g2}; h={h1,h2}; z={z1,z2}; x={x1,x2}; c=BlockDiag[Id[16],Id[8] ~Dir~ J[1,2]]; components={n,q,w,g,h,z,x}; mstepfunc={func1,func2}; msteparg={arg1,arg2}; model={components,mstepfunc,msteparg}; (* ratio=createratio[modelname]; rationame=createrationame[modelname]; *) ratio="None"; rationame=Automatic; dim2={2,2,2,2}; config2=createconfig2[modelname]; parametername= Join[ToString /@ CategoricalParameters[dim1,config1], ToString /@ CategoricalParameters[dim2,config2]]; name={parametername,rationame}; Return[{c,model,ratio,name}]]/;MemberQ[mod,modelname] (*---create design matrices-------------*) createx1[modname_]:= (*1-s, 2-e , 3-p 4, d*) Switch[modname[[1]], "sep", {{1,2,3,4}}, "s,ep", {{1,2,3}, {1,4},{2,3,4}}, "sp,se", {{1,2,3}, {1,3,4},{1,2,4}}, "sp,e", {{1,2,3}, {1,3,4},{2,4}}, "s,e,p", {{1,2,3}, {1,4},{2,4},{3,4}}, "e,p", {{1,2,3}, {2,4},{3,4}}, "s,p", {{1,2,3}, {1,4},{3,4}}, "s,e", {{1,2,3}, {1,4},{2,4}}] createx2a[modelname_]:= Module[{dim2,config2}, dim2={2,2,2,2}; (*1=s, 2=e, 3=p, 4=d *) config2=createconfig2[modelname]; x2a=CategoricalDesignMatrix[dim2,config2]; Return[x2a]]; createconfig2[modelname_]:= Module[{dim2,config2}, dim2={2,2,2,2}; (*1=s, 2=e, 3=p, 4=d *) config2=Switch[modelname[[2]], "pd", {{3,4}}, "sd", {{1,4}}, "sed", {{1,2,4}}, "ed", {{2,4}}, "sep", {{1,2,3}}, "ep,sp,se", {{2,3},{1,3},{1,2}}, "sp,se", {{1,3},{1,2}}, "ep,se", {{2,3},{1,2}}, "ep,sp", {{2,3},{1,3}}, "sp,e", {{1,3},{2}}, "ep,s", {{2,3},{1}}, "se,p", {{1,2},{3}}, "sep,d", {{1,2,3},{4}}, "ep,sp,se,d", {{2,3},{1,3},{1,2},{4}}, "sp,se,d", {{1,3},{1,2},{4}}, "ep,se,d", {{2,3},{1,2},{4}}, "ep,sp,d", {{2,3},{1,3},{4}}, "sp,e,d", {{1,3},{2},{4}}, "ep,s,d", {{2,3},{1},{4}}, "se,p,d", {{1,2},{3},{4}}, "e,p,d", {{2},{3},{4}}, "ep,d", {{2,3},{4}}, "e,p", {{2},{3}}, "ep", {{2,3}}]; Return[config2]]; (*-------------create ratio-----------------------*) createratio[modelname_]:= If[modelname==mod2 || modelname==mod31, createratioall[modelname], createratiobasic[modelname]] createratioall[modelname_]:= Module[{roc, trpa,fpra,ctpra,cfpra, tprb,fprb,ctprb,cfprb}, roc=Switch[modelname, mod2, {{1,0,0,0,0,0,0,0}, {1,0,1,0,0,0,0,0}, {1,0,1,0,1,0,0,0}, {1,1,1,0,1,0,0,0}, {1,1,1,0,1,0,1,0}, {1,1,1,1,1,0,1,0}, {1,1,1,1,1,1,1,0}}, mod31, {{1,0,0,0,0,0,0,0}, {1,0,0,0,1,0,0,0}, {1,0,1,0,1,0,0,0}, {1,0,1,0,1,0,1,0}, {1,1,1,0,1,0,1,0}, {1,1,1,0,1,1,1,0}, {1,1,1,1,1,1,1,0}}]; (*create tpr,fpr, cumulative tpr,cumulative fpr*) tpra=Dir[J[1,2],Id[8],{{1,0}}]; fpra=Dir[J[1,2],Id[8],{{0,1}}]; ctpra=Dir[J[1,2],roc,{{1,0}}]; cfpra=Dir[J[1,2],roc,{{0,1}}]; rmata=Vcat[tpra,fpra,ctpra,cfpra]; tprb=Dir[J[1,2],J[8,8],{{1,0}}]; fprb=Dir[J[1,2],J[8,8],{{0,1}}]; ctprb=Dir[J[1,2],J[7,8],{{1,0}}]; cfprb=Dir[J[1,2],J[7,8],{{0,1}}]; rmatb=Vcat[tprb,fprb,ctprb,cfprb]; Return[{rmata,rmatb}]] createratiobasic[modelname_]:= Module[{rmata,rmatb}, rmata=Dir[J[1,2],Id[8],{{1,0}}] ~Vcat~ Dir[J[1,2],Id[8],{{0,1}}]; rmatb=Dir[J[1,2],J[8,8],{{1,0}}] ~Vcat~ Dir[J[1,2],J[8,8],{{0,1}}]; Return[{rmata,rmatb}]] (*----createrationame---------*) createrationame[modelname_]:= If[modelname==mod2 || modelname==mod31, {"tpr+++","tpr++-","tpr+-+","tpr+--", "tpr-++","tpr-+-","tpr--+","tpr---", "fpr+++","fpr++-","fpr+-+","fpr+--", "fpr-++","fpr-+-","fpr--+","fpr---", "tpr1","tpr2","tpr3","tpr4","tpr5","tpr6","tpr7", "fpr1","fpr2","fpr3","fpr4","fpr5","fpr6","fpr7"}, (*else*) {"tpr+++","tpr++-","tpr+-+","tpr+--", "tpr-++","tpr-+-","tpr--+","tpr---", "fpr+++","fpr++-","fpr+-+","fpr+--", "fpr-++","fpr-+-","fpr--+","fpr---"}]