geepack/0000755000177400001440000000000012771473736012064 5ustar murdochusersgeepack/inst/0000755000177400001440000000000012771304236013025 5ustar murdochusersgeepack/inst/CITATION0000754000177400001440000000326712771304236014174 0ustar murdochuserscitHeader("To cite geepack in publications use:") citEntry(entry="Article", title = "The R Package geepack for Generalized Estimating Equations", author = personList(as.person("Søren Højsgaard"), as.person("Ulrich Halekoh"), as.person("Jun Yan")), year = 2006, journal = "Journal of Statistical Software", volume = "15/2", pages = "1--11", textVersion = paste("Højsgaard, S., Halekoh, U. & Yan J. (2006)", "The R Package geepack for Generalized Estimating Equations", "Journal of Statistical Software, 15, 2, pp1--11") ) citEntry(entry="Article", title = "Estimating Equations for Association Structures", author = personList(as.person("Jun Yan"), as.person("Jason P. Fine")), year = "2004", journal = "Statistics in Medicine", volume = "23", pages = "859--880", textVersion = paste("Yan, J. & Fine, J.P. (2004)", "Estimating Equations for Association Structures", "Statistics in Medicine, 23, pp859--880.") ) citEntry(entry="Article", title = "geepack: Yet Another Package for Generalized Estimating Equations", author = personList(as.person("Jun Yan")), year = "2002", journal = "R-News", volume = "2/3", pages = "12--14", textVersion = paste("Yan, J (2002)", "geepack: Yet Another Package for Generalized Estimating Equations", "R-News, 2/3, pp12-14.") ) geepack/inst/doc/0000755000177400001440000000000012404751310013562 5ustar murdochusersgeepack/inst/doc/geepack-manual.Rnw0000754000177400001440000001110612404751310017125 0ustar murdochusers% \VignetteIndexEntry{Users guide to geepack} % \VignetteKeyword{Generalized Estimating Equation} % \VignetteKeyword{Working correlation matrix} \documentclass{article} \usepackage{boxedminipage,color,a4,shortvrb,hyperref} \usepackage[latin1]{inputenc} \usepackage[T1]{fontenc} \MakeShortVerb| \def\pkg#1{{\bf #1}} <>= require( geepack ) prettyVersion <- packageDescription("geepack")$Version prettyDate <- format(Sys.Date()) @ \SweaveOpts{keep.source=T,prefix.string=figures/LSmeans} \title{On the usage of the \texttt{geepack} } \author{S{\o}ren H{\o}jsgaard and Ulrich Halekoh} \date{\pkg{geepack} version \Sexpr{prettyVersion} as of \Sexpr{prettyDate}} \begin{document} \parindent0pt\parskip4pt %% Efter preamble \definecolor{myGray}{rgb}{0.95,0.95,0.95} \makeatletter \renewenvironment{Schunk}{ \begin{lrbox}{\@tempboxa} \begin{boxedminipage} {\columnwidth}\scriptsize} {\end{boxedminipage} \end{lrbox}% \colorbox{myGray}{\usebox{\@tempboxa}} } \makeatother \maketitle \section{Introduction} \label{sec:intro} The primary reference for the |geepack| package is the Halekoh, U., Hjsgaard, S., Yan, J. (2006) -- paper in Journal of Statistical Software, see @ <<>>= library(geepack) citation("geepack") @ %def If you use |geepack| in your own work, please do cite the above reference. This note contains a few extra examples. We illustrate the usage of a the |waves| argument and the |zcor| argument together with a fixed working correlation matrix for the |geeglm()| function. To illustrate these features we simulate some data suitable for a regression model. @ <<>>= library(geepack) timeorder <- rep(1:5, 6) tvar <- timeorder + rnorm(length(timeorder)) idvar <- rep(1:6, each=5) uuu <- rep(rnorm(6), each=5) yvar <- 1 + 2*tvar + uuu + rnorm(length(tvar)) simdat <- data.frame(idvar, timeorder, tvar, yvar) head(simdat,12) @ %def Notice that clusters of data appear together in |simdat| and that observations are ordered (according to |timeorder|) within clusters. We can fit a model with an AR(1) error structure as @ <<>>= mod1 <- geeglm(yvar~tvar, id=idvar, data=simdat, corstr="ar1") mod1 @ %def This works because observations are ordered according to time within each subject in the dataset. \section{Using the \texttt{waves} argument} \label{sec:xxx} If observatios were not ordered according to cluster and time within cluster we would get the wrong result: @ <<>>= set.seed(123) ## library(doBy) simdatPerm <- simdat[sample(nrow(simdat)),] ## simdatPerm <- orderBy(~idvar, simdatPerm) simdatPerm <- simdatPerm[order(simdatPerm$idvar),] head(simdatPerm) @ %def Notice that in |simdatPerm| data is ordered according to subject but the time ordering within subject is random. Fitting the model as before gives @ <<>>= mod2 <- geeglm(yvar~tvar, id=idvar, data=simdatPerm, corstr="ar1") mod2 @ %def Likewise if clusters do not appear contigously in data we also get the wrong result (the clusters are not recognized): @ <<>>= ## simdatPerm2 <- orderBy(~timeorder, data=simdat) simdatPerm2 <- simdat[order(simdat$timeorder),] geeglm(yvar~tvar, id=idvar, data=simdatPerm2, corstr="ar1") @ %def To obtain the right result we must give the |waves| argument: @ <<>>= wav <- simdatPerm$timeorder wav mod3 <- geeglm(yvar~tvar, id=idvar, data=simdatPerm, corstr="ar1", waves=wav) mod3 @ %def \section{Using a fixed correlation matrix and the \texttt{zcor} argument} \label{sec:xxx} Suppose we want to use a fixed working correlation matrix: @ <<>>= cor.fixed <- matrix(c(1 , 0.5 , 0.25, 0.125, 0.125, 0.5 , 1 , 0.25, 0.125, 0.125, 0.25 , 0.25 , 1 , 0.5 , 0.125, 0.125, 0.125, 0.5 , 1 , 0.125, 0.125, 0.125, 0.125, 0.125, 1 ), 5, 5) cor.fixed @ %def Such a working correlation matrix has to be passed to |geeglm()| as a vector in the |zcor| argument. This vector can be created using the |fixed2Zcor()| function: @ <<>>= zcor <- fixed2Zcor(cor.fixed, id=simdatPerm$idvar, waves=simdatPerm$timeorder) zcor @ %def Notice that |zcor| contains correlations between measurements within the same cluster. Hence if a cluster contains only one observation, then there will be generated no entry in |zcor| for that cluster. Now we can fit the model with: @ <<>>= mod4 <- geeglm(yvar~tvar, id=idvar, data=simdatPerm, corstr="fixed", zcor=zcor) mod4 @ %def \end{document} geepack/inst/doc/geepack-manual.R0000644000177400001440000000633012404751310016561 0ustar murdochusers### R code from vignette source 'geepack-manual.Rnw' ### Encoding: UTF-8 ################################################### ### code chunk number 1: geepack-manual.Rnw:14-17 ################################################### require( geepack ) prettyVersion <- packageDescription("geepack")$Version prettyDate <- format(Sys.Date()) ################################################### ### code chunk number 2: geepack-manual.Rnw:55-57 ################################################### library(geepack) citation("geepack") ################################################### ### code chunk number 3: geepack-manual.Rnw:70-78 ################################################### library(geepack) timeorder <- rep(1:5, 6) tvar <- timeorder + rnorm(length(timeorder)) idvar <- rep(1:6, each=5) uuu <- rep(rnorm(6), each=5) yvar <- 1 + 2*tvar + uuu + rnorm(length(tvar)) simdat <- data.frame(idvar, timeorder, tvar, yvar) head(simdat,12) ################################################### ### code chunk number 4: geepack-manual.Rnw:87-89 ################################################### mod1 <- geeglm(yvar~tvar, id=idvar, data=simdat, corstr="ar1") mod1 ################################################### ### code chunk number 5: geepack-manual.Rnw:107-113 ################################################### set.seed(123) ## library(doBy) simdatPerm <- simdat[sample(nrow(simdat)),] ## simdatPerm <- orderBy(~idvar, simdatPerm) simdatPerm <- simdatPerm[order(simdatPerm$idvar),] head(simdatPerm) ################################################### ### code chunk number 6: geepack-manual.Rnw:123-125 ################################################### mod2 <- geeglm(yvar~tvar, id=idvar, data=simdatPerm, corstr="ar1") mod2 ################################################### ### code chunk number 7: geepack-manual.Rnw:132-135 ################################################### ## simdatPerm2 <- orderBy(~timeorder, data=simdat) simdatPerm2 <- simdat[order(simdat$timeorder),] geeglm(yvar~tvar, id=idvar, data=simdatPerm2, corstr="ar1") ################################################### ### code chunk number 8: geepack-manual.Rnw:148-152 ################################################### wav <- simdatPerm$timeorder wav mod3 <- geeglm(yvar~tvar, id=idvar, data=simdatPerm, corstr="ar1", waves=wav) mod3 ################################################### ### code chunk number 9: geepack-manual.Rnw:161-167 ################################################### cor.fixed <- matrix(c(1 , 0.5 , 0.25, 0.125, 0.125, 0.5 , 1 , 0.25, 0.125, 0.125, 0.25 , 0.25 , 1 , 0.5 , 0.125, 0.125, 0.125, 0.5 , 1 , 0.125, 0.125, 0.125, 0.125, 0.125, 1 ), 5, 5) cor.fixed ################################################### ### code chunk number 10: geepack-manual.Rnw:175-177 ################################################### zcor <- fixed2Zcor(cor.fixed, id=simdatPerm$idvar, waves=simdatPerm$timeorder) zcor ################################################### ### code chunk number 11: geepack-manual.Rnw:186-188 ################################################### mod4 <- geeglm(yvar~tvar, id=idvar, data=simdatPerm, corstr="fixed", zcor=zcor) mod4 geepack/inst/doc/geepack-manual.pdf0000644000177400001440000032216212404751310017135 0ustar murdochusers%PDF-1.5 % 17 0 obj << /Length 2467 /Filter /FlateDecode >> stream xYoݿCA7YNH=b iE$yJeyEZ>5<$Ap>E6ϊIq'_ڐ頌.]v~X—ZYkYCS_NlQK78m ~n n`xٜt~3#$N+mNAXS}CȴV, hkTl*>XXu#d2s?H7㥚vu(܄R@F\l>*_] '~DWlb93n\TenCTHƪgD+M !ꂟEx#4ٞ\"Cx&΃ cקWֲDf)N,*ZeQEo<,R(Γ*vI:ÅhdAuL^Xy@Ce9ĩS B§ty=> zd:TN2׳~'Z+o@)Wya0QߟV6吵K/Qɦ(< 5O37`9 fbJᬶk16*7-}9V{8 4<ŶI:)[ϳ7 gŻlCB2q=Df,'{ZwRw ڢT`oP2 gfY57 ؔȧ {\ g.ylŔK[P@C8M^K Gߪ~ A6V2}g*vHeÃ7[J} (hfMd.~s3>Kyq{(1 ).$r &  \uu(FO(QuH HZ )>!~I4L}{L⮗ w,_$>n;V,sl[˚RZ{ڱ~ݠ-#nщn*a 6!9&Gwh_6ay\JwNjU~C6/|7oЮ\B+Tu5RsyÊl@Cu0GU+w[T{I:5%$h.3o#*TUD/bc*C]6߇y^͛5O\ y4pqaLS;-9E3$Jې&!!Gڐ#|XW.@b]H2^ 왼y߰zFkwt^JQSvLv#,Ody-RJ(ˏ>ag!g,=]n[3PwȷveЏ`}@Xs7.\ҤGÎ⯢=}~ޟہݣ_=ʬk<4\E] 6Prh5bώR7}wTvjJA!Qo " l- 7P4' |~w[JRA(/ 1ӅPekM^E6**Un0HHΌ逜{V UQ)=pVg N !s{+\YYM͞Hͭow܃X!@$FZ@4BPt{t$GK0*"SG>0]PuI-вP񈖫=p#Tbbe'pΑ=%qf [N@@My$-_:;jAe> e]׉JI3xXl. V͏;ATZx%#򚙸V^tk`G7;L LG,WMGM!xtUE<]m;:KujKiŸ#BǗoRܤ|%tM=oם =1LJA~Vvix|W} endstream endobj 31 0 obj << /Length 1691 /Filter /FlateDecode >> stream xXrF+Pqd`6 ,;vʩ$XI@6({zD\`fz~(QYԼO5 fޝ3@J0\dCT/p.L}(i⃪ &g&}O$$ b^uy &M;ڹ s' Cg҇vC0y1>50* 00AZ"09m)Q< G<°sxE O{si&2VT-oܾ5Ble_u$(j n FJAgT/|oJnoMHg ˠ!}WMyG;Z*qʢ _f!gU뺕([S gÊhA9 |-khP#I|GVۄ$Τ. a9Xl#mK } Vy\ QCQG֪,)!ȺՄ=h9G<s$Ho9pX tK\b.rP:̖ȃ)JRWD%f}߯(g zY0[#,EKu*Dc<},UUqjjl\MJnr'10Z-l,dֽ\]UR Xk)%  ;3xI#L8GѶx⾸.s)'j!).5փ_,آ|ue?$CgƝr`;)ՠ_*Ʋ*P@uM<(ء(dp 95};tq[ʬjVuC|?r*FZto7at7r44,U5 j;;xOzdxdr,]BR\lm,#CkEC)4ry;oJ!]uH|iNb͂juC, Fڅ9FoX W)h ;2<S.$84 $lYr~Gpr#OXQh̉*8S15M[ rź]ÇU(i#k4٤(*y:HބOUZ&ѡk2F.2xd> x8̺ڀm!E;}1vQ]} ,[5kq$巯sxNqjŮs?=܎&?ɾN5@#Nԍ0vzo~kVH]@%4\Pm{%P0mMҩc' r8BIpwfLf I CU ibl")s3{ sh\lp!q-cu= *kI\h3}RawgTM #$Ґn[Y}5?<2}?fL\ӇXк[#4亜ba$sكt΂|ÄjJW3+XC~-tvH38%5 6m,pJzOM" #EzMmm Jd92 P<('tŵq:[暁4!"FEԭwu endstream endobj 35 0 obj << /Length 1284 /Filter /FlateDecode >> stream xWKs6W`%@!ii'鸱nHɜKQVC~{Ő$U=Z.v?,}Pz3S-5WZiH8jVPDO.25DzU4QU ku;%oaϾ95(;2tkp Lsp6yh/6FMSu1y4M0,Gz0,c.`y-C>0n`$0*`wd')=~"k1)ŬY?*Y3ɨZYgG-!=j8h- AV/yQ[AoN!O`?I?5AUF0Dz (J ,븒Ԟ㮹`9 }46X:S7 &WNPIWt*kq5_4TS^C>O+B_rrm2〉 %eVSO% }Ü` saU$5FZ6^k< TYJiձdG)<8+ܮ r()mm ?A뫤_jp;8:C_)MRة 0}]7qSk]w|QIERi^M;MN,tcznB'N_lѥF4Dܧ=C46dDT! -NPK5T&s-45+ & &$Ka f\-fB ] jpKټ(R`Ac&rjz}i3] qcwJ9[E4 p`2#.W@'[0\cPvtbo͛0Nv)$zŜexކi$ \9 9uVC%a/X{6|(ܭ:kس1ņr|nI62l̆AO3 endstream endobj 39 0 obj << /Length 2144 /Filter /FlateDecode >> stream xYIs6WRs+KgCYj=q|`SjQbwߞ" qz2I,D$6ϣ߅y"2cUM̦e^$J4/UjſӾgqɤ(,/Tމdsn]QtyQ6͵>&@$JT @h^"30FR$}}9J.娂#^ZM~o=--dG{wv'c4d@?P*[׭;`ra!F4?l4g#Ƀ:OF e;)}q~օë{wA]b~VE9/bI3+a:*G~n8uP4kGr> 4J}_=,uXqp[_~ E{zJ޴[8_q?<34?6SL*dN()M" ˿"R>Q\uT=XM7JJ~u5HF0f:EZؠ↱Su=$cLYq-E %3X J*CE52 g&K;Z#+ʝr!G'J/S9z-Y<)D+_^Ƞ<3q LI~kxKA(y56 껛~OhXm IYFlHpׯε]ΔBTdej^mЬ‹hvDuD̿*͹G>޷KTj4ʦ8WiET;\=<*~P ,8K6YH}tˇKJRoʖ jcze9ZoYT56f/ }B6—g7GKhhLJMc +[JeG;wAMirڕw_,_ 0h A]6 oFviV lӯU:ȉY !ۖ%~f/@ʈԝ$ٰ;kZ6Z\*l4Y2Ւxh7;Yn X A\=ø̶o/ Q&O3R Eab[($?mХFHPA2XcADXgc8|M``l$F5aIHF܆(]ü)1066"Yh >ր8g΢Rַj @  u!$eY oΪ && >xuBJ֔%V1 1i߆7rD f*]xo\}*jk^*Q>>J,y]6YʼxGz\C4Vֱ\?st9g؈0 GPOq!=8 eXI8/pbJ@_\ dB5`RtL>!KJY׫K<a݁js]X`Zi' DY>].)!50.⦋j"fű?/b?k-!5 (CeE (¿ ;G@ΫPI5'pCCVs7#Qw $xxi_!E.(q\^y)3}w`>%"Xu_}`$s~%E{:VA (iA~_p8^Kޮ8]RT&|ᰬuΑ2-2 jLD]w3 endstream endobj 43 0 obj << /Length 829 /Filter /FlateDecode >> stream xڝVKs0Wh893J4-vR=8IS8lvve #_ev!4ϳ5R %R2aKeț8ib218$}}^BTI} 57Y6Z b (NsCAځ^(TFKK`C2JZy!.I+oRz oNp_7?a@ZnOwH?bV8UV4_;ƹ.֝9U:Hn{CtAj|5N R`Ѓn#˩!ނ_=%o6hAnF=[3r6yND6κ*vૂ(GL0{'V}gnTԊaQ,{yx;#X!X%OBӬ劔T~:tW> stream xڍPz6΂tK K7 ,.]JHJtttww4R{{37;ss LtZs%Vrqrrq`21i\c2B]`ȿPL@TA`7{ 7/[@[P %"Y(qYU8`$prY۸>O3  @I3@\m- @- _.ٸ:@N8 ;jԄ@ݡ%U!пJdj\Th!\= Pf<-@-Ee#'YO;9voG0 #[`P2+;Mػ !=GP_X8]]8]`kvfY4 wu jw/_õ#<>AV02,A:pTQ/΃5%( :6(jqD8ʀ_>.w( o#Lnn%h1 Z r=7_f{Cc 5M]me0_%Bx}8y<@nn^a ?݁TT+;<*­@?x qk3u6,xg(?oe0^ɹ'8b<쳛m .T=-_+B$"Z\-l\L= UG~?8@n.=ܜã0?TЇp B!^\ ~8RK q&Vg@B@HX \A@Y}b/ >D7!ݿd/?! C!M!/<p\ rqa$ WĿ wWkM=? Z`N!,DCm?\~z>δ3 =]dRoº쳳s>{5诚5}oL5G71gFH?IV~LšbW7fvrU%"Yd~ |jScR@ dNQPSy$=+5+'8A=-8 |I2mrFr2j3Qfd0OQA,8+V?Ok$]>k$ջkFF]-X8vmѶ}KU>9Du_U{гghm;vfs =Ix?cjoC7<,xoxr_\{mC%f^N@YfYvj{YEĜ li'MChL_:G+۽Re*`D'"CrDSW֧"C5cv-+,|GKFL<^UCdd3Ky:"8FN$b*?kCɞ#~!^o`yn[˖sQys1nȚѪ*t31Cխ-֮'.*%Xm1^VZ^ES+O? Q;t}TusbQ~fS3<#34ԩ>eRGV@1Q4:8O[A⽩!<ًL;:v³$ϝ,Yz0XL:Dz5`|k#eYbt%QE.D 8GPQw2uj3[1CT j_ RD諪`E#pUpx\FVΏf%}ǘ[܏(B=ۢ J鴪 [襄Ȥ~%/~fW4DX{ a"=‰pu&_8c=oh.aZc 4Z6"ٷ2ɝizsJɎ u9nGSj{etWAT fA!ۨѻ c_ٟ7ʑZl~OM+S}4fmI8F2$}6\DQNa`̂x*VZgl߹B9D$lCϯA;liE+tV¦+0>l&եob%P yCu0dWvOȱ+LJ{:OY &gq OBKlsHm] er#9W%8*nPz0$13(np؉Ccpʨh{%\FTYW\e*3amRK)%}f~B#l} 4Ҷz| c"dY{ֆJTTI M5f fvuVIlaP hMN uM0-IԞ|Em (-2ˉmu'&)@r-ydr]:> G)65G}׮@dXMF1l%Vڟ|ꒄo=lxa~x?/4/oP e|þ8zkvq97ALQjlKVO[ 2 183ܨtr/2lγK>gf\kBUE6i/7,s꡼Wy'G6>E~T/]r\uA)lWU˷?G9.ʤ@ٌ0hd}]v1SAh@3N#$ wftqʄSQn%)1&)KH扖̑ƛLgSB#~WI Ća/kXI6Mji*BynKƻ$,WAЌp{@B2 %Haz2- 9 $ X(zyo9#*@\eZueos܂,p }&R%+5Ŋ3ՉJ}s@VfiW=xӕO K£oYگݪ0;؈k,6jw-]^%\j EP܇(n¶%"T/TYp>N&@XyHoCA5gFeKo5Ai|vHT~%L"eLyBt8b +%z xCʉO9P(b[?)Zo?Mˉw0#ǎeO=hx w桢W)Nנl:U{B;?Ky`.Hy?c[)0rkLz Hrvti Ҟ{˜zĸ jNqqro۱^=C)NT7~Z{}0ʞ=P׋w&Qݿ(ޓRW~m 9fh|mu*D;vz(sI;j,VKV9ɱYX5…gÌ͡sbEmQ]PnU)fVȜTߡjEƖAБCf%XL)@~;|z7-4<,^TP0*623_]dy2g>۟E01j9s~I ⪬ 6܀_ݦ.ﻵ>fPC\`wL5r7YKQ̹*~3E=Y2v=6fo,ŗ^%)M"1rivgQp_ē,w7kuFrg:?0`]7v~59Y:eKh;CIIs̆%J[U Eeko Եn*1%I_\h`ugk̟;L1BPXZ_oS>AQ |*fzÍ6ƽ`.'P-pOGwwRzziG]J4fx 5Gxz'ω!A$8!שq}V.kU)O]%nPWjiQ}~Rt%_IU%đO%9:|{R$6AL5AG!9DDB xnڙӹiXQTM }ϮBkDqZG]:gj#G{b?uf҇yr!=YJ;3 ~t3 {_:5&kK8%=lcynTjfx9"pz{l/^w]jށ'BjSE}GLg;BA-Хn0b-(s`"R0'B2DRld+ZǷz:8$1q2Ns`*=e{w]o/3[*(4ӔhQxZ^b.6 DpMZDIG}<` =!da`sԴ*a3[ ;.ȖŽcQre)ˏ÷::8LBxlꋽii8Z ahiXʙS?a_1I6&tg{yD9{agIpj˰+TʤOK J볙ni2oH~q5Yi{<䶌:}jA18#^ONFɭ1{(tm_ ͨmZ2#zWacC^VZלfRۘ={RI47=qDg1~HU¶zͦ;Yńh0DQhPXuDڍ*ɒbHg fh\@]ʟTREUIYsVJ0;|`wCmklþfG~@sB՞K\܍AfY #Nc\1:bg +Cp>Wݸ_A@Ð;NoR+'f:v)d' qj ^ fcGw- 4%C,Fi5lG*JX"m8? 9%(hzu-t9tK=yO^D|JnNr8q$'hIĢXI@"ؠ`D4e$&KM"zHB$Mn2yf"p13|ak]V⊲vCi/` BJG+ܝE[W#N֚c(v66:෌f9=cS*:M>e0&pIO}cQ6JW11'nL i{D5OqeCzNu+CdиX5h.GOr6mY>RҠ{;dx+(Fxko|#ؓy)FIpn.*5ip0y8ԳL5SC$?G1 7ZOV&li'_枦X1 TLkW5c3㧊 l4HdnX|?ŜZ5 k@~W3+pRt^Sl定MyRf{tb ϻ:]}r֏aŏ.u CU;hM!EDd?+L d:\]d&Zz?(18͔CG7߆O隶T5lڮP7G 2@ +i\3:W6vr. #Ok{3JY܆MtMv5Q9?CV` z )'k>ʾhc>,C(-6blu(,4%:3jLeJ-6ytzxLv sm:y5}Vo,f9}n"Ib"$Ļ i<'Gy/ɦ1IW=ۮGNPמ.D!Nuםw!$ ؅02LEyWu Ύ+)wLwkE[*%^͗b|[R' I50Ey͞>OsA.Xb $}=8=VS;%dGT-հ$y*?$VG|ܡO/$ kndu XT*)Z=𞬮+qQxŪ~nI^tԏJr3^{su ׯ T=l1q~@jpG'5sH9$rJ l2_94Sf_$AV$ڨa *'rj* "-cmok)lwFuڄJ_G R0YΈpR|j0c/aA1^8f@nWnwV!uF`=!ҟ)b6ݱ:JkPog*C傎L&h=bIRNAD/qPW|ڻ/Y~BL5*eϓ58j^Q}Thdˡ!vS ݵ'd_S|)0i~DtDP$^啾 ;=weHY.|.gH B3[Dsh8"x]0qŐafw?S)J[Ȭ˕u#"Zwj߂_&։#f h]xps#6VWX:.1~۸˻t>M2ii8|(v C,'/}-yQ2[!KJ[d%Rn񷖌nT64OY\tqƬķ J^'s|;)*ErmHؓ Xyմ3saټi5;Nih`^DkhԂ<2Tb߬&%&oz|y4" \l"2ﻰOě鈍TZ, (VE #}hD^ C68$ 쉸6;1T|^ٙBIxU5F>LcS<0EPCP1NZ`H|#3uv[#|۽CRe.tv  6Yty/)=D0a&w7.$wEK<[Y"c+WbSQ4ԝo]ёdE}XM 1 -OK1'3"Fa7jCt~GXQҙd3SȶnO flD%%)Fo8;6dCxZ΁TKݵ^DY3bzj{קgZfQEs0#U$&_(7;c6;Xc䨈6 VeE.SR* 6sd0:톐 D,?zÿ{W4 JG0^lw(4ImM+K/ z:%x_m!dcUl셛㍕w 9vn]+ tXiS*~g4t3i*BOEhW9;]zx1舦xXVVOer6Iuix;yQ llPU7 t xdWyݍ/:8 1FkLma&+ҍ%5B(LEKi$$usKӜ}+VJv 2xxI]qn7< Z;UtE XH ϔ*cIdph|ǿqs-S61%OI6ԥ`z Ԅ.BoTӯ5D^߯$&\? ͔0e= 33ev]\p]d+gs(=jLb?o;d~ǯEL>NWv'ѶÁcf3 Ɗgj5eaER6.da^#E}{ 1y̕fM9YD_y+-YظObj̚yIqC z4+WPdҜ]DQ endstream endobj 55 0 obj << /Length1 2215 /Length2 18223 /Length3 0 /Length 19544 /Filter /FlateDecode >> stream xڌP .wwwwwgpww!w$;s+Y-ݽTEQ (rcdeb+XXؙXX()5l6#Pj]\mA|w$LA9w{+;@G>@ "P;:yXYW9-tP4u:W47;ݼF͉ӓJif P]<LRƄ@ аq]x7ۘA 8@]V+X_ _gEd;mXR Ln^n S_6f % 0}oy.6NnL6Id˒ qG Iظ9z| ,m@pwb8e%nBc8YXXy@gܚ/z o'Nֿ }"6@;E s7 ~|/>X7p{ ~%E>11G//# אq_6?p`Y:xyﱠ,4F߀ob{ )w{4ܦ6xewPt|_ k6+f +U hbfn-ۀ*6=6 ?3{P\o}$cz#_;o03S.('Y/߈,e v` Y鿈EzgQY4hAf?_3AE>sGO_}gd0@#!,ld z3ax5w?{ma.#7Obw*GW\?tN, {+뿭h7]ֽ;]?w?| ~??{.]?.=߅tWYJswwn?O#4GX^p4 k%dܛΠe]vpDM tM#Is#B65Y8Qmz ai {po"xBF }g?`;.9gw^c {\3 Q1ѡ{΢O%#Dzm=WhvQAޠMS, .y#31~`:dˮQ5z-w¨ 1vk˚0]Ȕیc0jDbZ=+3o9d]A=O #w#M;=_ ߪf(&QH\(搕[6}-b:ժlK,R%=a?l  罵8ܾMQ3Jl$wXNnWLi>x3 1RxTm ǝgOrY Je#He%> 7MAlu4`H9(sW!ɍ;F.^5?l-Όޡ4 iHEu)H)2yCSa6{ny<<%F΂)4q,RFPLg+H,XjPy#MР[bSB8J3Wjt*hAV4ޮM5BJ4N~^Nq -'p8C8yj 5 vB0FZ4j)Q9j&:q 09r0>_nZ` 2W1e(RVdR)Q~o鈈&rYY2ڎr6F7 6+kjGL~c#@v^xp] Mˀ"se4Ȼ?eiAda7ȸUMz/Sl:s(sxgɶ~9~7g$v(R1˵`ppw"cL՘ѕgZ5BÀ#=*k%'&ׁ@LJ-OǦ2^%BAatX̘ߍ{8>s?'?HFibVy'7X֏បY9EFW<ЋmktSH>ۜOs|J*Ო'oώv %/+ʷ "l^$<Τ 3U;vY? ^?$:_*lEAFRfR۲ah@zn/h %B&(/uQhةgOcoUՓb6SN|X>6˃)*+NXﶳVqױb@gWlObleB<<8rJ1ܼ 6TɢKV?A\rRʍ{Uƿ(ljzD$n:h[l^^ ,xbYq7G)gGf/j^wcu,Erd(R_b3L7}9UZJխ#e~v2酇-`)Y5vNo֒&x(Xɾ cdǝʝtgJ!gaz r%5ma]Ukt0}`}Ӹ6KfH9("1viE#YWR߭BlN)r.F`\}# 'pO'I7ڣK Sw00!]Kx%Mµ>[ouSb&OH;toOR'tMߩ.źFST#h?) 4X"iSqx S̱iay+)ckI3xRI1PM%+_=4RZ)~PԨWj环W\8w)~ֽ8u."-F<^#LHkJ~>zt>+=*󉺮Q\OUdUvyˍh--[zTwK=j]Z%pn3d JS(FIA;(1P٨D+/ոzndm }bP]djEe9 cLasu3G5kE ۩k*f%Ho.Mn1L7{T\$I;P> q)U%Âqzb.JA ɯ% i?;ĐwG(O:1k6av8_W7}:ESBuu]zՊ}??UZ5JV%0rzW'ۤiI9 Ut{)ƃ+BhU[>peZ)Jݾw1KgNZub6'?fZ%C;deihԖӰs$:ښ/ϷMͺFAsC2g12op#q$c#&.= Q (aQWŭ93q_N~\$WgV41bfGG;j7(\ø5}%_5YڮCxURnՒ5<̪|8p2=4B ^littTFr~`oG@n8Hp}P V@o'sYЩ޿JSe T>"|up?gy-g@y FGXZ 2~w߷,ⵦ z,79S|0Y2iswԮh)hȦ.{EPne ˇ#"[ bXbu@oLV/#ۓs_py5Lu(v=F+oCx8yCҤ~TZ.mgMM#9ٛ٦KR7qv?e >pM0n~/UqLuؐ5hEpʜ=dbz^^2_=dsL2ؔgR4 v`D(z uL;4l(5.DRm/Ws:#|sBĨ0M5\y&o"0i(5I|5Z.m#]‹R%3p΍WVMw 30tכ+ !n8u {8Je?g/^fL9+r24Oi\eʀ ZK+EɎ|%"^\Jxeu,r!&_1Kt$}f{NnU{EvjfYP~TWK MRG:.GU*7`Էw}R8Z خXү_˜Fn? V<<WI ѳDliMvۣ?nhIOw>D}(JJQ燎&m%H(hB{483K$‡Dτ0AqzSxʠUe6"o#a"Q+5C;YlvKe-T~;!r2ii>i4 }tP8%Aæ,ڠVIGRfnz[XDdI @ V]gVzK{&òEJ:~i^Hz8€,5%~]} l靻=go1@v$G*8۫'6R3/Z'q(2LZUs,Ifڭ3߈Ĉ| /,?lňT%QZɄ(ԐgGOڪs+Xs|[-kXQְC9Ȍ-"I;d~S{KW~ub yg lx MKr9kĕ+A~0?:mYE\^^?kUFtgPWYLj\DRe\=J%?,5?F暿Ps9 9@QS|k|YGwҨMsl V˓=3}'R0E TvKQNH]p qb?5Gbfs4T{ .4hTZJZhd/e6fȣcQedv9{O1Œ,~\XdK\6f% 5MuDz@shW+>V=|̑{PO?:Cє$l c: gPxB`BZs--Z|~U@x}9 Dq9%Lur1'e-G\.5*zY Sѝjx|O.KғGIzCZ~v0R3~!_CX(.a?ƙ9Ю˴34ZTu8pCB5e:H>E7l1cy, WֽQbN9M)/꧌f7,}<YV gcmV2rn*X縩pdGve8Te{Y n6Lo%_G|bn2ߦjAcyȒĜB:+<{\E`in%Nٻ>lKH)̵Ph5 Ƕѕ5Osc4k[A_6V.)8*el7oJ"g!PFZW"M*%v0OJ{Bzts/&N^!ԡq'o,^>]Cq{ْ P¨QX (i ս"Ttd?g-r=}p9I8^qPu >ӿ"X >6mꐇiP͊H)~;?5=]HȭyZw#w`9,RZ=wU]_m?oK)L:d{3-D-X2D':/蹝3We5ȨA_j.Ԭ~by՟eyM7bכw>*ﵬ?wZSd;&™cDE]Y2Ή`٢lZڎ~4R:?e=Szkw;! D0s[{. #|JH1cPn[H0i/l.zhoi۱4OU7#Uw+2E"0D cY !&=:(1J$!L:EzyaG[{*1QX*~6h+o5Eu\͞.:ri)- =E 2zQF^"cb+<&kmbZrV)Ozv#-LǠ. #GYD<#%)ه~=OņHsN3VIω)a7d F׺TIK3n62G;'͉67HFS\|IP%ɱ[4ƣ%MPLWCD5#M.k2ec{H:L^A+g_ZiT4;*.I#o,FGe[:w, 1SRp"Cl;W8n!kJIu-nn7&Cg$̎/:rq U|2N|vU7.fԖu#|9( kKn$\p+<&WI&L4^J243UwpFL>]}_ȟy)(|Ns.ҽvH#~,}iNRok8 Fw6PݥX랾bv=/v~7֏ۚJefkg^9ށ KumR?RM%ٔ[B.gOL܇?&iEihtk1EGchgIl誑Y m' h9PmXb!v a(GŸ&oetD] z@i 6>N-h}b9"Tc愚uj󞚗u +qDu._M5AVⓖe漇 Q҆5W}Ke7hY \}bc=7cjY잷t^nXq ?/`|9zYRG/a^G""[3dU!10ܕ–d:ׯSՉ66ޖ_mM=?! {K^ J[aGj;ҕS~4n s>5a2Vk"!Y~4{[5z5^A/OzbPQdUjki\j1}K6~ؚ{mQX)[ i3@Dtaq/gH>\h%([D OMâGV%+ x㱥|צ sҕ/'G&4:-GeG?I3!)}kS+trDժ|*&GI9z9:^'-^>e1=); zewoQr5-5<ZB|):Ro+A2k0,p~?% ccTS;HPf;.ŭ=K; F\?0BnP:, ?q7 3s"&̝x`oup_!JdI]ϫʧhW! %b? a<nxR Gl.O\uk^ J]N 4Nr kn4|Dy)c@`$E$"ϢO \kW^:'b|%:R]V\ 55L9-LK%{Z.a,:u&1y~hTEӈEPq| < AWTc3h>h WZh :4)/0`{z36/MucٙqcYF_d|v_shaUb7Y0 :ɉf5m?@KFlMş+FpG=!JW&]3۬ܖQ(Ra4oBң/O=O}G圿I"p{7)ѓ2n$H" K?+׽H;T`nJՀv}Aϯ%!1asPwl/.+g2jb|"N,8FdtP?<vhu mXݮd_A!uu%usG! iRV>7g1sY̗9u(UL%gU.yt*xphR JƭCbW)(P *ΎX?2 &&{՗,&q)&?Y' } <gY@hl^s*iH9+V#2Qe,nw-G؞ |:`my,ڰ;CXG_dڮ*@:H>mrٖj}t=V@}lu{5cȺ- 0JXǝS-4Y۳ϳ7L.Of:CZ P{Z &:g__~ sNo C:ԢII%d?yQvhg;ٸ{ak{&$(jdJFsy*IiGA0pXv˓-rg%y4mMsEbYr^ȁUdki̪/xset1lzr1VOc%H\/vU}]ߎ^cwjQdn swZ yP17G/,g-opI();0f"K~'1 m"Y["S"C~Rb{cy6ܫq<W LtG n o_+N<.PKЅ%Qpȳ* ;LPYK ÕsUxgChN1[Eoߏ|TOd+o\u/nOV?b}&n;?DT2u!" f{EI hlj@ޓed2]f^s G)I~뭆Ħ hkskMZb<%I5<ʙKaJvwƊ8`+P>L|6Nf#@EQ'%,S2"ݛ‹i ,*ɜ.Do gt͕2fLf.@Rkd7βAxoNҡҟ,AlRnu545+!5"Bi81PxQ3bJl]U`ZOLSͳm[E:bH)?S D:s!*D8"$g_-w4SmTp@7y-nHH/QL_ &'4zKvvfn.Sat&NiO 3aOKD-hhN $rþXtTZ5qX)^bwFjvJpWcѪ]rm~}{H4LlQjQS¦mPJvC|BTh)[4`2-uЖPῚa&En\v?L49qmCWGyYaRP }QGFַTD݀홬>/G:Ug.Ew<_jfb&Ir+1WM9_d865p:CLlt]d9?ɯ/XRE/Rdž T Q\ߞNrb*QQGC iI:j'E(SbpO;Y+H>Rhg%IEoo=L@hm# l4sXnp j +3P5ϧBMt:)0*3ǿ;ۑJ(ԞJ{i.E7Jc_ (sj/KZ=ע=>ĺZHm8W!,j(|_(uĩFdP:?v  KTL`u.)|1r`ԹٵVw{{͹XwP= }!H. .EҢl2]^:X `A5kDdvz\` X1Q >L #|@ ?JFA'RyGf|B+uՑA#"Ϊ 'ъ|0LZ:_-2 H3PGlL>#c[ϰǵP%]Zr/=#T87]8f x8YH5_z/QoaӲ a]_ B]}M?FmD=|Z!mNJ㹙5ѱ%hqZ@)@RtY 'TgH4td{% DNyue<ѨQO^S?Im:vKWtwl >{ O?'ˮ2bI񐛈tuubTȜpMaN6ʞ~4FgB3D+ClQ=QZnJ|;0,_jX/Rv$X&\y\)[-?65NlSCrUd+6{ސB/-dZThpaWzڼ#RMj^$ Y:M4QP:  _ 6-+~$K/5]fY mFl9gJ*CW}͔joATso54~.rw6k"xtƔe.DoΖ g RvZO_E`rJՉb /~.Bȍ;I#ndܕ_J'o2Er>/g{Ptc<\n) x*1ezgg"2dGã F:q2|d~4=ծxv/@ v]2_3K**+xI8VNSrAӛlY DRMg>]p86ea$lخ[Ba{ajgoU:c .7 c"dËʡ%b1xLyE\[lexAn.EI0 M3Ah mұLʽ4Eh~6@Ms2-|xS66Y9qo倢8|с`F{Oʶ5G0`krn6.]tCgBNvҤTOe5Ty`vД4r xgy8[gu%B;=sᗡu;m+7͔qЗJQwױ M}9BOX\`lռ| '{ܟB ٲ'*B$|LVl%hA;o)ϙ0ҩ4ܮ(HX743v\+NXD8bsyw {FaQ(m0z5H;e5i pQm'A]Tv5@IP5EƊYs+oU>c~_4\=S ikn\#&<ւEκzڻs\L엉:,:<'T߹΍AfMTxzuZf'R[r-ﲍ)T$=OAc|YD;lڛuP~$*<[d+S:Mes†o\g)>:2ߛɪ%y4_$^bG&!EEnL@E: xOM%#^,%|c~i\Zl\Ĵ5פ6t @Afso\N4\?U3Ho_aa#NkYYmS2\YͳfEt?K.q+ X^UܳKn[S30* R jc}gwwU43& 3)_%dԞq=ih2JV}}g7Π*4 d_RvV )`T@d]zCf ':g#ZI?㘕O^GFٜÏ <x@NW}J&BNj ![i|AӾ{]_:^IҘv\L|띝1%VAk*RaUuLRsQ']]hrU$Y!# 0͓=m_Egf͏BDFM C5m`CuH }:y"~>YkνqaI6\AYyeIû>c|(K|YuH*1wf4;nli74&ܺrTCv:4C}69A0coOv2j]9>nn ")2HE(<їm#^)+M%t;|/Pm _L$KHk幑 a*\KO^%"JNI3] c41=(:B%VLvZ_U$ 2ҜwaʝI$KNaX]1ϝ#6pc DP$6AɆ7.l%N[xBk:ؠU.@<16z;ƍ\Xb2dۛFɔnv}wqMALlTTSb&]S6r1Ezwԁ ):YAh:?ᐖ[UNS3sܥe^ #T;m^Bݿg_kf?f\g H A;Ν`p4f_6Us F`#0ŷ.JǤ&tFC"n+Ň<|Jh/ZU;oV,nD.'?' _$;#)܈1봡 M)': גkzLܑQ QC,MפWmdA+.Edr#\֤ʳ,|B{Խs<`ms+q3t: aJ 7Ǟ@8j( +Mİ.nB~lйzbXus_khw~loZ2OlgbO^E_VGN_4/'BRZ 7l:B s#~{w%U} =Yσwt[ׂ^R\ZDg<Zv?~DlH Q[!߂JZsQ[;r4<2i:]MtC#z-We۾޲Q[ Ja:Ev7k5@Yf~6ȍw4..:tE3*V8-0$f(T|\f%0Dpkݝ0 wwqL2A@֢PٵITr (7ޅkRx:zjo_ qg:UL|nY KPH~ x9kh\.-y5M&g؞<2.{;oIp&!d?Gkr + XJ|q=. ЪurISPzՀ_`₤*~/JbY.C)a\N&@6ep䋞jx$Aʂ sy:uS%Lc6#*'mI7Pj~<1xڿNx$8.ӫ{_$W(O=%C3%QZqܯ^7׎(;9t˅υQ ]S}[kk^{9?=IRߍ_e.8"U"nϠNjzHRt/諏)ZXR[`elױ {o ?|EZڶ|),0TΙ1,'SXL p,NTr ۓlY}Rñ_ʭq\fm&~h;V!"mQ ޱg4Ў({ݥ, ʵ-@Iv8S8] .wm?-R^l)*3MS6mr(\C Xݩ}b[tw'$ResJ;ݗ41-ޮ1E?XYb}׽p=BVo^l~o]}NX-iqn9Ir/o@j{Mo.6NqVDs]”k'+<yާg[)\dBUa~ۃ%./CϹt7PC0w*#S҇Nt>OCH\p{1FxXxmJ]hC)lfPCb',:§2]j4E odf> stream xڍP-%Hh; 4N4n5@n <.33WuouUo4Z,V Yg + @JEΉJCmKJ 9e ݞe@g;g0@dgp *zYTX`+*3jgc?zK 'lAN--gK;usyzz\Y6 O;7[&Y~@2cEhڹ)rvBAg%AZ 5̀w tvv`#& ~]@;Gų3ZB nv)|2`+)g''w}vP{Y'/`mM¦sq)He,BGfr𰳳 p@.-Jgg ܠ +rp, ;0?џ ?sv^#d<^V`G/"ӟIJ:{|Y,<~~;? `kg?4< 6TGgy-86[j?5/Ivw{ MVYٹ;V `ǿU dnfi  ugWw tf|>y; qP(y8yx jcl`gg3=3wG8lE ~.?7A6˿٬9l$C/sZAnߐ [oų_f/\ÿ ?\?xm'/sd/5s0gWG |yd3xl>w_i<|@?~Kw(ZcAg?;Y./8[ ׅv dٝ{ tDNe^^Kbm_P<6 G%k=%jNﶣ.MNIh{t roRwqT//U?qu,|aW[5X9yHn,/qxa]]M>Q(&2rnp|t~IҐ wlWr?Mhѷd:>O9OﳫzpnJK3)H _mz|S)ewΏ5u/sV Wf$'5GzM4ݞz}dz:}M[z pO9l^=-fdѮC,W!/_[0e[;l<hSy +̝)Dzl3:r6j61Xd-5O-a}@+)"I,Ujvf~+W:ڐICV~'ȁm:$+qQn"6 6Fl*F/ЫtqjR.FK ]10W-At T`R#wY'߾(JD.pD^GiuN¢:^6QrkA.#}]Zҭ|#Šݶ7 @ id,/. ̆g |p) m\m`̛ɓ9a.ib0r8>"W.ohHö=8].LU=brY^ߋ}fYs&\R0 4|xT PR3uR?,{c^ӷ}Bha)9=Fz9v<-'9z+f9\|Ҹ]Unf L>%)zOA:Z;Z,n~9_L$QNtxK |H@]:lEg-LV_L$g0ĆlJMMw?#_ fإ2|RDF)6yj௹7i3+zQ ]T^њb_4}̥\`8b;:!>d%zHZbnLDCĻ~ Lr>GDXb+Hʏ{ w$@Rw|hO0Id"3tm&Tq}:c8r \8My g%W&U~-VX.)ҘJx:+xm~ў*dK|uu\avjԏ|ClE+<*gvu eBbB*(LU-)#JJD'8QIPqpt9 ? y/45QgqVGd͋+nޭwR oiH 4/cHg`8U>3HT6f~#77KC0P*vl8_#O"`NBR /[~xHXrj@X ii&=Lwfti/ћ>ah.TK(Rr "% ׊ }qmPqjxʺz+9{-AJ6U{4~ UVcDzzmch}eF?!%Y|MK*A)|BqyR.˪2KaS(S|gT%яg:>]7KO}u {H\װj濫\EӖD9G tͽ6% .34)\>lMfQtLGq ˵ۉsv~PTf;(1Y!jZ+7HL2[%hJu\̄~".Nk`Q7229{>~A6\d$F!0C >@?r>D6T t)|Dx?ɩvB$Ҹt\M,la_Ų( ܰTTAKi/8nR·wtShedĚ,1~Keձ-S#TWx#ՇѺLWSP&#=qvBVqs7fa)Μ_?E֒ a`RIP2E4>4\EoNScݓЂksDI\nlW[:nl }GzG z_8vN R"Qb!T)"@d#rg5>F+gō_5rA!Nz44%]TWyf EePW&M]݉2xNv({\@BW[ICZٴz 0UHfO17K3,Q0v9xIt۶K/K[΃sMeI(Iŵ =I#q{c#%;酬 "J+61A`ܥapt^,yT7\Z̯P>ͦ@7f2O Q4\'Qrp;AtW^s5^P J;_ qO{'GL<ʵ/IG$v(u<$e::jBoW˰Zp~ZFKŠiQDŽSZGL]@WS.zam,N=m_{^ IÚМ> ځVo1 D!gL'u[[5J=Ӭ\֖g\PB KJ>!Cjز UMQ)uS;p+eIzwy9EFӹOZ~R^]%v1JbXW| ZSk-F !+.{{$46bͼiOr! J s-M&ZO GD]o7_1'UXl DlUI|eQcC<Z代KuqH`Yu&v$&:nP:夎yS9utZd9"*ذc>Zļ6*#F"0KT#[uQ9b&;&=">k5>'?.J]s/K{a[WAeښq(yrjT8=[g܃ųqWk)>"#X=]NauX˜#rpv;T ܶha6o:P?,-u?"~F^Yl~ ,0EuJHbjrغSWVu@15]2c]-mė89X{I ІǛℌ —A9R5!̈́V{ &=Ob+FNa1ctvfob>Yk/U%a }$e_<_:dq]~ُthuH;ҸH\&!vI%a; 9Agj"U_\[(~usW($C}Oa{Wڄ&^-( uwѺCyWtd!/l¿I^"b`Mf=SH7;9>d&RC&LA1m !U*7ÿ)V/.tQ?0hu\ -/COq+'DYg3\LBgq6 hd:,1MeQpBTژv;Ă\$}mԛl~3*w,1x ټ914uz*Z{"5 `R/$!3YYc_bcRH-,94Y_my(|6׌_"VvkZhSyXb0z {Q,F9=Ti1$~퉶u|%N;Gs'`iZW􁭏WLj#=30>ad1yLwI[WZB>nGg$]l[ɻ28Ю)uM`h H x,L4g}}j#ļڴX1mhS?^ :$f;pJdҒ}3-bu^K2WpvL,%V_"eb-pU-Vp/ʘ>Ѫ&'j-Y^$SVYCU`iR= [b"? J{<3oYy6fEC۽"MI72hHB g1IJI<O,)epEƱ)UƞӰ^cu' D_7ă9vmX`UfF iZ ܯpb^O5wFա0^9OEs=.5#œ8\gY!AZHLDXщ&9z_K I_2ұ })Y9ܱ6HL>X^#)v5MD' #zMx˓ y_{X4Kp?X\ GtvklHD>mt i~'| F:|sE gGXjHY0+c_xIB6exd/WWzN0xVջtYܹBctVzt~tk3e*E>6u.PvǦkqޏUYz3!~b W9 3~C}8mDz)pҦ~݊ZxG=WS9DnZtjH=Jw T,a/ྂ^}*m}}=l\(hO/'@|ݳ]E"o/Ǘ'!Luzq䫿GFN+n㬬xx)h]LNLvDo V_{ c~*|tm,B8uU[֎v =$ nO\La6&tA$.(aйF`6!j, me!͠RZŒQuW/~.N>v[ұDiJX,uI j ULb55\\cx6V.5dv5>t(扪F/ >Eg!RMֲ#mDp{/]7gqYrW#ɬ{z!9Gʤui[yq6F^sdo a*VI,<*+;wĞ_bs m3.b[ ~\NZJ o3yO5w`xOIcquuaWvO],leב{6ֳ# Z$dN/-H伯~&ɉUȯl; Du*3oL"3mw&RWKBHI{BL"Wj"&̷&}45Z?/q~?X~bq_  \}w9Z ޟ yRp,SZ5N|- ; O1y!&KX#xӾxꆾ~bI7KT*#5Ӄ$0MJL0L<ޘe۟?$.tY.OB`a ~"ƍ2++F l^iI8J}d0UjLΏlnv~}0uxESq-%>ye,;dL-6"p BLIlo9N&rmVl :7V D8K2a酐(3lhۧt|PIi|d\X'1膄jLKqQٚDŽ-WP sڈޒ3ՒWߴߍn#@z +[[#]ZKsTlj7'x/."P)O6$z}k{.WaD@!Wρ[,lr;`#'FLr v/\cFlX$7M1onxG/N/URRЈ`Dt0>I%N-[MI!@`x@,AW=jYƐ!怟D@F?ys H;L0XTwj\%vQ:`R+QgCm`UZJ*H]2{ZJ g\y1SďD/)z+Xjw>FV~C|HSB3u/n`Y2d<TMg4XGpeE'#?F.diÅjXoYﰌ}x$d?f { mz{Ídgyo/s*QqPj'~ta2̃}ɞ\؝晍CD)/W1(frc=ʼÂ4S:n:% s/|[wŖ+z]H$L6O.T 1_3$gW~Q:-?+rOٌ1ZlS)-I2fe:$|Gt*yX;+C)OR=eTߚ&|mW͍8]zwIhJ]]ʯei_џ<~Aa=jͣX7oGT>Jb‱4MՊH1!D2yvq@5rQ oܩsR3 ڋ(=YV0 wlU}f_Vav4gwGF_%뼀xOkAą?,;&k'`+>? ]: H{ԙz)~\[^Z_æDZU),Pq,^k̤ 'A+Doy(>#.sQkXd6['5Q½֝qkyw`S0d,pZL훨-?`4z(_{8Rmπ-r8Ȩ(TNs* Sդtduu>%7378cυb/"n A:`QZVG%1EPT-*ְ' MQ5u\y蕔9lDd_0:Bg-wDIs@~Gd~+艙[۴|jj?CO5'=QnFֱ I]mQYmEʷ$iXûyafs.4!zgf䡹-䁯$1GDl@rroTGNleY޴B/{+`_uGjJVժ PkiD7&©+!~1uG0%;=ʟ~us,ySII.z,o^8YU16troP$uOpе`tK!#KrCdLL8[4"nG endstream endobj 59 0 obj << /Length1 1533 /Length2 7732 /Length3 0 /Length 8741 /Filter /FlateDecode >> stream xڍTT.L41H"ݝ2Cݝ%HH#!-t")ֺw筽w?^CO.a3 .\@A&1!.v?`'g *)'0& rySAv. A.>A   sH " vƠ9x:A]d c;AAP l93]/o$U pZ 88\@'__// ?\]j|l_{1>̅BlB>\HoOo3{/8`0Wg:]H .m0/R{hi@ oMh{9݆1h`D}?%:W{G@[NE|GW~lB+>9/ca5VP¼+fՉ1 ,/0˙#yNƂ3{~17@SmzkR۹Ԑl[["g7Ѹ܅9{4L&6Jݨ{kQ ѯ(hG^ТytkP8p /:}\J3 fXcO1u s}\=拻; e#z% wWgR qgu,guM5~v?V>H*擬nI<:)OCdK_+[Gy|=,s{N +ѫ0kM.X<6?>oTpOuIΕtdK-spݽ]rNlo`^GL1v Lj% <& M8qaOwE?B(b.X@ϒr)fq*{^I{T@(8dNvF"՝wj?d,zhe$uYŋ[B米6@oH-l=ܰ@8&t C:8 >\}ڡjWc9OF7Dx5B\;M0/IJq[` oF607V$[%} #xrJ.d] muss,yTа'e_>ײN'U65Kڮ͋J) :%pq~eXRL.&UvݒoKs{zgc*7p\=C*GFبBcj({dm\jR~ZfCF};R8 TΨ_ 8z=|e{w.ğjY̵:SR2X z@A7 $k/C% 4IhۖQw;7^w],HGdTE/uO{w8Q>]&}׮"JJ;OoD7lri- =igSk VA5)СTBu\sd֦{8: \?lW4:#@HbTm."ne"/oE "_||UĤS녙ņPy5RqRH6iŕCzYb5Ġ~M5X/&K"E!ԁ77W(1coe$ExOFl\Y~o3'$pjgo~H1bD,bIX%?7d׿DRma6-P mpgPOejl#sB|q"?Z.r]['D4a;+9tJL8ErmvHQ" ۰oo6{:8gƸUu*6CFNCY"2,i /DX>i-Ý^6H$JЛd3!\Yʈ~ʊF0?)%e5{b93SՁ @<="'~np*ì cN3=#R X0^q>e;UG6Tf^A.ѷ&TwWSA0PVͩIg$x!Q]Z ܞyG.lN4J>7O*J.(*wEj쨺V\TI y*: 10.Fw2up1ҭE7;rsr|!eUZ-DDSkc4@lxRZr/k¿zݨ\ڗr3-G4?:CxnPdy%=iGW1?όm pٚ0~<#2NV2M^/[t.b8^E}PpHg/4ib$bd]\ؓyINI_EDM|R&Hu.5o?AN3|P#e]{7".|E+ꛎ$$`V@#?TkBf0쀪ݳjZv܇On酸K\M$8.c>3]`;7Qh#"^w 0>N~qOLOnYK2ݢ925R u<|oxׂ,jqŲA=ݪ9kayhvb9ke *wn웋& ivrTibb Ob*^>/(C)wAcjԘ.Hm [Ѯ8n>4PhCD)|)pi&FG#hBrfkWYK$-В{:z颡 SaPo G9g`72ܧ ѱE9Y[excAczdʉ.%RUnXnLU:=/;Gٷ:\rMyʘQCoeUv(_!6sú6w׏hXQ?} ݊ipn[ n>iݚڡ{ƥʌYӬ"HSJ͒UP%^mהy \fO}D!Q+͗W33J.ƃƦ~ssQ-bEJ`gDM_ IOwܩyv?4<]U"Dh\L!0)6EoȊiCSdrj:m,>[KSlCWl7 ]"p[UWi9R~]GMSmDlYg@OXn~M$d%dPM'6bQc3Qɪ`}-` /t6+:@ϟ[Ƚv(6ƔDMcmvwH &Uqxlo37J?x:kۍTOճ;7$5Daux81O7q: 46ə,kY4*@O"geS(Rb-k~Od(-dTֿ|v4+0,}*̑<2{Y,'GdW̧fT ÈT"ex~C|@ d+XCt t WHy) Z0r# ܓ4Lc]gH?Oh梔58ߔc$p,7|t͊XЊwǙ/dgõnl%zo06 *㱭6}3n,҃^;؏ta_@9mnl;iWs-8dbˣ ֱ~\fmX>I}rNGG\fKQɨ\Pށ`L3BgCWy9Z弌eDGLL%hm1降s9K<EhcEN+s#d"z h?Ԏ$4wq[؎aX>.UojhTKy.q85ӶȒth%h/ڑF顋#z[1nu-co:[>#)c5'hʯS{a Ӻu(r3˗\k2n Ob7(]9+JZxQ4ɵ4{bw,VF lǗ|7VwGuZXށmCMg!{hlsRN#`g4t*ӻDgZ$'z5S ? C %ѐ=-G1glgu?YiepP._~5 4.wV@z^gk̬ŧJa?1'+0ڈFCz!Xgc._9Ո>6=d~,y 7r2,%ӎ5[_M<î|Zi*G܃TW:҅ahZVR0*r2 ϔ=*}znJgnh Y6 _UdR4fpE1SC]W63;1Q]2,Dix/@&&=?k3;h 1\OD6/-1ZUȝ?(NZ B. kB #@5>49&c+O[ë<@'-}&χELjyeGUEm)}ڍ-8WӍY+>y'Il఍%t=SEysk$KSV~[O8nao4d-JȜt. ٶp=6G88 d5(+[p:FxAn(+3nxK?ϟjtAE`QhɰĊ R[<3RC-hI"wEL}GB”OnwEJ9MïGY{-|<|'Zyd ؀jG9ܡ.#D؈h*m,o"uy u[) 2y"kW:= n!r7:KڿyaW%~Cu!"t{(~۶f7kmP4 6=6';lz!w|\GO[EYZKHEǯ חm#׊W s$Ie1tHӨ {A+#hu'QW~wg!/qVϡu[bI\R_ x%[͖>|@ƛN^e7`w/%~_5g[T[klt@7 ǥՎ?-N!:~C̰yۚ`;See>@a S1)RY81Xv}-~Tw -}SypRbo͜s٢Hsd1Z p[OnUs#5ɧ+xqYPS50[e j ݨȚ3p4_|Rؑb` N=xXA>k;MwuG^Rbn5@,GmwM, >2\+uÉgkiz L[l:XfA^5/{*ޡi[ZhxOQwڀ~ /Zlύc +^Bx(_NQ#y$reOAFZ0gb xBN/Rђ\R@+Qt?Nk/ A"bB*ꉃ6?$Oɨ(:tvoppҽ(6$qVƇcfXU@`"ؓ\afmRRO,ӥlp"%z LEȼqt,㕯WN87SdwӠ<6<0WNMM3gF*=MBI?U) :(Tvtw/ýC6vb&$gcuهc✹)Ҷz܁r4|Jz ZTL,D M 8 ]gZ.s;rѻ E+7da˜꘤y!)]Go)#A]iSN5ɇj_^?O~#;D! KJUo^z 7'?ar%lմp޳\Z.gAAGě~җ&ǐ6ccgo{c^2=8}uъ(lo8Sȉ5Bq/)̦fX򘿵x:ԅ*18es^W\O7_= ]% Y UH@  *nBxyaNe >^ Z#z[ĞN_~Ʈن#[fg ).qS&H1JYUXJ{ B#uC=U=YtlRהLWX 1Aүvȶ ^Lzvt1^_>#*T7N &Dӓ%2[ 2t#WPrkxy?1:Q9'bDjGmn4ٜ}N57/PVj,k ƶ}:1DNh av >ڵ o0ER[1`ΰ@*ԍ\Wg0@Ǟ̂\^\g)tCLOy%'= LܱYcTM-9Lz(Gʼ&֨~iE_m &%4`p_fl"Z/p3 =EQ9klJl^Lxŧ֯'5QjwzM#@ endstream endobj 61 0 obj << /Length1 2261 /Length2 13369 /Length3 0 /Length 14724 /Filter /FlateDecode >> stream xڍuT.L7HK3twtw0twt7HwtJtKK7HqsYkf_R3LR {&6fV~+JDtrKF hIEA9W[_A?@ ANV.`O 50:Y],v`ƶuLоtqqgaqwwg6sf9Y1ܭ\,j@g ;m䘑VA.N@`ke w+ڛ`uYoa)sm/ecSSPR`vpaۛ4u݌lMo UsOΦNV.Vdm\hI{3qw|VN@Sp=Yi=673+PV?R` n,0dD7`Nke y;.N@_3!̬L]&@ +{?d<NV=VXg33͢&+.O@o&vV; _CEU1Ox2(ko|?A%x?[j bޅTV෕-crK" c;+[Ȁ$ ߢw[hfjse]"jox&>fNVRV@3+S˿{~ 6# n_, x׫)&sq=Xf)0ۃ\*psrsX~BA<;X :'o2V6Ty,&9b3ق O;E$?_(98?^["XE0#op#OK$4Apm W ?9]L~oſ\ OP`ڿD&i'8 8G"9غ\GW _gSU76pTLg|mX\,8hwпeu_\M:X_=ؒoWNuS[_"-̓LBB:D ݙvq pk޾r"Bn3C+ٔr~MɑPуV 'qb ń$8fn|ďr@;u:@w(9,sFVyC%$>'?pT#$,FT>t,c}[:(< YeFN hn~P {4Kù N9D/.yn^|+ѻ%D? JA'U܎(krew!(ֈGŖ2^ $K.5iq(*zj+ŝ Qi.&HV>  ZYoHXća6s@~kORJC#yfptp@j3qRq!t?$Ah5K`"">_rt24tlG'g(C2}_i=;ajMӪf`VhM ֞#}d}OX:qqLCpY,U }i ~o Y]~piW0}1Y3 JO.:zڨ ?`n<ZLNiT{B3~jDX(kCc l{OS򬘻/G1Qv_ZW`Ujd ~SM{5oX f0S3}u@ݝɉrCFR9NqSƄeuInI H4`zp忛VW ͅXz"=¯KK@\-.;F9+S|8g486Q:Ef4F55wߕpܶ;DĜKZ\ ^\p5Rn)^̢s 2ef1x]n a@qcSeV&9F!#Ћ,8Z J XwHLtdfR +Nlᖗ>.hgt'AO]v_-?9M̚-?uؤHJJ(bp \L0)V5r|oF ǞDlBz!IIM2 FSՁ,ۛ؃h w]h%Qvd !-Ì/IR<1Ʋš➂oZ`.uLش?߲Q#6HB}|~e~i+]y#?#pa|ZK`E7q*Z$nz{g1*1*e?,8`}QTo0rZ=HI^w8 ?` ۜO}b0գ9\guF?u&HT ZIHr@{7"goxX@z =1'$"憶~bnCIl趫\a1=派9Vn j.sV(LƟm#&[QFH$,ꓞ)Ԯ2}>cpo@Ӂ ΤhoYPu^?b^,saӣO`ٳO`$vQzKQD(>xUX]#Lmexf S c^ФOGw&>A-ړ g)<~>@!mWi(ZŔHf H jW}QH8r7|UEs̓N{?A.*OᥓNtg^ 'oHְi2.Jm*W©]| [=Hj휣)$s,ǺĐ,XSr'e$IkPQYb>(a쿅1੓$VM 1s4@]m9i?0h1"h0dѻ</A}֏;~H}zrB6&W}sNk\ތ#ܘQC`nťne@݅Ѭ{1~m[<>|Mbzr7W{[.H@}aE5,1wJ_l'yܾ7=$e #4qݏϸ2BȽ>\zFV|Ϥ¶83ordzRbrn?DcH1䜨hG8!iQ򃡾#IeQOjTa$g<4SNJIMQNe_["'iҧ5= 0}0f4}1-u!nBFl6_gyJg(NI& wFItrvVa'bl3|aX8qq#GT@qDlmNgsȀ@E~e+Gߑ. 2)CY̸sLj% O_&$lQ}_hoXwQ>}U%2&~Q~<<ޜD?CGYj"(ȹ-Q+q|p4z{MI9b)9iL(ImS6U-#0;k/(=Y#f{a&g&1'Ì>.]dޤdW0<;?BeWwd7򽏩fVLϑsy_\b"GAٟ`Ŭ&*ؼi~p$u4x+P|~[ 4XX2IV\/ǣju&N,^/?עw"#pkj Gs7./&N. RΦS푦\$WO<^B/xڢu]hum*{.ƨ;횖o ˼^a3a}!xN3~ѱN8-,kJ-פDMo1Ysr vjՅ޵"b;.0'֮Z [A]'j[y86*縣tN[ w98D]a$Dz8km/tL+Ͷ.foq"&,3=x^5}Nzc_œeJPe>2 (-1Xg!B.c/zyF^J!|l&|Os8݉ǛKc߿%:3ֻ]$1*B _ںfTl$V789*vCvsa~, 3*!%fTR^~h#[NgXޘU*I &ӌ1݀V.jTkN!~ OCHV+GI4 XT6L[L>?g)2Sc!CjQKLJH>un5k[t8VGތ0=d|KpU9B8KgefAq-lmUzJ<F}T (l7kŒld-ϷϿ+ ?=ejҋQ*)t]#<쫭:,,7W4(C!(4˔ΌLx= w=A9Lܴ/,Tg" C_Tݚ=2*sgY~ufPj(AnS7oKQYEs*=>&! 9bY漺ba |=/sz>Ƙ-uh4Q|9 atT͔2^M""\CY?9LPڿxXrIff(i'}̹=$ah5P"-5i}9aVƸRIg6d b I*4 )굞puR\>`*p+BPmH2c-X^/Қ165⅁C"M'gLb#%*K<|[FF|w~qmU'99O)Ov5ʙ(w;OeƠ4H6PDfd%7)d@x2 u}^ClPi$ /0dqrx {^z}<^] J]1H)@2޲3}.0cdzEx,Mؒf=e59E3ՃeA5~!zpExnYcń! cI>uuvвb8&ƌ = ׯy7 h?1>}o<N|=xZa(!,wo~gh oJȉCN'VVA/s=K9r1܌줎֤*}Fa.Cl5+̼^ ܙWCQ.aQ/+kMJMR8njd#3߳~556 R VTU{(-1#(!\9=NѢ6l-en8l< ڪ3S(?F]%3PpU:jϜlSxi +!ؼ44>xͼ$&3;"$e^X<*<7L}Y>Wt{Ȉ[7{50?@hGSUHSUlAN𰫧8muனGI>c^%ϽSڡod;PԀDwIccnLF3 mm- zDf/O;dntai2z!n'|51c|c N1d$͹,}TVt"Cو``U uTSy'[H?t8譑;p `ڤCC|ߧQ̛bwѿ 5w 4>~lCpLlw0k;mtA⨑bHFN qPŝտ#`Lh&Jԩ<,)뭌>,<(` ej8ŋh"mBuXA&0|ޕYhPP›ސDfQ0klER꙾3f-_45@gj6KU0a()ڤdB.:pD.τ:#ֆ,Bp/q2r0G} NM7<_l^.sg)Zj˳SIHt ")̉͞bw~> +NT$wvg#DҬQ*%ҰCcO F33iQȥVZ^L ǭ[벑zZ"z+|zV+l|HlmgVeR+gccТFر: q6Zܢ57BށYZfa%,k ǯĴأ*MH:щ?vYL*2Z6Zh hTJUX^*ƿ)ƍJaS=CQcΝO*Aq_0W@oCIuBCMF{ kGq.L^_@ѸngDnׯNGnjٖonyۻW3|E!8N'!IxrqВD._t\5˼Ҝǵ 3zǝ0o$}1 |gM*a@B(Лp ?. gC]&pd޿VU&%X`Sߟ-)HZza7[{k/M?_*~qnW#r.] #ւ[Ir"ʪ,ͥ9(V6{RcogRdkx \\qht[טR"?;C5? u." 5')Lv:IBBj >i iəCJt;D OY '>Mbyڮk}b ^b[ehibj" 2нQ+N[5S{PlShXR[gbi)k@ƂXJMyTE^<3 m:PVpмk73[~O Q -}ClwbAe j624%ulydJٶ]qs3πXy(#I+ۅ,R*:24/Eh0R8Sm$ Iݞ'\z!+1~ш\4Me]7)\fuMKw8SB]Q;T&Q äk0`d}$ 'EwwARㆲ;j:Ò4BWxZHmeL +̘jt!1f՚p"K~(NcV.}CTThGiu*(;h,"|Ph Uv4YFmȸf}K֊4I$DAPֲPfzn;8U2s0/ Y98hZ:x)83~21p-E$A,?1Hf=m*FCͫJr@D1+Uӵ_ѱ ydz?k@9, h^$=S.!3Ls%\f_ϗ'}ep_o5\rb@Фα*i@x-dH=5v8D(m1#!%%ls2J!L ; ޚt"z[uɺ ˲~QxU7mABQ؅x *Y~Zޟ “F*_Q7- J Sy;=ky FjMrMvY>IT//H4͜zɣD&Yv'JQ P?Da-hZ ݻF}ϋqPwY a7W Hky5JVnH]׋-NC,3h&P8Kرp@N [s<o` B.(G7>(.,dJ(uZ-Rʢh1",[* ~po1'+WF*k~5qQ&cأ*d@37G[P,k*%bٙ6rO3ǝx1~80i4bl&.\pVRLFEFMl0 o/?Te/[E+Qӕ_<6]Lg}X*oVYԢHk/T18ZovxVxtk̟q kB$Gn7$wP!%D T1הHs$@A;JyBA"sۂκ(6H5ĻYV:xUQj>?6T&ew CunoќdoDv_֥4+sg羝2m j2PƏMgK7a"oaO6,i~97f caږu)՘"!e^rs%xJ4i ;2Yv!Dhݹ1Pm m"l?_bMϳY#R[<)-''͒z.ذ`vZ/rZ`-W؂$M x_%ɴ%&:h"u$,CHg_DFp¦FOӓA/FJ8 [0(7 |ovbo~TS9mlmڮ{0kjڷ4acj1/_l$"1͸/Y?!u!+ZjΊNnI2!*O'DzBl'rjlNNKI֚騞ZV^z@R38pl4ֱ5`4` d$*[n=DtKH_leOӵ^L˘2Ү{^[Pݛi'Q'S:9GY-/woֶL !GdKCj*&ʚ^7o17%2;¼~;DM?FW)]_RfSlF>zjK ~{=8k0w_l<"Tc^D/uAN݄DqF:zc%$Ӥٱ>^H|wsbH5jW:FZFS*;tP?\ޕv^u `%w}`¹Q;'j@  Cp@׽ TdJs"_]B0 ."[s<ҾjT/痗Bt thFh,l "Z|.F;(1_xR ]ZTa"%>`I|!ujxݬAz6qu6:7 UJKrg15J{J_h޳B|/w49qL("uqB?ԣ^CSt#ׄ,`µ1%5Pc=/zqxtxY˾~ho2z{:O8W釐,s>3[򮆗[ENy]" oxffYq@9di!=5ѕ_Qqꄉj zqq2&/}T5A E5aK ٸFTH:Fc=2#4 8Hɯn}[SDud8lښ }R9,M.ԫGQc:9-.nx|\,[U'Tf^+sh7t7{,}C&ZBم-l#ࡄݢX/h=k#Ծ2u[=&mAn]Ɔc_(>N) Z :p޼yjqZSJFsif5rYMr+d dp4[K>j%aS*ZϋqC6lu ELvz_'oyv{.WJېm\"~nاZD5 ?bLOSxa3,W5!aNK6"e-ҠyXR<Ȼ[o^^ MSd _Ooa x Vo~}fu?VR .1[fp+7U O񢼙G +s_}oO0(M*hpa!7`VCHػ qIQ}T&M17E,@[:~nN3]4אb9eM);C sb-HŶ8яHI%v:mXaR4Hv(Rd!4n*:"Qkl>D2?4)X!jZw~8sL,}wћl0; f*R{\eT@nbu TaN!r鐙WUV,^>'7%2F~&\C*^" w%Y1a@j&5"'[ ǝ,}:4'Ä_I+%o8J6o Yp ;O(YpFGkƄt!QHYNW2W!Ƒ->j  8Jٍ}ZmAa@CxjaJD7̅boF]852bzTTTRq endstream endobj 63 0 obj << /Length1 1748 /Length2 10846 /Length3 0 /Length 11953 /Filter /FlateDecode >> stream xڍT-S(ݭK@ P݊Kq-̝{g[Y+>g?磣fX N06.vNa'N s[N!N`@A@س LT8\<.~a.aNN7'п0 l Pe(A@t2g/(VL.!!?R ( P@m/v00;ѕgbxav-+Q2@ 4vt:_ m `+볉5 xVT;EVWs\\qN @'/-˩>o5o#PT0`(!6^7G/o/ߵ)l ܻ^0u4Lyf7z>?M6/ߌ3^1 |p_>_ 9V|)'[4*YkaVvn̿Ҁxol\{>9oT/#:YA8=n>~ zs>7FA6 {6^{ {.6[ͯ [nI`]e<5 3ι竹߳89SOJq,~1<>Fܱ7ޫ:ܮ=ĴFD䈗83>J>%EbٜLp)}ǺNUq9B~h;uGXD,6r[vѮ",֪Pռ|v7. .NꦌGmзWW<ᩢ-(鷟:v,=uBG-HJ{ In$Zͤx7vGޓqTA;oF/ĩ"E>KfJ{# H2ZkIoU3r{Weyw4,uGbGHsFYw-)djx |_E ?'NM(ݟ%[5L:r}Ziʥ'>jj͟HVɳRIΧ|SW$+$ZQSd]03񫋿۵lhp)VNّ7bGf^64WY3 ^!mnð?9={'6ed4k~tCݯGertBHZF(Fh{AL3gG6(7o `ׯSs*22&~vc!m*8;K>lc3DpMDL^}lJN}i^$9)?NLK"-+)G_ AY&]43wO/GQnN OdI7 fQA meW|rVĜ컸:Q?zpa_X(gFz ǎǴY+]9J9(+=vλ_PS02~(e0y!ݪ瞚 /ƴŝ!堼(;)9|o9#?gv`jUC s:R!W3%:td>!DʟeB=>ozQD|]nL`]l`9fšP/yMMh@2EPj"Bׯ^ۻ9kDvTȉ?@g2f[׫nX#:iU21cɴ6#q̏/ΏL8/_ru/ICOp>0L3l̗(+]:J-Ts`!NS=7ԟ/$/ `I.& Ƴإ}|W d} HfẢrVP-?grÆ!uX1o9gݒ z~*ϝ>+'ux !JO͙ ]F!ҖT' c 6b? /x!*S⼆Dvt'88MRp/+li= ɖ,Wm }߰tMpl`yn%ʹ\1`wg MJ}*d4 09{nw&ccwMp xN-j&QKV0JSPX8YI]=Q3O2z$. l6 \ِSO'?f.?)np@]};T1v6{yy.z7w'"LA0`j>;ooK%L>!^B9J6On 1v)\rDyA:]zbAIߘM*3f΂AeQUr )Ajhj$ UʣA1}V׀Knð8~$ ;&Aq|ik Tmͪ 8;iiE׹w[{] z^d>Ux؅ylX '{Bwu,K;`("8#ZݏIImY -s&}WOe)`; nXqGW{RLrQIoob&&PoHе\%نDjws@p~u;7l/BC/ >JZE}F{6X Z@C{0Qp>j."KPю!iSA_Ѣ0r$iwk-i9* /{3أR ]~7;dc?ae T55^ UtVdI".[7x^-(fMOS-@e0 sm-A US{z]Ļl;|κ >r՛{Xxg /P&KĂP.D2A!^pwz羖-Ul?Db%$Y-o&>nOſZyz#>܇ CԔ(~=U{YKݾ;j.K>d~ڵTu^/%:5gj҅X`qW5 jð. q^,VhCgKQ[8>j)@ #ktɈsTy׍C[mQoVvmK|ȋZ8}4#ySm*@1 ۋ:AiC9Ny#>pq8sՠU͐CBCzdX8kV` :g^m_uф7l%UNpKV,k!EP1G4\V l*`o}н*U1o pQz+3hԐ%j\ssiJW̴dXa~iӶuGI;?bYvF#VtlsHO Ĺ( Z 70K!aJ)F7! *h#!.Qa+®tԪ(^[Bj&ȩ|1vL"oPXV۪;1UVQ΅1?r·2G1 Jf+~ PMZ|L$MpO3ສa,Fn0+ry%:xm/|kIh),:>`sw7Oa/?ڠ$ryը͜ rK9 ,ǣqF3TDU65{%z1N,zPs"610᷎ a;juȜ)O'*  _n$Pvā8ńyI뮲=j>zöL>-f+1 0“k78AiGǨo"* }5n1❽We{Xu7iۀ᫒!X7砂n*҆:SPS'#"rʧl3ls Y`\yLR X>%gV5q%̚c)ڋZ;̔{j'K,qGK<:?#qw;!r쯿ӼUfk"ҧ-\4&أ:<)i觭R~zDG(o p%ccY@CY1aa蛱DZ< f~حc!{< [,: _Kk!@Yj"x <>T( l:])ȷVfx:~ nkPW*[nӐ>6hfq]fq7Dg-!J| l*ED}_~>RL$J0TX|0[N _/m]_h`NI:k aʩN6x AhExKy֤qU /?âLQ &䵟O/G;cGW0 Sn!Fe?TͲ! g@2Fs V׆|{-xq5AщI%hB C{DZQ9z~2h1Mo%]n VՌOs|X`Q24*Jm(czS`1oN G* 545cR[jA(Ɲݜ([m J*6"#|)W5M&)}PZg&+vilxJ9}'0U)-C4K J=+ s[շ|F*w/6a'}sKG9s+Rmߎ" 6K ,Y#8,Q_MnpsKnach۾"2Ep@(%f~ +BLT$: -J,̥7(\.p1DFL v3t^U eXv'*},!N3!Ry[<1qZ]. vo z&L :Q1FadU|% jT#PYdݣ#GC[fJm&< D 1b-1j'A1?J-]7.$FN%<}ѠqZ%]~@X)q:qKIʾ(Ȇ]-QGF棈QwjwRBbsYa[ձȦ~*NnYE yo2<,.u704k5s_\T4je`{W U8q(Qc ue)m4`l!O`LԷeN<u1Ft|>3`Fzv`gA<a[BOʎvH-dsl̄-2U|[ä"S׍z$-xjNf 1,0 ߒkTw,JRf- !T)$g}8?OW1hz%c3IU~2%|ȃ|MA\0yi)d'G"ǿT{0l+LG/fl-v&Ĺb A*Xo/1] !NƿHqGg2on$7uMQm V*7ݴspMwkuŒ,@>VWaоah+VCzG-,xyZMa u:P+^\|ut|B(_o>OЌA>9[R{U ⪅. 4wxI}]m;흰y}}()Fͽ[!bT*bb3^_g\^zQem_&}HBl0-\2Ujo+HKdi*sUc 'sY[u%YuS+)lz I'71!,܄~[sI>|O6G&<^q')&ETJ H|%SYI\[zQ<{y0: {\#rm(tLi>iUbD7cg$$;1@zְ'HVdgg- !uMPOcw?{ܕ/P,v&F_l$wj5 +IN]n[wL歚~J8Ec,'J'$>8W8;Zr7 q|V&]:_0jeyP&=]#-{L{ -2Ĉ}l%J+?@Ƚ36[7ҾͬD%E鵬NqS_07w̸&.4i?k{^h4wCEd}w 5㦗1ί(OZ%3ĺ$QLnȟF7Vq#")f4` ڦ}!DM{C/ ~PMK&pibI[CD{-"gb`bz6*mA<]JV#$#S &Ĕ; |/_%{ ntFNR9aZ7Ue 2RQƶ%LRY|3FXqׄtqМh`9C8 կ!E7~m] 37 Ԙ_;łw+V<vb,AjSf1^ s JQ4JbP ʺx&"ݠs&ޘve]zwHF Mø=8p! u4ƣ^.vHr'תpRwƁT{4F_( RVTM͉0vv-^[b_ٚHE2mcNҠ[}hNZ=,"|#mUaϓO$ZJV|Բ3L^.b#/\u \3 }wC O)3R ~l^S4*ePy-y[kj:eji|M4[ 324,*韢S0aTe=:yw+1!xLXQJ׸ ZKpg/E(בLo [ v014+uh(=y˹͗0 *HA6Cg!*5gLv;v'7&Xݜkc)u[y3t݉/j. (,$_(V$^/5"8" 4sw/GXKY C@N8E՜&?,o@/:w FՏۈ#o"OҞG#sFy˩{S_Q}y+ܪl%6sقjg]cЪ-+DO[0f>'[vvʻ94.JVw[qs}[=2mZ\UMQiJ f0{ݣьoV7kBJ V(9iRfOէ 2k/P QÉ1 < F%_$F(7ohA}ؗ>ڎ] uڼ <*۵P/$=< R0Cѿp 2;VJ4cWgҳGM+'Ad![Zl41q.{}XlW~|9jơ^ၬOm\5xS*2uh(rsadAlcòmX-UQo:ŐuP%&:PK4t/!!}?¾JO2EN nP-jo ?2Ĉ|O z1t S]>)O-lWY谼6T2~32҉"Ţ]PB\m!{{srg^7ja¸z8/CW;Gڌ |:˰ 0*!gq9Ifr(tFL {pxH19-̍ 2q!C esV0ul.g )L(E-`oYomfDTo&4E4g|uwm'j".4c] ц u"a.ҳ.!pvGνHӦj'{yRӛ?#Ç0Z $D#קOy>.aUo_ה>ݟcT%A"U;VfiH9R  }t}1QftQS T,}#;o%i`=buJw}'hHBxG*z#I}_^.f5|vn|Boʉ.oTzyh%9/eRܓVEVg2'h]ms*NLQM8ϋoOfI)*Mȿ*/0DkAǰpmBhHџe`ؤ oJE̎V\ߊne~˱K}!)#S.Q>Nyh䄓SL_t]nI>*ŗ;1W]!~>x: ¨u>u _(k:bmi}V`%'թ 1{7ڀ]P!'9129vOSR¢FqTU;ÆG ^8:1:Sb?a/ut8s 1\ zJȓ Qʀj u!96;Z`oeՑ4gjL(-Uۣk HV dH&di?~W{cN7wҿgC̪VǔEw5|~zD}-*5t[KϨϴϯsWIDbCK|ZeI]_n`Oc0tgw*]O.K J 酅t{fR@T?HQlrJU(ܤ,&q2>">ol:/JQF _2YͽI)i=8kGyQ-BaBkh9gxӋc҇2x,.BH$L]T(xCry/UK&Rĕ~__p%>4Dbp7 veɛ|r{rF37,5, u=o%l[2 Hpj_< 8Aaf?+I| ęE(${NLjY*߻kxj4RMv^ =Wp8 T'?Q)0 9SL%]'֕d&!-t^^ X:2ri/vG[h<ѿgM|vqENN$3cDrk8\vViܲb2k{=͡6dsة }ev."r^B%ӺIF ެ*iAtAVTQMYϮ .FFL oBEU.&2IZPEǓb,p9Eʹ[0!Qjpu2ϓ+WTKGǵF@*v~ɜu,I"O P39eQfn/ ?"(isoG,l,dbV)49^B{%=Aw/6.1%" P% %wc~]A7ch͒\H@ )d(9]6 4O,/l;U@~ޠ;{,ӥMd ucКMpבUl/_lDNۼibIc%\;#8zm[޼Cb3 2[n4SmV->/Λ(5ݽ5w"] endstream endobj 65 0 obj << /Length1 1554 /Length2 3050 /Length3 0 /Length 4028 /Filter /FlateDecode >> stream xڍt 4m>R1%,Ȗ}'kVc7L̘^DH%6[ٲ7J"kZvQ9w朙) k;.It(B [##!RR:iH9TLR#B bL $3?"Phu: pd:`'K%Li)}2%J3 bF:R X н@fG,ؑW YM/:1 %ML<$0t/TSc|MjJ)ދ@# " h?`EI?-~(J_6 H,C $OO =`H@ Ffc1"ƃqt `k` 7ѰTNSaec6$>> Nπ@̹6/כDf"<ïQ`GH_?`3iyt*+/`` )nfr )I %A$: 7 ']i?0Δ~sc* G&o\1QWa/9"(RY@!U /?oX1ͳ3%ɀ Ῡ ͥpT3+2H)*ȏH1p3f?:s3, 7Ζ _)]' 4#B&б^y D & E1W|Shp̍! Kƭ0T*&g B i0%LB< YR5UY7@j !2@edzL@$U`?Ad"6_Ա~T*UP's.? 5y$zHw/:ҊTj=;8l(&B_˜rN\nѸ/&˽!ԅޯފR iZY!G꜏+pB*l0u:v+ΌJ3֔(XiL٤NqۅTY^SWmVu*Qhϐ[sQ~l@1?tJ 7 #1_.A{nOlDdd8bdؤ y{IHyO%n =Td?ֲ՚G1az-yt2MfdZ_9.+GyOپŠr.Ogm9~v+d%af|l{ g˾q4$~i);7 ,_4yk(M޳F&q#| V s4 aN/9@\*yl JB̫g*θ锪Uԛ<9#')~&LQ|=ŕf<1HXd 9nN u>_UGP@;^2˼K޵HC'Uft뵎CEu#YשsQ+;Nd}Vw^Iѹ; rv B=\Bޑ唎>_܊PB8noa]1*Z΃bjvOFo㥅JRKi |Hy<*48K{.>ͨK[rN?oȒdKQ@K~>qGhJe45:Yl0Zią57.iYlvL2,bD F.4Y/qZ&ΕQC+|i}gYJ޲«]ĕ ?Y=<~5kK˅92q Jʥ-2vP'X׉ÏsQxt#%ENBVYm;{.ku{׹W`AYEp~XU9 `>b:nÅU=|qǢ-#%r-@0Unv'-zn wFe:=.ВV/N)i+;6M.>ܦ]{pJfHf]SOxKўNK/`4MWkbBE3AO`WʏՐm-*] ڼ@dԤz Uf#1Qj;ܫnjHz]D~{CPᝆ4@ ɓ*&#o>˕;*ԞU׷X<)8C>ͫ^ـqOkfx$ܹBR4{9gn2Oȷ7U'3 })ح gVP{첂;t /k%L:ߴdNI$4V칫%RM讗/@YMjMJj#yUi D!]A۳D;1[9O;FDUC}!]aK\ܫiSgҖFdN:9kx&Zl۳{/ʻF d SŖK*Jk܋A\H |ĝRe4{/o6\{q~ޞДħJL,B1y!5IE#䕵9pZ~jVN\`}"n;=Ͼrh .sZ)U[bBƴDq&te!hSؖD GPiHxIX7?PcZƞEPS͘(#r/x}>jޤ=hf+Q.]N>r Eu=7-+)t+P+߅|xE"9(v+ziwٔ4.ܶɲLsuʕ]3T"~5{oV8>|wtߥ19Sf%gXCǎt5mE xUHddWVQ`-Ȋ)~*_{[ e1xAZÉd`md.g;)n =dmE/)%}4ϯJtMNbʖ*>Pz)'j!gV}k,Ii[/C @4 jYxT9ͳ;afqg:Ct&F M]GD܄:0eK4d;%0 TrʛR<|ey>B?(+.d!5p , 5#hVqObZknɊ/y4Sc'/P v?Kv\[vql)yu((7ssזB]Whe 'կu}sR z;mABtp*u 5>;?+dto)Z 1ʄ].+fhsX#E7Z趰yf@ʡl_-FbcŎ" .>Y[< 僙}ZDTqoXެsQZ_|)շ=*R]y0K]ǙQM& [1_2!̜֑jpJi7geuڑaŗPgcl=m5+= ?M&]z􏿸$ endstream endobj 67 0 obj << /Length1 2489 /Length2 10850 /Length3 0 /Length 12278 /Filter /FlateDecode >> stream xڍTk6, - -]CCwwJt7H#"݈t# Z߷fv_~fhԵإ @9%Vpqrpq30h . Xi9&1T `K77/[@[P %C@dP '/-?_̖,naaAR@9b:2Z; B0BN"掮,l t T3@ghۂ\kA.@L]an`+  Ps6Vۀ Oow /gsKK9 X59e' `mh -`UnCup9; ˲`+i# uE] h k'kx} oVnN:`PQQfx@gҖwxm/'_Jb?'F>}\݁O#tnn ڀabv. O!l\_~3hrH)騾d/ v~;/ , JzfkX3, 3B` 0??%yrQoɹ98fKQ;1 *jT"@nUÖC loAr O:ji׸`@`:ssqmvTe`K{s [O+_s C0@RE#A##pr)x /S<"Xv,#e|D ZA<"0, 6ٿoHy`%Z`g`|Y[<" sK{ b }+{ U ÂYB`3 ocy`c9Wzg7>=fGj0? (ar@@XUv@X0Vk#}s=35,6?GX|'_F6 -8=8A@+?8qäGN]>y6@? {>[ K VcKjhad?`1vay0o? ,V`.W_5׏ h k }wS/E3Ç5| Uw[}O#XZ%oQ̲Tn̏ #V{=b.{u╦wH[lGnd97SBy?OEz+vk)(9ƶ|rQrk 4;cKW&uKbu?cJb$d hui,zT*KD1(m"}0!t>j ov Xޓp>WVNU|l:}_0jlA \ >[ҘL [!{bsHhNA: t̜8]')BD(UndIl2{٣t8s5ҋ-O|v[4z#Rv߆۵5j}~~5pJ!Î͉g .P+3:=[<6I$`~av룪rcntg(gi#EtbQO5gB~D(b$j(|%Oz\9 /cDf yn>4lPw)p'9 Ngh:H'5l@fx,RdZ#lYX"Eo<炙gBIcaWHR\`Yf\tX ? A3E{Ȩ~+5ɝ)Q+5C Ay+93y_lb% 'hl Gۏ ,Wa`BXdEfl֌Uԅ Oʦk& f} H왐tjͷu |7yvX'BD2Tf5ƻu:oW(2F 2ɍ@vW eP|qXhBRVSƒ,i`vwfCV;j>4[_jl"w~W3\cx!!@Cq|WP"gOճu\Λ=zɶ~~e03*}moR`ڲhy$2jj'q&;ʷD QD0&/1 `՗Ȉ /Fō_5/fgp?DXuQnt$.8[?!9@78gm2d*[=YJ3plCɳq~ =t =*B*'IQBo1x[;4a3u)}7!m%: DWwD4hmV|GF8tRZ _|i%Y3nO JZiHidnySb}+:ףּB^jD 1+'אּV:֙v NAih*C.-2HQ_,qݬ8Q\aZp "ZbrRMC[@mUY\և%KEd4V!݁jeTFXU{n_#)3x}xxWV4۝&xcyO5"cJ|22pVDVqT{6[XO߾M-.I(sMKS)so|̀и=,|#U-K1/$4B9Q]5p>IgyyCZk*S͠&" 4#giM%Ny{"j$sv.6()y0r 3t,l8Q!d:&b"AυķE_grw4&}nPho,t:oRaM KZvFwplj2K2cя!EM]yOk#'zXwz mHYɔBB~k,[EaJ:Nz~bX!ks(UOT|Dȃ߼|@ddoF=6^K~9CGky\4.{]q,[:?EO.&RH{+C}n'wUb+(\WXM/ޭOxeGd:{f l$h+7m/CGii٩䆪I(ed4qU_5|o^M_OQvԈ$'8MՑC|<E+>4 mz ;?:K|_ؤ5i,APO%ꋲչ. ŎfT[gzYo[F-OL8ד^ ~\giՊΧlF~9soӈArlq`a {ЄvZ;qTHr[ߩߙL.f[^z"DPy^=X93bV8{.<-yNANY*z 24^5Iڀ%Ǚ#H)s RD"K/h_>/W0_`9QY7XWu\^.7DmW.$HG},o1I`9 R&UPlack`3wajL&:eO'r.I&rza_- \U,2/"}QY! &]2'xhUJ'vym X.ql7:9RʂxX.E۽]fu'wcx$-|:t9Ifཔ}Ɍ0 fh9(aRn5wAG'm "zJqtk|ֱD}!Ⳝh.=-l53rZ1GU*A4biQ{E_J T?k&+X5 p,\-!t Cq]hG935} ^m YiEpMKee8`Dl*C//C-YB)a;~+EbO5}삘#woFZa"ژjuB= -i(VPZ<ze ۅ!w4 %+)qbQET_ͮr(Oe k-I|"%?JoÄ_i㦒ƕUPDLĹQqk .[5)iP${h$q8tS>kp`r0j\߾cc# j=*K WpNZRڟ)z WZ+GvKohT_ȓRrNfd[݃11~S9 n kh8 w/PI^+X("֩4ktn>;:+W}!-~EJY.3oɔfk@f8t]eψWC̪VJmbfKr`2)< -Lu•؆G)NLi2c:TpٜnhP$,ZM,; ڶH ^1qb/TjhO?"AwC/Kz[7J/]v]F&W zc-p]yfL|OCzYkNʱsRޢRvX>$,~lyԏ(Q7iϒ!{zþ^CCo!n5?/*[e1jxj@ ӵnCY+զDaṟ;aDߩ$B.n }hzZI;%DrtVfK%MG*8A(k'.c}kݾ|v6|C8:e|@:6 X`7'u$Ըj87e=n=JH߁lRh6 suڠ6܎Ur^daHV$vSQ.zJ&\٭n_Z)@^/u 㰦~Qh sUt׺#寯?V&ʂr9{?gO2"}͵;U˕6ʈ% kgF043 t-cFCjJ0^ɨ.q5S*+D:ɰ^ g05z VnAhWn2}v|xP 'xi!uC1O6sʣWn^ a* fNQ!, !>a9 2yw ;VK)?9.čN^ʒ3#1J'CBv|@ˊ@x-N*DFT{ icSn@dxMDT޴˵&LaH!֫fv_/uOqt;_ьI ~ĕ`-ox8Owt P/XFv@ =(,H -Hܩ%/.jAB&Q9p qA -}wvYT5)::;FaCs7ϼҾ]Eʢ8Ryqg0p#*ՠfy㮂&ezn#^(Z+Տs'%4)$qLb@aUH wwy{ mp08h azk|xph|F&-/۲Pv?Ｗa?s40O2TrDEx31Hk9Y<ރΓӐ=}ɣ dcz2zq[| Z M]dz^ӛ y/6IyV˩[x]jQٗ F E|C}B,˘+roٸUǜ7KX%_/K.F1DF X<[^] %' fV7tA_ZJ+E8@b\`yVn:"vzy)9J^ Vꓛ AGH6RqV~@z(lKP 2cC>( R Yo "ٿ Ԧe4 ~wFHX~b'.yRE_)=;6fɝB@by"WyQ!\OP Bg׹$DV啹߬G hL#7/}~j(eϕ[Cqm+΂="M]Pyj[byK:n@O4 IK=P|-r:k4hZ="QV־Y 0|8D9^$) ']o=jHWSq'NQچSĶ&lck.JLK/VR2'8o{>V츽*Z,A4RݖJ ]7}.ղKDQ(8h@1y1&#&PC˫SAA֑g Fi x_`ID Qsfs U.ql 0XOs5MM+ y~? I."oqJC&8^(txB7\Y1SaNWP.(v%_S{P󲰩 XBLuq*%w6#N:ljW~SVh:Gc:!bQ6^htrrč oI h &-Ҍ5+2m jP'9QA圌}cu)E&IN'(k"K(䀰z$)6Sl7LcR 򅊯E[R(<Q ?>@m}Yk&T/3/Q5Z>z8.n,ϩG*E[=1DXu7h&9*ölA9Gf +GL%fŊ>|RD/xWI7 v x%)&M~ j[R=, ~JDYv:(_OF9b-?C;o˺~QHqscpMզ^n* |T 1dqZIxtGdP"lGv>:WUQ= V#sY a>o,jS p)`VUn[+3Tba!z9"]QsӉ1!EBAp-tѡ$@F+LyF2LaIfͲ\T"1UFȱܿitNp30嚣$۱]Jk33Ʌ{+*|^jw7ZwP,`敌WRxT g'! ߆;9,*=%;r q6ܝz yP:vdit)::Re3{N_׭aL=Poaυ %q.J<9P sԚ:_Iи%W=3LnON@ f[+ŚE]k f!eacyTltMɀF ΍VpdCutGƄ:H qT~E%;Rk~>_h%B*j;ԽOwç 17CmRMK瞗7tW7bx0Kyhe;]sFbǗ,}]~="9h2|!!(Yq#(^3r-XOz 1sK@2a?E?MzftJ1 _L4J噅d\1D$T>*`lU[}g_NNI %>Z m0" KdʐSo8E;7bƽ9٭[E`}f|"o7 CK$JFjb-ܥ>=CI3Qacde1se:+Ӭ*+=qxw&TSDX69C56*^_cGڶ$ ? i֡ h)2ZI!tב!ӓƵ\dKޕL/Z}]t#dXnTLw:0q%F||ϪԖL+;*~N#@#Z 56?JaIVyiPq:FYv9[FhkD\(`'W^bJzT,K!(''Ipk9$>rvǤA$`Ӄ-_imTYtIRO=8ltWa)o3u =aӯ:.+JeV޿4yr4(v7&+W҃xn9YݲvXQ, B:JdINIq5r endstream endobj 75 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.14)/Keywords() /CreationDate (D:20140913071448+02'00') /ModDate (D:20140913071448+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.5-1.40.14 (TeX Live 2013/Debian) kpathsea version 6.1.1) >> endobj 2 0 obj << /Type /ObjStm /N 60 /First 448 /Length 2466 /Filter /FlateDecode >> stream xZ[Sۺ~ϯc3<3lZZڲއ7qOCBc-IlCΙ".ZZKKa*aiR  $ xh&|ʄaR T)#z 8bf9Ȑ5Sy㘲,T,hyqNX4 ]&)L`(1SA2)I;& Ez'{A;LtbR3Kj 3 R11a faHz2RϠ&% ,N{(91I b^K%;Mz3=ɼ*=% \IfDZvCI΃&d-/uSkQF·2FCySEuO\@ +.)بm`6wv?/+ȵ*хys/xUrxTI_"րv-p5q]v_pL Lu+{w;Ѫ GdcS)OyB&OPhC/gJ!c)㐓$stкcK>D\#T?e$fUkR) 9֘u[Wf0ԗu{4xS4˒e @YgЦu_୥ck5|isJWvk z{SQ´#JLQiz,1"(JT_WzR4ӻ8C@V_Ȗ4?aH+*ںAѐ<û̂Ad]R;Ҕ7PyGt:EaHr~uS p"$սJ"y @ J~+DiіRCF?Xjz[^O=+oIǵyWTa,"28z"D z=(T@0q1&-Zr1E ڒb{ǝ[ݩ2b)h@䤁K-EZL!|)Ib ڪEb24eM"x#> c 'tc}9F[H,1;'Ұ{5a%BB.S)= zxBJ%넂YX|aϊ=X6eehUH@]ILH粝̊j:WF^='/lbxbXu( v ]hSP>ΟMoqPCA{U6.ۓ8gIU[pk&l@q 7<>9R?OO'9?3^W<)˭8j\oCH@'mm;`+Ѵg@9!?@T>t<<;Fd h8N~rL,Kk3?gt .;?O3M[M0.@nB 7n->)+V8]\Em_ttTT@wFǬAǨ&:I@P!@((-Ml;{u ێ%V8Xd 2KmwHY9(sT+<_*$I]it<+]+N9"0"ϖ ]1N ;oVjoo~$m6viK[閛뾺vˮz[.:ʯěNZJ=Dw_ ԭQn=vtpMԯYJ;94aWxQ }} ]ws3z^ ] /Length 208 /Filter /FlateDecode >> stream x9NQs~@eyr.eXCBgcm؅% #include "tnt/subscript.h" #include "tnt/tnt.h" #include "tnt/vec.h" #include "tnt/fmat.h" #include "tnt/region1d.h" #include "tnt/region2d.h" #include "tnt/transv.h" #include "tnt/lu.h" namespace TNT { typedef Vector DVector; typedef Vector IVector; typedef Fortran_Matrix DMatrix; template inline T fmin(T a, T b) { return (a < b ? a : b); } template inline T fmax(T a, T b) { return (a > b ? a : b); } //typedef Region1D subDVector; //typedef Region2D subDMatrix; //matrix operation on Region2D; template Fortran_Matrix operator+(const_Region2D > &A, const_Region2D > &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Fortran_Matrix ans(M, N); for (Subscript i = 1; i <= M; i++) for (Subscript j = 1; j <= N; j++) ans(i, j) = A(i, j) + B(i, j); return ans; } template Fortran_Matrix operator+(const Region2D > &A, const Region2D > &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Fortran_Matrix ans(M, N); for (Subscript i = 1; i <= M; i++) for (Subscript j = 1; j <= N; j++) ans(i, j) = A(i, j) + B(i, j); return ans; } template Fortran_Matrix operator-(const_Region2D > &A, const_Region2D > &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Fortran_Matrix ans(M, N); for (Subscript i = 1; i <= M; i++) for (Subscript j = 1; j <= N; j++) ans(i, j) = A(i, j) - B(i, j); return ans; } template Fortran_Matrix operator-(const Region2D > &A, const Region2D > &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Fortran_Matrix ans(M, N); for (Subscript i = 1; i <= M; i++) for (Subscript j = 1; j <= N; j++) ans(i, j) = A(i, j) - B(i, j); return ans; } template Fortran_Matrix mult_element(const Region2D > &A, const Region2D > &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Fortran_Matrix tmp(M,N); Subscript i,j; for (i=1; i<=M; i++) for (j=1; j<=N; j++) tmp(i,j) = A(i,j) * B(i,j); return tmp; } template Fortran_Matrix transpose(const Region2D > &A) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); Fortran_Matrix S(N,M); Subscript i, j; for (i=1; i<=M; i++) for (j=1; j<=N; j++) S(j,i) = A(i,j); return S; } template inline Fortran_Matrix matmult(const Region2D > &A, const Region2D > &B) { #ifdef TNT_BOUNDS_CHECK assert(A.num_cols() == B.num_rows()); #endif Subscript M = A.num_rows(); Subscript N = A.num_cols(); Subscript K = B.num_cols(); Fortran_Matrix tmp(M,K); T sum; for (Subscript i=1; i<=M; i++) for (Subscript k=1; k<=K; k++) { sum = 0; for (Subscript j=1; j<=N; j++) sum = sum + A(i,j) * B(j,k); tmp(i,k) = sum; } return tmp; } template inline Fortran_Matrix operator*(const Region2D > &A, const Region2D > &B) { return matmult(A,B); } template inline int matmult(Fortran_Matrix& C, const Region2D >&A, const Region2D >&B) { assert(A.num_cols() == B.num_rows()); Subscript M = A.num_rows(); Subscript N = A.num_cols(); Subscript K = B.num_cols(); C.newsize(M,K); // adjust shape of C, if necessary T sum; const T* row_i; const T* col_k; for (Subscript i=1; i<=M; i++) { for (Subscript k=1; k<=K; k++) { row_i = &A(i,1); col_k = &B(1,k); sum = 0; for (Subscript j=1; j<=N; j++) { sum += *row_i * *col_k; row_i += M; col_k ++; } C(i,k) = sum; } } return 0; } template Vector matmult(const Region2D > &A, const Vector &x) { #ifdef TNT_BOUNDS_CHECK assert(A.num_cols() == x.dim()); #endif Subscript M = A.num_rows(); Subscript N = A.num_cols(); Vector tmp(M); T sum; for (Subscript i=1; i<=M; i++) { sum = 0; for (Subscript j=1; j<=N; j++) sum = sum + A(i,j) * x(j); tmp(i) = sum; } return tmp; } template inline Vector operator*(const Region2D > &A, const Vector &x) { return matmult(A,x); } template inline Fortran_Matrix operator*(const Region2D > &A, const T &x) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); Subscript MN = M*N; Fortran_Matrix res(M,N); const T* a = A.begin(); T* t = res.begin(); T* tend = res.end(); for (t=res.begin(); t < tend; t++, a++) *t = *a * x; return res; } //convert Region2D to matrix or vector template Fortran_Matrix asMat(const Region2D > &A) { Subscript m = A.num_rows(), n = A.num_cols(); Fortran_Matrix ans(m, n); for (Subscript i = 1; i <= m; i++) for (Subscript j = 1; j <= n; j++) ans(i, j) = A(i, j); return ans; } template Fortran_Matrix asMat(const_Region2D > &A) { Subscript m = A.num_rows(), n = A.num_cols(); Fortran_Matrix ans(m, n); for (Subscript i = 1; i <= m; i++) for (Subscript j = 1; j <= n; j++) ans(i, j) = A(i, j); return ans; } template Vector asVec(const Region2D > &A) { // A is 1 row or 1 col Subscript m = A.num_rows(), n = A.num_cols(); if (m == 1) { Vector ans(n); for (Subscript i = 1; i <= n; i++) ans(i) = A(1,i); return ans; } else { Vector ans(m); for (Subscript i = 1; i <= m; i++) ans(i) = A(i,1); return ans; } } template Vector asVec(const_Region2D > A) { // A is 1 row or 1 col Subscript m = A.num_rows(), n = A.num_cols(); if (m == 1) { Vector ans(n); for (Subscript i = 1; i <= n; i++) ans(i) = A(1,i); return ans; } else { Vector ans(m); for (Subscript i = 1; i <= m; i++) ans(i) = A(i,1); return ans; } } //convert vector to matrix template Fortran_Matrix asRowMat(const Vector &v) { Subscript n = v.size(); Fortran_Matrix ans(1,n); for (Subscript i = 1; i <= n; i++) ans(1,i) = v(i); return ans; } template Fortran_Matrix asColMat(const Vector &v) { Subscript n = v.size(); Fortran_Matrix ans(n,1); for (Subscript i = 1; i <= n; i++) ans(i,1) = v(i); return ans; } //scalar multiplication template inline Vector operator*(const Vector &v, const T &x) { Subscript m = v.size(); Vector ans(m); for (Subscript i = 1; i <= m; i++) ans(i) = v(i) * x; return ans; } template inline Vector operator*(const T &x, const Vector &v) { return v * x; } template inline Fortran_Matrix operator*(const T &x, const Fortran_Matrix &A) { Fortran_Matrix ans = A * x; return ans; } // utilities: template Region2D > MatSubs(Fortran_Matrix &x, const Index1D &I, const Index1D &J) { return x(I, J); } template Region2D > MatRow(Fortran_Matrix &x, int i) { int n = x.num_cols(); Index1D I(i,i), J(1,n); return x(I,J); } template Region2D > MatCol(Fortran_Matrix &x, int i) { int m = x.num_rows(); Index1D I(1,m), J(i,i); return x(I,J); } template Region2D > MatRows(Fortran_Matrix &x, const Index1D &I) { int n = x.num_cols(); Index1D J(1,n); return x(I,J); } template Region2D > MatCols(Fortran_Matrix &x, const Index1D &J) { int m = x.num_rows(); Index1D I(1,m); return x(I,J); } template Region1D > VecSubs(Vector &x, const Index1D &I) { return Region1D >(x, I); } template Vector asVec(const Region1D > &x) { Vector ans(x.dim()); for (int i = 1; i <= ans.size(); i++) ans(i) = x(i); return ans; } // transp(A) * inv(B) * C template Fortran_Matrix matmult( const Transpose_View & A, const Fortran_Matrix &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(B.num_rows() == N); Subscript L = B.num_cols(); Fortran_Matrix x(M,L); Subscript i, j, k; T tmp = 0; for (i=1; i<=M; i++) { for (j=1; j<=L; j++) { tmp = 0; for (k = 1; k <= N; k++) tmp += A(i,k) * B(k,j); x(i,j) = tmp; } } return x; } template Fortran_Matrix matmult( const Fortran_Matrix & A, const Transpose_View &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(B.num_rows() == N); Subscript L = B.num_cols(); Fortran_Matrix x(M,L); Subscript i, j, k; T tmp = 0; for (i=1; i<=M; i++) { for (j=1; j<=L; j++) { tmp = 0; for (k = 1; k <= N; k++) tmp += A(i,k) * B(k,j); x(i,j) = tmp; } } return x; } template inline Fortran_Matrix operator*(const Transpose_View & A, const Fortran_Matrix &B) { return matmult(A,B); } template inline Fortran_Matrix operator*(const Fortran_Matrix & A, const Transpose_View &B) { return matmult(A,B); } //crossprod template Fortran_Matrix crossprod(const Fortran_Matrix &B) { return matmult(Transpose_View >(B), B); } //outerprod template Fortran_Matrix outerprod(const Vector &v) { int n = v.size(); Fortran_Matrix ans(n,n); for (int i = 1; i <= n; i++) for (int j = 1; j <= n; j++) ans(i,j) = v(i) * v(j); return ans; } template Fortran_Matrix outerprod(const Vector &v1, const Vector &v2) { int m = v1.size(), n = v2.size(); Fortran_Matrix ans(m,n); for (int i = 1; i <= m; i++) for (int j = 1; j <= n; j++) ans(i,j) = v1(i) * v2(j); return ans; } template T fmax(const Vector & v) { T ans = v(1); for (int i = 1; i <= v.dim(); i++) if (ans < v(i)) ans = v(i); return ans; } template T fmin(const Vector & v) { T ans = v(1); for (int i = 1; i <= v.dim(); i++) if (ans > v(i)) ans = v(i); return ans; } template T fmax(const Fortran_Matrix &m) { T ans = m(1, 1); for (int i = 1; i <= m.dim(1); i++) for (int j = 1; j <= m.dim(2); j++) if (ans < m(i, j)) ans = m(i, j); return ans; } template T fmin(const Fortran_Matrix &m) { T ans = m(1, 1); for (int i = 1; i <= m.dim(1); i++) for (int j = 1; j <= m.dim(2); j++) if (ans > m(i, j)) ans = m(i, j); return ans; } template T sum(const Vector &v) { T ans = 0; for (int i = 1; i <= v.dim(); i++) ans += v(i); return ans; } template T sum(const Fortran_Matrix &m) { T ans = 0; for (int i = 1; i <= m.dim(1); i++) for (int j = 1; j <= m.dim(2); j++) ans += m(i, j); return ans; } } //namespace TNT #endif //TNTSUPP_H geepack/inst/include/tnt/0000755000177400001440000000000012404310560015243 5ustar murdochusersgeepack/inst/include/tnt/region2d.h0000754000177400001440000003436307752031670017154 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // 2D Regions for arrays and matrices #ifndef REGION2D_H #define REGION2D_H #include "tnt/index.h" #include #include namespace TNT { template class const_Region2D; template class Region2D { protected: Array2D & A_; Subscript offset_[2]; // 0-offset internally Subscript dim_[2]; public: typedef typename Array2D::value_type T; typedef Subscript size_type; typedef T value_type; typedef T element_type; typedef T* pointer; typedef T* iterator; typedef T& reference; typedef const T* const_iterator; typedef const T& const_reference; Array2D & array() { return A_; } const Array2D & array() const { return A_; } Subscript lbound() const { return A_.lbound(); } Subscript num_rows() const { return dim_[0]; } Subscript num_cols() const { return dim_[1]; } Subscript offset(Subscript i) const // 1-offset { #ifdef TNT_BOUNDS_CHECK assert( A_.lbound() <= i); assert( i<= dim_[0] + A_.lbound()-1); #endif return offset_[i-A_.lbound()]; } Subscript dim(Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert( A_.lbound() <= i); assert( i<= dim_[0] + A_.lbound()-1); #endif return dim_[i-A_.lbound()]; } Region2D(Array2D &A, Subscript i1, Subscript i2, Subscript j1, Subscript j2) : A_(A) { #ifdef TNT_BOUNDS_CHECK assert( i1 <= i2 ); assert( j1 <= j2); assert( A.lbound() <= i1); assert( i2<= A.dim(A.lbound()) + A.lbound()-1); assert( A.lbound() <= j1); assert( j2<= A.dim(A.lbound()+1) + A.lbound()-1 ); #endif offset_[0] = i1-A.lbound(); offset_[1] = j1-A.lbound(); dim_[0] = i2-i1+1; dim_[1] = j2-j1+1; } Region2D(Array2D &A, const Index1D &I, const Index1D &J) : A_(A) { #ifdef TNT_BOUNDS_CHECK assert( I.lbound() <= I.ubound() ); assert( J.lbound() <= J.ubound() ); assert( A.lbound() <= I.lbound()); assert( I.ubound()<= A.dim(A.lbound()) + A.lbound()-1); assert( A.lbound() <= J.lbound()); assert( J.ubound() <= A.dim(A.lbound()+1) + A.lbound()-1 ); #endif offset_[0] = I.lbound()-A.lbound(); offset_[1] = J.lbound()-A.lbound(); dim_[0] = I.ubound() - I.lbound() + 1; dim_[1] = J.ubound() - J.lbound() + 1; } Region2D(Region2D &A, Subscript i1, Subscript i2, Subscript j1, Subscript j2) : A_(A.A_) { #ifdef TNT_BOUNDS_CHECK assert( i1 <= i2 ); assert( j1 <= j2); assert( A.lbound() <= i1); assert( i2<= A.dim(A.lbound()) + A.lbound()-1); assert( A.lbound() <= j1); assert( j2<= A.dim(A.lbound()+1) + A.lbound()-1 ); #endif offset_[0] = (i1 - A.lbound()) + A.offset_[0]; offset_[1] = (j1 - A.lbound()) + A.offset_[1]; dim_[0] = i2-i1 + 1; dim_[1] = j2-j1+1; } Region2D operator()(Subscript i1, Subscript i2, Subscript j1, Subscript j2) { #ifdef TNT_BOUNDS_CHECK assert( i1 <= i2 ); assert( j1 <= j2); assert( A_.lbound() <= i1); assert( i2<= dim_[0] + A_.lbound()-1); assert( A_.lbound() <= j1); assert( j2<= dim_[1] + A_.lbound()-1 ); #endif return Region2D(A_, i1+offset_[0], offset_[0] + i2, j1+offset_[1], offset_[1] + j2); } Region2D operator()(const Index1D &I, const Index1D &J) { #ifdef TNT_BOUNDS_CHECK assert( I.lbound() <= I.ubound() ); assert( J.lbound() <= J.ubound() ); assert( A_.lbound() <= I.lbound()); assert( I.ubound()<= dim_[0] + A_.lbound()-1); assert( A_.lbound() <= J.lbound()); assert( J.ubound() <= dim_[1] + A_.lbound()-1 ); #endif return Region2D(A_, I.lbound()+offset_[0], offset_[0] + I.ubound(), offset_[1]+J.lbound(), offset_[1] + J.ubound()); } inline T & operator()(Subscript i, Subscript j) { #ifdef TNT_BOUNDS_CHECK assert( A_.lbound() <= i); assert( i<= dim_[0] + A_.lbound()-1); assert( A_.lbound() <= j); assert( j<= dim_[1] + A_.lbound()-1 ); #endif return A_(i+offset_[0], j+offset_[1]); } inline const T & operator() (Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert( A_.lbound() <= i); assert( i<= dim_[0] + A_.lbound()-1); assert( A_.lbound() <= j); assert( j<= dim_[1] + A_.lbound()-1 ); #endif return A_(i+offset_[0], j+offset_[1]); } Region2D & operator=(const Region2D &R) { Subscript M = num_rows(); Subscript N = num_cols(); // make sure both sides conform assert(M == R.num_rows()); assert(N == R.num_cols()); Subscript start = R.lbound(); Subscript Mend = start + M - 1; Subscript Nend = start + N - 1; for (Subscript i=start; i<=Mend; i++) for (Subscript j=start; j<=Nend; j++) (*this)(i,j) = R(i,j); return *this; } Region2D & operator=(const const_Region2D &R) { Subscript M = num_rows(); Subscript N = num_cols(); // make sure both sides conform assert(M == R.num_rows()); assert(N == R.num_cols()); Subscript start = R.lbound(); Subscript Mend = start + M - 1; Subscript Nend = start + N - 1; for (Subscript i=start; i<=Mend; i++) for (Subscript j=start; j<=Nend; j++) (*this)(i,j) = R(i,j); return *this; } Region2D & operator=(const Array2D &R) { Subscript M = num_rows(); Subscript N = num_cols(); // make sure both sides conform assert(M == R.num_rows()); assert(N == R.num_cols()); Subscript start = R.lbound(); Subscript Mend = start + M - 1; Subscript Nend = start + N - 1; for (Subscript i=start; i<=Mend; i++) for (Subscript j=start; j<=Nend; j++) (*this)(i,j) = R(i,j); return *this; } Region2D & operator=(const T &scalar) { Subscript start = lbound(); Subscript Mend = lbound() + num_rows() - 1; Subscript Nend = lbound() + num_cols() - 1; for (Subscript i=start; i<=Mend; i++) for (Subscript j=start; j<=Nend; j++) (*this)(i,j) = scalar; return *this; } }; //************************ template class const_Region2D { protected: const Array2D & A_; Subscript offset_[2]; // 0-offset internally Subscript dim_[2]; public: typedef typename Array2D::value_type T; typedef T value_type; typedef T element_type; typedef const T* const_iterator; typedef const T& const_reference; const Array2D & array() const { return A_; } Subscript lbound() const { return A_.lbound(); } Subscript num_rows() const { return dim_[0]; } Subscript num_cols() const { return dim_[1]; } Subscript offset(Subscript i) const // 1-offset { #ifdef TNT_BOUNDS_CHECK assert( TNT_BASE_OFFSET <= i); assert( i<= dim_[0] + TNT_BASE_OFFSET-1); #endif return offset_[i-TNT_BASE_OFFSET]; } Subscript dim(Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert( TNT_BASE_OFFSET <= i); assert( i<= dim_[0] + TNT_BASE_OFFSET-1); #endif return dim_[i-TNT_BASE_OFFSET]; } const_Region2D(const Array2D &A, Subscript i1, Subscript i2, Subscript j1, Subscript j2) : A_(A) { #ifdef TNT_BOUNDS_CHECK assert( i1 <= i2 ); assert( j1 <= j2); assert( TNT_BASE_OFFSET <= i1); assert( i2<= A.dim(TNT_BASE_OFFSET) + TNT_BASE_OFFSET-1); assert( TNT_BASE_OFFSET <= j1); assert( j2<= A.dim(TNT_BASE_OFFSET+1) + TNT_BASE_OFFSET-1 ); #endif offset_[0] = i1-TNT_BASE_OFFSET; offset_[1] = j1-TNT_BASE_OFFSET; dim_[0] = i2-i1+1; dim_[1] = j2-j1+1; } const_Region2D(const Array2D &A, const Index1D &I, const Index1D &J) : A_(A) { #ifdef TNT_BOUNDS_CHECK assert( I.lbound() <= I.ubound() ); assert( J.lbound() <= J.ubound() ); assert( TNT_BASE_OFFSET <= I.lbound()); assert( I.ubound()<= A.dim(TNT_BASE_OFFSET) + TNT_BASE_OFFSET-1); assert( TNT_BASE_OFFSET <= J.lbound()); assert( J.ubound() <= A.dim(TNT_BASE_OFFSET+1) + TNT_BASE_OFFSET-1 ); #endif offset_[0] = I.lbound()-TNT_BASE_OFFSET; offset_[1] = J.lbound()-TNT_BASE_OFFSET; dim_[0] = I.ubound() - I.lbound() + 1; dim_[1] = J.ubound() - J.lbound() + 1; } const_Region2D(const_Region2D &A, Subscript i1, Subscript i2, Subscript j1, Subscript j2) : A_(A.A_) { #ifdef TNT_BOUNDS_CHECK assert( i1 <= i2 ); assert( j1 <= j2); assert( TNT_BASE_OFFSET <= i1); assert( i2<= A.dim(TNT_BASE_OFFSET) + TNT_BASE_OFFSET-1); assert( TNT_BASE_OFFSET <= j1); assert( j2<= A.dim(TNT_BASE_OFFSET+1) + TNT_BASE_OFFSET-1 ); #endif offset_[0] = (i1 - TNT_BASE_OFFSET) + A.offset_[0]; offset_[1] = (j1 - TNT_BASE_OFFSET) + A.offset_[1]; dim_[0] = i2-i1 + 1; dim_[1] = j2-j1+1; } const_Region2D operator()(Subscript i1, Subscript i2, Subscript j1, Subscript j2) { #ifdef TNT_BOUNDS_CHECK assert( i1 <= i2 ); assert( j1 <= j2); assert( TNT_BASE_OFFSET <= i1); assert( i2<= dim_[0] + TNT_BASE_OFFSET-1); assert( TNT_BASE_OFFSET <= j1); assert( j2<= dim_[0] + TNT_BASE_OFFSET-1 ); #endif return const_Region2D(A_, i1+offset_[0], offset_[0] + i2, j1+offset_[1], offset_[1] + j2); } const_Region2D operator()(const Index1D &I, const Index1D &J) { #ifdef TNT_BOUNDS_CHECK assert( I.lbound() <= I.ubound() ); assert( J.lbound() <= J.ubound() ); assert( TNT_BASE_OFFSET <= I.lbound()); assert( I.ubound()<= dim_[0] + TNT_BASE_OFFSET-1); assert( TNT_BASE_OFFSET <= J.lbound()); assert( J.ubound() <= dim_[1] + TNT_BASE_OFFSET-1 ); #endif return const_Region2D(A_, I.lbound()+offset_[0], offset_[0] + I.ubound(), offset_[1]+J.lbound(), offset_[1] + J.ubound()); } inline const T & operator() (Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert( TNT_BASE_OFFSET <= i); assert( i<= dim_[0] + TNT_BASE_OFFSET-1); assert( TNT_BASE_OFFSET <= j); assert( j<= dim_[1] + TNT_BASE_OFFSET-1 ); #endif return A_(i+offset_[0], j+offset_[1]); } }; // ************** std::ostream algorithms ******************************* template std::ostream& operator<<(std::ostream &s, const const_Region2D &A) { Subscript start = A.lbound(); Subscript Mend=A.lbound()+ A.num_rows() - 1; Subscript Nend=A.lbound() + A.num_cols() - 1; s << A.num_rows() << " " << A.num_cols() << "\n"; for (Subscript i=start; i<=Mend; i++) { for (Subscript j=start; j<=Nend; j++) { s << A(i,j) << " "; } s << "\n"; } return s; } template std::ostream& operator<<(std::ostream &s, const Region2D &A) { Subscript start = A.lbound(); Subscript Mend=A.lbound()+ A.num_rows() - 1; Subscript Nend=A.lbound() + A.num_cols() - 1; s << A.num_rows() << " " << A.num_cols() << "\n"; for (Subscript i=start; i<=Mend; i++) { for (Subscript j=start; j<=Nend; j++) { s << A(i,j) << " "; } s << "\n"; } return s; } } // namespace TNT #endif // REGION2D_H geepack/inst/include/tnt/lapack.h0000754000177400001440000001176407752031670016676 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // Header file for Fortran Lapack #ifndef LAPACK_H #define LAPACK_H // This file incomplete and included here to only demonstrate the // basic framework for linking with the Fortran Lapack routines. #include "tnt/fortran.h" #include "tnt/vec.h" #include "tnt/fmat.h" #define F77_DGESV dgesv_ #define F77_DGELS dgels_ #define F77_DSYEV dsyev_ #define F77_DGEEV dgeev_ extern "C" { // linear equations (general) using LU factorizaiton // void F77_DGESV(cfi_ N, cfi_ nrhs, fda_ A, cfi_ lda, fia_ ipiv, fda_ b, cfi_ ldb, fi_ info); // solve linear least squares using QR or LU factorization // void F77_DGELS(cfch_ trans, cfi_ M, cfi_ N, cfi_ nrhs, fda_ A, cfi_ lda, fda_ B, cfi_ ldb, fda_ work, cfi_ lwork, fi_ info); // solve symmetric eigenvalues // void F77_DSYEV( cfch_ jobz, cfch_ uplo, cfi_ N, fda_ A, cfi_ lda, fda_ W, fda_ work, cfi_ lwork, fi_ info); // solve unsymmetric eigenvalues // void F77_DGEEV(cfch_ jobvl, cfch_ jobvr, cfi_ N, fda_ A, cfi_ lda, fda_ wr, fda_ wi, fda_ vl, cfi_ ldvl, fda_ vr, cfi_ ldvr, fda_ work, cfi_ lwork, fi_ info); } // solve linear equations using LU factorization using namespace TNT; Vector Lapack_LU_linear_solve(const Fortran_Matrix &A, const Vector &b) { const Fortran_integer one=1; Subscript M=A.num_rows(); Subscript N=A.num_cols(); Fortran_Matrix Tmp(A); Vector x(b); Vector index(M); Fortran_integer info = 0; F77_DGESV(&N, &one, &Tmp(1,1), &M, &index(1), &x(1), &M, &info); if (info != 0) return Vector(0); else return x; } // solve linear least squares problem using QR factorization // Vector Lapack_LLS_QR_linear_solve(const Fortran_Matrix &A, const Vector &b) { const Fortran_integer one=1; Subscript M=A.num_rows(); Subscript N=A.num_cols(); Fortran_Matrix Tmp(A); Vector x(b); Fortran_integer info = 0; char transp = 'N'; Fortran_integer lwork = 5 * (M+N); // temporary work space Vector work(lwork); F77_DGELS(&transp, &M, &N, &one, &Tmp(1,1), &M, &x(1), &M, &work(1), &lwork, &info); if (info != 0) return Vector(0); else return x; } // *********************** Eigenvalue problems ******************* // solve symmetric eigenvalue problem (eigenvalues only) // Vector Upper_symmetric_eigenvalue_solve(const Fortran_Matrix &A) { char jobz = 'N'; char uplo = 'U'; Subscript N = A.num_rows(); assert(N == A.num_cols()); Vector eigvals(N); Fortran_integer worksize = 3*N; Fortran_integer info = 0; Vector work(worksize); Fortran_Matrix Tmp = A; F77_DSYEV(&jobz, &uplo, &N, &Tmp(1,1), &N, eigvals.begin(), work.begin(), &worksize, &info); if (info != 0) return Vector(); else return eigvals; } // solve unsymmetric eigenvalue problems // int eigenvalue_solve(const Fortran_Matrix &A, Vector &wr, Vector &wi) { char jobvl = 'N'; char jobvr = 'N'; Fortran_integer N = A.num_rows(); assert(N == A.num_cols()); if (N<1) return 1; Fortran_Matrix vl(1,N); /* should be NxN ? **** */ Fortran_Matrix vr(1,N); Fortran_integer one = 1; Fortran_integer worksize = 5*N; Fortran_integer info = 0; Vector work(worksize, 0.0); Fortran_Matrix Tmp = A; wr.newsize(N); wi.newsize(N); // void F77_DGEEV(cfch_ jobvl, cfch_ jobvr, cfi_ N, fda_ A, cfi_ lda, // fda_ wr, fda_ wi, fda_ vl, cfi_ ldvl, fda_ vr, // cfi_ ldvr, fda_ work, cfi_ lwork, fi_ info); F77_DGEEV(&jobvl, &jobvr, &N, &Tmp(1,1), &N, &(wr(1)), &(wi(1)), &(vl(1,1)), &one, &(vr(1,1)), &one, &(work(1)), &worksize, &info); return (info==0 ? 0: 1); } #endif // LAPACK_H geepack/inst/include/tnt/trisolve.h0000754000177400001440000000760207752031670017306 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // Triangular Solves #ifndef TRISLV_H #define TRISLV_H #include "triang.h" namespace TNT { template VecToR Lower_triangular_solve(const MaTriX &A, const VecToR &b) { Subscript N = A.num_rows(); // make sure matrix sizes agree; A must be square assert(A.num_cols() == N); assert(b.dim() == N); VecToR x(N); Subscript i; for (i=1; i<=N; i++) { typename MaTriX::element_type tmp=0; for (Subscript j=1; j VecToR Unit_lower_triangular_solve(const MaTriX &A, const VecToR &b) { Subscript N = A.num_rows(); // make sure matrix sizes agree; A must be square assert(A.num_cols() == N); assert(b.dim() == N); VecToR x(N); Subscript i; for (i=1; i<=N; i++) { typename MaTriX::element_type tmp=0; for (Subscript j=1; j VecToR linear_solve(const LowerTriangularView &A, const VecToR &b) { return Lower_triangular_solve(A, b); } template VecToR linear_solve(const UnitLowerTriangularView &A, const VecToR &b) { return Unit_lower_triangular_solve(A, b); } //********************** Upper triangular section **************** template VecToR Upper_triangular_solve(const MaTriX &A, const VecToR &b) { Subscript N = A.num_rows(); // make sure matrix sizes agree; A must be square assert(A.num_cols() == N); assert(b.dim() == N); VecToR x(N); Subscript i; for (i=N; i>=1; i--) { typename MaTriX::element_type tmp=0; for (Subscript j=i+1; j<=N; j++) tmp = tmp + A(i,j)*x(j); x(i) = (b(i) - tmp)/ A(i,i); } return x; } template VecToR Unit_upper_triangular_solve(const MaTriX &A, const VecToR &b) { Subscript N = A.num_rows(); // make sure matrix sizes agree; A must be square assert(A.num_cols() == N); assert(b.dim() == N); VecToR x(N); Subscript i; for (i=N; i>=1; i--) { typename MaTriX::element_type tmp=0; for (Subscript j=i+1; j VecToR linear_solve(const UpperTriangularView &A, const VecToR &b) { return Upper_triangular_solve(A, b); } template VecToR linear_solve(const UnitUpperTriangularView &A, const VecToR &b) { return Unit_upper_triangular_solve(A, b); } } // namespace TNT #endif // TRISLV_H geepack/inst/include/tnt/tnt.h0000754000177400001440000000612507752031670016243 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ #ifndef TNT_H #define TNT_H //--------------------------------------------------------------------- // tnt.h TNT general header file. Defines default types // and conventions. //--------------------------------------------------------------------- //--------------------------------------------------------------------- // Include current version //--------------------------------------------------------------------- #include "tnt/version.h" //--------------------------------------------------------------------- // Define the data type used for matrix and vector Subscripts. // This will default to "int", but it can be overriden at compile time, // e.g. // // g++ -DTNT_SUBSCRIPT_TYPE='unsinged long' ... // // See subscript.h for details. //--------------------------------------------------------------------- #include "tnt/subscript.h" //--------------------------------------------------------------------- // Define this macro if you want TNT to ensure all refernces // are within the bounds of the array. This encurs a run-time // overhead, of course, but is recommended while developing // code. It can be turned off for production runs. // // #define TNT_BOUNDS_CHECK //--------------------------------------------------------------------- // #define TNT_BOUNDS_CHECK #ifdef TNT_NO_BOUNDS_CHECK #undef TNT_BOUNDS_CHECK #endif //--------------------------------------------------------------------- // Define this macro if you want to utilize matrix and vector // regions. This is typically on, but you can save some // compilation time by turning it off. If you do this and // attempt to use regions you will get an error message. // // #define TNT_USE_REGIONS //--------------------------------------------------------------------- // #define TNT_USE_REGIONS //--------------------------------------------------------------------- // //--------------------------------------------------------------------- // if your system doesn't have abs() min(), and max() uncoment the following //--------------------------------------------------------------------- // // //#define __NEED_ABS_MIN_MAX_ #include "tnt/tntmath.h" #endif // TNT_H geepack/inst/include/tnt/transv.h0000754000177400001440000000737607752031670016764 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // Matrix Transpose Views #ifndef TRANSV_H #define TRANSV_H #include #include #include "tnt/vec.h" namespace TNT { template class Transpose_View { protected: const Array2D & A_; public: typedef typename Array2D::element_type T; typedef T value_type; typedef T element_type; typedef T* pointer; typedef T* iterator; typedef T& reference; typedef const T* const_iterator; typedef const T& const_reference; const Array2D & array() const { return A_; } Subscript num_rows() const { return A_.num_cols();} Subscript num_cols() const { return A_.num_rows();} Subscript lbound() const { return A_.lbound(); } Subscript dim(Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert( A_.lbound() <= i); assert( i<= A_.lbound()+1); #endif if (i== A_.lbound()) return num_rows(); else return num_cols(); } Transpose_View(const Transpose_View &A) : A_(A.A_) {}; Transpose_View(const Array2D &A) : A_(A) {}; inline const typename Array2D::element_type & operator()( Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert(lbound()<=i); assert(i<=A_.num_cols() + lbound() - 1); assert(lbound()<=j); assert(j<=A_.num_rows() + lbound() - 1); #endif return A_(j,i); } }; template Transpose_View Transpose_view(const Matrix &A) { return Transpose_View(A); } template Vector matmult( const Transpose_View & A, const Vector &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(B.dim() == N); Vector x(M); Subscript i, j; T tmp = 0; for (i=1; i<=M; i++) { tmp = 0; for (j=1; j<=N; j++) tmp += A(i,j) * B(j); x(i) = tmp; } return x; } template inline Vector operator*(const Transpose_View & A, const Vector &B) { return matmult(A,B); } template std::ostream& operator<<(std::ostream &s, const Transpose_View &A) { Subscript M=A.num_rows(); Subscript N=A.num_cols(); Subscript start = A.lbound(); Subscript Mend = M + A.lbound() - 1; Subscript Nend = N + A.lbound() - 1; s << M << " " << N << endl; for (Subscript i=start; i<=Mend; i++) { for (Subscript j=start; j<=Nend; j++) { s << A(i,j) << " "; } s << endl; } return s; } } // namespace TNT #endif // TRANSV_H geepack/inst/include/tnt/version.h0000754000177400001440000000074407752031670017124 0ustar murdochusers// Template Numerical Toolkit (TNT) for Linear Algebra // // BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE // Please see http://math.nist.gov/tnt for updates // // R. Pozo // Mathematical and Computational Sciences Division // National Institute of Standards and Technology #ifndef TNT_VERSION_H #define TNT_VERSION_H #define TNT_MAJOR_VERSION '0' #define TNT_MINOR_VERSION '9' #define TNT_SUBMINOR_VERSION '4' #define TNT_VERSION_STRING "0.9.4" #endif geepack/inst/include/tnt/tntreqs.h0000754000177400001440000000466307752031670017143 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // The requirements for a bare-bones vector class: // // // o) must have 0-based [] indexing for const and // non-const objects (i.e. operator[] defined) // // o) must have size() method to denote the number of // elements // o) must clean up after itself when destructed // (i.e. no memory leaks) // // -) must have begin() and end() methods (The begin() // method is necessary, because relying on // &v_[0] may not work on a empty vector (i.e. v_ is NULL.) // // o) must be templated // o) must have X::value_type defined to be the types of elements // o) must have X::X(const &x) copy constructor (by *value*) // o) must have X::X(int N) constructor to N-length vector // (NOTE: this constructor need *NOT* initalize elements) // // -) must have X::X(int N, T scalar) constructor to initalize // elements to value of "scalar". // // ( removed, because valarray<> class uses (scalar, N) rather // than (N, scalar) ) // -) must have X::X(int N, const T* scalars) constructor to copy from // any C linear array // // ( removed, because of same reverse order of valarray<> ) // // o) must have assignment A=B, by value // // NOTE: this class is *NOT* meant to be derived from, // so its methods (particularly indexing) need not be // declared virtual. // // // Some things it *DOES NOT* need to do are // // o) bounds checking // o) array referencing (e.g. reference counting) // o) support () indexing // o) I/O // geepack/inst/include/tnt/tntmath.h0000754000177400001440000000324107752031670017111 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // Header file for scalar math functions #ifndef TNTMATH_H #define TNTMATH_H // conventional functions required by several matrix algorithms namespace TNT { inline double abs(double t) { return ( t > 0 ? t : -t); } inline double min(double a, double b) { return (a < b ? a : b); } inline double max(double a, double b) { return (a > b ? a : b); } inline float abs(float t) { return ( t > 0 ? t : -t); } inline float min(float a, float b) { return (a < b ? a : b); } inline float max(float a, float b) { return (a > b ? a : b); } inline double sign(double a) { return (a > 0 ? 1.0 : -1.0); } inline float sign(float a) { return (a > 0.0 ? 1.0f : -1.0f); } } /* namespace TNT */ #endif /* TNTMATH_H */ geepack/inst/include/tnt/fortran.h0000754000177400001440000000431307752031670017106 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // Header file to define C/Fortran conventions (Platform specific) #ifndef FORTRAN_H #define FORTRAN_H // help map between C/C++ data types and Fortran types typedef int Fortran_integer; typedef float Fortran_float; typedef double Fortran_double; typedef Fortran_double *fda_; // (in/out) double precision array typedef const Fortran_double *cfda_; // (in) double precsion array typedef Fortran_double *fd_; // (in/out) single double precision typedef const Fortran_double *cfd_; // (in) single double precision typedef Fortran_float *ffa_; // (in/out) float precision array typedef const Fortran_float *cffa_; // (in) float precsion array typedef Fortran_float *ff_; // (in/out) single float precision typedef const Fortran_float *cff_; // (in) single float precision typedef Fortran_integer *fia_; // (in/out) single integer array typedef const Fortran_integer *cfia_; // (in) single integer array typedef Fortran_integer *fi_; // (in/out) single integer typedef const Fortran_integer *cfi_; // (in) single integer typedef char *fch_; // (in/out) single character typedef char *cfch_; // (in) single character #ifndef TNT_SUBSCRIPT_TYPE #define TNT_SUBSCRIPT_TYPE TNT::Fortran_integer #endif #endif // FORTRAN_H geepack/inst/include/tnt/vecadaptor.h0000754000177400001440000001650407752031670017570 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ #ifndef VECADAPTOR_H #define VECADAPTOR_H #include #include #include #include #include "tnt/subscript.h" #ifdef TNT_USE_REGIONS #include "tnt/region1d.h" #endif namespace TNT { // see "tntreq.h" for TNT requirements for underlying vector // class. This need NOT be the STL vector<> class, but a subset // that provides minimal services. // // This is a container adaptor that provides the following services. // // o) adds 1-offset operator() access ([] is always 0 offset) // o) adds TNT_BOUNDS_CHECK to () and [] // o) adds initialization from strings, e.g. "1.0 2.0 3.0"; // o) adds newsize(N) function (does not preserve previous values) // o) adds dim() and dim(1) // o) adds free() function to release memory used by vector // o) adds regions, e.g. A(Index(1,10)) = ... // o) add getVector() method to return adapted container // o) adds simple I/O for ostreams template class Vector_Adaptor { public: typedef typename BBVec::value_type T; typedef T value_type; typedef T element_type; typedef T* pointer; typedef T* iterator; typedef T& reference; typedef const T* const_iterator; typedef const T& const_reference; Subscript lbound() const { return 1; } protected: BBVec v_; T* vm1_; public: Subscript size() const { return v_.size(); } // These were removed so that the ANSI C++ valarray class // would work as a possible storage container. // // //iterator begin() { return v_.begin();} //iterator begin() { return &v_[0];} // //iterator end() { return v_.end(); } //iterator end() { return &v_[0] + v_.size(); } // //const_iterator begin() const { return v_.begin();} //const_iterator begin() const { return &v_[0];} // //const_iterator end() const { return v_.end(); } //const_iterator end() const { return &v_[0] + v_.size(); } BBVec& getVector() { return v_; } Subscript dim() const { return v_.size(); } Subscript dim(Subscript i) { #ifdef TNT_BOUNDS_CHECK assert(i==TNT_BASE_OFFSET); #endif return (i==TNT_BASE_OFFSET ? v_.size() : 0 ); } Vector_Adaptor() : v_() {}; Vector_Adaptor(const Vector_Adaptor &A) : v_(A.v_) { vm1_ = ( v_.size() > 0 ? &(v_[0]) -1 : NULL); } Vector_Adaptor(Subscript N, /*const*/ char *s) : v_(N) { istrstream ins(s); for (Subscript i=0; i> v_[i] ; vm1_ = ( v_.size() > 0 ? &(v_[0]) -1 : NULL); }; Vector_Adaptor(Subscript N, const T& value = T()) : v_(N) { for (Subscript i=0; i 0 ? &(v_[0]) -1 : NULL); } Vector_Adaptor(Subscript N, const T* values) : v_(N) { for (Subscript i=0; i 0 ? &(v_[0]) -1 : NULL); } Vector_Adaptor(const BBVec & A) : v_(A) { vm1_ = ( v_.size() > 0 ? &(v_[0]) -1 : NULL); } // NOTE: this assumes that BBVec(0) constructor creates an // null vector that does not take up space... It would be // great to require that BBVec have a corresponding free() // function, but in particular STL vectors do not. // Vector_Adaptor& free() { return *this = Vector_Adaptor(0); } Vector_Adaptor& operator=(const Vector_Adaptor &A) { v_ = A.v_ ; vm1_ = ( v_.size() > 0 ? &(v_[0]) -1 : NULL); return *this; } Vector_Adaptor& newsize(Subscript N) { // NOTE: this is not as efficient as it could be // but to retain compatiblity with STL interface // we cannot assume underlying implementation // has a newsize() function. return *this = Vector_Adaptor(N); } Vector_Adaptor& operator=(const T &a) { Subscript i; Subscript N = v_.size(); for (i=0; i& resize(Subscript N) { if (N == size()) return *this; Vector_Adaptor tmp(N); Subscript n = (N < size() ? N : size()); // min(N, size()); Subscript i; for (i=0; i > Region; typedef const_Region1D< Vector_Adaptor > const_Region; Region operator()(const Index1D &I) { return Region(*this, I); } Region operator()(const Subscript i1, Subscript i2) { return Region(*this, i1, i2); } const_Region operator()(const Index1D &I) const { return const_Region(*this, I); } const_Region operator()(const Subscript i1, Subscript i2) const { return const_Region(*this, i1, i2); } #endif // TNT_USE_REGIONS }; #include template std::ostream& operator<<(std::ostream &s, const Vector_Adaptor &A) { Subscript M=A.size(); s << M << endl; for (Subscript i=1; i<=M; i++) s << A(i) << endl; return s; } template std::istream& operator>>(std::istream &s, Vector_Adaptor &A) { Subscript N; s >> N; A.resize(N); for (Subscript i=1; i<=N; i++) s >> A(i); return s; } } // namespace TNT #endif geepack/inst/include/tnt/cmat.h0000754000177400001440000002723207752031670016364 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // C compatible matrix: row-oriented, 0-based [i][j] and 1-based (i,j) indexing // #ifndef CMAT_H #define CMAT_H #include "tnt/subscript.h" #include "tnt/vec.h" #include #include #include #include #ifdef TNT_USE_REGIONS #include "tnt/region2d.h" #endif namespace TNT { template class Matrix { public: typedef Subscript size_type; typedef T value_type; typedef T element_type; typedef T* pointer; typedef T* iterator; typedef T& reference; typedef const T* const_iterator; typedef const T& const_reference; Subscript lbound() const { return 1;} protected: Subscript m_; Subscript n_; Subscript mn_; // total size T* v_; T** row_; T* vm1_ ; // these point to the same data, but are 1-based T** rowm1_; // internal helper function to create the array // of row pointers void initialize(Subscript M, Subscript N) { mn_ = M*N; m_ = M; n_ = N; v_ = new T[mn_]; row_ = new T*[M]; rowm1_ = new T*[M]; assert(v_ != NULL); assert(row_ != NULL); assert(rowm1_ != NULL); T* p = v_; vm1_ = v_ - 1; for (Subscript i=0; i &A) { initialize(A.m_, A.n_); copy(A.v_); } Matrix(Subscript M, Subscript N, const T& value = T()) { initialize(M,N); set(value); } Matrix(Subscript M, Subscript N, const T* v) { initialize(M,N); copy(v); } Matrix(Subscript M, Subscript N, const char *s) { initialize(M,N); std::istrstream ins(s); Subscript i, j; for (i=0; i> row_[i][j]; } // destructor // ~Matrix() { destroy(); } // reallocating // Matrix& newsize(Subscript M, Subscript N) { if (num_rows() == M && num_cols() == N) return *this; destroy(); initialize(M,N); return *this; } // assignments // Matrix& operator=(const Matrix &A) { if (v_ == A.v_) return *this; if (m_ == A.m_ && n_ == A.n_) // no need to re-alloc copy(A.v_); else { destroy(); initialize(A.m_, A.n_); copy(A.v_); } return *this; } Matrix& operator=(const T& scalar) { set(scalar); return *this; } Subscript dim(Subscript d) const { #ifdef TNT_BOUNDS_CHECK assert( d >= 1); assert( d <= 2); #endif return (d==1) ? m_ : ((d==2) ? n_ : 0); } Subscript num_rows() const { return m_; } Subscript num_cols() const { return n_; } inline T* operator[](Subscript i) { #ifdef TNT_BOUNDS_CHECK assert(0<=i); assert(i < m_) ; #endif return row_[i]; } inline const T* operator[](Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert(0<=i); assert(i < m_) ; #endif return row_[i]; } inline reference operator()(Subscript i) { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i <= mn_) ; #endif return vm1_[i]; } inline const_reference operator()(Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i <= mn_) ; #endif return vm1_[i]; } inline reference operator()(Subscript i, Subscript j) { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i <= m_) ; assert(1<=j); assert(j <= n_); #endif return rowm1_[i][j]; } inline const_reference operator() (Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i <= m_) ; assert(1<=j); assert(j <= n_); #endif return rowm1_[i][j]; } #ifdef TNT_USE_REGIONS typedef Region2D > Region; Region operator()(const Index1D &I, const Index1D &J) { return Region(*this, I,J); } typedef const_Region2D< Matrix > const_Region; const_Region operator()(const Index1D &I, const Index1D &J) const { return const_Region(*this, I,J); } #endif }; /* *************************** I/O ********************************/ template std::ostream& operator<<(std::ostream &s, const Matrix &A) { Subscript M=A.num_rows(); Subscript N=A.num_cols(); s << M << " " << N << "\n"; for (Subscript i=0; i std::istream& operator>>(std::istream &s, Matrix &A) { Subscript M, N; s >> M >> N; if ( !(M == A.num_rows() && N == A.num_cols() )) { A.newsize(M,N); } for (Subscript i=0; i> A[i][j]; } return s; } // *******************[ basic matrix algorithms ]*************************** template Matrix operator+(const Matrix &A, const Matrix &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Matrix tmp(M,N); Subscript i,j; for (i=0; i Matrix operator-(const Matrix &A, const Matrix &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Matrix tmp(M,N); Subscript i,j; for (i=0; i Matrix mult_element(const Matrix &A, const Matrix &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Matrix tmp(M,N); Subscript i,j; for (i=0; i Matrix transpose(const Matrix &A) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); Matrix S(N,M); Subscript i, j; for (i=0; i inline Matrix matmult(const Matrix &A, const Matrix &B) { #ifdef TNT_BOUNDS_CHECK assert(A.num_cols() == B.num_rows()); #endif Subscript M = A.num_rows(); Subscript N = A.num_cols(); Subscript K = B.num_cols(); Matrix tmp(M,K); T sum; for (Subscript i=0; i inline Matrix operator*(const Matrix &A, const Matrix &B) { return matmult(A,B); } template inline int matmult(Matrix& C, const Matrix &A, const Matrix &B) { assert(A.num_cols() == B.num_rows()); Subscript M = A.num_rows(); Subscript N = A.num_cols(); Subscript K = B.num_cols(); C.newsize(M,K); T sum; const T* row_i; const T* col_k; for (Subscript i=0; i Vector matmult(const Matrix &A, const Vector &x) { #ifdef TNT_BOUNDS_CHECK assert(A.num_cols() == x.dim()); #endif Subscript M = A.num_rows(); Subscript N = A.num_cols(); Vector tmp(M); T sum; for (Subscript i=0; i inline Vector operator*(const Matrix &A, const Vector &x) { return matmult(A,x); } } // namespace TNT #endif // CMAT_H geepack/inst/include/tnt/fmat.h0000754000177400001440000002742107752031670016367 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // Fortran-compatible matrix: column oriented, 1-based (i,j) indexing #ifndef FMAT_H #define FMAT_H #include "tnt/subscript.h" #include "tnt/vec.h" #include #include #include #include #ifdef TNT_USE_REGIONS #include "tnt/region2d.h" #endif // simple 1-based, column oriented Matrix class namespace TNT { template class Fortran_Matrix { public: typedef T value_type; typedef T element_type; typedef T* pointer; typedef T* iterator; typedef T& reference; typedef const T* const_iterator; typedef const T& const_reference; Subscript lbound() const { return 1;} protected: T* v_; // these are adjusted to simulate 1-offset Subscript m_; Subscript n_; T** col_; // these are adjusted to simulate 1-offset // internal helper function to create the array // of row pointers void initialize(Subscript M, Subscript N) { // adjust col_[] pointers so that they are 1-offset: // col_[j][i] is really col_[j-1][i-1]; // // v_[] is the internal contiguous array, it is still 0-offset // v_ = new T[M*N]; col_ = new T*[N]; assert(v_ != NULL); assert(col_ != NULL); m_ = M; n_ = N; T* p = v_ - 1; for (Subscript i=0; i &A) { initialize(A.m_, A.n_); copy(A.v_); } Fortran_Matrix(Subscript M, Subscript N, const T& value = T()) { initialize(M,N); set(value); } Fortran_Matrix(Subscript M, Subscript N, const T* v) { initialize(M,N); copy(v); } Fortran_Matrix(Subscript M, Subscript N, char *s) { initialize(M,N); std::istringstream ins(s); Subscript i, j; for (i=1; i<=M; i++) for (j=1; j<=N; j++) ins >> (*this)(i,j); } // destructor ~Fortran_Matrix() { destroy(); } // assignments // Fortran_Matrix& operator=(const Fortran_Matrix &A) { if (v_ == A.v_) return *this; if (m_ == A.m_ && n_ == A.n_) // no need to re-alloc copy(A.v_); else { destroy(); initialize(A.m_, A.n_); copy(A.v_); } return *this; } Fortran_Matrix& operator=(const T& scalar) { set(scalar); return *this; } Subscript dim(Subscript d) const { #ifdef TNT_BOUNDS_CHECK assert( d >= 1); assert( d <= 2); #endif return (d==1) ? m_ : ((d==2) ? n_ : 0); } Subscript num_rows() const { return m_; } Subscript num_cols() const { return n_; } Fortran_Matrix& newsize(Subscript M, Subscript N) { if (num_rows() == M && num_cols() == N) return *this; destroy(); initialize(M,N); return *this; } // 1-based element access // inline reference operator()(Subscript i, Subscript j) { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i <= m_) ; assert(1<=j); assert(j <= n_); #endif return col_[j][i]; } inline const_reference operator() (Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i <= m_) ; assert(1<=j); assert(j <= n_); #endif return col_[j][i]; } #ifdef TNT_USE_REGIONS typedef Region2D > Region; typedef const_Region2D< Fortran_Matrix > const_Region; Region operator()(const Index1D &I, const Index1D &J) { return Region(*this, I,J); } const_Region operator()(const Index1D &I, const Index1D &J) const { return const_Region(*this, I,J); } #endif }; /* *************************** I/O ********************************/ template std::ostream& operator<<(std::ostream &s, const Fortran_Matrix &A) { Subscript M=A.num_rows(); Subscript N=A.num_cols(); s << M << " " << N << "\n"; for (Subscript i=1; i<=M; i++) { for (Subscript j=1; j<=N; j++) { s << A(i,j) << " "; } s << "\n"; } return s; } template std::istream& operator>>(std::istream &s, Fortran_Matrix &A) { Subscript M, N; s >> M >> N; if ( !(M == A.num_rows() && N == A.num_cols())) { A.newsize(M,N); } for (Subscript i=1; i<=M; i++) for (Subscript j=1; j<=N; j++) { s >> A(i,j); } return s; } // *******************[ basic matrix algorithms ]*************************** template Fortran_Matrix operator+(const Fortran_Matrix &A, const Fortran_Matrix &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Fortran_Matrix tmp(M,N); Subscript i,j; for (i=1; i<=M; i++) for (j=1; j<=N; j++) tmp(i,j) = A(i,j) + B(i,j); return tmp; } template Fortran_Matrix operator-(const Fortran_Matrix &A, const Fortran_Matrix &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Fortran_Matrix tmp(M,N); Subscript i,j; for (i=1; i<=M; i++) for (j=1; j<=N; j++) tmp(i,j) = A(i,j) - B(i,j); return tmp; } // element-wise multiplication (use matmult() below for matrix // multiplication in the linear algebra sense.) // // template Fortran_Matrix mult_element(const Fortran_Matrix &A, const Fortran_Matrix &B) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M==B.num_rows()); assert(N==B.num_cols()); Fortran_Matrix tmp(M,N); Subscript i,j; for (i=1; i<=M; i++) for (j=1; j<=N; j++) tmp(i,j) = A(i,j) * B(i,j); return tmp; } template Fortran_Matrix transpose(const Fortran_Matrix &A) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); Fortran_Matrix S(N,M); Subscript i, j; for (i=1; i<=M; i++) for (j=1; j<=N; j++) S(j,i) = A(i,j); return S; } template inline Fortran_Matrix matmult(const Fortran_Matrix &A, const Fortran_Matrix &B) { #ifdef TNT_BOUNDS_CHECK assert(A.num_cols() == B.num_rows()); #endif Subscript M = A.num_rows(); Subscript N = A.num_cols(); Subscript K = B.num_cols(); Fortran_Matrix tmp(M,K); T sum; for (Subscript i=1; i<=M; i++) for (Subscript k=1; k<=K; k++) { sum = 0; for (Subscript j=1; j<=N; j++) sum = sum + A(i,j) * B(j,k); tmp(i,k) = sum; } return tmp; } template inline Fortran_Matrix operator*(const Fortran_Matrix &A, const Fortran_Matrix &B) { return matmult(A,B); } template inline int matmult(Fortran_Matrix& C, const Fortran_Matrix &A, const Fortran_Matrix &B) { assert(A.num_cols() == B.num_rows()); Subscript M = A.num_rows(); Subscript N = A.num_cols(); Subscript K = B.num_cols(); C.newsize(M,K); // adjust shape of C, if necessary T sum; const T* row_i; const T* col_k; for (Subscript i=1; i<=M; i++) { for (Subscript k=1; k<=K; k++) { row_i = &A(i,1); col_k = &B(1,k); sum = 0; for (Subscript j=1; j<=N; j++) { sum += *row_i * *col_k; row_i += M; col_k ++; } C(i,k) = sum; } } return 0; } template Vector matmult(const Fortran_Matrix &A, const Vector &x) { #ifdef TNT_BOUNDS_CHECK assert(A.num_cols() == x.dim()); #endif Subscript M = A.num_rows(); Subscript N = A.num_cols(); Vector tmp(M); T sum; for (Subscript i=1; i<=M; i++) { sum = 0; for (Subscript j=1; j<=N; j++) sum = sum + A(i,j) * x(j); tmp(i) = sum; } return tmp; } template inline Vector operator*(const Fortran_Matrix &A, const Vector &x) { return matmult(A,x); } template inline Fortran_Matrix operator*(const Fortran_Matrix &A, const T &x) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); //Subscript MN = M*N; Fortran_Matrix res(M,N); const T* a = A.begin(); T* t = res.begin(); T* tend = res.end(); for (t=res.begin(); t < tend; t++, a++) *t = *a * x; return res; } } // namespace TNT #endif // FMAT_H geepack/inst/include/tnt/stopwatch.h0000754000177400001440000000454007752031670017451 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ #ifndef STPWATCH_H #define STPWATCH_H // for clock() and CLOCKS_PER_SEC #include namespace TNT { /* Simple stopwatch object: void start() : start timing double stop() : stop timing void reset() : set elapsed time to 0.0 double read() : read elapsed time (in seconds) */ inline double seconds(void) { static const double secs_per_tick = 1.0 / CLOCKS_PER_SEC; return ( (double) clock() ) * secs_per_tick; } class stopwatch { private: int running; double last_time; double total; public: stopwatch() : running(0), last_time(0.0), total(0.0) {} void reset() { running = 0; last_time = 0.0; total=0.0; } void start() { if (!running) { last_time = seconds(); running = 1;}} double stop() { if (running) { total += seconds() - last_time; running = 0; } return total; } double read() { if (running) { total+= seconds() - last_time; last_time = seconds(); } return total; } }; } // namespace TNT #endif geepack/inst/include/tnt/index.h0000754000177400001440000000366507752031670016553 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // Vector/Matrix/Array Index Module #ifndef INDEX_H #define INDEX_H #include "tnt/subscript.h" namespace TNT { class Index1D { Subscript lbound_; Subscript ubound_; public: Subscript lbound() const { return lbound_; } Subscript ubound() const { return ubound_; } Index1D(const Index1D &D) : lbound_(D.lbound_), ubound_(D.ubound_) {} Index1D(Subscript i1, Subscript i2) : lbound_(i1), ubound_(i2) {} Index1D & operator=(const Index1D &D) { lbound_ = D.lbound_; ubound_ = D.ubound_; return *this; } }; inline Index1D operator+(const Index1D &D, Subscript i) { return Index1D(i+D.lbound(), i+D.ubound()); } inline Index1D operator+(Subscript i, const Index1D &D) { return Index1D(i+D.lbound(), i+D.ubound()); } inline Index1D operator-(Index1D &D, Subscript i) { return Index1D(D.lbound()-i, D.ubound()-i); } inline Index1D operator-(Subscript i, Index1D &D) { return Index1D(i-D.lbound(), i-D.ubound()); } } // namespace TNT #endif geepack/inst/include/tnt/region1d.h0000754000177400001440000002276007752031670017151 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ #ifndef REGION1D_H #define REGION1D_H #include "tnt/subscript.h" #include "tnt/index.h" #include #include namespace TNT { template class const_Region1D; template class Region1D { protected: Array1D & A_; Subscript offset_; // 0-based Subscript dim_; typedef typename Array1D::element_type T; public: const Array1D & array() const { return A_; } Subscript offset() const { return offset_;} Subscript dim() const { return dim_; } Subscript offset(Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert(i==TNT_BASE_OFFSET); #endif return offset_; } Subscript dim(Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert(i== TNT_BASE_OFFSET); #endif return offset_; } Region1D(Array1D &A, Subscript i1, Subscript i2) : A_(A) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <= i1 ); assert(i2 <= A.dim() + (TNT_BASE_OFFSET-1)); assert(i1 <= i2); #endif offset_ = i1 - TNT_BASE_OFFSET; dim_ = i2-i1 + 1; } Region1D(Array1D &A, const Index1D &I) : A_(A) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <=I.lbound()); assert(I.ubound() <= A.dim() + (TNT_BASE_OFFSET-1)); assert(I.lbound() <= I.ubound()); #endif offset_ = I.lbound() - TNT_BASE_OFFSET; dim_ = I.ubound() - I.lbound() + 1; } Region1D(Region1D &A, Subscript i1, Subscript i2) : A_(A.A_) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <= i1 ); assert(i2 <= A.dim() + (TNT_BASE_OFFSET - 1)); assert(i1 <= i2); #endif // (old-offset) (new-offset) // offset_ = (i1 - TNT_BASE_OFFSET) + A.offset_; dim_ = i2-i1 + 1; } Region1D operator()(Subscript i1, Subscript i2) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <= i1); assert(i2 <= dim() + (TNT_BASE_OFFSET -1)); assert(i1 <= i2); #endif // offset_ is 0-based, so no need for // ( - TNT_BASE_OFFSET) // return Region1D(A_, i1+offset_, offset_ + i2); } Region1D operator()(const Index1D &I) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET<=I.lbound()); assert(I.ubound() <= dim() + (TNT_BASE_OFFSET-1)); assert(I.lbound() <= I.ubound()); #endif return Region1D(A_, I.lbound()+offset_, offset_ + I.ubound()); } T & operator()(Subscript i) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <= i); assert(i <= dim() + (TNT_BASE_OFFSET-1)); #endif return A_(i+offset_); } const T & operator() (Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <= i); assert(i <= dim() + (TNT_BASE_OFFSET-1)); #endif return A_(i+offset_); } Region1D & operator=(const Region1D &R) { // make sure both sides conform assert(dim() == R.dim()); Subscript N = dim(); Subscript i; Subscript istart = TNT_BASE_OFFSET; Subscript iend = istart + N-1; for (i=istart; i<=iend; i++) (*this)(i) = R(i); return *this; } Region1D & operator=(const const_Region1D &R) { // make sure both sides conform assert(dim() == R.dim()); Subscript N = dim(); Subscript i; Subscript istart = TNT_BASE_OFFSET; Subscript iend = istart + N-1; for (i=istart; i<=iend; i++) (*this)(i) = R(i); return *this; } Region1D & operator=(const T& t) { Subscript N=dim(); Subscript i; Subscript istart = TNT_BASE_OFFSET; Subscript iend = istart + N-1; for (i=istart; i<= iend; i++) (*this)(i) = t; return *this; } Region1D & operator=(const Array1D &R) { // make sure both sides conform Subscript N = dim(); assert(dim() == R.dim()); Subscript i; Subscript istart = TNT_BASE_OFFSET; Subscript iend = istart + N-1; for (i=istart; i<=iend; i++) (*this)(i) = R(i); return *this; } }; template std::ostream& operator<<(std::ostream &s, Region1D &A) { Subscript N=A.dim(); Subscript istart = TNT_BASE_OFFSET; Subscript iend = N - 1 + TNT_BASE_OFFSET; for (Subscript i=istart; i<=iend; i++) s << A(i) << endl; return s; } /* --------- class const_Region1D ------------ */ template class const_Region1D { protected: const Array1D & A_; Subscript offset_; // 0-based Subscript dim_; typedef typename Array1D::element_type T; public: const Array1D & array() const { return A_; } Subscript offset() const { return offset_;} Subscript dim() const { return dim_; } Subscript offset(Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert(i==TNT_BASE_OFFSET); #endif return offset_; } Subscript dim(Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert(i== TNT_BASE_OFFSET); #endif return offset_; } const_Region1D(const Array1D &A, Subscript i1, Subscript i2) : A_(A) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <= i1 ); assert(i2 <= A.dim() + (TNT_BASE_OFFSET-1)); assert(i1 <= i2); #endif offset_ = i1 - TNT_BASE_OFFSET; dim_ = i2-i1 + 1; } const_Region1D(const Array1D &A, const Index1D &I) : A_(A) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <=I.lbound()); assert(I.ubound() <= A.dim() + (TNT_BASE_OFFSET-1)); assert(I.lbound() <= I.ubound()); #endif offset_ = I.lbound() - TNT_BASE_OFFSET; dim_ = I.ubound() - I.lbound() + 1; } const_Region1D(const_Region1D &A, Subscript i1, Subscript i2) : A_(A.A_) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <= i1 ); assert(i2 <= A.dim() + (TNT_BASE_OFFSET - 1)); assert(i1 <= i2); #endif // (old-offset) (new-offset) // offset_ = (i1 - TNT_BASE_OFFSET) + A.offset_; dim_ = i2-i1 + 1; } const_Region1D operator()(Subscript i1, Subscript i2) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <= i1); assert(i2 <= dim() + (TNT_BASE_OFFSET -1)); assert(i1 <= i2); #endif // offset_ is 0-based, so no need for // ( - TNT_BASE_OFFSET) // return const_Region1D(A_, i1+offset_, offset_ + i2); } const_Region1D operator()(const Index1D &I) { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET<=I.lbound()); assert(I.ubound() <= dim() + (TNT_BASE_OFFSET-1)); assert(I.lbound() <= I.ubound()); #endif return const_Region1D(A_, I.lbound()+offset_, offset_ + I.ubound()); } const T & operator() (Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert(TNT_BASE_OFFSET <= i); assert(i <= dim() + (TNT_BASE_OFFSET-1)); #endif return A_(i+offset_); } }; template std::ostream& operator<<(std::ostream &s, const_Region1D &A) { Subscript N=A.dim(); for (Subscript i=1; i<=N; i++) s << A(i) << endl; return s; } } // namespace TNT #endif // const_Region1D_H geepack/inst/include/tnt/fcscmat.h0000754000177400001440000001126707752031670017061 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // Templated compressed sparse column matrix (Fortran conventions). // uses 1-based offsets in storing row indices. // Used primarily to interface with Fortran sparse matrix libaries. // (CANNOT BE USED AS AN STL CONTAINER.) #ifndef FCSCMAT_H #define FCSCMAT_H #include #include #include "tnt/tnt.h" #include "tnt/vec.h" using namespace std; namespace TNT { template class Fortran_Sparse_Col_Matrix { protected: Vector val_; // data values (nz_ elements) Vector rowind_; // row_ind (nz_ elements) Vector colptr_; // col_ptr (n_+1 elements) int nz_; // number of nonzeros Subscript m_; // global dimensions Subscript n_; public: Fortran_Sparse_Col_Matrix(void); Fortran_Sparse_Col_Matrix(const Fortran_Sparse_Col_Matrix &S) : val_(S.val_), rowind_(S.rowind_), colptr_(S.colptr_), nz_(S.nz_), m_(S.m_), n_(S.n_) {}; Fortran_Sparse_Col_Matrix(Subscript M, Subscript N, Subscript nz, const T *val, const Subscript *r, const Subscript *c) : val_(nz, val), rowind_(nz, r), colptr_(N+1, c), nz_(nz), m_(M), n_(N) {}; Fortran_Sparse_Col_Matrix(Subscript M, Subscript N, Subscript nz, char *val, char *r, char *c) : val_(nz, val), rowind_(nz, r), colptr_(N+1, c), nz_(nz), m_(M), n_(N) {}; Fortran_Sparse_Col_Matrix(Subscript M, Subscript N, Subscript nz, const T *val, Subscript *r, Subscript *c) : val_(nz, val), rowind_(nz, r), colptr_(N+1, c), nz_(nz), m_(M), n_(N) {}; ~Fortran_Sparse_Col_Matrix() {}; T & val(Subscript i) { return val_(i); } const T & val(Subscript i) const { return val_(i); } Subscript & row_ind(Subscript i) { return rowind_(i); } const Subscript & row_ind(Subscript i) const { return rowind_(i); } Subscript col_ptr(Subscript i) { return colptr_(i);} const Subscript col_ptr(Subscript i) const { return colptr_(i);} Subscript num_cols() const { return m_;} Subscript num_rows() const { return n_; } Subscript dim(Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert( 1 <= i ); assert( i <= 2 ); #endif if (i==1) return m_; else if (i==2) return m_; else return 0; } Subscript num_nonzeros() const {return nz_;}; Subscript lbound() const {return 1;} Fortran_Sparse_Col_Matrix& operator=(const Fortran_Sparse_Col_Matrix &C) { val_ = C.val_; rowind_ = C.rowind_; colptr_ = C.colptr_; nz_ = C.nz_; m_ = C.m_; n_ = C.n_; return *this; } Fortran_Sparse_Col_Matrix& newsize(Subscript M, Subscript N, Subscript nz) { val_.newsize(nz); rowind_.newsize(nz); colptr_.newsize(N+1); return *this; } }; template ostream& operator<<(ostream &s, const Fortran_Sparse_Col_Matrix &A) { Subscript M=A.num_rows(); Subscript N=A.num_cols(); s << M << " " << N << " " << A.num_nonzeros() << endl; for (Subscript k=1; k<=N; k++) { Subscript start = A.col_ptr(k); Subscript end = A.col_ptr(k+1); for (Subscript i= start; i // index method namespace TNT { // // Only upper part of A is used. Cholesky factor is returned in // lower part of L. Returns 0 if successful, 1 otherwise. // template int Cholesky_upper_factorization(SPDMatrix &A, SymmMatrix &L) { Subscript M = A.dim(1); Subscript N = A.dim(2); assert(M == N); // make sure A is square // readjust size of L, if necessary if (M != L.dim(1) || N != L.dim(2)) L = SymmMatrix(N,N); Subscript i,j,k; typename SPDMatrix::element_type dot=0; for (j=1; j<=N; j++) // form column j of L { dot= 0; for (i=1; i class LowerTriangularView { protected: const MaTRiX &A_; const typename MaTRiX::element_type zero_; public: typedef typename MaTRiX::const_reference const_reference; typedef const typename MaTRiX::element_type element_type; typedef const typename MaTRiX::element_type value_type; typedef element_type T; Subscript dim(Subscript d) const { return A_.dim(d); } Subscript lbound() const { return A_.lbound(); } Subscript num_rows() const { return A_.num_rows(); } Subscript num_cols() const { return A_.num_cols(); } // constructors LowerTriangularView(/*const*/ MaTRiX &A) : A_(A), zero_(0) {} inline const_reference get(Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert(lbound()<=i); assert(i<=A_.num_rows() + lbound() - 1); assert(lbound()<=j); assert(j<=A_.num_cols() + lbound() - 1); #endif if (i > const_Region; const_Region operator()(/*const*/ Index1D &I, /*const*/ Index1D &J) const { return const_Region(*this, I, J); } const_Region operator()(Subscript i1, Subscript i2, Subscript j1, Subscript j2) const { return const_Region(*this, i1, i2, j1, j2); } #endif // TNT_USE_REGIONS }; /* *********** Lower_triangular_view() algorithms ****************** */ template VecToR matmult(/*const*/ LowerTriangularView &A, VecToR &x) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(N == x.dim()); Subscript i, j; typename MaTRiX::element_type sum=0.0; VecToR result(M); Subscript start = A.lbound(); Subscript Mend = M + A.lbound() -1 ; for (i=start; i<=Mend; i++) { sum = 0.0; for (j=start; j<=i; j++) sum = sum + A(i,j)*x(j); result(i) = sum; } return result; } template inline VecToR operator*(/*const*/ LowerTriangularView &A, VecToR &x) { return matmult(A,x); } template class UnitLowerTriangularView { protected: const MaTRiX &A_; const typename MaTRiX::element_type zero; const typename MaTRiX::element_type one; public: typedef typename MaTRiX::const_reference const_reference; typedef typename MaTRiX::element_type element_type; typedef typename MaTRiX::element_type value_type; typedef element_type T; Subscript lbound() const { return 1; } Subscript dim(Subscript d) const { return A_.dim(d); } Subscript num_rows() const { return A_.num_rows(); } Subscript num_cols() const { return A_.num_cols(); } // constructors UnitLowerTriangularView(/*const*/ MaTRiX &A) : A_(A), zero(0), one(1) {} inline const_reference get(Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i<=A_.dim(1)); assert(1<=j); assert(j<=A_.dim(2)); assert(0<=i && ij) return A_(i,j); else if (i==j) return one; else return zero; } inline const_reference operator() (Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i<=A_.dim(1)); assert(1<=j); assert(j<=A_.dim(2)); #endif if (i>j) return A_(i,j); else if (i==j) return one; else return zero; } #ifdef TNT_USE_REGIONS // These are the "index-aware" features typedef const_Region2D< UnitLowerTriangularView > const_Region; const_Region operator()(/*const*/ Index1D &I, /*const*/ Index1D &J) const { return const_Region(*this, I, J); } const_Region operator()(Subscript i1, Subscript i2, Subscript j1, Subscript j2) const { return const_Region(*this, i1, i2, j1, j2); } #endif // TNT_USE_REGIONS }; template LowerTriangularView Lower_triangular_view( /*const*/ MaTRiX &A) { return LowerTriangularView(A); } template UnitLowerTriangularView Unit_lower_triangular_view( /*const*/ MaTRiX &A) { return UnitLowerTriangularView(A); } template VecToR matmult(const UnitLowerTriangularView &A, VecToR &x) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(N == x.dim()); Subscript i, j; typename MaTRiX::element_type sum=0.0; VecToR result(M); Subscript start = A.lbound(); Subscript Mend = M + A.lbound() -1 ; for (i=start; i<=Mend; i++) { sum = 0.0; for (j=start; j inline VecToR operator*(const UnitLowerTriangularView &A, VecToR &x) { return matmult(A,x); } //********************** Algorithms ************************************* template std::ostream& operator<<(std::ostream &s, const LowerTriangularView&A) { Subscript M=A.num_rows(); Subscript N=A.num_cols(); s << M << " " << N << endl; for (Subscript i=1; i<=M; i++) { for (Subscript j=1; j<=N; j++) { s << A(i,j) << " "; } s << endl; } return s; } template std::ostream& operator<<(std::ostream &s, const UnitLowerTriangularView&A) { Subscript M=A.num_rows(); Subscript N=A.num_cols(); s << M << " " << N << endl; for (Subscript i=1; i<=M; i++) { for (Subscript j=1; j<=N; j++) { s << A(i,j) << " "; } s << endl; } return s; } // ******************* Upper Triangular Section ************************** template class UpperTriangularView { protected: /*const*/ MaTRiX &A_; /*const*/ typename MaTRiX::element_type zero_; public: typedef typename MaTRiX::const_reference const_reference; typedef /*const*/ typename MaTRiX::element_type element_type; typedef /*const*/ typename MaTRiX::element_type value_type; typedef element_type T; Subscript dim(Subscript d) const { return A_.dim(d); } Subscript lbound() const { return A_.lbound(); } Subscript num_rows() const { return A_.num_rows(); } Subscript num_cols() const { return A_.num_cols(); } // constructors UpperTriangularView(/*const*/ MaTRiX &A) : A_(A), zero_(0) {} inline const_reference get(Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert(lbound()<=i); assert(i<=A_.num_rows() + lbound() - 1); assert(lbound()<=j); assert(j<=A_.num_cols() + lbound() - 1); #endif if (i>j) return zero_; else return A_(i,j); } inline const_reference operator() (Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert(lbound()<=i); assert(i<=A_.num_rows() + lbound() - 1); assert(lbound()<=j); assert(j<=A_.num_cols() + lbound() - 1); #endif if (i>j) return zero_; else return A_(i,j); } #ifdef TNT_USE_REGIONS typedef const_Region2D< UpperTriangularView > const_Region; const_Region operator()(const Index1D &I, const Index1D &J) const { return const_Region(*this, I, J); } const_Region operator()(Subscript i1, Subscript i2, Subscript j1, Subscript j2) const { return const_Region(*this, i1, i2, j1, j2); } #endif // TNT_USE_REGIONS }; /* *********** Upper_triangular_view() algorithms ****************** */ template VecToR matmult(/*const*/ UpperTriangularView &A, VecToR &x) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(N == x.dim()); Subscript i, j; typename VecToR::element_type sum=0.0; VecToR result(M); Subscript start = A.lbound(); Subscript Mend = M + A.lbound() -1 ; for (i=start; i<=Mend; i++) { sum = 0.0; for (j=i; j<=N; j++) sum = sum + A(i,j)*x(j); result(i) = sum; } return result; } template inline VecToR operator*(/*const*/ UpperTriangularView &A, VecToR &x) { return matmult(A,x); } template class UnitUpperTriangularView { protected: const MaTRiX &A_; const typename MaTRiX::element_type zero; const typename MaTRiX::element_type one; public: typedef typename MaTRiX::const_reference const_reference; typedef typename MaTRiX::element_type element_type; typedef typename MaTRiX::element_type value_type; typedef element_type T; Subscript lbound() const { return 1; } Subscript dim(Subscript d) const { return A_.dim(d); } Subscript num_rows() const { return A_.num_rows(); } Subscript num_cols() const { return A_.num_cols(); } // constructors UnitUpperTriangularView(/*const*/ MaTRiX &A) : A_(A), zero(0), one(1) {} inline const_reference get(Subscript i, Subscript j) const { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i<=A_.dim(1)); assert(1<=j); assert(j<=A_.dim(2)); assert(0<=i && i > const_Region; const_Region operator()(const Index1D &I, const Index1D &J) const { return const_Region(*this, I, J); } const_Region operator()(Subscript i1, Subscript i2, Subscript j1, Subscript j2) const { return const_Region(*this, i1, i2, j1, j2); } #endif // TNT_USE_REGIONS }; template UpperTriangularView Upper_triangular_view( /*const*/ MaTRiX &A) { return UpperTriangularView(A); } template UnitUpperTriangularView Unit_upper_triangular_view( /*const*/ MaTRiX &A) { return UnitUpperTriangularView(A); } template VecToR matmult(/*const*/ UnitUpperTriangularView &A, VecToR &x) { Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(N == x.dim()); Subscript i, j; typename VecToR::element_type sum=0.0; VecToR result(M); Subscript start = A.lbound(); Subscript Mend = M + A.lbound() -1 ; for (i=start; i<=Mend; i++) { sum = x(i); for (j=i+1; j<=N; j++) sum = sum + A(i,j)*x(j); result(i) = sum + x(i); } return result; } template inline VecToR operator*(/*const*/ UnitUpperTriangularView &A, VecToR &x) { return matmult(A,x); } //********************** Algorithms ************************************* template std::ostream& operator<<(std::ostream &s, /*const*/ UpperTriangularView&A) { Subscript M=A.num_rows(); Subscript N=A.num_cols(); s << M << " " << N << endl; for (Subscript i=1; i<=M; i++) { for (Subscript j=1; j<=N; j++) { s << A(i,j) << " "; } s << endl; } return s; } template std::ostream& operator<<(std::ostream &s, /*const*/ UnitUpperTriangularView&A) { Subscript M=A.num_rows(); Subscript N=A.num_cols(); s << M << " " << N << endl; for (Subscript i=1; i<=M; i++) { for (Subscript j=1; j<=N; j++) { s << A(i,j) << " "; } s << endl; } return s; } } // namespace TNT #endif //TRIANG_H geepack/inst/include/tnt/vec.h0000754000177400001440000001674507752031670016224 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ // Basic TNT numerical vector (0-based [i] AND 1-based (i) indexing ) // #ifndef VEC_H #define VEC_H #include "tnt/subscript.h" #include #include #include #include namespace TNT { template class Vector { public: typedef Subscript size_type; typedef T value_type; typedef T element_type; typedef T* pointer; typedef T* iterator; typedef T& reference; typedef const T* const_iterator; typedef const T& const_reference; Subscript lbound() const { return 1;} protected: T* v_; T* vm1_; // pointer adjustment for optimzied 1-offset indexing Subscript n_; // internal helper function to create the array // of row pointers void initialize(Subscript N) { // adjust pointers so that they are 1-offset: // v_[] is the internal contiguous array, it is still 0-offset // assert(v_ == NULL); v_ = new T[N]; assert(v_ != NULL); vm1_ = v_-1; n_ = N; } void copy(const T* v) { Subscript N = n_; Subscript i; #ifdef TNT_UNROLL_LOOPS Subscript Nmod4 = N & 3; Subscript N4 = N - Nmod4; for (i=0; i &A) : v_(0), vm1_(0), n_(0) { initialize(A.n_); copy(A.v_); } Vector(Subscript N, const T& value = T()) : v_(0), vm1_(0), n_(0) { initialize(N); set(value); } Vector(Subscript N, const T* v) : v_(0), vm1_(0), n_(0) { initialize(N); copy(v); } Vector(Subscript N, char *s) : v_(0), vm1_(0), n_(0) { initialize(N); std::istringstream ins(s); Subscript i; for (i=0; i> v_[i]; } // methods // Vector& newsize(Subscript N) { if (n_ == N) return *this; destroy(); initialize(N); return *this; } // assignments // Vector& operator=(const Vector &A) { if (v_ == A.v_) return *this; if (n_ == A.n_) // no need to re-alloc copy(A.v_); else { destroy(); initialize(A.n_); copy(A.v_); } return *this; } Vector& operator=(const T& scalar) { set(scalar); return *this; } inline Subscript dim() const { return n_; } inline Subscript size() const { return n_; } inline reference operator()(Subscript i) { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i <= n_) ; #endif return vm1_[i]; } inline const_reference operator() (Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert(1<=i); assert(i <= n_) ; #endif return vm1_[i]; } inline reference operator[](Subscript i) { #ifdef TNT_BOUNDS_CHECK assert(0<=i); assert(i < n_) ; #endif return v_[i]; } inline const_reference operator[](Subscript i) const { #ifdef TNT_BOUNDS_CHECK assert(0<=i); assert(i < n_) ; #endif return v_[i]; } }; /* *************************** I/O ********************************/ template std::ostream& operator<<(std::ostream &s, const Vector &A) { Subscript N=A.dim(); s << N << endl; for (Subscript i=0; i std::istream & operator>>(std::istream &s, Vector &A) { Subscript N; s >> N; if ( !(N == A.size() )) { A.newsize(N); } for (Subscript i=0; i> A[i]; return s; } // *******************[ basic matrix algorithms ]*************************** template Vector operator+(const Vector &A, const Vector &B) { Subscript N = A.dim(); assert(N==B.dim()); Vector tmp(N); Subscript i; for (i=0; i Vector operator-(const Vector &A, const Vector &B) { Subscript N = A.dim(); assert(N==B.dim()); Vector tmp(N); Subscript i; for (i=0; i Vector operator*(const Vector &A, const Vector &B) { Subscript N = A.dim(); assert(N==B.dim()); Vector tmp(N); Subscript i; for (i=0; i T dot_prod(const Vector &A, const Vector &B) { Subscript N = A.dim(); assert(N == B.dim()); Subscript i; T sum = 0; for (i=0; i #include #include #include using namespace std; namespace TNT { template class Fortran_Sparse_Vector { public: typedef Subscript size_type; typedef T value_type; typedef T element_type; typedef T* pointer; typedef T* iterator; typedef T& reference; typedef const T* const_iterator; typedef const T& const_reference; Subscript lbound() const { return 1;} protected: Vector val_; Vector index_; Subscript dim_; // prescribed dimension public: // size and shape information Subscript dim() const { return dim_; } Subscript num_nonzeros() const { return val_.dim(); } // access T& val(Subscript i) { return val_(i); } const T& val(Subscript i) const { return val_(i); } Subscript &index(Subscript i) { return index_(i); } const Subscript &index(Subscript i) const { return index_(i); } // constructors Fortran_Sparse_Vector() : val_(), index_(), dim_(0) {}; Fortran_Sparse_Vector(Subscript N, Subscript nz) : val_(nz), index_(nz), dim_(N) {}; Fortran_Sparse_Vector(Subscript N, Subscript nz, const T *values, const Subscript *indices): val_(nz, values), index_(nz, indices), dim_(N) {} Fortran_Sparse_Vector(const Fortran_Sparse_Vector &S): val_(S.val_), index_(S.index_), dim_(S.dim_) {} // initialize from string, e.g. // // Fortran_Sparse_Vector A(N, 2, "1.0 2.1", "1 3"); // Fortran_Sparse_Vector(Subscript N, Subscript nz, char *v, char *ind) : val_(nz, v), index_(nz, ind), dim_(N) {} // assignments Fortran_Sparse_Vector & newsize(Subscript N, Subscript nz) { val_.newsize(nz); index_.newsize(nz); dim_ = N; return *this; } Fortran_Sparse_Vector & operator=( const Fortran_Sparse_Vector &A) { val_ = A.val_; index_ = A.index_; dim_ = A.dim_; return *this; } // methods }; /* *************************** I/O ********************************/ template ostream& operator<<(ostream &s, const Fortran_Sparse_Vector &A) { // output format is : N nz val1 ind1 val2 ind2 ... Subscript nz=A.num_nonzeros(); s << A.dim() << " " << nz << endl; for (Subscript i=1; i<=nz; i++) s << A.val(i) << " " << A.index(i) << endl; s << endl; return s; } template istream& operator>>(istream &s, Fortran_Sparse_Vector &A) { // output format is : N nz val1 ind1 val2 ind2 ... Subscript N; Subscript nz; s >> N >> nz; A.newsize(N, nz); for (Subscript i=1; i<=nz; i++) s >> A.val(i) >> A.index(i); return s; } } // namespace TNT #endif // FSPVEC_H geepack/inst/include/tnt/lu.h0000754000177400001440000001214407752031670016054 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ #ifndef LU_H #define LU_H // Solve system of linear equations Ax = b. // // Typical usage: // // Matrix(double) A; // Vector(Subscript) ipiv; // Vector(double) b; // // 1) LU_Factor(A,ipiv); // 2) LU_Solve(A,ipiv,b); // // Now b has the solution x. Note that both A and b // are overwritten. If these values need to be preserved, // one can make temporary copies, as in // // O) Matrix(double) T = A; // 1) LU_Factor(T,ipiv); // 1a) Vector(double) x=b; // 2) LU_Solve(T,ipiv,x); // // See details below. // // for fabs() // #include // right-looking LU factorization algorithm (unblocked) // // Factors matrix A into lower and upper triangular matrices // (L and U respectively) in solving the linear equation Ax=b. // // // Args: // // A (input/output) Matrix(1:n, 1:n) In input, matrix to be // factored. On output, overwritten with lower and // upper triangular factors. // // indx (output) Vector(1:n) Pivot vector. Describes how // the rows of A were reordered to increase // numerical stability. // // Return value: // // int (0 if successful, 1 otherwise) // // namespace TNT { template int LU_factor( MaTRiX &A, VecToRSubscript &indx) { assert(A.lbound() == 1); // currently for 1-offset assert(indx.lbound() == 1); // vectors and matrices Subscript M = A.num_rows(); Subscript N = A.num_cols(); if (M == 0 || N==0) return 0; if (indx.dim() != M) indx.newsize(M); Subscript i=0,j=0,k=0; Subscript jp=0; typename MaTRiX::element_type t; Subscript minMN = (M < N ? M : N) ; // min(M,N); for (j=1; j<= minMN; j++) { // find pivot in column j and test for singularity. jp = j; t = fabs(A(j,j)); for (i=j+1; i<=M; i++) if ( fabs(A(i,j)) > t) { jp = i; t = fabs(A(i,j)); } indx(j) = jp; // jp now has the index of maximum element // of column j, below the diagonal if ( A(jp,j) == 0 ) return 1; // factorization failed because of zero pivot if (jp != j) // swap rows j and jp for (k=1; k<=N; k++) { t = A(j,k); A(j,k) = A(jp,k); A(jp,k) =t; } if (j int LU_solve(const MaTRiX &A, const VecToRSubscripts &indx, VecToR &b) { assert(A.lbound() == 1); // currently for 1-offset assert(indx.lbound() == 1); // vectors and matrices assert(b.lbound() == 1); Subscript i,ii=0,ip,j; Subscript n = b.dim(); typename MaTRiX::element_type sum = 0.0; for (i=1;i<=n;i++) { ip=indx(i); sum=b(ip); b(ip)=b(i); if (ii) for (j=ii;j<=i-1;j++) sum -= A(i,j)*b(j); else if (sum) ii=i; b(i)=sum; } for (i=n;i>=1;i--) { sum=b(i); for (j=i+1;j<=n;j++) sum -= A(i,j)*b(j); b(i)=sum/A(i,i); } return 0; } } // namespace TNT #endif // LU_H geepack/inst/include/tnt/qr.h0000754000177400001440000001363707752031670016066 0ustar murdochusers/* * * Template Numerical Toolkit (TNT): Linear Algebra Module * * Mathematical and Computational Sciences Division * National Institute of Technology, * Gaithersburg, MD USA * * * This software was developed at the National Institute of Standards and * Technology (NIST) by employees of the Federal Government in the course * of their official duties. Pursuant to title 17 Section 105 of the * United States Code, this software is not subject to copyright protection * and is in the public domain. The Template Numerical Toolkit (TNT) is * an experimental system. NIST assumes no responsibility whatsoever for * its use by other parties, and makes no guarantees, expressed or implied, * about its quality, reliability, or any other characteristic. * * BETA VERSION INCOMPLETE AND SUBJECT TO CHANGE * see http://math.nist.gov/tnt for latest updates. * */ #ifndef QR_H #define QR_H // Classical QR factorization example, based on Stewart[1973]. // // // This algorithm computes the factorization of a matrix A // into a product of an orthognal matrix (Q) and an upper triangular // matrix (R), such that QR = A. // // Parameters: // // A (in): Matrix(1:N, 1:N) // // Q (output): Matrix(1:N, 1:N), collection of Householder // column vectors Q1, Q2, ... QN // // R (output): upper triangular Matrix(1:N, 1:N) // // Returns: // // 0 if successful, 1 if A is detected to be singular // #include //for sqrt() & fabs() #include "tnt/tntmath.h" // for sign() // Classical QR factorization, based on Stewart[1973]. // // // This algorithm computes the factorization of a matrix A // into a product of an orthognal matrix (Q) and an upper triangular // matrix (R), such that QR = A. // // Parameters: // // A (in/out): On input, A is square, Matrix(1:N, 1:N), that represents // the matrix to be factored. // // On output, Q and R is encoded in the same Matrix(1:N,1:N) // in the following manner: // // R is contained in the upper triangular section of A, // except that R's main diagonal is in D. The lower // triangular section of A represents Q, where each // column j is the vector Qj = I - uj*uj'/pi_j. // // C (output): vector of Pi[j] // D (output): main diagonal of R, i.e. D(i) is R(i,i) // // Returns: // // 0 if successful, 1 if A is detected to be singular // namespace TNT { template int QR_factor(MaTRiX &A, Vector& C, Vector &D) { assert(A.lbound() == 1); // ensure these are all assert(C.lbound() == 1); // 1-based arrays and vectors assert(D.lbound() == 1); Subscript M = A.num_rows(); Subscript N = A.num_cols(); assert(M == N); // make sure A is square Subscript i,j,k; typename MaTRiX::element_type eta, sigma, sum; // adjust the shape of C and D, if needed... if (N != C.size()) C.newsize(N); if (N != D.size()) D.newsize(N); for (k=1; k eta ? absA : eta ); } if (eta == 0) // matrix is singular { cerr << "QR: k=" << k << "\n"; return 1; } // form Qk and premiltiply M by it // for(i=k; i<=N; i++) A(i,k) = A(i,k) / eta; sum = 0; for (i=k; i<=N; i++) sum = sum + A(i,k)*A(i,k); sigma = sign(A(k,k)) * sqrt(sum); A(k,k) = A(k,k) + sigma; C(k) = sigma * A(k,k); D(k) = -eta * sigma; for (j=k+1; j<=N; j++) { sum = 0; for (i=k; i<=N; i++) sum = sum + A(i,k)*A(i,j); sum = sum / C(k); for (i=k; i<=N; i++) A(i,j) = A(i,j) - sum * A(i,k); } D(N) = A(N,N); } return 0; } // modified form of upper triangular solve, except that the main diagonal // of R (upper portion of A) is in D. // template int R_solve(const MaTRiX &A, /*const*/ Vector &D, Vector &b) { assert(A.lbound() == 1); // ensure these are all assert(D.lbound() == 1); // 1-based arrays and vectors assert(b.lbound() == 1); Subscript i,j; Subscript N = A.num_rows(); assert(N == A.num_cols()); assert(N == D.dim()); assert(N == b.dim()); typename MaTRiX::element_type sum; if (D(N) == 0) return 1; b(N) = b(N) / D(N); for (i=N-1; i>=1; i--) { if (D(i) == 0) return 1; sum = 0; for (j=i+1; j<=N; j++) sum = sum + A(i,j)*b(j); b(i) = ( b(i) - sum ) / D(i); } return 0; } template int QR_solve(const MaTRiX &A, const Vector &c, /*const*/ Vector &d, Vector &b) { assert(A.lbound() == 1); // ensure these are all assert(c.lbound() == 1); // 1-based arrays and vectors assert(d.lbound() == 1); Subscript N=A.num_rows(); assert(N == A.num_cols()); assert(N == c.dim()); assert(N == d.dim()); assert(N == b.dim()); Subscript i,j; typename MaTRiX::element_type sum, tau; for (j=1; j &Gis); void HisandGis(DVector &Ycur, DMatrix &X, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, IVector &Clusz, IVector &ZcorSize, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, GeeParam &par, GeeStr &geestr, Corr &cor, IVector &Scur, IVector &level, //output Vector &His, Vector &Gis); /* DVector interpprev(double t, Vector &VV, DVector &tis); double interpprev(double t, DVector &v, DVector &tis); DVector getY(double t, DVector &Yall); IVector getS(double t, DVector &S); void AandCis(Vector &Yall, DMatrix &X, Vector &Offset, Vector &Doffset, Vector &Weight, IVector &LinkWave, IVector &Clusz, IVector &ZcorSize, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, Vector &Beta, Vector &Gamma, Vector &Alpha, DVector &W, DVector &S, DVector &Tis, DVector &Tlim, int l, DVector &Ita, GeeStr &geestr, Corr &cor, int ndivs, int fgconf, //output: DMatrix &A, Vector &Cis); */ /* This fix was suggested by Jeffrey Horner and Cole Beck . Cole Beck's email on Jan. 4, 2012 explains why: I believe the function definition for the template function "Valid" (see geesubs.cc) should actually be in the header file. Taken from http://www.cplusplus.com/doc/tutorial/templates/: Because templates are compiled when required, this forces a restriction for multi-file projects: the implementation (definition) of a template class or function must be in the same file as its declaration. That means that we cannot separate the interface in a separate header file, and that we must include both interface and implementation in any file that uses the templates. */ //get the valid components in X by valid indicator VI template Vector Valid(Vector &X, IVector &VI) { int l = sum(VI), k = 1; Vector ans(l); for (int i = 1; i <= VI.dim(); i++) { if (VI(i) == 1) ans(k++) = X(i); } return ans; } template Fortran_Matrix Valid(Fortran_Matrix &X, IVector &VI) { int l = sum(VI), k = 1, nc = X.num_cols(); Fortran_Matrix ans(l, nc); for (int i = 1; i <= VI.dim(); i++) { if (VI(i) == 1) { for (int j = 1; j <= nc; j++) ans(k, j) = X(i, j); k++; } } return ans; } IVector genVI(IVector &Si, int c = 1); IVector genCrossVI(IVector &Si, int c = 1); void getDatI(DVector &Y, DVector &Offset, DVector &Doffset, DVector &W, DVector &CorP, DMatrix &X, DMatrix &Zsca, DMatrix &Zcor, IVector &LinkWave, //extract indicator Index1D &I, Index1D &J, IVector Scuri, Corr &cor, //output DVector &VYi, DVector &VOffseti, DVector &VDoffseti, DVector &VWi, DVector &VCorPi, DMatrix &VXi, DMatrix &VZscai, DMatrix &VZcori, IVector &VLinkWavei); #endif //GEESUBS_H geepack/inst/include/gee2.h0000754000177400001440000000523212736704150015447 0ustar murdochusers#ifndef GEE2_H #define GEE2_H #include "tntsupp.h" #include "geese.h" // extern "C"{ #include #include #include // } #include "famstr.h" #include "param.h" #include "inter.h" #include "utils.h" #include "geesubs.h" IVector comp_lev(GeeStr &geestr, Corr &cor); void gee_var(DVector &Y, DMatrix &X, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, IVector &ZcorSize, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con); double update_beta(DVector &Y, DMatrix &X, DVector &Offset, DVector &W, IVector &LinkWave, DVector &CorP, DMatrix &Zcor, IVector &Clusz, IVector &ZcorSize, IVector &Jack, GeeParam &par, GeeStr &geestr, Corr &cor); double update_gamma(DVector &PR, DVector &W, IVector &LinkWave, IVector &Clusz, IVector &Jack, DVector &Doffset, DMatrix &Zsca, GeeParam &par, GeeStr &geestr); double update_alpha(DVector &PR, DVector &Phi, DVector &CorP, DVector &W, IVector &Clusz, IVector &ZcorSize, IVector &Jack, DMatrix &Zcor, GeeParam &par, GeeStr &geestr, Corr &cor); void gee_est(DVector &Y, DMatrix &X, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, IVector &ZcorSize, GeeStr &geestr, Corr &cor, GeeParam &par, IVector &Jack, Control &con); void getJackVar(Vector &beta_i, Vector &alpha_i, Vector &gamma_i, GeeParam &par, int jack); void gee_jack(DVector &Y, DMatrix &Xmat, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, IVector &ZcorSize, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con); void jack_ajs(DVector &Y, DMatrix &X, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, IVector &ZcorSize, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con); void gee_top(DVector &Y, DMatrix &Xmat, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con); extern "C" { SEXP gee_rap(SEXP y, SEXP x, SEXP offset, SEXP doffset, SEXP w, SEXP linkwave, SEXP zsca, SEXP zcor, SEXP corp, SEXP clusz, SEXP geestr, SEXP cor, SEXP par, SEXP con); } #endif //GEE2_H geepack/inst/include/ordgee.h0000754000177400001440000000663412736704202016077 0ustar murdochusers#ifndef ORDGEE_H #define ORDGEE_H //#include "tnt/region1d.h" #include "tntsupp.h" #include "geese.h" // extern "C"{ #include #include #include // } #include "famstr.h" #include "param.h" #include "inter.h" #include "utils.h" #include "geesubs.h" double odds2p11(double psi, double mu1, double mu2); DMatrix odds2p11(DVector &Psi, DVector &Mu1, DVector &Mu2); double p11_odds(double psi, double mu1, double mu2); DVector p11_mu(double psi, double mu1, double mu2); DVector p11_odds(DVector &Psi, DVector &Mu1, DVector &Mu2); DMatrix Vijj(DVector &Mu, bool rev); DMatrix Vijk(DVector &Mu1, DVector &Mu2, DVector &Psi); DMatrix getU3_Beta(DVector &Mu1, DVector &Mu2, DVector &Psi, DMatrix &D1, DMatrix &D2, DVector &PR1, DVector &PR2); DMatrix ord2V1(DVector &Mu, DVector &Psi, int clusz, bool rev); DMatrix Mu2V1(DVector &Mu, int clusz, bool rev); void ord_prep_beta(DVector &Y, DMatrix &X, DVector &Offset, DMatrix &Z, DVector &Ooffset, Index1D &I, Index1D &J, int clusz, int c, bool rev, IVector &LinkWave, GeeParam &par, GeeStr &geestr, Corr &cor, //output DMatrix &Di, DVector &PRi, DMatrix &Vi); double update_beta(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, DVector &W, IVector &LinkWave, //DVector &CorP, DMatrix &Z, IVector &Clusz, int c, bool rev, //IVector &ZcorSize, IVector &Jack, GeeParam &par, GeeStr &geestr, Corr &cor); DVector kronecker(const DVector &v1, const DVector &v2); DVector vec(const DMatrix &m); DMatrix ESSTijk(DVector &Mu1, DVector &Mu2, DMatrix &P11, int c1, int c3, bool rev); DMatrix ESST(DVector &Mu1, DVector &Mu2, DMatrix &P11, bool rev); void ord_prep_alpha(DVector &PR1, DVector &PR2, //DMatrix &V, DVector &Mu1, DVector &Mu2, //c^2 x 1 c x 1 c x 1 DMatrix &Z, DVector &Ooffset, bool rev, GeeParam &par, GeeStr &geestr, //output DVector &U2, DMatrix &V2, DMatrix &D2); double update_alpha(DVector &PR, DVector &Mu, DVector &W, DMatrix &Z, DVector &Ooffset, IVector &Clusz, int c, bool rev, GeeParam &par, GeeStr &geestr, Corr &cor); void ordgee_est(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, DVector &W, IVector &LinkWave, DMatrix &Z, IVector &Clusz, int c, bool rev, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con); void HiandGi(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, IVector &LinkWave, DMatrix &Z, int s1, int c, bool rev, Index1D &I, Index1D &J, GeeParam &par, GeeStr &geestr, Corr &cor, //output Hess &Hi, Grad &Gi); void HnandGis(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, IVector &LinkWave, DMatrix &Z, IVector &Clusz, int c, bool rev, GeeParam &par, GeeStr &geestr, Corr &cor, IVector &Scur, Hess &Hn, Vector &Gis); void HnandGis(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, IVector &LinkWave, DMatrix &Z, IVector &Clusz, int c, bool rev, GeeParam &par, GeeStr &geestr, Corr &cor, Hess &Hn, Vector &Gis); extern "C" { SEXP ordgee_rap(SEXP y, SEXP x, SEXP offset, SEXP doffset, SEXP w, SEXP linkwave, SEXP z, SEXP clusz, SEXP ncat, SEXP rev, SEXP geestr, SEXP cor, SEXP par, SEXP con); } #endif //ORDGEE_H geepack/inst/include/utils.h0000754000177400001440000000264111710513306015756 0ustar murdochusers#ifndef UTILS_H #define UTILS_H #include "tntsupp.h" #include "geese.h" void VecPrint(const DVector &v); Fortran_Matrix ident (int n); Fortran_Matrix MatRowCol(const Fortran_Matrix &mat, const Vector &r, const Vector &c); Fortran_Matrix rho2mat(const Vector &rho); //solve(a, b = ident(n)) DMatrix solve(const DMatrix &a, const DMatrix &b); DVector solve(const DMatrix &A, const DVector &b); DMatrix solve(const DMatrix &a); DMatrix AtBiC(const DMatrix &A, const DMatrix &B, const DMatrix &C); DVector AtBiC(const DMatrix &A, const DMatrix &B, const DVector &C); DMatrix apply_elwise(const DMatrix &x, double f(double)); DVector apply_elwise(const DVector &x, double f(double)); DVector sqrt(const DVector &x); double square(double x); DVector square(const DVector &x); double reciproot(double x); DVector reciproot(const DVector &x); double recip(double x); DVector recip(const DVector &x); int cluscount(DVector &ID); Vector clussize(DVector &ID); DVector SMult(const DVector &v1, const DVector &v2); DMatrix SMult(const DVector &v, const DMatrix &m); DMatrix operator*(const DVector &v, const DMatrix &m); DMatrix diag(const DVector &v); DVector diag(const DMatrix &m); DMatrix inv(const DMatrix &x); DMatrix fabs(const DMatrix &m); DVector fabs(const DVector &v); #endif //UTILS_H geepack/inst/include/geese.h0000754000177400001440000000014607752031670015716 0ustar murdochusers#ifndef GEESE_H #define GEESE_H using namespace std; using namespace TNT; #endif //GEESE_H geepack/inst/include/param.h0000754000177400001440000000673407752031670015737 0ustar murdochusers#ifndef PARAM_H #define PARAM_H #include "tntsupp.h" #include "geese.h" class Control{ protected: int _trace; int _ajs; int _j1s; int _fij; int _maxiter; double _tol; public: Control(int trace, int ajs, int j1s, int fij, int maxiter, double tol); Control(int *con, double tol); Control(const Control &C); int trace() const {return _trace;} int ajs() const {return _ajs;} int j1s() const {return _j1s;} int fij() const {return _fij;} int maxiter() const {return _maxiter;} double tol() const {return _tol;} void set_maxiter(int mit) {_maxiter = mit;} }; class GeeParam{ protected: DVector _beta; DVector _alpha; DVector _gamma; DMatrix _vbeta; DMatrix _vbeta_naiv; DMatrix _vbeta_ajs; DMatrix _vbeta_j1s; DMatrix _vbeta_fij; DMatrix _valpha; DMatrix _valpha_stab; DMatrix _valpha_naiv; DMatrix _valpha_ajs; DMatrix _valpha_j1s; DMatrix _valpha_fij; DMatrix _vgamma; DMatrix _vgamma_ajs; DMatrix _vgamma_j1s; DMatrix _vgamma_fij; //int _ScaleFix; int _err; public: GeeParam(DVector Beta, DVector Alpha, DVector Gamma); GeeParam(DVector Beta, DVector Alpha, DVector Gamma, DMatrix VBeta, DMatrix VBeta_naiv, DMatrix VBeta_ajs, DMatrix VBeta_j1s, DMatrix VBeta_fij, DMatrix VAlpha, DMatrix VAlpha_stab, DMatrix VAlpha_naiv, DMatrix VAlpha_ajs, DMatrix VAlpha_j1s, DMatrix VAlpha_fij, DMatrix VGamma, DMatrix VGamma_ajs, DMatrix VGamma_j1s, DMatrix VGamma_fij); ~GeeParam() {} void set_beta(const DVector &v) {_beta = v;} void set_alpha(const DVector &v) {_alpha = v;} void set_vbeta(const DMatrix &m) {_vbeta = m;} void set_vbeta_naiv(const DMatrix &m) {_vbeta_naiv = m;} void set_vbeta_ajs(const DMatrix &m) {_vbeta_ajs = m;} void set_vbeta_j1s(const DMatrix &m) {_vbeta_j1s = m;} void set_vbeta_fij(const DMatrix &m) {_vbeta_fij = m;} void set_valpha(const DMatrix &m) {_valpha = m;} void set_valpha_stab(const DMatrix &m) {_valpha_stab = m;} void set_valpha_naiv(const DMatrix &m) {_valpha_naiv = m;} void set_valpha_ajs(const DMatrix &m) {_valpha_ajs = m;} void set_valpha_j1s(const DMatrix &m) {_valpha_j1s = m;} void set_valpha_fij(const DMatrix &m) {_valpha_fij = m;} void set_gamma(const DVector &v) {_gamma = v;} void set_vgamma(const DMatrix &m) {_vgamma = m;} void set_vgamma_ajs(const DMatrix &m) {_vgamma_ajs = m;} void set_vgamma_j1s(const DMatrix &m) {_vgamma_j1s = m;} void set_vgamma_fij(const DMatrix &m) {_vgamma_fij = m;} void set_err(int e) {_err = e;} DVector beta() {return _beta;} DVector alpha() {return _alpha;} DVector gamma() {return _gamma;} DMatrix vbeta() {return _vbeta;} DMatrix valpha() {return _valpha;} DMatrix vbeta_naiv() {return _vbeta_naiv;} DMatrix vbeta_ajs() {return _vbeta_ajs;} DMatrix vbeta_j1s() {return _vbeta_j1s;} DMatrix vbeta_fij() {return _vbeta_fij;} DMatrix valpha_stab() {return _valpha_stab;} DMatrix valpha_naiv() {return _valpha_naiv;} DMatrix valpha_ajs() {return _valpha_ajs;} DMatrix valpha_j1s() {return _valpha_j1s;} DMatrix valpha_fij() {return _valpha_fij;} DMatrix vgamma() {return _vgamma;} DMatrix vgamma_ajs() {return _vgamma_ajs;} DMatrix vgamma_j1s() {return _vgamma_j1s;} DMatrix vgamma_fij() {return _vgamma_fij;} //int ScaleFix() {return _ScaleFix;} int p() {return _beta.dim();} int r() {return _gamma.dim();} int q() {return _alpha.dim();} int err() {return _err;} }; #endif //PARAM_H geepack/inst/include/famstr.h0000754000177400001440000001035411633415752016124 0ustar murdochusers#ifndef FAMSTR_H #define FAMSTR_H #include "tntsupp.h" #include "geese.h" typedef double fun1(double); typedef bool fun2(double); enum links {L_0, IDENT, LOGIT, PROBIT, CLOGLOG, LOG, INVERSE, FISHERZ, LWYBC2, LWYLOG}; enum variances {V_0, GAUSSIAN, BINOMIAL, POISSON, GAMMA}; enum correlations {C_0, INDEPENDENCE, EXCHANGEABLE, AR1, UNSTRUCTURED, USERDEFINED, FIXED}; DMatrix cor_exch(const DVector &rho, const DVector &wave); DMatrix cor_rho_exch(const DVector &rho, const DVector &wave); DMatrix cor_indep(const DVector &, const DVector &wave); DMatrix cor_rho_indep(const DVector &, const DVector &); DMatrix cor_ar1(const DVector &rho, const DVector &wave); DMatrix cor_rho_ar1(const DVector &rho, const DVector &wave); DMatrix cor_unstr(const DVector &rho, const DVector &wave); DMatrix cor_rho_unstr(const DVector &rho, const DVector &wave); DMatrix cor_fixed(const DVector &, const DVector &wave); //get cor matrix DMatrix cor_rho_fixed(const DVector &, const DVector &); //derivative class Corr{ public: typedef DMatrix matfun(const DVector &, const DVector&); typedef DMatrix cor_rho_fun(const DVector &, const DVector&); protected: int _corst, _nparam, _maxwave; matfun *_mat; cor_rho_fun *_cor_rho; void init(matfun *mat, cor_rho_fun *cor_rho) { _mat = mat; _cor_rho = cor_rho; } public: Corr(int corst, int maxwave); ~Corr() {} DMatrix mat(DVector &rho, DVector &wave) { return _mat(rho, wave); } DMatrix cor_rho(DVector &rho, DVector &wave) { return _cor_rho(rho, wave); } int nparam(){return _nparam;} int corst() {return _corst; } }; class Link{ protected: fun1 *_linkfun, *_linkinv, *_mu_eta; void init(fun1* linkfun, fun1* linkinv, fun1* mu_eta) { _linkfun = linkfun; _linkinv = linkinv; _mu_eta = mu_eta; } public: //Link(int link); //Link() {int link = IDENT; Link(link); } Link(int link = IDENT); Link(fun1* linkfun, fun1* linkinv, fun1* mu_eta); ~Link() {} double linkfun(double mu) {return _linkfun(mu);} double linkinv(double eta) {return _linkinv(eta);} double mu_eta(double eta) {return _mu_eta(eta);} }; class Variance{ protected: fun1 *_v, *_v_mu; fun2 *_validmu; void init(fun1* v, fun1* v_mu, fun2 validmu) { _v = v; _v_mu = v_mu; _validmu = validmu; } public: Variance(fun1* v, fun1* v_mu, fun2* validmu) { init(v, v_mu, validmu); } //Variance(int var); //Variance() {int var = GAUSSIAN; Variance(var);} Variance(int var = GAUSSIAN); ~Variance() {} double v(double mu) {return _v(mu);} double v_mu(double mu) {return _v_mu(mu);} bool validmu(double mu) {return _validmu(mu);} }; /* static Link Ident(1), Logit(2), Probit(3), Cloglog(4), Log(5), Inverse(6), Fisherz(7); static Variance Gaussian(1), Binomial(2), Poisson(3), Gamma(4); static Link LINK[] = {Ident, Logit, Probit, Cloglog, Log, Inverse, Fisherz}; static Variance VARIANCE[] = {Gaussian, Binomial, Poisson, Gamma}; */ class GeeStr{ Vector MeanLink; Vector V; Vector ScaleLink; Link CorrLink; int ScaleFix_; public: GeeStr(int n, Vector meanlink, Vector v, Vector scalelink, int corrlink, int scalefix); ~GeeStr() {} int ScaleFix() {return ScaleFix_;} double MeanLinkfun(double mu, int wave) { return MeanLink(wave).linkfun(mu); } double MeanLinkinv(double eta, int wave) { return MeanLink(wave).linkinv(eta); } double MeanMu_Eta(double eta, int wave) { return MeanLink(wave).mu_eta(eta); } DVector MeanLinkfun(const DVector &Mu, const IVector &Wave); DVector MeanLinkinv(const DVector &Eta, const IVector &Wave); DVector MeanMu_eta(const DVector &Eta, const IVector &Wave); DVector ScaleLinkfun(const DVector &Mu, const IVector &Wave); DVector ScaleLinkinv(const DVector &Eta, const IVector &Wave); DVector ScaleMu_eta(const DVector &Eta, const IVector &Wave); DVector CorrLinkfun(const DVector &Mu); DVector CorrLinkinv(const DVector &Eta); DVector CorrMu_eta(const DVector &Eta); DVector v(const DVector &Mu, const IVector &Wave); DVector v_mu(const DVector &Mu, const IVector &Wave); bool validMu(const DVector &Mu, const IVector &Wave); }; #endif //FAMSTR_H geepack/inst/include/inter.h0000754000177400001440000000122112736704174015746 0ustar murdochusers#ifndef INTER_H #define INTER_H // extern "C" { #include #include // } #include "tntsupp.h" #include "geese.h" #include "famstr.h" #include "param.h" #include "geesubs.h" DMatrix asDMatrix(SEXP a); DVector asDVector(SEXP a); IVector asIVector(SEXP a); Vector asVDVector(SEXP a); SEXP asSEXP(const DMatrix &a); SEXP asSEXP(const DVector &a); SEXP asSEXP(const IVector &a); SEXP asSEXP(const Vector &a); Control asControl(SEXP con); GeeParam asGeeParam(SEXP par); GeeStr asGeeStr(SEXP geestr); Corr asCorr(SEXP cor); SEXP asSEXP(GeeParam &Par); #endif //INTER_H geepack/src/0000755000177400001440000000000012771411433012635 5ustar murdochusersgeepack/src/Makevars0000754000177400001440000000005212771411433014330 0ustar murdochusersPKG_CPPFLAGS = -I../inst/include -DNDEBUG geepack/src/gee2.cc0000754000177400001440000004403112771411433013772 0ustar murdochusers// using namespace std; // #include "tntsupp.h" // #include "geese.h" // extern "C"{ // #include // #include // #include // } // #include "famstr.h" // #include "param.h" // #include "inter.h" // #include "utils.h" // #include "geesubs.h" #include "gee2.h" IVector comp_lev(GeeStr &geestr, Corr &cor) { IVector level(2); if (geestr.ScaleFix() != 1) level(1) = 1; if (cor.nparam() > 0) level(2) = 1; return level; } DMatrix gee_infls(DVector &Y, DMatrix &X, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con) { Hess Hi(par), H(par); Grad Gi(par); int n = Clusz.size(); IVector ZcorSize(n); //if (cor.nparam() > 1) if (cor.corst() > AR1) // == UNSTRUCTRUED || USERDEFINED || FIXED for (int i = 1; i <= n; i++) ZcorSize(i) = Clusz(i) * (Clusz(i) - 1) / 2; else ZcorSize = 1; IVector level(2); level = 0; if (geestr.ScaleFix() != 1) level(1) = 1; if (cor.nparam() > 0) level(2) = 1; int p = par.p(), q = par.q(), r = par.r(); DMatrix L11(p,p), L12(p,r), L13(p,q), L22(r,r), L23(r,q), L33(q,q); int l = p + q + r; DMatrix infls(l, n), HH(l, l); Index1D I(0,0), J(0,0); Index1D I1(0, 0), JJ(0, 0), I2(0, 0), I3(0, 0); I1 = Index1D(1, p); I2 = Index1D(p + 1, p + r); I3 = Index1D(p + r + 1, p + r + q); for (int i = 1; i <= n; i++) { int s1 = Clusz(i), s2 = ZcorSize(i), crs = s1 * (s1 - 1) / 2;; I = Index1D(1, s1) + I.ubound(); if (s2 > 0) J = Index1D(1, s2) + J.ubound(); DVector PRi(s1), Vi(s1), V_Mui(s1); DMatrix Di(s1,p); gee_prep(Y, X, Offset, I, LinkWave, par, geestr, PRi, Di, Vi, V_Mui); DVector Phii(s1); DMatrix D2i(s1, r); PhiandD2(I, LinkWave, Doffset, Zsca, par, geestr, Phii, D2i); DMatrix R(s1, s1), E(crs, q); RandE(Zcor, I, J, CorP, par, geestr, cor, R, E); //cout << "i = " << i; DVector Wi = asVec(VecSubs(W, I)); HiandGi(PRi, Phii, Di, R, Vi, V_Mui, D2i, E, Wi, level, Hi, Gi); //cout << "Hi = " << Hi; cout << "H = " << H; //cout << "Gi = " << Gi; H.inc(Hi); JJ = Index1D(i, i); infls(I1, JJ) = asColMat(Gi.U1()); if (level(1) == 1) infls(I2, JJ) = asColMat(Gi.U2()); if (level(2) == 1) infls(I3, JJ) = asColMat(Gi.U3()); } Hess Hinv = inv(H, level); I1 = Index1D(1, p); HH(I1, I1) = Hinv.A(); if (level(1) == 1) { HH(I2, I1) = Hinv.B(); HH(I2, I2) = Hinv.C(); } if (level(2) == 1) { HH(I3, I1) = Hinv.D(); HH(I3, I3) = Hinv.F(); if (level(1) == 1) HH(I3, I2) = Hinv.E(); } infls = HH * infls; return infls; } void gee_var(DVector &Y, DMatrix &X, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, IVector &ZcorSize, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con) { Hess Hi(par), H(par); Grad Gi(par); IVector level(2); level = 0; if (geestr.ScaleFix() != 1) level(1) = 1; if (cor.nparam() > 0) level(2) = 1; int p = par.p(), q = par.q(), r = par.r(); DMatrix L11(p,p), L12(p,r), L13(p,q), L22(r,r), L23(r,q), L33(q,q); Index1D I(0,0), J(0,0); for (int i = 1; i <= Clusz.size(); i++) { int s1 = Clusz(i), s2 = ZcorSize(i), crs = s1 * (s1 - 1) / 2;; I = Index1D(1, s1) + I.ubound(); if (s2 > 0) J = Index1D(1, s2) + J.ubound(); DVector PRi(s1), Vi(s1), V_Mui(s1); DMatrix Di(s1,p); gee_prep(Y, X, Offset, I, LinkWave, par, geestr, PRi, Di, Vi, V_Mui); DVector Phii(s1); DMatrix D2i(s1, r); PhiandD2(I, LinkWave, Doffset, Zsca, par, geestr, Phii, D2i); DMatrix R(s1, s1), E(crs, q); RandE(Zcor, I, J, CorP, par, geestr, cor, R, E); //cout << "i = " << i; DVector Wi = asVec(VecSubs(W, I)); HiandGi(PRi, Phii, Di, R, Vi, V_Mui, D2i, E, Wi, level, Hi, Gi); //cout << "Hi = " << Hi; cout << "H = " << H; //cout << "Gi = " << Gi; H.inc(Hi); L11 = L11 + outerprod(Gi.U1()); if (level(1) == 1) { L12 = L12 + outerprod(Gi.U1(), Gi.U2()); L22 = L22 + outerprod(Gi.U2()); } if (level(2) == 1) { L13 = L13 + outerprod(Gi.U1(), Gi.U3()); L33 = L33 + outerprod(Gi.U3()); if (level(1) == 1) L23 = L23 + outerprod(Gi.U2(), Gi.U3()); } } //Vbeta: Hess Hinv = inv(H, level); par.set_vbeta_naiv(Hinv.A()); par.set_vbeta(Hinv.A() * L11 * Hinv.A()); //Vgamma: if (level(1) == 1) { par.set_vgamma((Hinv.B() * L11 + Hinv.C() * transpose(L12)) * transpose(Hinv.B()) + (Hinv.B() * L12 + Hinv.C() * L22) * Hinv.C()); } //Valpha: if (level(2) == 1) { par.set_valpha_naiv(Hinv.F()); par.set_valpha_stab(Hinv.F() * L33 * Hinv.F()); par.set_valpha((Hinv.D() * L11 + Hinv.E() * transpose(L12) + Hinv.F() * transpose(L13)) * transpose(Hinv.D()) + (Hinv.D() * L12 + Hinv.E() * L22 + Hinv.F() * transpose(L23)) * transpose(Hinv.E()) + (Hinv.D() * L13 + Hinv.E() * L23 + Hinv.F() * L33) * Hinv.F()); } } double update_beta(DVector &Y, DMatrix &X, DVector &Offset, DVector &W, DVector &Phi, IVector &LinkWave, DVector &CorP, DMatrix &Zcor, IVector &Clusz, IVector &ZcorSize, IVector &Jack, GeeParam &par, GeeStr &geestr, Corr &cor) { double del = 0; // DVector alp = par.alpha(); int p = par.p(); DMatrix H(p,p); DVector G(p); int n = Clusz.size(); Index1D I(0,0), J(0,0); for (int i = 1; i <= n; i++) { int s1 = Clusz(i), s2 = ZcorSize(i); I = Index1D(1, s1) + I.ubound(); if (s2 > 0) J = Index1D(1, s2) + J.ubound(); //?? what is s2 == 0 ?? if (Jack(i) == 1) continue; DVector PRi(s1); DMatrix Di(s1,p); PRandD(Y, X, Offset, I, LinkWave, par, geestr, PRi, Di); DVector rootInvPhii = sqrt(recip(asVec(VecSubs(Phi, I)))); DVector rootWi = sqrt(asVec(VecSubs(W, I))); Di = SMult(rootWi, Di); PRi = SMult(rootWi, PRi); Di = SMult(rootInvPhii, Di); PRi = SMult(rootInvPhii, PRi); DMatrix R = getR(Zcor, I, J, CorP, par, geestr, cor); H = H + AtBiC(Di, R, Di); G = G + AtBiC(Di, R, PRi); } DVector Del = solve(H, G); DVector Bnew = par.beta() + Del; while (1) { // cerr << "in updating beta: " << "Del = " << Del << endl; DVector Eta = X * Bnew + Offset; DVector Mu = geestr.MeanLinkinv(Eta, LinkWave); if (geestr.validMu(Mu, LinkWave)) break; Del = 0.5 * Del; Bnew = par.beta() + Del; } par.set_beta(Bnew); del = fmax(fabs(Del)); return del; } double update_gamma(DVector &PR, DVector &W, IVector &LinkWave, IVector &Clusz, IVector &Jack, DVector &Doffset, DMatrix &Zsca, GeeParam &par, GeeStr &geestr) { double del = 0; int r = par.r(), n = Clusz.size(); // double adj = (double) (PR.size()) / (double)(PR.size() - par.p()); if (geestr.ScaleFix() == 1) return del; DMatrix H(r,r); DVector G(r); Index1D I(0,0); for (int i = 1; i <= n; i++) { int s1 = Clusz(i); I = Index1D(1, s1) + I.ubound(); if (Jack(i) == 1) continue; DVector Phii(s1), Si(s1); DMatrix D2i(s1, r); gm_prep(PR, I, LinkWave, Doffset, Zsca, par, geestr, Phii, Si, D2i); //DMatrix V2 = diag(2.0 * Phii); //independence working structure only now, so no inverting below DVector WiV2inv = SMult(asVec(VecSubs(W, I)), recip(2.0 * Phii)); H = H + Transpose_view(D2i) * SMult(WiV2inv, D2i); G = G + Transpose_view(D2i) * SMult(WiV2inv, Si - Phii); //adj * Si //H = H + AtBiC(D2i, WiV2, D2i); //G = G + AtBiC(D2i, WiV2, Si - Phii); } DVector Del = solve(H, G); //cout << "H = " << H << "G = " << G; //par.set_gamma((double) N / (double)(N - p) * (par.gamma() + Del)); par.set_gamma(par.gamma() + Del); del = fmax(fabs(Del)); return del; } double update_alpha(DVector &PR, DVector &Phi, DVector &CorP, DVector &W, IVector &Clusz, IVector &ZcorSize, IVector &Jack, DMatrix &Zcor, GeeParam &par, GeeStr &geestr, Corr &cor) { double del = 0; int q = par.q(), n = Clusz.size(); if (cor.nparam() == 0) return del; DMatrix H(q,q); DVector G(q); Index1D I(0,0), J(0,0); for (int i = 1; i <= n; i++) { int s1 = Clusz(i), s2 = ZcorSize(i), crs = s1 * (s1 - 1) / 2; I = Index1D(1, s1) + I.ubound(); if (s2 > 0) J = Index1D(1, s2) + J.ubound(); if (Jack(i) == 1) continue; if (s1 == 1) continue; DVector PRi = asVec(VecSubs(PR, I)); DVector Phii = asVec(VecSubs(Phi, I)); DVector sPRi = SMult(reciproot(Phii), PRi); DVector zi = genzi(sPRi); DMatrix R(s1, s1), E(crs, q); RandE(Zcor, I, J, CorP, par, geestr, cor, R, E); DVector rhoi = utri(R); DVector Wi = asVec(VecSubs(W, I)); //DMatrix V3 = diag(genzi(rootWi)); //independence working correlation only now, no need of inverting below DVector WiV3inv = genzi(Wi); H = H + Transpose_view(E) * SMult(WiV3inv, E); G = G + Transpose_view(E) * SMult(WiV3inv, zi - rhoi); //H = H + AtBiC(E, V3, E); //G = G + AtBiC(E, V3, zi - rhoi); } DVector Del = solve(H, G); par.set_alpha(par.alpha() + Del); del = fmax(fabs(Del)); return del; } /********************************************************* Input: Y: response vector; X: covariate matrix for mean structure; LinkWave: determines which link to apply on each response component; Weight: weight, to be implemented ... ... ???; Offset: offset, to be implemented ... ... ???; Zsca: covariate matrix for scale structure; Zcor: covariate matrix for correlation structure; Corp: correlation parameters to feed cor.mat(rho, .), can be distances for spatial correlation; it is now a vector, which can not really handle >=2 spatial correlations; it really should be a matrix which contains the data to feed cor.mat(rho, .); it actually is the same as LinkWave now, but should be more general to contain high dimensional data, such as coordinates in R x R. Clusz: cluster sizes; ZcorSize: number of rows in Zcor for each cluster; geestr: GEE structure, contains links, variances for each wave; cor: correlation structure; par: parameter values; Jack: Jackknife indicator; con: control parameters: ScaleFix, ajs, j1s, fij, tol, maxiter; *********************************************************/ void gee_est(DVector &Y, DMatrix &X, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, IVector &ZcorSize, GeeStr &geestr, Corr &cor, GeeParam &par, IVector &Jack, Control &con) { DVector Del(3); int N = Y.size(); DVector PR(N), Phi(N); int iter; double del; for (iter = 0; iter < con.maxiter(); iter++) { if (con.trace() == 1) { //cerr << "iter " << iter << endl; //cerr << "beta = " << par.beta() << "gamma = " << par.gamma() << "alpha = " << par.alpha(); Rprintf("iter = %d\n", iter); Rprintf("beta = "); VecPrint(par.beta()); Rprintf("gamma = "); VecPrint(par.gamma()); Rprintf("alpha = "); VecPrint(par.alpha()); } //updating beta; Phi = getPhi(Doffset, Zsca, LinkWave, par, geestr); Del(1) = update_beta(Y, X, Offset, W, Phi, LinkWave, CorP, Zcor, Clusz, ZcorSize, Jack, par, geestr, cor); //updating gamma; PR = getPR(Y, X, Offset, LinkWave, par, geestr); //cout << "PR = " << PR; //PR = (double) (N / (N - p)) * PR; //df adjusting Del(2) = update_gamma(PR, W, LinkWave, Clusz, Jack, Doffset, Zsca, par, geestr); //updating alpha; Phi = getPhi(Doffset, Zsca, LinkWave, par, geestr); Del(3) = update_alpha(PR, Phi, CorP, W, Clusz, ZcorSize, Jack, Zcor, par, geestr, cor); del = fmax(Del); if (del <= con.tol()) break; } if (iter == con.maxiter()) par.set_err(1); } void getJackVar(Vector &beta_i, Vector &alpha_i, Vector &gamma_i, GeeParam &par, int jack) { //jack = 1, 2, 3 for ajs, j1s, fij int I = beta_i.size(), p = par.p(), q = par.q(), r = par.r(); DMatrix vb(p,p), va(q,q), vc(r,r); //cout << par.beta(); for (int i = 1; i <= I; i++) { //cout << "i = " << i << " " << beta_i(i); vb = vb + outerprod(beta_i(i) - par.beta()); //can use level as in gee2_var va = va + outerprod(alpha_i(i) - par.alpha()); vc = vc + outerprod(gamma_i(i) - par.gamma()); } double f = (double) (I - p - q - r) / I; if (jack == 3) {//fij par.set_vbeta_fij(f * vb); par.set_valpha_fij(f * va); par.set_vgamma_fij(f * vc); } else if (jack == 2) { //j1s par.set_vbeta_j1s(f * vb); par.set_valpha_j1s(f * va); par.set_vgamma_j1s(f * vc); } else {//ajs par.set_vbeta_ajs(f * vb); par.set_valpha_ajs(f * va); par.set_vgamma_ajs(f * vc); } } void gee_jack(DVector &Y, DMatrix &Xmat, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, IVector &ZcorSize, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con) { int I = Clusz.size(); // int p = par.p(), q = par.q(), r = par.r(); IVector Jack(I); Vector beta_i(I), alpha_i(I), gamma_i(I); Vector beta_fi(I), alpha_fi(I), gamma_fi(I); //DVector b0(p), a0(q), c0(r); //beta_i = b0; alpha_i(I) = a0; gamma_i(I) = c0; //beta_fi = b0; alpha_fi(I) = a0; gamma_fi(I) = c0; Control con1(con); con1.set_maxiter(1); //for j1s for (int i = 1; i <= I; i++) { Jack(i) = 1; GeeParam par_i(par.beta(), par.alpha(), par.gamma()); if (con.j1s() == 1) { gee_est(Y, Xmat, Offset, Doffset, W, LinkWave, Zsca, Zcor, CorP, Clusz, ZcorSize, geestr, cor, par_i, Jack, con1); //1-step beta_i(i) = par_i.beta(); alpha_i(i) = par_i.alpha(); gamma_i(i) = par_i.gamma(); } if (con.fij() == 1) { gee_est(Y, Xmat, Offset, Doffset, W, LinkWave, Zsca, Zcor, CorP, Clusz, ZcorSize, geestr, cor, par_i, Jack, con); //full iterated beta_fi(i) = par_i.beta(); alpha_fi(i) = par_i.alpha(); gamma_fi(i) = par_i.gamma(); } Jack(i) = 0; } if (con.j1s() == 1) getJackVar(beta_i, alpha_i, gamma_i, par, 2); if (con.fij() == 1) getJackVar(beta_fi, alpha_fi, gamma_fi, par, 3); } void jack_ajs(DVector &Y, DMatrix &X, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, IVector &ZcorSize, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con) {//con is not used int I = Clusz.size(), p = par.p(), q = par.q(), r = par.r(); Vector His(I); Vector Gis(I); IVector level = comp_lev(geestr, cor), Scur(Y.size()); Scur = 1; HisandGis(Y, X, Offset, Doffset, W, LinkWave, Clusz, ZcorSize, Zsca, Zcor, CorP, par, geestr, cor, Scur, level, His, Gis); Hess Hn(par); for (int i = 1; i <= I; i++) Hn.inc(His(i)); Vector beta_i(I), alpha_i(I), gamma_i(I); DVector b0(p), a0(q), c0(r); beta_i = b0; alpha_i(I) = a0; gamma_i(I) = c0; DMatrix vb(p,p), va(q,q), vc(r,r); for (int i = 1; i <= I; i++) { Hess H_i = Hn - His(i); H_i = inv(H_i, level); beta_i(i) = H_i.A() * Gis(i).U1(); gamma_i(i) = H_i.B() * Gis(i).U1() + H_i.C() * Gis(i).U2(); alpha_i(i) = H_i.D() * Gis(i).U1() + H_i.E() * Gis(i).U2() + H_i.F() * Gis(i).U3(); vb = vb + outerprod(beta_i(i)); //can use level as in gee2_var va = va + outerprod(alpha_i(i)); vc = vc + outerprod(gamma_i(i)); } double f = (double) (I - p - q - r) / I; par.set_vbeta_ajs(f * vb); par.set_valpha_ajs(f * va); par.set_vgamma_ajs(f * vc); } void gee_top(DVector &Y, DMatrix &Xmat, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, IVector &Clusz, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con) { int I = Clusz.size(); IVector Jack(I), ZcorSize(I); //initializing ZcorSize //if (cor.nparam() > 1) if (cor.corst() > AR1) // == UNSTRUCTRUED || USERDEFINED || FIXED for (int i = 1; i <= I; i++) ZcorSize(i) = Clusz(i) * (Clusz(i) - 1) / 2; else ZcorSize = 1; gee_est(Y, Xmat, Offset, Doffset, W, LinkWave, Zsca, Zcor, CorP, Clusz, ZcorSize, geestr, cor, par, Jack, con); gee_var(Y, Xmat, Offset, Doffset, W, LinkWave, Zsca, Zcor, CorP, Clusz, ZcorSize, geestr, cor, par, con); if (con.ajs() == 1) jack_ajs(Y, Xmat, Offset, Doffset, W, LinkWave, Zsca, Zcor, CorP, Clusz, ZcorSize, geestr, cor, par, con); if (con.j1s() + con.fij() > 0) gee_jack(Y, Xmat, Offset, Doffset, W, LinkWave, Zsca, Zcor, CorP, Clusz, ZcorSize, geestr, cor, par, con); } extern "C" { SEXP gee_rap(SEXP y, SEXP x, SEXP offset, SEXP doffset, SEXP w, SEXP linkwave, SEXP zsca, SEXP zcor, SEXP corp, SEXP clusz, SEXP geestr, SEXP cor, SEXP par, SEXP con) { DVector Y = asDVector(y), Offset = asDVector(offset), Doffset = asDVector(doffset), W = asDVector(w); IVector LinkWave = asIVector(linkwave); DVector CorP = asDVector(corp); DMatrix X = asDMatrix(x), Zsca = asDMatrix(zsca), Zcor = asDMatrix(zcor); IVector Clusz = asIVector(clusz); // ZcorSize = asIVector(zcorsize); Control Con = asControl(con); GeeParam Par = asGeeParam(par); GeeStr Geestr = asGeeStr(geestr); Corr Cor = asCorr(cor); gee_top(Y, X, Offset, Doffset, W, LinkWave, Zsca, Zcor, CorP, Clusz, Geestr, Cor, Par, Con); SEXP ans = asSEXP(Par); return ans; } /* return the influence functions for parameters */ SEXP infls_rap(SEXP y, SEXP x, SEXP offset, SEXP doffset, SEXP w, SEXP linkwave, SEXP zsca, SEXP zcor, SEXP corp, SEXP clusz, SEXP geestr, SEXP cor, SEXP par, SEXP con) { DVector Y = asDVector(y), Offset = asDVector(offset), Doffset = asDVector(doffset), W = asDVector(w); IVector LinkWave = asIVector(linkwave); DVector CorP = asDVector(corp); DMatrix X = asDMatrix(x), Zsca = asDMatrix(zsca), Zcor = asDMatrix(zcor); IVector Clusz = asIVector(clusz); // ZcorSize = asIVector(zcorsize); Control Con = asControl(con); GeeParam Par = asGeeParam(par); GeeStr Geestr = asGeeStr(geestr); Corr Cor = asCorr(cor); DMatrix infls = gee_infls(Y, X, Offset, Doffset, W, LinkWave, Zsca, Zcor, CorP, Clusz, Geestr, Cor, Par, Con); SEXP ans = asSEXP(infls); return ans; } } geepack/src/inter.cc0000754000177400001440000001135212771411433014271 0ustar murdochusersusing namespace std; #include "tntsupp.h" #include "geese.h" #include #include #include #include "famstr.h" #include "param.h" #include "inter.h" DMatrix asDMatrix(SEXP a) { double *x; x = NUMERIC_POINTER(AS_NUMERIC(a)); int *dims = INTEGER_POINTER(AS_INTEGER(GET_DIM(a))); DMatrix ans(dims[0], dims[1], x); return ans; } DVector asDVector(SEXP a) { double *x; x = NUMERIC_POINTER(AS_NUMERIC(a)); int len = GET_LENGTH(a); DVector ans(len, x); return ans; } IVector asIVector(SEXP a) { int *x; x = INTEGER_POINTER(AS_INTEGER(a)); int len = GET_LENGTH(a); IVector ans(len, x); return ans; } Vector asVDVector(SEXP a) {//a is a matrix double *x; x = NUMERIC_POINTER(AS_NUMERIC(a)); int *dims = INTEGER_POINTER(AS_INTEGER(GET_DIM(a))); Vector ans(dims[1]); for (int i = 1; i <= ans.size(); i++) { DVector tmp(dims[0], x); ans(i) = tmp; x += dims[0]; } return ans; } SEXP asSEXP(const DMatrix &a) { int size = a.num_cols() * a.num_rows(); SEXP val; PROTECT(val = NEW_NUMERIC(size)); double *p = NUMERIC_POINTER(val); const double *q = a.begin(); for (int i = 0; i < size; i++) p[i] = q[i]; // SET_CLASS(val, ScalarString(mkChar("matrix"))); SEXP dim; PROTECT(dim = NEW_INTEGER(2)); INTEGER(dim)[0] = a.num_rows(); INTEGER(dim)[1] = a.num_cols(); SET_DIM(val, dim); UNPROTECT(2); return val; } SEXP asSEXP(const DVector &a) { int size = a.size(); SEXP val; PROTECT(val = NEW_NUMERIC(size)); double *p = NUMERIC_POINTER(val); const double *q = a.begin(); for (int i = 0; i < size; i++) p[i] = q[i]; // SET_CLASS(val, ScalarString(mkChar("vector"))); SEXP len; PROTECT(len = NEW_INTEGER(1)); INTEGER(len)[0] = size; SET_LENGTH(val, size); UNPROTECT(2); return val; } SEXP asSEXP(const IVector &a) { int size = a.size(); SEXP val; PROTECT(val = NEW_INTEGER(size)); int *p = INTEGER_POINTER(val); const int *q = a.begin(); for (int i = 0; i < size; i++) p[i] = q[i]; // SET_CLASS(val, ScalarString(mkChar("vector"))); SEXP len; PROTECT(len = NEW_INTEGER(1)); INTEGER(len)[0] = size; SET_LENGTH(val, size); UNPROTECT(2); return val; } Control asControl(SEXP con) { //con is a list of trace, jack, j1s, fij, maxiter, epsilon int trace, jack, j1s, fij, maxiter; double tol; trace = INTEGER(VECTOR_ELT(con, 0))[0]; jack = INTEGER(VECTOR_ELT(con, 1))[0]; j1s = INTEGER(VECTOR_ELT(con, 2))[0]; fij = INTEGER(VECTOR_ELT(con, 3))[0]; maxiter = INTEGER(VECTOR_ELT(con, 4))[0]; tol = REAL(VECTOR_ELT(con, 5))[0]; Control Con(trace, jack, j1s, fij, maxiter, tol); return Con; } GeeParam asGeeParam(SEXP par) { //par is a list of beta, alpha, gamma; DVector Beta = asDVector(VECTOR_ELT(par, 0)); DVector Alpha = asDVector(VECTOR_ELT(par, 1)); DVector Gamma = asDVector(VECTOR_ELT(par, 2)); GeeParam Par(Beta, Alpha, Gamma); return Par; } GeeStr asGeeStr(SEXP geestr) { //geestr is a list of maxwave, meanlink, v, scalelink, corrlink, scale.fix; int maxwave = INTEGER(AS_INTEGER(VECTOR_ELT(geestr, 0)))[0]; IVector MeanLink = asIVector(AS_INTEGER(VECTOR_ELT(geestr, 1))); IVector V = asIVector(AS_INTEGER(VECTOR_ELT(geestr, 2))); IVector ScaleLink = asIVector(AS_INTEGER(VECTOR_ELT(geestr, 3))); int corrlink = INTEGER(AS_INTEGER(VECTOR_ELT(geestr, 4)))[0]; int scalefix = INTEGER(AS_INTEGER(VECTOR_ELT(geestr, 5)))[0]; GeeStr G(maxwave, MeanLink, V, ScaleLink, corrlink, scalefix); return G; } Corr asCorr(SEXP cor) { //cor is a list of corst, maxwave int corstr, maxwave; corstr = INTEGER(VECTOR_ELT(cor, 0))[0]; maxwave = INTEGER(VECTOR_ELT(cor, 1))[0]; Corr Cor(corstr, maxwave); return Cor; } SEXP asSEXP(GeeParam &Par) { SEXP ans; PROTECT(ans = NEW_LIST(19)); SET_VECTOR_ELT(ans, 0, asSEXP(Par.beta())); SET_VECTOR_ELT(ans, 1, asSEXP(Par.alpha())); SET_VECTOR_ELT(ans, 2, asSEXP(Par.gamma())); SET_VECTOR_ELT(ans, 3, asSEXP(Par.vbeta())); SET_VECTOR_ELT(ans, 4, asSEXP(Par.valpha())); SET_VECTOR_ELT(ans, 5, asSEXP(Par.vgamma())); SET_VECTOR_ELT(ans, 6, asSEXP(Par.vbeta_naiv())); SET_VECTOR_ELT(ans, 7, asSEXP(Par.valpha_naiv())); SET_VECTOR_ELT(ans, 8, asSEXP(Par.valpha_stab())); SET_VECTOR_ELT(ans, 9, asSEXP(Par.vbeta_ajs())); SET_VECTOR_ELT(ans, 10, asSEXP(Par.valpha_ajs())); SET_VECTOR_ELT(ans, 11, asSEXP(Par.vgamma_ajs())); SET_VECTOR_ELT(ans, 12, asSEXP(Par.vbeta_j1s())); SET_VECTOR_ELT(ans, 13, asSEXP(Par.valpha_j1s())); SET_VECTOR_ELT(ans, 14, asSEXP(Par.vgamma_j1s())); SET_VECTOR_ELT(ans, 15, asSEXP(Par.vbeta_fij())); SET_VECTOR_ELT(ans, 16, asSEXP(Par.valpha_fij())); SET_VECTOR_ELT(ans, 17, asSEXP(Par.vgamma_fij())); IVector Err(1); Err(1) = Par.err(); SET_VECTOR_ELT(ans, 18, asSEXP(Err)); UNPROTECT(1); return ans; } geepack/src/param.cc0000754000177400001440000000423112771411433014246 0ustar murdochusersusing namespace std; #include "tntsupp.h" #include "geese.h" #include "param.h" //class Control Control::Control(int trace, int ajs, int j1s, int fij, int maxiter, double tol) : _trace(trace), _ajs(ajs), _j1s(j1s), _fij(fij), _maxiter(maxiter), _tol(tol){} Control::Control(int *con, double tol) { _trace = con[0]; _ajs = con[1]; _j1s = con[2]; _fij = con[3]; _maxiter = con[4]; _tol = tol; } Control::Control(const Control &C) : //{ _trace(C.trace()), _ajs(C.ajs()), _j1s(C.j1s()), _fij(C.fij()), _maxiter(C.maxiter()), _tol(C.tol()) {} // _trace = C.trace(); _ajs = C.ajs(); _j1s = C.j1s(); //_fij = C.fij(); _maxiter = C.maxiter(); _tol = C.tol(); //} //class GeeParam GeeParam::GeeParam(DVector Beta, DVector Alpha, DVector Gamma): _beta(Beta), _alpha(Alpha), _gamma(Gamma), _err(0) { int p = Beta.size(), q = Alpha.size(), r = Gamma.size(); DMatrix vb(p,p), va(q,q), vg(r,r); _vbeta = vb; _vbeta_naiv = vb; _vbeta_ajs = vb; _vbeta_j1s = vb; _vbeta_fij = vb; _valpha = va; _valpha_naiv = va; _valpha_ajs = va; _valpha_j1s = va; _valpha_fij = va; _valpha_stab = va; _vgamma = vg; _vgamma_ajs = vg; _vgamma_j1s = vg; _vgamma_fij = vg; } GeeParam::GeeParam(DVector Beta, DVector Alpha, DVector Gamma, DMatrix VBeta, DMatrix VBeta_naiv, DMatrix VBeta_ajs, DMatrix VBeta_j1s, DMatrix VBeta_fij, DMatrix VAlpha, DMatrix VAlpha_stab, DMatrix VAlpha_naiv, DMatrix VAlpha_ajs, DMatrix VAlpha_j1s, DMatrix VAlpha_fij, DMatrix VGamma, DMatrix VGamma_ajs, DMatrix VGamma_j1s, DMatrix VGamma_fij): _beta(Beta), _alpha(Alpha), _gamma(Gamma), _vbeta(VBeta), _vbeta_naiv(VBeta_naiv), _vbeta_ajs(VBeta_ajs), _vbeta_j1s(VBeta_j1s), _vbeta_fij(VBeta_fij), _valpha(VAlpha), _valpha_stab(VAlpha_stab), _valpha_naiv(VAlpha_naiv), _valpha_ajs(VAlpha_ajs), _valpha_j1s(VAlpha_j1s), _valpha_fij(VAlpha_fij), _vgamma(VGamma), _vgamma_ajs(VGamma_ajs), _vgamma_j1s(VGamma_j1s), _vgamma_fij(VGamma_fij) {} /* GeeParam(int p, int q, double *beta, double *alpha, double *vbeta, double *vbeta_naiv, double *valpha, double *valpha_stab, double *valpha_naiv) { _beta(beta, p); _alpha(alpha, q); _vbeta(vbeta, p, p); } */ geepack/src/famstr.cc0000754000177400001440000002641512771411433014452 0ustar murdochusersusing namespace std; #include "tntsupp.h" #include "geese.h" #include "utils.h" #include "famstr.h" #include #include /* typedef double fun1(double); typedef double fun2(double, int); DVector Apply_elt(const DVector &V, fun1* f) { DVector ans(V.size()); for (int i = 1; i <= V.size(); i++) ans(i) = f(V(i)); return ans; } DVector Apply_elt(const DVector &V, const DVector &Wave, fun2* f) { DVector ans(V.size()); for (int i = 1; i <= V.size(); i++) ans(i) = f(V(i), (int)Wave(i)); return ans; } */ /* double dnorm(double x) {return dnorm4(x, 0, 1, 0);} double pnorm(double x) {return pnorm5(x, 0, 1, 1, 0);} double qnorm(double x) {return qnorm5(x, 0, 1, 1, 0);} */ //link functions // logit double linkfun_logit(double mu) {return log(mu/(1 - mu));} double linkinv_logit(double eta) { double thres = - log(DBL_EPSILON); eta = (eta > thres) ? thres : eta; eta = (eta < - thres) ? -thres : eta; return exp(eta)/(1 + exp(eta)); } double mu_eta_logit(double eta) { double thres = - log(DBL_EPSILON); if (fabs(eta) >= thres) return DBL_EPSILON; else return exp(eta)/pow(1 + exp(eta), 2); } bool valideta_logit(double eta) {return true;} //probit double linkfun_probit(double mu) {return qnorm(mu,0,1,1,0);} double linkinv_probit(double eta) { double thres = -qnorm(DBL_EPSILON,0,1,1,0); eta = min(thres, max(eta, -thres)); return pnorm(eta,0,1,1,0); } double mu_eta_probit(double eta) { return max(dnorm(eta,0,1,0), DBL_EPSILON); } bool valideta_probit(double eta) {return true;} //cloglog double linkfun_cloglog(double mu) {return log(-log(1 - mu));} double linkinv_cloglog(double eta) { double ans = 1 - exp(- exp(eta)); ans = min(1 - DBL_EPSILON, ans); return max(DBL_EPSILON, ans); } double mu_eta_cloglog(double eta) { eta = min(eta, 700.0); return max(DBL_EPSILON, exp(eta) * exp(-exp(eta))); } bool valideta_cloglog(double eta) {return true;} //ident double linkfun_ident(double mu) {return mu;} double linkinv_ident(double eta) {return eta;} double mu_eta_ident(double eta) {return 1.0;} bool valideta_ident(double eta) {return true;} //log double linkfun_log(double mu) {return log(mu);} double linkinv_log(double eta) {return max(DBL_EPSILON, exp(eta));} double mu_eta_log(double eta) {return max(DBL_EPSILON, exp(eta));} bool valideta_log(double eta) {return true;} //sqrt double linkfun_sqrt(double mu) {return sqrt(mu);} double inkinv_sqrt(double eta) {return eta * eta;} double mu_eta_sqrt(double eta) {return 2 * eta;} bool valideta_sqrt(double eta) {return eta > 0;} //recipsquare double linkfun_recipsquare(double mu) {return 1 / mu / mu;} double linkinv_recipsquare(double eta) {return 1 / sqrt(eta);} double mu_eta_recipsquare(double eta) {return -1 / (2 * pow(eta, 1.5));} bool valideta_recipsquare(double eta) {return eta > 0;} //inverse double linkfun_inverse(double mu) {return 1 / mu;} double linkinv_inverse(double eta) {return 1 / eta;} double mu_eta_inverse(double eta) {return -1 / eta / eta;} bool valideta_inverse(double eta) {return eta != 0;} //fisherz double linkfun_fisherz(double mu) {return log(2/(1 - mu) - 1);} double linkinv_fisherz(double eta) { double thres = - log(DBL_EPSILON); eta = (eta > thres) ? thres : eta; eta = (eta < - thres) ? -thres : eta; return 1 - 2 / (exp(eta) + 1); } double mu_eta_fisherz(double eta) { double thres = - log(DBL_EPSILON); if (fabs(eta) >= thres) return DBL_EPSILON; return 2 * exp(eta) / pow(1 + exp(eta), 2); } bool valideta_fisherz(double eta) {return true;} //Lin, Wei, Ying double linkfun_lwyBC2(double mu) { return log(sqrt(mu + 1) - 1); } double linkinv_lwyBC2(double eta) { double foo = max(DBL_EPSILON, exp(eta)); return pow(1 + foo, 2.0) - 1; } double mu_eta_lwyBC2(double eta) { double foo = exp(eta); return max(DBL_EPSILON, 2 * (1 + foo) * foo); } double linkfun_lwylog(double mu) { return log(exp(mu) - 1); } double linkinv_lwylog(double eta) { return log(exp(eta) + 1); } double mu_eta_lwylog(double eta) { double foo = exp(eta); return foo/(foo + 1); } //variance functions double variance_binomial(double mu) {return mu * (1 - mu);} double v_mu_binomial(double mu) {return 1 - 2 * mu;} bool validmu_binomial(double mu) {return mu > 0 && mu < 1;} double variance_gaussian(double mu) {return 1.0;} double v_mu_gaussian(double mu) {return .0;} bool validmu_gaussian(double mu) {return true;} double variance_poisson(double mu) {return mu;} double v_mu_poisson(double mu) {return 1.0;} bool validmu_poisson(double mu) {return mu > 0;} double variance_inverse_gaussian(double mu) {return pow(mu, 3);} double v_mu_inverse_gaussian(double mu) {return 3 * mu * mu;} bool validmu_inverse_gaussian(double mu) {return true;} double variance_Gamma(double mu) {return mu * mu;} double v_mu_Gamma(double mu) {return 2 * mu;} bool validmu_Gamma(double mu) {return mu > 0;} DMatrix cor_exch(const DVector &rho, const DVector &wave) { int n = wave.size(); DMatrix ans(n,n); for (int i = 1; i <= n; i++) for (int j = 1; j <= n; j++) ans(i,j) = (i == j) ? 1.0 : rho(1); return ans; } DMatrix cor_rho_exch(const DVector &rho, const DVector &wave) { int n = wave.size(); DMatrix ans(n * (n - 1) / 2, 1); ans = 1.0; return ans; } DMatrix cor_indep(const DVector &, const DVector &wave) { return ident(wave.size()); } DMatrix cor_rho_indep(const DVector &, const DVector &) { return ident(0); } DMatrix cor_fixed(const DVector &rho, const DVector &wave) { return cor_unstr(rho, wave); } DMatrix cor_rho_fixed(const DVector &, const DVector &) { return ident(0); } DMatrix cor_ar1(const DVector &rho, const DVector &wave) { int n = wave.size(); DMatrix ans(n,n); for (int i = 1; i <= n; i++) for (int j = 1; j <= n; j++) ans(i,j) = (i == j) ? 1.0 : pow(rho(1), fabs(wave(j) - wave(i))); return ans; } DMatrix cor_rho_ar1(const DVector &rho, const DVector &wave) { int n = wave.size(); DMatrix ans(n * (n - 1) / 2, 1); int k = 1; for (int i = 1; i <= n - 1; i++) { for (int j = i + 1; j <= n; j ++) { double tmp = fabs(wave(j) - wave(i)); ans(k, 1) = (tmp == 1.0) ? 1.0 : (tmp * pow(rho(1), tmp - 1.0)); k++; } } return ans; } DMatrix cor_unstr(const DVector &rho, const DVector &wave) { DMatrix fullmat = rho2mat(rho); return MatRowCol(fullmat, wave, wave); } DMatrix cor_rho_unstr(const DVector &rho, const DVector &wave) { int n = wave.size(); return ident(n * (n - 1) / 2); } //class Corr Corr:: Corr(int corst, int maxwave): _corst(corst), _maxwave(maxwave) { switch(corst) { case INDEPENDENCE: _nparam = 0; init(cor_indep, cor_rho_indep); break; case EXCHANGEABLE: _nparam = 1; init(cor_exch, cor_rho_exch); break; case AR1: _nparam = 1; init(cor_ar1, cor_rho_ar1); break; case UNSTRUCTURED: case USERDEFINED: _nparam = maxwave; init(cor_unstr, cor_rho_unstr); break; case FIXED: _nparam = 0; init(cor_fixed, cor_rho_fixed); break; } } //class Link //Link::Link() { Link(IDENT); } //Link::Link(int link) { Link::Link(int link) { switch(link) { case LOGIT: init(linkfun_logit, linkinv_logit, mu_eta_logit); break; case IDENT: init(linkfun_ident, linkinv_ident, mu_eta_ident); break; case PROBIT: init(linkfun_probit, linkinv_probit, mu_eta_probit); break; case CLOGLOG: init(linkfun_cloglog, linkinv_cloglog, mu_eta_cloglog); break; case LOG: init(linkfun_log, linkinv_log, mu_eta_log); break; case INVERSE: init(linkfun_inverse, linkinv_inverse, mu_eta_inverse); break; case FISHERZ: init(linkfun_fisherz, linkinv_fisherz, mu_eta_fisherz); break; case LWYBC2: init(linkfun_lwyBC2, linkinv_lwyBC2, mu_eta_lwyBC2); break; case LWYLOG: init(linkfun_lwylog, linkinv_lwylog, mu_eta_lwylog); break; } } Link::Link(fun1* linkfun, fun1* linkinv, fun1* mu_eta) { init(linkfun, linkinv, mu_eta); } //class Variance //Variance::Variance() {Variance(GAUSSIAN); } Variance::Variance(int var) { //Variance::Variance(int var) { switch(var) { case GAUSSIAN: init(variance_gaussian, v_mu_gaussian, validmu_gaussian); break; case BINOMIAL: init(variance_binomial, v_mu_binomial, validmu_binomial); break; case POISSON: init(variance_poisson, v_mu_poisson, validmu_poisson); break; case GAMMA: init(variance_Gamma, v_mu_Gamma, validmu_Gamma); break; } } //class GeeStr GeeStr::GeeStr(int n, Vector meanlink, Vector v, Vector scalelink, int corrlink, int scalefix) : CorrLink(corrlink), ScaleFix_(scalefix) { //int n = meanlink.size(); //MeanLink.newsize(n); V.newsize(n); ScaleLink.newsize(n); Vector ML(n), SL(n); Vector VS(n); for (int i = 1; i <= n; i++) { Link ml(meanlink(i)), sl(scalelink(i)); Variance vi(v(i)); ML(i) = ml; //MeanLink(i) = LINK[meanlink(i) - 1]; VS(i) = vi; //V(i) = VARIANCE[v(i) - 1]; SL(i) = sl; //ScaleLink(i) = LINK[scalelink(i) - 1]; } MeanLink = ML; V = VS; ScaleLink = SL; } DVector GeeStr::MeanLinkfun(const DVector &Mu, const IVector &Wave) { int size = Mu.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = MeanLink(Wave(i)).linkfun(Mu(i)); return ans; } DVector GeeStr::MeanLinkinv(const DVector &Eta, const IVector &Wave) { int size = Eta.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = MeanLink(Wave(i)).linkinv(Eta(i)); return ans; } DVector GeeStr::MeanMu_eta(const DVector &Eta, const IVector &Wave) { int size = Eta.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = MeanLink(Wave(i)).mu_eta(Eta(i)); return ans; } DVector GeeStr::ScaleLinkfun(const DVector &Mu, const IVector &Wave) { int size = Mu.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = ScaleLink(Wave(i)).linkfun(Mu(i)); return ans; } DVector GeeStr::ScaleLinkinv(const DVector &Eta, const IVector &Wave) { int size = Eta.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = ScaleLink(Wave(i)).linkinv(Eta(i)); return ans; } DVector GeeStr::ScaleMu_eta(const DVector &Eta, const IVector &Wave) { int size = Eta.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = ScaleLink(Wave(i)).mu_eta(Eta(i)); return ans; } DVector GeeStr::CorrLinkfun(const DVector &Mu) { int size = Mu.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = CorrLink.linkfun(Mu(i)); return ans; } DVector GeeStr::CorrLinkinv(const DVector &Eta) { int size = Eta.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = CorrLink.linkinv(Eta(i)); return ans; } DVector GeeStr::CorrMu_eta(const DVector &Eta) { int size = Eta.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = CorrLink.mu_eta(Eta(i)); return ans; } DVector GeeStr::v(const DVector &Mu, const IVector &Wave) { int size = Mu.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = V(Wave(i)).v(Mu(i)); return ans; } DVector GeeStr::v_mu(const DVector &Mu, const IVector &Wave) { int size = Mu.size(); DVector ans(size); for (int i = 1; i <= size; i++) ans(i) = V(Wave(i)).v_mu(Mu(i)); return ans; } bool GeeStr::validMu(const DVector &Mu, const IVector &Wave) { int size = Mu.size(); bool ans = true; for (int i = 1; i <= size; i++) { if ( !( V(Wave(i)).validmu(Mu(i)) ) ) { ans = false; break; } } return ans; } geepack/src/geesubs.cc0000754000177400001440000004176012771411433014613 0ustar murdochusers// Sep. 17, 2012: // workaround since it does not compile otherwise --- Thank B. Ripley // I spent hours but could not figure out why it would not work // without this undef. Should keep it in mind. // Jan. 26, 2012: // This line is commented out to remove NOTE of assert // from R CMD check, as suggested by K. Hornik and B. Ripley. // #undef NDEBUG using namespace std; #include "tntsupp.h" #include "geese.h" #include "famstr.h" #include "param.h" #include "geesubs.h" #include "utils.h" #include "inter.h" //#include "lgtdl.h" //#include "fgee.h" /*******************************************************************/ Grad & Grad::operator=(const Grad &G) { U1_ = G.U1_; U2_ = G.U2_; U3_ = G.U3_; return *this; } ostream& operator<<(ostream& s, const Grad &G) { s << "U1 = " << G.U1() << "U2 = " << G.U2() << "U3 = " << G.U3(); return s; } Hess operator-(Hess &H1, Hess &H2) { Hess ans(H1); ans.dec(H2); return ans; } Hess inv(Hess &H, IVector &level) { Hess ans(H); ans.set_A(inv(H.A())); if (level(1) == 1) { ans.set_C(inv(H.C())); ans.set_B(-1.0 * ans.C() * H.B() * ans.A()); } if (level(2) == 1) { ans.set_F(inv(H.F())); ans.set_E(-1.0 * ans.F() * H.E() * ans.C()); ans.set_D(-1.0 * ans.F() * (H.D() * ans.A() + H.E() * ans.B())); } return ans; } Hess operator*(const double &x, const Hess &H) { Hess ans(H); ans.set_A(x * H.A()); ans.set_B(x * H.B()); ans.set_C(x * H.C()); ans.set_D(x * H.D()); ans.set_E(x * H.E()); ans.set_F(x * H.F()); return ans; } ostream& operator<<(ostream& s, const Hess &H) { s << "A = " << H.A() << "B = " << H.B() << "C = " << H.C() << "D = " << H.D()<< "E = " << H.E() << "F = " << H.F(); return s; } DVector genzi(const DVector &PR) { int n = PR.size(); DVector ans(n * (n - 1)/2); int k = 1; for (int i = 1; i <= n - 1; i++) for (int j = i + 1; j <= n; j++) ans(k++) = PR(i) * PR(j); return ans; } DVector utri(const DMatrix &R) { int n = R.dim(1); //assert (n > 1); DVector ans(n * (n - 1) / 2); int k = 1; for (int i = 1; i <= n - 1; i++) for (int j = i + 1; j <= n; j++) ans(k++) = R(i,j); return ans; } DMatrix getZ_Beta(DMatrix &D, DVector &PR, DVector &V, DVector &V_Mu, DVector &z) { //note: this is the version which excludes phi in the formula DMatrix ans(z.size(), D.dim(2)); int k = 1, n = PR.size(); for (int i = 1; i <= n - 1; i++) { DMatrix Di = asMat(MatRow(D,i)); for (int j = i + 1; j <= n; j++) { DMatrix Dj = asMat(MatRow(D,j)); DMatrix foo = V_Mu(i) * reciproot(V(i)) * Di + V_Mu(j) * reciproot(V(j)) * Dj; DMatrix bar = - PR(i) * Di - PR(j) * Dj - 0.5 * PR(i) * PR(j) * foo; //cout << "bar = " << bar << "k = " << k; MatRow(ans, k) = bar; //cout << " ans = " << ans; k++; } } return ans; } DMatrix getZ_Gamma(DMatrix &D, DVector &PR, DVector &Phi, DVector &z) { DMatrix ans(z.size(), D.dim(2)); int k = 1, n = PR.size(); for (int i = 1; i <= n - 1; i++) { DMatrix Di = asMat(MatRow(D,i)); for (int j = i + 1; j <= n; j++) { DMatrix Dj = asMat(MatRow(D,j)); //MatRow(ans, k) = -0.5 * z(k) * (sqrt(Phi(j)/Phi(i)) * Di + //sqrt(Phi(i)/Phi(j)) * Dj); //This has caused the scale problem; The first time, scale problem was caused by operator * for Hess, where one component did not get touched, in the old geese (LAPACK); MatRow(ans, k) = -0.5 * z(k) * (1.0 / Phi(i) * Di + 1.0 / Phi(j) * Dj); k++; } } return ans; } DMatrix getS_Beta(DMatrix &D, DVector &PR, DVector &V, DVector &V_Mu) { DMatrix ans(D); for (int i = 1; i <= ans.dim(1); i++) { DMatrix Di = asMat(MatRow(D,i)); double f = -2 * PR(i) / sqrt(V(i)) - PR(i) * PR(i)/V(i) * V_Mu(i); MatRow(ans, i) = f * Di; } return ans; } void HiandGi(DVector &PRi, DVector &Phii, DMatrix &Di, DMatrix &R, DVector &Vi, DVector &V_Mui, DMatrix &D2i, DMatrix &E, DVector &Wi, IVector &level, //output Hess &H, Grad &G) { int s = PRi.size(); //beta DVector rootPhii = sqrt(Phii); DMatrix V1 = diag(rootPhii) * R * diag(rootPhii); DVector rootWi = sqrt(Wi); DMatrix rootWD = SMult(rootWi, Di); DVector rootWPR = SMult(rootWi, PRi); H.set_A(AtBiC(rootWD, V1, rootWD)); G.set_U1(AtBiC(rootWD, V1, rootWPR)); //H.set_A(AtBiC(Di, V1, Di)); //G.set_U1(AtBiC(Di, V1, PRi)); //gamma if (level(1) == 1) {//if (par.ScaleFix() != 1) { DVector Si = square(PRi); DVector WiV2inv = SMult(Wi, recip(2.0 * Phii)); H.set_C(Transpose_view(D2i) * SMult(WiV2inv, D2i)); DMatrix S_Beta = getS_Beta(Di, PRi, Vi, V_Mui); H.set_B(Transpose_view(D2i) * SMult(-1.0 * WiV2inv, S_Beta)); G.set_U2(Transpose_view(D2i) * SMult(WiV2inv, Si - Phii)); //DMatrix V2 = diag(2.0 * Phii); //H.set_C(AtBiC(D2i, V2, D2i)); //DMatrix S_Beta = getS_Beta(Di, PRi, Vi, V_Mui); //H.set_B(AtBiC(D2i, V2, S_Beta)); //G.set_U2(AtBiC(D2i, V2, S - Phii)); } //alpha if (level(2) == 1) {//if (cor.nparam() > 0) { if (s == 1) return; DVector sPRi = SMult(reciproot(Phii), PRi); DVector zi = genzi(sPRi); DVector rhoi = utri(R); //DMatrix W = ident(s * (s - 1) / 2); DVector Sca = genzi(reciproot(Phii)); DVector WiV3inv = genzi(Wi); //H.set_F(AtBiC(E, W, E)); H.set_F(Transpose_view(E) * SMult(WiV3inv, E)); DMatrix Z_Beta = getZ_Beta(Di, PRi, Vi, V_Mui, zi); Z_Beta = SMult(Sca, Z_Beta); //H.set_D(AtBiC(E, W, Z_Beta)); H.set_D(Transpose_view(E) * SMult(-1.0 * WiV3inv, Z_Beta)); //G.set_U3(AtBiC(E, W, zi - rhoi)); G.set_U3(Transpose_view(E) * SMult(WiV3inv, zi - rhoi)); if (level(1) == 1) {//if (par.ScaleFix() != 1) { DMatrix Z_Gamma = getZ_Gamma(D2i, PRi, Phii, zi); //H.set_E(AtBiC(E, W, Z_Gamma)); H.set_E(Transpose_view(E) * SMult(-1.0 * WiV3inv, Z_Gamma)); } } } void PRandD(DVector &Yi, DMatrix &Xi, DVector &Offseti, IVector &Wavei, GeeParam &par, GeeStr &geestr, DVector &PRi, DMatrix &Di) { DVector Eta = Xi * par.beta() + Offseti; DVector Mu = geestr.MeanLinkinv(Eta, Wavei); DVector V = geestr.v(Mu, Wavei); DVector Mu_Eta = geestr.MeanMu_eta(Eta, Wavei); DVector InvRootV = reciproot(V); Di = SMult(InvRootV, SMult(Mu_Eta, Xi)); PRi = SMult(InvRootV, Yi - Mu); } void PRandD(DVector &Y, DMatrix &X, DVector &Offset, Index1D &I, IVector &LinkWave, GeeParam &par, GeeStr &geestr, DVector &PRi, DMatrix &Di) { DVector Yi = asVec(VecSubs(Y, I)); DMatrix Xi = asMat(MatRows(X, I)); DVector Offseti = asVec(VecSubs(Offset, I)); IVector Wavei = asVec(VecSubs(LinkWave, I)); DVector Eta = Xi * par.beta() + Offseti; DVector Mu = geestr.MeanLinkinv(Eta, Wavei); DVector V = geestr.v(Mu, Wavei); DVector Mu_Eta = geestr.MeanMu_eta(Eta, Wavei); DVector InvRootV = reciproot(V); Di = SMult(InvRootV, SMult(Mu_Eta, Xi)); PRi = SMult(InvRootV, Yi - Mu); } void gee_prep(DVector &Yi, DMatrix &Xi, DVector &Offseti, IVector &Wavei, GeeParam &par, GeeStr &geestr, DVector &PRi, DMatrix &Di, DVector &Vi, DVector &V_Mui) { DVector Eta = Xi * par.beta() + Offseti; DVector Mu = geestr.MeanLinkinv(Eta, Wavei); DVector V = geestr.v(Mu, Wavei); DVector Mu_Eta = geestr.MeanMu_eta(Eta, Wavei); DVector InvRootV = reciproot(V); Di = SMult(InvRootV, SMult(Mu_Eta, Xi)); PRi = SMult(InvRootV, Yi - Mu); Vi = geestr.v(Mu, Wavei); V_Mui = geestr.v_mu(Mu, Wavei); } void gee_prep(DVector &Y, DMatrix &X, DVector &Offset, Index1D &I, IVector &LinkWave, GeeParam &par, GeeStr &geestr, DVector &PRi, DMatrix &Di, DVector &Vi, DVector &V_Mui) { DVector Yi = asVec(VecSubs(Y, I)); DMatrix Xi = asMat(MatRows(X, I)); DVector Offseti = asVec(VecSubs(Offset, I)); IVector Wavei = asVec(VecSubs(LinkWave, I)); DVector Eta = Xi * par.beta() + Offseti; DVector Mu = geestr.MeanLinkinv(Eta, Wavei); DVector V = geestr.v(Mu, Wavei); DVector Mu_Eta = geestr.MeanMu_eta(Eta, Wavei); DVector InvRootV = reciproot(V); Di = SMult(InvRootV, SMult(Mu_Eta, Xi)); PRi = SMult(InvRootV, Yi - Mu); Vi = geestr.v(Mu, Wavei); V_Mui = geestr.v_mu(Mu, Wavei); } DMatrix getR(DMatrix &Zmati, DVector &corp, GeeParam &par, GeeStr &geestr, Corr &cor) { DVector alp = par.alpha(); int s = corp.dim(); // corp should determine meta par for R if (s == 1) return ident(1); else if (cor.corst() == INDEPENDENCE) //indenpendence return cor.mat(alp, corp); else { DVector Eta = Zmati * alp; DVector Rho = geestr.CorrLinkinv(Eta); return cor.mat(Rho, corp); } } DMatrix getR(DMatrix &Zmat, Index1D &I, Index1D &J, DVector &CorP, GeeParam &par, GeeStr &geestr, Corr &cor) { DVector alp = par.alpha(); DVector corp = asVec(VecSubs(CorP, I)); int s = corp.dim(); // corp should determine meta par for R if (s == 1) return ident(1); else if (cor.corst() == INDEPENDENCE) //indenpendence return cor.mat(alp, corp); else{ DMatrix Zmati = asMat(MatRows(Zmat, J)); DVector Eta = Zmati * alp; DVector Rho = geestr.CorrLinkinv(Eta); return cor.mat(Rho, corp); } } int RandE(DMatrix &Zmati, DVector &corp, GeeParam &par, GeeStr &geestr, Corr &cor, DMatrix &R, DMatrix &E) { DVector alp = par.alpha(); //DVector corp = asVec(VecSubs(CorP, I)); int s = corp.dim(); if (s == 1) { R = ident(1); return 0; } else if (cor.corst() == INDEPENDENCE) { //no need for E R = cor.mat(alp, corp); return 0; } else if (cor.corst() == FIXED) { DVector Eta = Zmati * alp; DVector Rho = geestr.CorrLinkinv(Eta); R = cor.mat(Rho, corp); return 0; } else { //DMatrix Zmati = asMat(MatRows(Zmat, J)); DVector Eta = Zmati * alp; DVector Rho = geestr.CorrLinkinv(Eta); R = cor.mat(Rho, corp); DVector Rho_Alp = geestr.CorrMu_eta(Eta); DMatrix Cor_Rho = cor.cor_rho(Rho, corp); E = Cor_Rho * SMult(Rho_Alp, Zmati); return 0; } } int RandE(DMatrix &Zmat, Index1D &I, Index1D &J, DVector &CorP, GeeParam &par, GeeStr &geestr, Corr &cor, DMatrix &R, DMatrix &E) { DVector alp = par.alpha(); DVector corp = asVec(VecSubs(CorP, I)); int s = corp.dim(); if (s == 1) { R = ident(1); return 0; } else if (cor.corst() == INDEPENDENCE) { //no need for E R = cor.mat(alp, corp); return 0; } else if (cor.corst() == FIXED) { DMatrix Zmati = asMat(MatRows(Zmat, J)); DVector Eta = Zmati * alp; DVector Rho = geestr.CorrLinkinv(Eta); R = cor.mat(Rho, corp); return 0; } else { DMatrix Zmati = asMat(MatRows(Zmat, J)); DVector Eta = Zmati * alp; DVector Rho = geestr.CorrLinkinv(Eta); R = cor.mat(Rho, corp); DVector Rho_Alp = geestr.CorrMu_eta(Eta); DMatrix Cor_Rho = cor.cor_rho(Rho, corp); E = Cor_Rho * SMult(Rho_Alp, Zmati); return 0; } } void gm_prep(DVector &PRi, IVector &Wavei, DVector &Doffseti, DMatrix &Zi, GeeParam &par, GeeStr &geestr, DVector &Phii, DVector &Si, DMatrix &D2i) { DVector Zeta = Zi * par.gamma() + Doffseti; DVector Phi_Zeta = geestr.ScaleMu_eta(Zeta, Wavei); Phii = geestr.ScaleLinkinv(Zeta, Wavei); Si = square(PRi); D2i = Phi_Zeta * Zi; } void gm_prep(DVector &PR, Index1D &I, IVector &LinkWave, DVector &Doffset, DMatrix &Zsca, GeeParam &par, GeeStr &geestr, DVector &Phii, DVector &Si, DMatrix &D2i) { DMatrix Zi = asMat(MatRows(Zsca, I)); DVector Doffseti = asVec(VecSubs(Doffset, I)); IVector Wavei = asVec(VecSubs(LinkWave, I)); DVector Zeta = Zi * par.gamma() + Doffseti; DVector Phi_Zeta = geestr.ScaleMu_eta(Zeta, Wavei); DVector PRi = asVec(VecSubs(PR, I)); Phii = geestr.ScaleLinkinv(Zeta, Wavei); Si = square(PRi); D2i = Phi_Zeta * Zi; } void PhiandD2(IVector &Wavei, DVector &Doffseti, DMatrix &Zi, GeeParam &par, GeeStr &geestr, DVector &Phii, DMatrix &D2i) { DVector Zeta = Zi * par.gamma() + Doffseti; Phii = geestr.ScaleLinkinv(Zeta, Wavei); if (geestr.ScaleFix() == 1) return; DVector Phi_Zeta = geestr.ScaleMu_eta(Zeta, Wavei); D2i = Phi_Zeta * Zi; } void PhiandD2(Index1D &I, IVector &LinkWave, DVector &Doffset, DMatrix &Zsca, GeeParam &par, GeeStr &geestr, DVector &Phii, DMatrix &D2i) { DMatrix Zi = asMat(MatRows(Zsca, I)); DVector Doffseti = asVec(VecSubs(Doffset, I)); IVector Wavei = asVec(VecSubs(LinkWave, I)); DVector Zeta = Zi * par.gamma() + Doffseti; Phii = geestr.ScaleLinkinv(Zeta, Wavei); if (geestr.ScaleFix() == 1) return; DVector Phi_Zeta = geestr.ScaleMu_eta(Zeta, Wavei); D2i = Phi_Zeta * Zi; } DVector getPR(DVector &Y, DMatrix &X, DVector &Offset, IVector &LinkWave, GeeParam &par, GeeStr &geestr) { DVector Eta = X * par.beta() + Offset; DVector Mu = geestr.MeanLinkinv(Eta, LinkWave); DVector V = geestr.v(Mu, LinkWave); DVector InvRootV = reciproot(V); return SMult(InvRootV, Y - Mu); } DVector getPhi(DVector &Doffset, DMatrix &Zsca, IVector &LinkWave, GeeParam &par, GeeStr &geestr) { DVector Zeta = Zsca * par.gamma() + Doffset; return geestr.ScaleLinkinv(Zeta, LinkWave); } void getDatI(DVector &Y, DVector &Offset, DVector &Doffset, DVector &W, DVector &CorP, DMatrix &X, DMatrix &Zsca, DMatrix &Zcor, IVector &LinkWave, //extract indicator Index1D &I, Index1D &J, IVector Scuri, Corr &cor, //output DVector &VYi, DVector &VOffseti, DVector &VDoffseti, DVector &VWi, DVector &VCorPi, DMatrix &VXi, DMatrix &VZscai, DMatrix &VZcori, IVector &VLinkWavei) { int s = Scuri.size(); //get dat i DVector Yi = asVec(VecSubs(Y, I)); DVector Offseti = asVec(VecSubs(Offset, I)); DVector Wi = asVec(VecSubs(W, I)); DVector CorPi = asVec(VecSubs(CorP, I)); DMatrix Xi = asMat(MatRows(X, I)); DMatrix Zscai = asMat(MatRows(Zsca, I)); IVector LinkWavei = asVec(VecSubs(LinkWave, I)); DMatrix Zcori; DVector Doffseti; if (cor.corst() > INDEPENDENCE && s > 1 ) { Zcori = asMat(MatRows(Zcor, J)); } Doffseti = asVec(VecSubs(Doffset, I)); //valid dat i IVector VI = genVI(Scuri), VJ = genCrossVI(Scuri); VYi = Valid(Yi, VI); VOffseti = Valid(Offseti, VI); VWi = Valid(Wi, VI); VCorPi = Valid(CorPi, VI); VXi = Valid(Xi, VI); VZscai = Valid(Zscai, VI); VLinkWavei = Valid(LinkWavei, VI); if (cor.corst() > INDEPENDENCE && s > 1) { if (cor.nparam() == 1) VZcori = Zcori; else VZcori = Valid(Zcori, VJ); //VDoffseti = Valid(Doffseti, VJ); //this is for log odds for ordinal } VDoffseti = Valid(Doffseti, VI); } void HnandGis(DVector &Y, DMatrix &X, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, IVector &Clusz, IVector &ZcorSize, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, GeeParam &par, GeeStr &geestr, Corr &cor, IVector &Scur, IVector &level, //Scur is the valid data indicator //output Hess &Hn, Vector &Gis) { int N = Clusz.size(); Hess H(par); Vector His(N); His = H; HisandGis(Y, X, Offset, Doffset, W, LinkWave, Clusz, ZcorSize, Zsca, Zcor, CorP, par, geestr, cor, Scur, level, His, Gis); for (int i = 1; i <= N; i++) H.inc(His(i)); Hn = (1.0/(double) N) * H; } void HisandGis(DVector &Y, DMatrix &X, DVector &Offset, DVector &Doffset, DVector &W, IVector &LinkWave, IVector &Clusz, IVector &ZcorSize, DMatrix &Zsca, DMatrix &Zcor, DVector &CorP, GeeParam &par, GeeStr &geestr, Corr &cor, IVector &Scur, IVector &level, //output Vector &His, Vector &Gis) { Index1D I(0,0), J(0,0); int N = Clusz.size(); int pb = par.p(), pg = par.r(), pa = par.q(); DVector V0(pb); Hess H(par), Hi(par); Grad Gi(par); //cout << "N = " << N; for (int i = 1; i <= N; i++) { int s1 = Clusz(i), s2 = ZcorSize(i); I = Index1D(1, s1) + I.ubound(); if (s2 > 0) J = Index1D(1, s2) + J.ubound(); IVector Scuri = asVec(VecSubs(Scur, I)); if (sum(Scuri) == 0) continue; //get and valid data i DVector Yi, Offseti, Doffseti, Wi, CorPi; DMatrix Xi, Zscai, Zcori; IVector LinkWavei; getDatI(Y, Offset, Doffset, W, CorP, X, Zsca, Zcor, LinkWave, I, J, Scuri, cor, Yi, Offseti, Doffseti, Wi, CorPi, Xi, Zscai, Zcori, LinkWavei); DVector PRi(s1), Vi(s1), V_Mui(s1); DMatrix Di(s1,pb); gee_prep(Yi, Xi, Offseti, LinkWavei, par, geestr, PRi, Di, Vi, V_Mui); DVector Phii(s1); DMatrix D2i(s1, pg); PhiandD2(LinkWavei, Doffseti, Zscai, par, geestr, Phii, D2i); DMatrix R(s1, s1), E(s2, pa); RandE(Zcori, CorPi, par, geestr, cor, R, E); HiandGi(PRi, Phii, Di, R, Vi, V_Mui, D2i, E, Wi, level, Hi, Gi); His(i) = Hi; Gis(i) = Gi; } } IVector genVI(IVector &Si, int c) { int s = Si.size(), k = 1; IVector ans(s * c); ans = 0; for (int i = 1; i <= s; i++) { if (Si(i) == 1) { for (int j = 1; j <= c; j++) { ans(k) = 1; k++; } } } return ans; } IVector genCrossVI(IVector &Si, int c) { int s = Si.size(); IVector ans(s * (s - 1) * c * c / 2); ans = 0; IVector vv(c * c); vv = 1; Index1D I(0,0); for (int i = 1; i <= s - 1; i++) { for (int j = i + 1; j <= s; j++) { I = Index1D(1, c * c) + I.ubound(); if (Si(i) == 1 && Si(j) == 1) VecSubs(ans, I) = vv; } } return ans; } geepack/src/ordgee.cc0000754000177400001440000005343712771411433014427 0ustar murdochusers// using namespace std; // #include "tnt/region1d.h" // #include "tntsupp.h" // #include "geese.h" // extern "C"{ // #include // #include // #include // } // #include "famstr.h" // #include "param.h" // #include "inter.h" // #include "utils.h" // #include "geesubs.h" #include "ordgee.h" double odds2p11(double psi, double mu1, double mu2) { if (fabs(psi - 1.0) < .001) return mu1 * mu2; else { double exp1 = 1 + (mu1 + mu2) * ( psi - 1); double s = exp1 * exp1 + 4 * psi * (1 - psi) * mu1 * mu2; s = sqrt(s); return .5 / (psi - 1) * (exp1 - s); } } DMatrix odds2p11(DVector &Psi, DVector &Mu1, DVector &Mu2) { //Psi is c^2 by 1, contains odds ratio in the sequence: 1-1, 1-2, 2-1, 2-2 //which can be viewed as the result of hvec of PSI matrix int c = Mu1.size(), k = 1; DMatrix ans(c, c); for (int i = 1; i <= c; i++) for (int j = 1; j <= c; j++) ans(i, j) = odds2p11(Psi(k++), Mu1(i), Mu2(j)); return ans; } /* get derivative from R function f <- deriv( ~ .5 / (psi - 1) * (1 + (mu1 + mu2) * ( psi - 1) - (((1 + (mu1 + mu2) * ( psi - 1))^ 2 + 4 * psi * (1 - psi) * mu1 * mu2))^.5), c("psi", "mu1", "mu2"), function(psi, mu1, mu2){}) */ double p11_odds(double psi, double mu1, double mu2) { if (fabs(psi - 1.0) < .001) return mu1*mu2*( - (mu1 + mu2) + mu1*mu2 + 1); else { double expr1 = psi - 1.0; double expr2 = .5 / expr1; double expr3 = mu1 + mu2; double expr5 = 1 + expr3 * expr1; double expr7 = 4 * psi; double expr8 = 1 - psi; double expr9 = expr7 * expr8; double expr10 = expr9 * mu1; double expr12 = pow(expr5, 2.0) + expr10 * mu2; double expr14 = expr5 - pow(expr12, 0.5); double expr23 = pow(expr12, -0.5); //double expr33 = 2 * (expr1 * expr5); //.value <- .expr2 * .expr14 double ans = expr2 * (expr3 - 0.5 * ((2 * (expr3 * expr5) + (4 * expr8 - expr7) * mu1 * mu2) * expr23)) - 0.5/pow(expr1, 2.0) * expr14; return ans; } } DVector p11_mu(double psi, double mu1, double mu2) { DVector ans(2); if (fabs(psi - 1.0) < .001) { ans(1) = mu2; ans(2) = mu1; return ans; } double expr1 = psi - 1.0; double expr2 = .5 / expr1; double expr3 = mu1 + mu2; double expr5 = 1 + expr3 * expr1; double expr7 = 4 * psi; double expr8 = 1 - psi; double expr9 = expr7 * expr8; double expr10 = expr9 * mu1; double expr12 = pow(expr5, 2.0) + expr10 * mu2; // double expr14 = expr5 - pow(expr12, 0.5); double expr23 = pow(expr12, -0.5); double expr33 = 2 * (expr1 * expr5); // .grad[, "mu1"] <- .expr2 * (.expr1 - 0.5 * ((.expr33 + .expr9 * mu2) * .expr23)) ans(1) = expr2 * (expr1 - 0.5 * ((expr33 + expr9 * mu2) * expr23)); // .grad[, "mu2"] <- .expr2 * (.expr1 - 0.5 * ((.expr33 + .expr10) * .expr23)) ans(2) = expr2 * (expr1 - 0.5 * ((expr33 + expr10) * expr23)); return ans; } DVector p11_odds(DVector &Psi, DVector &Mu1, DVector &Mu2) { //Mu1 and Mu2 are c x 1, Psi is c^2 x 1 int c = Mu1.size(), k = 1; DVector ans(c * c); for (int i = 1; i <= c; i++) for (int j = 1; j <= c; j++) { ans(k) = p11_odds(Psi(k), Mu1(i), Mu2(j)); //need more attention to the ordering of Mu1 and Mu2, row-major or col-major; this is row major!!! k++; } return ans; } /* DMatrix Vijj(DVector &Mu) { int c = Mu.size(); DMatrix ans(c,c); for (int i = 1; i <= c; i++) for (int j = 1; j <= c; j++) ans(i,j) = Mu(fmax(i, j)) - Mu(i) * Mu(j); return ans; } */ DMatrix Vijj(DVector &Mu, bool rev) { //rev = false: usual cumulated ordering; //rev = true: Heagerty and Zeger (1996) int c = Mu.size(), ij; DMatrix ans(c,c); for (int i = 1; i <= c; i++) for (int j = 1; j <= c; j++) { if (rev) ij = fmax(i, j); else ij = fmin(i, j); ans(i,j) = Mu(ij) - Mu(i) * Mu(j); } return ans; } DMatrix Vijk(DVector &Mu1, DVector &Mu2, DVector &Psi) { //Psi is a c^2 by 1 vector; int c = Mu1.size(); DMatrix ans(c,c); int k = 1; for (int i = 1; i <= c; i++) { for (int j = 1; j <= c; j++) { double psi = Psi(k++); double p11 = odds2p11(psi, Mu1(i), Mu2(j)); ans(i, j) = p11 - Mu1(i) * Mu2(j); } } return ans; } DMatrix getU3_Beta(DVector &Mu1, DVector &Mu2, DVector &Psi, DMatrix &D1, DMatrix &D2, DVector &PR1, DVector &PR2) { int c = Mu1.size(), p = D1.num_cols(); DMatrix ans(c * c, p); int k = 1; for (int i = 1; i <= c; i++) { DMatrix D1i = asMat(MatRow(D1,i)); for (int j = 1; j <= c; j++) { DMatrix D2j = asMat(MatRow(D2,j)); double psi = Psi(k); DVector P11_Mu = p11_mu(psi, Mu1(i), Mu2(j)); P11_Mu(1) = P11_Mu(1) - Mu2(j); P11_Mu(2) = P11_Mu(2) - Mu1(i); //MatRow(ans, k) = P11_Mu(1) * D1i + P11_Mu(2) * D2j; MatRow(ans, k) = (- PR2(j) - P11_Mu(1)) * D1i + (-PR1(i) - P11_Mu(2)) * D2j; k++; } } return ans; } DMatrix ord2V1(DVector &Mu, DVector &Psi, int clusz, bool rev) { //Mu is (ni*c) x 1, Psi is (choose(ni,2)*c^2) * 1 //This function should be named as ord2V1 instead of ord_V1, since it is forming V1 rather than taking derivatives int c = Mu.size() / clusz; DMatrix ans(Mu.size(), Mu.size()); Index1D I(0,0), K(0,0); for (int i = 1; i <= clusz; i++) { I = Index1D(1, c) + I.ubound(); Index1D J = I; DVector Mui = asVec(VecSubs(Mu, I)); ans(I, I) = Vijj(Mui, rev); for (int j = i + 1; j <= clusz; j++) { J = Index1D(1, c) + J.ubound(); DVector Muj = asVec(VecSubs(Mu, J)); K = Index1D(1, c*c) + K.ubound(); DVector Psik = asVec(VecSubs(Psi, K)); ans(I, J) = Vijk(Mui, Muj, Psik); ans(J, I) = ans(I, J); } } return ans; } DMatrix Mu2V1(DVector &Mu, int clusz, bool rev) { int c = Mu.dim() / clusz; DMatrix ans(Mu.dim(), Mu.dim()); ans = .0; Index1D I(0,0); for (int i = 1; i <= clusz; i++) { I = Index1D(1, c) + I.ubound(); DVector Mui = asVec(VecSubs(Mu, I)); ans(I, I) = Vijj(Mui, rev); } return ans; } void ord_prep_beta(DVector &Yi, DMatrix &Xi, DVector &Offseti, DMatrix &Zi, DVector &Ooffseti, int clusz, int c, bool rev, IVector &LinkWavei, GeeParam &par, GeeStr &geestr, Corr &cor, //output DMatrix &Di, DVector &PRi, DMatrix &Vi) { DVector Etai = Xi * par.beta() + Offseti; DVector Mui = geestr.MeanLinkinv(Etai, LinkWavei); DVector Mu_Etai = geestr.MeanMu_eta(Etai, LinkWavei); PRi = Yi - Mui; Di = SMult(Mu_Etai, Xi); if (clusz == 1) Vi = Vijj(Mui, rev); else if (cor.nparam() == 0) Vi = Mu2V1(Mui, clusz, rev); else { //cluster size greater than 1; DVector Psii = geestr.CorrLinkinv(Zi * par.alpha() + Ooffseti); Vi = ord2V1(Mui, Psii, clusz, rev); } } void ord_prep_beta(DVector &Y, DMatrix &X, DVector &Offset, DMatrix &Z, DVector &Ooffset, Index1D &I, Index1D &J, int clusz, int c, bool rev, IVector &LinkWave, GeeParam &par, GeeStr &geestr, Corr &cor, //output DMatrix &Di, DVector &PRi, DMatrix &Vi) { DVector Yi = asVec(VecSubs(Y, I)); DMatrix Xi = asMat(MatRows(X, I)); DVector Offseti = asVec(VecSubs(Offset, I)); IVector LinkWavei = asVec(VecSubs(LinkWave, I)); //cout << "Xi = " << Xi << "par.beta() = " << par.beta(); DVector Etai = Xi * par.beta() + Offseti; DVector Mui = geestr.MeanLinkinv(Etai, LinkWavei); DVector Mu_Etai = geestr.MeanMu_eta(Etai, LinkWavei); PRi = Yi - Mui; Di = SMult(Mu_Etai, Xi); //if (I.lbound() == 1) cout << "Yi = " << Yi << "Xi = " << Xi << "Etai = " << Etai << "Mui = " << Mui; if (clusz == 1) Vi = Vijj(Mui, rev); else if (cor.nparam() == 0) Vi = Mu2V1(Mui, clusz, rev); else { //cluster size greater than 1; DMatrix Zi = asMat(MatRows(Z, J)); DVector Ooffseti = asVec(VecSubs(Ooffset, J)); DVector Psii = geestr.CorrLinkinv(Zi * par.alpha() + Ooffseti); Vi = ord2V1(Mui, Psii, clusz, rev); } } double update_beta(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, DVector &W, IVector &LinkWave, //DVector &CorP, DMatrix &Z, IVector &Clusz, int c, bool rev, //IVector &ZcorSize, IVector &Jack, GeeParam &par, GeeStr &geestr, Corr &cor) { double del = 0; int p = par.p(), n = Clusz.size(); DMatrix H(p,p); DVector G(p); Index1D I(0,0), J(0,0); for (int i = 1; i <= n; i++) { int s1 = Clusz(i); int s2 = s1 * (s1 - 1) / 2; I = Index1D(1, s1 * c) + I.ubound(); if (s2 > 0) J = Index1D(1, s2 * c * c) + J.ubound(); // cout << "i = " << i << " J.lbound = " << J.lbound() << " J.ubound = " << J.ubound() << endl; DVector PRi(s1 * c); DMatrix Di(s1 * c, p), Vi(s1 * c, s1 * c); DVector Yi = asVec(VecSubs(Y, I)); DMatrix Xi = asMat(MatRows(X, I)); DVector Offseti = asVec(VecSubs(Offset, I)); IVector LinkWavei = asVec(VecSubs(LinkWave, I)); DMatrix Zi; DVector Ooffseti; if (cor.nparam() == 0 || s2 == 0) { Zi = DMatrix(1,1); Ooffseti = DVector(1); } else { Zi = asMat(MatRows(Z, J)); Ooffseti = asVec(VecSubs(Ooffset, J)); } ord_prep_beta(Yi, Xi, Offseti, Zi, Ooffseti, s1, c, rev, LinkWavei, par, geestr, cor, Di, PRi, Vi); //if (i == 1) cout << "PRi = " << PRi << "Di = " << Di << "Vi = " << Vi; DVector rootWi = sqrt(asVec(VecSubs(W, I))); Di = SMult(rootWi, Di); PRi = SMult(rootWi, PRi); H = H + AtBiC(Di, Vi, Di); G = G + AtBiC(Di, Vi, PRi); } DVector Del = solve(H, G); par.set_beta(par.beta() + Del); del = fmax(fabs(Del)); return del; } DVector kronecker(const DVector &v1, const DVector &v2) { int n1 = v1.size(), n2 = v2.size(); DVector ans(n1 * n2); Index1D I(0,0); for (int i = 1; i <= n1; i++) { I = Index1D(1, n2) + I.ubound(); VecSubs(ans, I) = v1(i) * v2; } return ans; } DVector vec(const DMatrix &m) { int r = m.num_rows(), c = m.num_cols(); DVector ans(r * c, m.begin()); return ans; } DVector hvec(const DMatrix &m) { int r = m.num_rows(), c = m.num_cols(), k = 1; DVector ans(r * c); for (int i = 1; i <= r; i++) for (int j = 1; j <= c; j++) ans(k++) = m(i, j); return ans; } DMatrix ESSTijk(DVector &Mu1, DVector &Mu2, DMatrix &P11, int c1, int c3, bool rev) { //P11 is c x c matrix int c = Mu1.size(), c13, c24; if (rev) c13 = fmax(c1, c3); else c13 = fmin(c1, c3); DMatrix ans(c, c); for (int c2 = 1; c2 <= c; c2++) { for (int c4 = c2; c4 <= c; c4++) { if (rev) c24 = fmax(c2, c4); else c24 = fmin(c2, c4); ans(c2, c4) = P11(c13, c24) - P11(c13, c2) * Mu2(c4) - P11(c13, c4) * Mu2(c2) + Mu1(c13) * Mu2(c2) * Mu2(c4) - P11(c1, c24) * Mu1(c3) + P11(c1, c2) * Mu1(c3) * Mu2(c4) + P11(c1, c4) * Mu1(c3) * Mu2(c2) - 3 * Mu1(c1) * Mu1(c3) * Mu2(c2) * Mu2(c4) - P11(c3, c24) * Mu1(c1) + P11(c3, c2) * Mu1(c1) * Mu2(c4) + P11(c3, c4) * Mu1(c1) * Mu2(c2) + Mu1(c1) * Mu1(c3) * Mu2(c24); if (c4 > c2) ans(c4, c2) = ans(c2, c4); } } return ans; } DMatrix ESST(DVector &Mu1, DVector &Mu2, DMatrix &P11, bool rev) { int c = Mu1.size(); DMatrix ans(c*c, c*c); Index1D I(0,0), J(0,0); for (int c1 = 1; c1 <= c; c1++) { J = I; I = Index1D(1, c) + I.ubound(); for (int c3 = c1; c3 <= c; c3++) { J = Index1D(1, c) + J.ubound(); ans(I, J) = ESSTijk(Mu1, Mu2, P11, c1, c3, rev); if (c3 > c1) ans(J, I) = ans(I, J); } } return ans; } void ord_prep_alpha(DVector &PR1, DVector &PR2, //DMatrix &V, DVector &Mu1, DVector &Mu2, //c^2 x 1 c x 1 c x 1 DMatrix &Z, DVector &Ooffset, bool rev, GeeParam &par, GeeStr &geestr, //output DVector &U2, DMatrix &V2, DMatrix &D2) { DVector Zeta = Z * par.alpha() + Ooffset; //Z is C^2 x q; DVector Psi = geestr.CorrLinkinv(Zeta); //cout << "PR1 = " << PR1 << "PR2 = " << PR2; DVector S = kronecker(PR1, PR2); //cout << "S = " << S; DMatrix V = Vijk(Mu1, Mu2, Psi); // cout << "V = " << V; DVector Sigma = hvec(V); U2 = S - Sigma; DVector P11_Odds = p11_odds(Psi, Mu1, Mu2); DVector Odds_Zeta = geestr.CorrMu_eta(Zeta); D2 = SMult(SMult(P11_Odds, Odds_Zeta), Z); //D2 = d V / d alpha = d(P11 - mu1 * mu2) / d alpha = d P11 / d alpha DMatrix P11 = odds2p11(Psi, Mu1, Mu2); V2 = ESST(Mu1, Mu2, P11, rev) - outerprod(Sigma); } double update_alpha(DVector &PR, DVector &Mu, DVector &W, DMatrix &Z, DVector &Ooffset, IVector &Clusz, int c, bool rev, GeeParam &par, GeeStr &geestr, Corr &cor) { double del = 0; int q = par.q(), n = Clusz.size(); if (cor.nparam() == 0) return del; DMatrix H(q,q); DVector G(q); Index1D I(0,0), J(0,0); for (int i = 1; i <= n; i++) { int s1 = Clusz(i); int s2 = s1 * (s1 - 1) / 2; I = Index1D(1, s1 * c) + I.ubound(); if (s2 > 0) J = Index1D(1, s2 * c * c) + J.ubound(); if (s1 == 1) continue; DVector PRi = asVec(VecSubs(PR, I)); DVector Mui = asVec(VecSubs(Mu, I)); DMatrix Zi = asMat(MatRows(Z, J)); DVector Ooffseti = asVec(VecSubs(Ooffset, J)); Index1D K(0,0); for (int j = 1; j <= s1 - 1; j++) { Index1D I1((j - 1) * c + 1, j * c); DVector PR1 = asVec(VecSubs(PRi, I1)); DVector Mu1 = asVec(VecSubs(Mui, I1)); for (int k = j + 1; k <= s1; k++) { Index1D I2((k - 1) * c + 1, k * c); DVector PR2 = asVec(VecSubs(PRi, I2)); DVector Mu2 = asVec(VecSubs(Mui, I2)); K = Index1D(1,c*c) + K.ubound(); DVector Ooffsetijk = asVec(VecSubs(Ooffseti, K)); DMatrix Zijk = asMat(MatRows(Zi, K)); DVector U2(c*c, 1); DMatrix V2(c*c, c*c), D2(c*c, q); //cout << "i = " << i << " j = " << j << " k = " << k; ord_prep_alpha(PR1, PR2, Mu1, Mu2, Zijk, Ooffsetijk, rev, par, geestr, U2, V2, D2); //if (i == 1) cout << "U2 = " << U2 << "D2 = " << D2 << "V2 = "<< V2; H = H + AtBiC(D2, V2, D2); //cout << " AtBiC(D2, V2, D2) = " << AtBiC(D2, V2, D2); //if (i == 37) cout << "V2 = "<< V2; G = G + AtBiC(D2, V2, U2); } } } //cout << "H = " << H; DVector Del = solve(H, G); par.set_alpha(par.alpha() + Del); del = fmax(fabs(Del)); return del; } /* the following estimation procedure assumed that each cluster has size at least 1. Nov. 6, 2002. */ void ordgee_est(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, DVector &W, IVector &LinkWave, DMatrix &Z, IVector &Clusz, int c, bool rev, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con) { DVector Del(3); Del = 0.0; int N = Y.size(); // N = sum(n_i) * c; DVector PR(N), Mu(N); int iter; double del; for (iter = 0; iter < con.maxiter(); iter++) { if (con.trace() == 1) { //cerr << "iter " << iter << endl; //cerr << "beta = " << par.beta() << "gamma = " << par.gamma() << "alpha = " << par.alpha(); Rprintf("iter = %d\n", iter); Rprintf("beta = "); VecPrint(par.beta()); Rprintf("gamma = "); VecPrint(par.gamma()); Rprintf("alpha = "); VecPrint(par.alpha()); } //updating beta; Del(1) = update_beta(Y, X, Offset, Ooffset, W, LinkWave, Z, Clusz, c, rev, par, geestr, cor); //no updating gamma; //updating alpha; Mu = geestr.MeanLinkinv(X * par.beta() + Offset, LinkWave); PR = Y - Mu; Del(3) = update_alpha(PR, Mu, W, Z, Ooffset, Clusz, c, rev, par, geestr, cor); del = fmax(Del); if (del <= con.tol()) break; } if (iter == con.maxiter()) par.set_err(1); } void HiandGi(DVector &Yi, DMatrix &Xi, DVector &Offseti, DVector &Ooffseti, IVector &LinkWavei, DMatrix &Zi, int s1, int c, bool rev, //Index1D &I, Index1D &J, GeeParam &par, GeeStr &geestr, Corr &cor, //output Hess &Hi, Grad &Gi) { //need D1, V1, U1, D2, V2, U2, Sig_Beta for H and G int p = par.p(), q = par.q(); DVector PRi(s1 * c); DMatrix D1i(s1 * c, p), V1i(s1 * c, s1 * c); ord_prep_beta(Yi, Xi, Offseti, Zi, Ooffseti, s1, c, rev, LinkWavei, par, geestr, cor, D1i, PRi, V1i); Hi.set_A(AtBiC(D1i, V1i, D1i)); Gi.set_U1(AtBiC(D1i, V1i, PRi)); if (s1 == 1) return; if (cor.nparam() == 0) return; DVector Mui = Yi - PRi; Index1D K(0,0); for (int j = 1; j <= s1 - 1; j++) { Index1D I1((j - 1) * c + 1, j * c); DVector PR1 = asVec(VecSubs(PRi, I1)); DVector Mu1 = asVec(VecSubs(Mui, I1)); DMatrix D1j = asMat(MatRows(D1i, I1)); for (int k = j + 1; k <= s1; k++) { Index1D I2((k - 1) * c + 1, k * c); DVector PR2 = asVec(VecSubs(PRi, I2)); DVector Mu2 = asVec(VecSubs(Mui, I2)); DMatrix D1k = asMat(MatRows(D1i, I2)); K = Index1D(1,c*c) + K.ubound(); DVector Ooffsetijk = asVec(VecSubs(Ooffseti, K)); DMatrix Zijk = asMat(MatRows(Zi, K)); DVector U3i(c*c, 1); DMatrix V3i(c*c, c*c), D3i(c*c, q); ord_prep_alpha(PR1, PR2, Mu1, Mu2, Zijk, Ooffsetijk, rev, par, geestr, U3i, V3i, D3i); Hi.inc_F(AtBiC(D3i, V3i, D3i)); Gi.set_U3(Gi.U3() + AtBiC(D3i, V3i, U3i)); DVector Zeta = Zi * par.alpha() + Ooffseti; //Z is C^2 x q; DVector Psi = geestr.CorrLinkinv(Zeta); DMatrix U3_Beta = getU3_Beta(Mu1, Mu2, Psi, D1j, D1k, PR1, PR2); Hi.inc_D(AtBiC(D3i, V3i, -1.0 * U3_Beta)); } } } void HnandGis(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, IVector &LinkWave, DMatrix &Z, IVector &Clusz, int c, bool rev, GeeParam &par, GeeStr &geestr, Corr &cor, Hess &Hn, Vector &Gis) { // Hess H(par), Hi(par); Grad Gi(par); // Index1D I(0,0), J(0,0); // int N = Clusz.size(); // for (int i = 1; i <= N; i++) { // int s1 = Clusz(i); // int s2 = s1 * (s1 - 1) / 2; // I = Index1D(1, s1 * c) + I.ubound(); // if (s2 > 0) J = Index1D(1, s2 * c * c) + J.ubound(); // Hess Hi(par); Grad Gi(par); // HiandGi(Y, X, Offset, Ooffset, LinkWave, Z, s1, c, I, J, // par, geestr, cor, Hi, Gi); // H.inc(Hi); Gis(i) = Gi; // } // Hn = (1.0/(double) N) * H; IVector Scur(Y.size() / c); Scur = 1; HnandGis(Y, X, Offset, Ooffset, LinkWave, Z, Clusz, c, rev, par, geestr, cor, Scur, Hn, Gis); } void HnandGis(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, IVector &LinkWave, DMatrix &Z, IVector &Clusz, int c, bool rev, GeeParam &par, GeeStr &geestr, Corr &cor, IVector &Scur, Hess &Hn, Vector &Gis) { Hess H(par), Hi(par); Grad Gi(par); Index1D I(0,0), J(0,0), K(0,0); int N = Clusz.size(); for (int i = 1; i <= N; i++) { int s1 = Clusz(i); int s2 = s1 * (s1 - 1) / 2; K = Index1D(1, s1) + K.ubound(); I = Index1D(1, s1 * c) + I.ubound(); if (s2 > 0) J = Index1D(1, s2 * c * c) + J.ubound(); IVector Scuri = asVec(VecSubs(Scur, K)); int clsz = sum(Scuri); //this is the new cluster size that should be passed down!!!!!!! if (clsz == 0) continue; //get dat i DVector Yi = asVec(VecSubs(Y, I)); DMatrix Xi = asMat(MatRows(X, I)); DVector Offseti = asVec(VecSubs(Offset, I)); IVector LinkWavei = asVec(VecSubs(LinkWave, I)); DMatrix Zi; DVector Ooffseti; if (cor.nparam() == 0 || s2 == 0) { Zi = DMatrix(1,1); Ooffseti = DVector(1); } else { Zi = asMat(MatRows(Z, J)); Ooffseti = asVec(VecSubs(Ooffset, J)); } //valid data i IVector VI = genVI(Scuri, c), VJ = genCrossVI(Scuri, c); DVector VYi = Valid(Yi, VI), VOffseti = Valid(Offseti, VI); IVector VLinkWavei = Valid(LinkWavei, VI); DMatrix VXi = Valid(Xi, VI); DMatrix VZi; DVector VOoffseti; if (cor.nparam() == 0 || clsz == 1) {//clsz == 1: no need to go association VZi = DMatrix(1,1); VOoffseti = DVector(1); } else { VZi = Valid(Zi, VJ); VOoffseti = Valid(Ooffseti, VJ); } Hess Hi(par); Grad Gi(par); HiandGi(VYi, VXi, VOffseti, VOoffseti, VLinkWavei, VZi, clsz, c, rev, par, geestr, cor, Hi, Gi); H.inc(Hi); Gis(i) = Gi; } Hn = (1.0/(double) N) * H; } void ordgee_var(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, DVector &W, IVector &LinkWave, DMatrix &Z, IVector &Clusz, int c, bool rev, GeeStr &geestr, Corr &cor, GeeParam &par) { int N = Clusz.size(), p = par.p(), q = par.q(); Hess Hn(par); Vector Gis(N); Grad G0(par); Gis = G0; HnandGis(Y, X, Offset, Ooffset, LinkWave, Z, Clusz, c, rev, par, geestr, cor, Hn, Gis); IVector level(2); level(2) = 1; Hess Hinv = inv(Hn, level); Vector Beta_infs(N), Alpha_infs(N); DMatrix VB(p,p), VA(q,q); for (int i = 1; i <= N; i++) { Beta_infs(i) = Hinv.A() * Gis(i).U1(); VB = VB + outerprod(Beta_infs(i)); if (cor.nparam() == 0) continue; Alpha_infs(i) = Hinv.D() * Gis(i).U1() + Hinv.F() * Gis(i).U3(); VA = VA + outerprod(Alpha_infs(i)); } par.set_vbeta_naiv(1.0/N * Hinv.A()); par.set_vbeta(1.0/N/N * VB); if (cor.nparam() == 0) return; //only those cluster with size 2 or more contributes to the variance of alpha //int Nalp = 0; //for (int i = 1; i <= N; i++) if (Clusz(i) > 1) Nalp++; par.set_valpha_naiv(1.0/N * Hinv.F()); //par.set_valpha(1.0/Nalp/Nalp * VA); par.set_valpha(1.0/N/N * VA); } void ordgee_top(DVector &Y, DMatrix &X, DVector &Offset, DVector &Ooffset, DVector &W, IVector &LinkWave, DMatrix &Z, IVector &Clusz, int c, bool rev, GeeStr &geestr, Corr &cor, GeeParam &par, Control &con) { ordgee_est(Y, X, Offset, Ooffset, W, LinkWave, Z, Clusz, c, rev, geestr, cor, par, con); ordgee_var(Y, X, Offset, Ooffset, W, LinkWave, Z, Clusz, c, rev, geestr, cor, par); } extern "C" { SEXP ordgee_rap(SEXP y, SEXP x, SEXP offset, SEXP doffset, SEXP w, SEXP linkwave, SEXP z, SEXP clusz, SEXP ncat, SEXP rev, SEXP geestr, SEXP cor, SEXP par, SEXP con) { DVector Y = asDVector(y), Offset = asDVector(offset), Doffset = asDVector(doffset), W = asDVector(w); IVector LinkWave = asIVector(linkwave); DMatrix X = asDMatrix(x), Z = asDMatrix(z); IVector Clusz = asIVector(clusz); int C = INTEGER(AS_INTEGER(ncat))[0]; bool Rev = LOGICAL(AS_LOGICAL(rev))[0]; Control Con = asControl(con); GeeParam Par = asGeeParam(par); GeeStr Geestr = asGeeStr(geestr); Corr Cor = asCorr(cor); ordgee_top(Y, X, Offset, Doffset, W, LinkWave, Z, Clusz, C, Rev, Geestr, Cor, Par, Con); SEXP ans = asSEXP(Par); return ans; } } geepack/src/utils.cc0000754000177400001440000001104212771411433014304 0ustar murdochusers// using namespace std; #include #include #include "tntsupp.h" #include "geese.h" void VecPrint(const DVector &v) { for (int i = 0; i < v.dim(); i++) Rprintf("%f ", v[i]); Rprintf("\n"); } Fortran_Matrix ident (int n) { Fortran_Matrix ans(n,n); for (int i = 1; i <= n; i++) ans(i,i) = 1.0; return ans; } Fortran_Matrix MatRowCol(const Fortran_Matrix &mat, const Vector &r, const Vector &c) { int m = r.size(), n = c.size(); Fortran_Matrix ans(m,n); for (int i = 1; i <= m; i++) for (int j = 1; j <= n; j++) ans(i,j) = mat((int) r(i), (int) c(j)); return ans; } Fortran_Matrix rho2mat(const Vector &rho) { int s = rho.size(); // s = n(n-1)/2 int n = (int) (0.5 * ( 1 + sqrt(1.0 + 8 * s))); Fortran_Matrix fullmat = ident(n); int k = 1; for (int i = 1; i <= n - 1; i++) for (int j = i + 1; j <= n; j++) { fullmat(i, j) = rho(k++); fullmat(j, i) = fullmat(i, j); } return fullmat; } //solve(a, b = ident(n)) DMatrix solve(const DMatrix &a, const DMatrix &b) { Subscript m = a.dim(1); // assert(m == a.dim(2)); Subscript n = b.dim(1); // assert(m == n); Subscript l = b.dim(2); Vector index(m); DMatrix T(a), B(b); DMatrix ans(n,l); if (LU_factor(T, index) != 0) { // cerr << "LU_factor() failed." << endl; return ans; } DVector v(m); for (int i = 1; i <= l; i++) { v = asVec(MatCol(B,i)); LU_solve(T, index, v); MatCol(ans, i) = asColMat(v); } return ans; } DVector solve(const DMatrix &A, const DVector &b) { DMatrix T(A); Vector index(b.size()); DVector ans(b); if (LU_factor(T, index) !=0) { //cerr << "LU_factor() failed." << endl; return ans; } if (LU_solve(T, index, ans) != 0) { //cerr << "LU_Solve() failed." << endl; return ans; } return ans; } DMatrix solve(const DMatrix &a) { DMatrix b = ident(a.dim(1)); return solve(a, b); } DMatrix AtBiC(const DMatrix &A, const DMatrix &B, const DMatrix &C) { DMatrix BiC = solve(B, C); return Transpose_view(A) * BiC; } DVector AtBiC(const DMatrix &A, const DMatrix &B, const DVector &C) { DVector BiC = solve(B, C); return Transpose_view(A) * BiC; } DMatrix apply_elwise(const DMatrix &x, double f(double)) { DMatrix ans = x; for (int i = 1; i <= x.dim(1); i++) for (int j = 1; j <= x.dim(2); j++) ans(i, j) = f(x(i, j)); return ans; } /* DMatrix apply_elwise(DMatrix &x, double f(double)) { return apply_elwise(x, f); } */ DVector apply_elwise(const DVector &x, double f(double)) { DVector ans = x; for (int i = 1; i <= x.dim(); i++) ans(i) = f(x(i)); return ans; } /* DVector apply_elwise(DVector &x, double f(double)) { return apply_elwise(x, f); } */ DVector sqrt(const DVector &x) { return apply_elwise(x, sqrt); } double square(double x) { return x * x; } DVector square(const DVector &x) { return apply_elwise(x, square); } double reciproot(double x) { return 1./sqrt(x); } DVector reciproot(const DVector &x) { return apply_elwise(x, reciproot); } double recip(double x) {return 1./x;} DVector recip(const DVector &x) { return apply_elwise(x, recip); } int cluscount(DVector &ID) { int ans = 1; for (int i = 1; i < ID.dim(); i++) if (ID(i - 1) != ID(i)) ans++; return ans; } Vector clussize(DVector &ID) { int K = ID.size(); Vector ans(K); ans = 1; //double id = ID(0); int k = 1; for (int i = 1; i <= (ID.dim() - 1); i++) { if (ID(i + 1) == ID(i)) ans(k) += 1; else k++; } return ans; } DVector SMult(const DVector &v1, const DVector &v2) { // assert (v1.dim() == v2.dim()); DVector ans = v1; for (int i = 1; i <= v1.dim(); i++) ans(i) = v1(i) * v2(i); return ans; } DMatrix SMult(const DVector &v, const DMatrix &m) { // assert (v.dim() == m.dim(1)); DMatrix tmp = m; for (int i = 1; i <= m.dim(1); i++) for (int j = 1; j <= m.dim(2); j++) tmp(i, j) = v(i) * m(i, j); return tmp; } DMatrix operator*(const DVector &v, const DMatrix &m) { return SMult(v, m); } DMatrix diag(const DVector &v) { int n = v.dim(); DMatrix ans(n, n); ans = .0; for (int i = 1; i <= n; i++) ans(i, i) = v(i); return ans; } DVector diag(const DMatrix &m) { int n = m.dim(1); //assert m.dim(0) == m.dim(1); DVector ans(n); ans = .0; for (int i = 1; i <= n; i++) ans(i) = m(i,i); return ans; } DMatrix inv(const DMatrix &x) { return solve(x); } DMatrix fabs(const DMatrix &m) { return apply_elwise(m, fabs); } DVector fabs(const DVector &v) { return apply_elwise(v, fabs); } geepack/NAMESPACE0000754000177400001440000000153312736754210013275 0ustar murdochusersuseDynLib(geepack) importFrom("graphics", "abline", "lines", "plot") importFrom("stats", "binomial", "coef", "fitted", "formula", "gaussian", "glm.fit", "is.empty.model", "lm.fit", "lowess", "model.extract", "model.matrix", "model.offset", "model.response", "model.weights", "na.omit", "naresid", "pchisq", "printCoefmat", "quasi", "residuals", "summary.glm", "var") importFrom("utils", "head") # maintained by Soren export(geeglm, fixed2Zcor, anovageePrim2) S3method(anova, geeglm) S3method(print, geeglm) S3method(residuals, geeglm) S3method(summary, geeglm) S3method(print, summary.geeglm) # maintained by Jun export(geese, geese.fit, ordgee, geese.control) export(genZcor, genZodds) export(relRisk) export(compCoef) S3method(print, geese) S3method(summary, geese) S3method(print, summary.geese) geepack/data/0000755000177400001440000000000012404310560012747 5ustar murdochusersgeepack/data/koch.txt.gz0000754000177400001440000000170611710514753015072 0ustar murdochusersU=V E|VQz?zcIxex;> _~wiW{=ޯW !m+2%t$HN vF:t$Dy#y:ϠsCБ` eqHΰAGy$疓!O} :\\!G[چPDuJ-Qc2euQ0 !B˄LhM5EфLx yE?[K s0WL+\-v4t.ބMλWR1D&s%e;x0W G2JB+wߧ-Z&vvZ& ~LhAC ooB+wOZ&eB+~PZ&n&oTIE&;&esx20W~ v4a.ZA1Eh2Ļ-Z&xcM$Lx q(4>-/V)BCOCDOKOK릹a\Iu55-S}s.B˄ eB˄&wI E˄ -~&O"Lh :)B˄7tqKC˄iΕT>%MV~cZ&zIфV\SMT^ĻwZ&e\A%Ž&Lh{"eB˄V)BTo5 ~ sкi&s%չjKĻ_MTJ7TK"e;&a "eB˄_STi}CEф sa.v4ὂxa.2Ļ_-˄xe\&n:6MTo"WRmxGes%Ļ? ށ\Qgeepack/data/spruce.txt.gz0000754000177400001440000001103711710514753015445 0ustar murdochusers}][*. Λ\ ˮjVS3=]=ԗ_~|ۗ}o|o~_}׿O?˯__Sy+[}!ǮH[{Ժ 9 xe(6?i1bu_Hwd̷Wx+ ڗBVZiy5\[BVGNR{6?H}!SOR 0C~p:U:9}A@'}I 6[ HCTG~:޷H +UHJmJ69a#akj ԱRVR$uprJխұR V5868E ݐCXjHXeiRHT&,Lu ,ӽIu0b>]aJ_uW$(57ArR9l͐P}9`T "=BbYN@ު:8UzXj[>pXզ( Bki nڜC MW-f)V[!굕DΒ*ˑ0 U_JCU*j-b˴u}4SQj2bMVWٯ[k4RiSv-"uI뫮OIKyL;Sr>@h+_z 02Ic' v*+(7MbPy'!V|`DI]Sl(l Xa;S8Ts,979} *H Ƞ!O]O: a MF|,u':F0| %d^$wX0lLG>ŚVTkz*Vzlߩdۛh3 X)]R {0hPnb%[sڭ ܱE0ava%\_jOo64Mb`"6 za`W'yPp`Xv9h},Xbo/wN1rNyNZ(?Ji8s4SN5%l[tʕc*> ox<)gPr!NPćBFΑ,ϐF:1et)- |L";G";D O5d#3Lݴ Yrm{mXQP>XumP"Y_ cX_MRbX{-(XTB(6oVbJ@8ESH{80D%ObA!7PtTA ӷt>$|H)9I=bEjIaJbN:t"s6G9{]I2>}-r7  G_1SdCvC1fl1C7tYu|Ԋ1CW{f>ZX`* g'sv=y-pK;puo }IT5IY8ټCԢ{$t}'Ag3 :;CRdl=$΄,w"nH:;)'owL(zw fJN[X-a):oKض:;͘PS'o0TV:t$]SЙIS(茬ΰ3PPl5]Onz]p@KNQz|tMt:)l RU!cT+Us*I@ u*:5}{t;.)Gc!n*#+rgznKn095Ř3 aP,`} yM=;ma;/@(EbCOVd"9lP,`%2yN]w*If0,Pngj΂K,,\*UgϨ 7'+6xnk*D wauk/@ʍ@p1#1RG49hEO9e1 #q#`$n,[t=-}8I(-uP} Q c gCȑHn* WGb܆\l2?[axl% %+D4Dhn4 &lqg#$I2L̘Q"mԮPV_  革g LERbG]AL8 AUqZN%RU@!@!u\wEXD팩 +=f&@ֱ*pZǭT / < G/4:aL) DBH]ٯv(p9E묂HCcF1s'8fLqZTW}ݵ!+*8f!tpJ!WJ3 C Qժ@H!R 仵|E\YᢤH j8$ /^+MD֏Y畲}2;nqIx(EȢ-"txO/8}d(7W ]B G A߱{4 }%T>aK WyCW:D 8Yl:,"#uTPA]O=!+ (| D٫^@*y ^e @>aNjOO5~x ] *_|j*pHkWA˻"t@S3PPET#@\7 PPgJ>@TW)pJfsdu-6&3j O>jW:8qjW39(ԅ +T3{S VŨ 㪔]kZz:-VJ+pW3:~q 8i\PU-- n߀(W }VrzB $Z!l8T/@TN׈UMV^iWQ13AVc*$}c(p)'(1HDv/Ԯ~틡pm?2-H HES b?-!@ș%JAߑB /T5:]z@Ģ-(ֆs[SdZ V]Hqɻ^k m_I髚¢ČdqĈ1eZiO\x<iCx<: #יf, +ZDAǦFzpYWBZ+NBk[@ Ujgeepack/data/seizure.txt.gz0000754000177400001440000000072311710514753015632 0ustar murdochusersMSIn1 z%y@{K~_Nbl(3,v|=}݆^a_,{:<_}H%\MN%;gEײGa1 r< NoeUyvIi.&Iv'E QFW*7=5)CVGE~RbzOɠc(h/:Na4"1z$ېǡ Šm/bQ Xlcg.$IFױǘX~ߵ9T`E:05?Rƪм܏?@tgeepack/data/sitka89.txt.gz0000754000177400001440000000476111710514753015446 0ustar murdochusersmK6D罊ZįF G^}Q*ONu?_ϟ?ϿqW:_MW[CI^\JFnckz*c揣lIr$)Ir#|}>B.$ |tI8?_>IjOӧꬆ>^Ӓ $\$§}\8?B|Ir.$\nd$\$}'>B&|#c|Ε3t-G}ܱ>IGȂ<O^ug&O:OL3vG}p~f +IOs3'I+x2#>vUI2'|V;W;z'I=tMG&jsC^#"t(R2RIR߅$YIO;K~2#yu'ɢOyƏ|(Ui|Zl|G}=ۘ#AAřdg,D=U Mڮ)ӓЧ~X$աۘ#K0_#IIP߅ I2;g>IG1χz%7MƳ>:'2}4$>Bdq 1 98?I?ǎCIA(YHc?2U#w!K |>$1 *Iұ߅_U|(d!BdXV`p2?g!W^(zl韹ߓ,ƳtxQIRPu ꗐZ]nOJr1[~@?V#B: !w%!*:W=l$'GHE=POw!;U2$7,Ztç躇Ou'Ǡʳ:EFIrAQ k#畠_sNr7F=r/*' 8~L@rq|N#紵>I ao;#dlVl!9%FYg%Xfy>|2?7dD=m_s HGMo(S! }g%ƨB (aHGxFOz*Y^ $<~AO&g>I !<z kLTԌidH~U1?Rd}Ə9^)$<~!d^yw!xovr>K#!|La /!<v>rqXE#C!s !_:ANGgď.d`G׃l;K bd؉tt1#=61%qLWB=gyƏg>rg?>M 騑LƏdUwbϯ?dHbL'=Uic<1cme)lʌ){Cmq*2@eS"c'ꮱ2rgx}nXw܇TxjB팹KDv7v S&  5?c&z_U{ }Ҭ߈5Tic}b9~xf!,gOuT㰾>)3fg\duwzׄ- kѡn?e<3rX97k9M~~.硹Z@~1/>3O[/  fh9k]1,dp}+ }3Ο1iZ׃mGM GYMYMa]{?Zgy=1*Ϻq o>W184 NUy>;؅`j ` î]~?c;˃m?e 1c3u{ӬaW{k?q} ?Ϧ +S?ߓm??Zk~8xԔZa \o.11Z[Uh߻ BTm9&a|Jy|Q !Y !f?:! Q=.]clc D9؇xuj !ʹocy0(N [ !ʹI0r:9: !ʩ\A! ѹ: 0ƨ:9! Q=ՙϩ Bz6_esci/9&arԙ׾&au?V !y1!ʩc.1 Qr2Ƨt~B!1QN~IqACH0D룓֞ Tr_^[- 0GXw2/d^Mr*c ۖaPs182t'?R4VAepZkHזa8BQ־pc.|0D98!0tܲ! Q=&1 QέN}spAar37[0e! QrܶZI˅!ʩC(zc(JM!O)'ψ~Ʃ_>-! Q=u+y6D1ѼLcs;~i9&arZ Bw\k0D9u+sLx1!ǯG D9&g=vc)n 0D\ }MգS BR=e8gAS5 0DN{ BjQ.uvQz[! Tg\鷿]T CT- a79uAaQ=i1!͕Ͻ.arꖽ! Qj翷y !kUg^ !Yb2ACS'{/ !n;geepack/data/respdis.txt.gz0000754000177400001440000000065511710514753015621 0ustar murdochusersuK }N1 T6}l9Ȥ^5g\$_x"3< GN=u!BwR=„zܟ".Wn! h31  * }@r@Gdb{;:2hTp@[M7_3 Aq@'+4`0 Ln hLn%W+x ^r=_ ^r/K^YP1& L(j`ђzb+`+6GeV&$#al AaP4|-Iv| #~j_wtDm`ciF `, *cv|0RT|n-̿+E\[[K5~ykpw geepack/data/dietox.txt.gz0000754000177400001440000002052011710514753015435 0ustar murdochusersuKlnEb `;ivK0 W >dF[͓;dd\Ͽ<׿_?/矞~i_~OOk?z|~_?ycgfןC|߯{vlvHnó?&g3=LϮu[{XM/Z7++r ,dӥv~/"Pm}L O_,ZYt,\xV~RGVW|[oõqb^tޖ=xqy[s3++t'|+fO#7\''n`z_~ o 'FE|ж\:fcrS4IS{hjpC| mOdzD(|#Fou߽Qr6N8x[nDqۂsGqX <3w|bl,O\0X/)`>QO\pBcPP˝,S.'ʼnq>rck\`fR~`:& mA'f-Ot|99^S(-1 o˵mmppԄ#'Ә-"ޖ,R~9npƒG98ۂ KwENh'8ΆJO}"q`\:r re5Z9q"ok-YoxD'D&ѷ]',;<-7+)U=jN| o}9)S`M};Ac6 GWt9Cψnx6 ^T>Kp Go rKLYV)N_I / ]"lx[8{QCP^"!G4BF?hD4hUM(p4ذ S9h˩ozQN-rUZP|kBsD<ٞh`qGg-rVֈ.x\@tR5Ȁn%߻,hJClldC2\\yoz\4N"[B%!jJ^CEOCup0IZ"7I]#anB:hmm#z`wE:dFxz7 E2)U* )} P3`-HK *nhԡ%Ԉ5X4IrLOCf4WUE?Dg7]0ϤzT@WL4)]"[B-& o ҊzH(| mژKz"BמBL;~5K)fDyߪlȊ#/()-D`S| A'2cStel戦:60 8= %?t2 ۹Me 9ƱxBG~!wDW鏀{^8ك-nJ=ĠTt y*^>^)(ΔtM4r%A(^Or jkDO-txhߣ(G>GjДch=dE4׹[Jڕ}SSdKrŏ)ym}zw_k.V?tD@SD?5zZDw6|CVеxxܧ,vG/&V uM}xѓG@TMn?>e¿]HU/ \&|g]5Άhh!F@S/VM_[~ތjϗqaWDC[EU񏛦w?:_ F.ѩ?niIQKX]X:~xz`z>YzhQPҧ]ӠO_Og[Ω.`D('"Y];NѢNztɺ' OSw2 聑Aߔev k诫+ѧJ8>}#}R -.j{V3ccѠOf?eoj?&'e;/#[H=*vSPN CSO>=4N Dth#\tA`UmP?4ӌ#C􏛦)WR}:>5 鹁&~x)Sʻ5*ѠOѭyT{|/m(}p.Jn_*~4iJ%wFB[OW^?:߫_ZFɛ66׍C?^'rD7xtˈ>_l_lU菀^? uqjBsРO9__:vhtAB,["[ҧ?کȖr ?j[jN+ S+* Ar+V#꧜ߖSGh=~KSK@>=| -5M}ʍ.#m{F| ~O}#爞Rl ubۏjExbH+ď^h{OC{DRԍ}@'4C?V`OGQj"# XS4U3AEfnrM/ȖJv>OOttt2'F6)GK@CxjF)*(zD>]*c%GU>9nqOC̠T}T?cӋD}M_m 1WӀ}zzxtt}8"9jD7MCꧧi@W/94* h$n#ٰ 8M'T+|rRdK۬&v)%mc"PTEʫ9G>mjvDzr΀ta G4ө̖/.tOTM)pfE茧߈.V?ٲX}:4ncUJa}jƐ<=Pid  4 P/{=u4s?AۜY=O#a>%MקQ4hZxzESc޶Lw9 ݑ_z6 3٤N͜]tGSTP{;~.vimw}L\Ɏ}Fl uY87ꯊ Ӎmv c^l~4 :yTa@0-imT#nX#q,VFWӀmsrۀ%K@cqVjsnHԶ_9Af(ڔVOvxZ~ uvzxqӠm(:~xtAEA3 d;iAۜRhЧ'6so[wMQ}ShiЧP9:>At/'tƈ𞈠o= tNV]Q# iҧ< u~_2ʎ~HGzdKlQ7N2co?utz| ΘV)S;RobDIӟ| #'<?8~<ߐTIh|O?%7}:ŋ2f$?T?jk3j4dymMS{CxO7 9t3_7=Đ _xP?]JhHPQ>/x%wN$ npG@ӝ0]_kBRmdѠO~j=QD:fD9T3_xoT~=]^{ U CJ>*n,n=}OD4O?- t8UOk S|.#H_tyW3s7cPӀ?-uNnjJ1iЧTv^SNb#Qʀ?UT# /ܟok/.a,uKz\@w_xR=ݭ\@OT?r}~:ߖN έRW9Fb}:|T@>VG@W]"Yh8h h< .Ɇz%* z>0Nnʀ&}Ie2˨R8-| >gS_dFt3'{Рdò! O wgӠOY#S?n|TO wg4_g5,e{I^!U4S)T?TtG3TG@>Az!c͆Z*;gEx:dvVDt MC݁]An[^:zӡۀ)ϿdO Sk* et/up4P&&_}O4V^6~8("|q4-&(~}* ΦMk))רW/3{6r{q=<]/7MSVܴKV͎=k<%7=;MGn)"[6ZqLD1}!]f{ |7.Qt}tE A/|2xz&T5UU},ISA h/e==kv4ӳkF4=5n/~ж4SޑniЧLc3u"zӨlOk>zP?T}lW.?xޟ:%Ge6EU 9nĴT#i)2f+헒ch֧t,=iЧg*5|O4GQmsf{ Msj7U=_i?ީ+=The.QcS돦д_-n6;}Q+q,yWB2ο8~n7͈EyW>#noDI_,oieG'l uژmPQ!2Ga kCSрTOhBf5kr4g+P.ЋnIoDg 7/H8ԫo[+HAqj]nv؊┊h@S8C) Oӌl̉q\_&&8:=_"voDCqБ-07*MȖP]~^{}7}=?*|Thߗڮ3Y_["`Kg$G ]1hu4s@o"zi@ Q,ӅzۗN]pnn@FЊ33* |% jHxF@gAnr#3FaRѐ%3f'&oz ;\WD/7+nF6҄,ЬOE<7hOttCȠiq!1i!'HFXgq-87MW*~tA5f+f&W)lƉcLiɦ㇧9n<#KFq7M5p63/q㋧qC≸NU;-gD>gѠOAh4wodeӑ-QqM~')%m6s 5fcX4ޔ/4⍄fcϦh* 脧ŏ7t6aJ^>"<cLjg&ZnrS-ig'Ntӈ7*="[B&'s#Q$c=mTm,M}8F4OV]W`lNIoTtkI4O9"\O7M3nfcVK+GNވms6f&N*; u{z*Kl*YO, #%=h?'R6#~ʢUm| h63M7VKaf"nT4OQݟ#= 6ULV4̡а#'"TXqCh!;j;oz4U4m։6jxEtB6l?QtGX@CZoTRCGr/g⽧Qt$5/(;JkDO6fzѦ{Og˿hSS^- ~ YBGVޣT4AaT PTcJxzbL|01q>Fv"-v!bDtyt2`Ó5S/ ٸ&&=M;l鵛з5n&nzbL<բn jzlt}FtB?ԣQ\Dx#joȖu=Q6zpnٲ.[?**Q :~xܿ(i6:_؆5I7nвGwaCψ63n~L州^?$7R8%cE緞N:FM^<geepack/data/ohio.txt.gz0000754000177400001440000001147411710514753015107 0ustar murdochusersM]v%݊揔1REaS?{m=9-eđ5B_?׿__vsz?&7o"'7o&Q7Qo'ѓ7o=Mo3M77t}}}O=77t}}}O=77tM7=t=M7=t=M7U?M7=t=M7=t=C?3?t3?C?3?t3?C?3?t3?񇍿li3?t3?C?3?t3?Ek_Ek_Ek_Ek_Ek_Ek_Ek_􇥿,i9/_t5/_t5ot=ot=ot=ot=ot=ot=ot=otz˞M{Cg?Cg?Cg?Cg?Cg?Cg?Cg?Cg?Cg?*ˊiϺr^.º$rd]u.ҺZ[rl]u.⺘\rt]u.^r|]u.`>  #wgS-ß5vg;ğQYbwgmǟu|0-ps>}0Mp>}0mp>]Gl:Fp3?~0ps?0p?0p? @J M@b0RF P@h-xP f P@h=P P#%Ah MxP P+eAh ]P P3Ah mwSSS >A(B(!!Ft|$agH=C!~&#=C!~& ;^\3xqq27g ;^\3xqq2Ih23$! >3!=Gx3#ϐz|dp=~72G^2ϐx^8͵cg! 9!zqkag! 9!zqkeg! 9!zqkIux3䒑! OFz\~%#=CϐKFz3$! gH3䖑!7!! e g-ϐx2> SFgSLmmux3YgH ydt|g! z?Iuz3${gH$2H.6In1yH(d2 BF!Q(d2 BF!Q(d2 BF!Q(d2 BF!Q(d2 BF!Q(e2J%RF)Q(e2J%RF)Q(e2J%RF)Q(e2J%RF)Q(e2J%RF)Q¨dT2*JF%QdT2*JF%QdT2*JF%QdT2*JF%QdT2*JF%Qe2j5ZF-Qèe2j5ZF-Qèe2j5ZF-Qèe2j5ZF-Qèe2j5ZF-QHz34 gh3 QzQ(23 \&egFMp'Ng]ﺻ`T2*u$aT2*uų`T2*u}T0*ϺQdT> FQ O8+tVgeepack/R/0000755000177400001440000000000012771411302012242 5ustar murdochusersgeepack/R/ordgee.R0000754000177400001440000001401511660233566013647 0ustar murdochusersordgee <- function(formula = formula(data), ooffset = NULL, id, waves = NULL, data=parent.frame, subset=NULL, na.action=na.omit, contrasts=NULL, weights=NULL, z=NULL, ##family=binomial(), mean.link="logit", corstr="independence", control=geese.control(...), b=NA, alpha=NA, scale.fix=TRUE, scale.val=1, int.const=TRUE, rev=FALSE, ##rev TRUE for coding in HZ 1996. ...) { ### y is sum(n_i) * c x 1 ### x is sum(n_i) * c x (p + c) scall <- match.call() mnames <- c("", "formula", "data", "offset", "weights", "subset", "id", "waves") cnames <- names(scall) cnames <- cnames[match(mnames,cnames,0)] mcall <- scall[cnames] if (is.null(mcall$id)) mcall$id <- as.name("id") mcall[[1]] <- as.name("model.frame") m <- eval(mcall, parent.frame()) id <- model.extract(m, "id") ## N <- length(unique(id)) clusz <- unlist(lapply(split(id, id), length)) maxclsz <- max(clusz) if (is.null(waves)) waves <- unlist(sapply(clusz, function(x) 1:x)) else waves <- model.extract(m, "waves") # if (is.na(b)){ # foo <- polr(formula, data, ...) # b <- c(foo$zeta, foo$coef) # } y <- model.extract(m, "response") if (length(y) != length(id)) stop("response and id are not of the same length.") if (class(y)[1] != 'ordered') stop("response is not an ordered factor.") lev <- levels(y) nlev <- length(lev) ncat <- nlev - 1 y <- unclass(y) Y <- rep(y, rep(ncat, sum(clusz))) if (rev) Y <- as.double(Y <= rep(1:ncat, sum(clusz))) else Y <- as.double(Y > rep(1:ncat, sum(clusz))) mterms <- attr(m, "terms") x <- model.matrix(mterms, m, contrasts) xvars <- as.character(attr(mterms, "variables"))[-1] if ((yvar <- attr(mterms, "response")) > 0) xvars <- xvars[-yvar] xlev <- if (length(xvars) > 0) { xlev <- lapply(m[xvars], levels) xlev[!sapply(xlev, is.null)] } xint <- match("(Intercept)", colnames(x), nomatch = 0) n <- nrow(x) pc <- ncol(x) if (xint > 0) { x <- x[, -xint, drop = FALSE] pc <- pc - 1 } else warning("an intercept is needed and assumed") ind <- gl(sum(clusz), ncat) x <- x[ind,, drop=FALSE] if (int.const) { xc <- matrix(diag(ncat), sum(clusz) * ncat, ncat, byrow=TRUE) colnames(xc) <- paste("Inter", lev[1:ncat], sep=":") } else { foo <- sapply(waves, function(x, maxclsz, ncat) { bar <- matrix(0, maxclsz*ncat, ncat) bar[(x-1)*ncat + 1:ncat,] <- diag(ncat) bar }, maxclsz=maxclsz, ncat=ncat) xc <- matrix(unlist(foo), ncol=maxclsz*ncat, byrow=TRUE) colnames(xc) <- paste("Inter", paste(rep(1:maxclsz, rep(ncat, maxclsz)), rep(lev[1:ncat], maxclsz), sep=":"), sep=":") ##b <- c(rep(b[1:ncat], maxclsz), b[-(1:ncat)]) } xmat <- cbind(xc, x) # note the negate sign!!! p <- ncol(xmat) offset <- model.extract(m, "offset") if (is.null(offset)) offset <- rep(0, length(id)) offset <- - rep(offset, rep(ncat, sum(clusz))) w <- model.extract(m, "weights") if (is.null(w)) w <- rep(1, length(id)) w <- rep(w, rep(ncat, sum(clusz))) CORSTRS <- c("independence", "exchangeable", "NA_ar1", "unstructured", "userdefined") CORSTRS.ALLOWED <- c("independence", "exchangeable", "unstructured", "userdefined") corstrv <- pmatch(corstr, CORSTRS.ALLOWED, -1) if (corstrv == -1) stop("invalid corstr.") corstrv <- pmatch(corstr, CORSTRS) corr <- list(as.integer(corstrv), maxclsz) if (is.null(ooffset)) ooffset <- rep(0, sum(clusz*(clusz-1)/2) * ncat^2) if (is.null(z)) { if (corstrv == 5) stop("need z matrix for userdefined corstr.") else z <- genZodds(clusz, waves, corstrv, ncat) } if (length(ooffset) != sum(clusz*(clusz-1)/2) * ncat^2) stop("length(ooffset) != sum(clusz*(clusz-1)) * ncat^2 detected.") if (corstrv > 1 && nrow(z) != sum(clusz*(clusz-1)/2) * ncat^2) stop("nrow(z) != sum(clusz*(clusz-1)) * ncat^2 detected.") waves <- rep(waves, rep(ncat, sum(clusz))) if (is.null(id)) stop("ID variable not found.") LINKS <- c("NA_identity", "logit", "probit", "cloglog", "NA_log", "NA_inverse", "NA_fisherz", "NA_lwybc2", "NA_lwylog") LINKS.ALLOWED <- c("logit", "probit", "cloglog") mean.link.v <- pmatch(mean.link, LINKS.ALLOWED, -1) if (mean.link.v == -1) stop("mean.link invalid.") mean.link.v <- pmatch(mean.link, LINKS, -1) geestr <- list(maxwave=maxclsz, mean.link=rep(mean.link.v, maxclsz), variance=rep(2, maxclsz), sca.link=rep(1, maxclsz), cor.link=5, scale.fix=as.integer(scale.fix)) p <- ncol(xmat) q <- ncol(z) if (!is.matrix(z)) z <- as.matrix(z) if (is.na(b)) { link <- mean.link b <- glm.fit(xmat, Y, w, family=binomial(link))$coef } if (is.na(alpha)) alpha <- rep(0,q); param <- list(b, alpha, gm=rep(scale.val, 1)) ans <- .Call("ordgee_rap", Y, xmat, offset, ooffset, w, waves, z, clusz, ncat, rev, geestr, corr, param, control, PACKAGE = "geepack") names(ans) <- c("beta", "alpha", "gamma", "vbeta", "valpha", "vgamma", "vbeta.naiv", "valpha.naiv", "valpha.stab", "vbeta.ajs", "valpha.ajs", "vgamma.ajs", "vbeta.j1s", "valpha.j1s", "vgamma.j1s", "vbeta.fij", "valpha.fij", "vgamma.fij", "error") ans$xnames <- dimnames(xmat)[[2]] ans$zcor.names <- dimnames(z)[[2]] names(ans$beta) <- ans$xnames names(ans$alpha) <- ans$zcor.names ans <- c(ans, list(call=scall, clusz=clusz, control=control, model=list(mean.link=mean.link, variance="binomial", sca.link=NULL, cor.link="log", corstr=corstr, scale.fix=scale.fix))) class(ans) <- "geese" ans } geepack/R/rrr.R0000754000177400001440000000346611635141511013205 0ustar murdochusers## This is a wrapper function for relative risk regression ## for binary data with log link using the copy method relRisk<- function(formula, id, waves = NULL, data = parent.frame(), subset = NULL, contrasts = NULL, na.action = na.omit, corstr = "indep", ncopy = 1000, control = geese.control(), b = NULL, alpha = NULL) { family <- binomial("log") ## fixed scall <- match.call() mnames <- c("", "formula", "data", "offset", "subset", "na.action", "id", "waves") cnames <- names(scall) cnames <- cnames[match(mnames,cnames,0)] mcall <- scall[cnames] if (is.null(mcall$id)) mcall$id <- as.name("id") mcall[[1]] <- as.name("model.frame") m <- eval(mcall, parent.frame()) y <- model.extract(m, "response") if (is.null(dim(y))) N <- length(y) else N <- dim(y)[1] mterms <- attr(m, "terms") x <- model.matrix(mterms, m, contrasts) offset <- model.extract(m, "offset") if (is.null(offset)) offset <- rep(0, N) w <- rep(1 - 1 / ncopy, N) w.copy <- rep(1 / ncopy, N) y.copy <- 1 - y id <- model.extract(m, id) waves <- model.extract(m, waves) ## augmented data Y <- c(y, y.copy) W <- c(w, w.copy) X <- rbind(x, x) ID <- c(id, id + max(id)) Waves <- c(waves, waves) Offset <- c(offset, offset) Freq <- rep(c(2, 1), each = N) ## get initial values fit0 <- glm.fit(X, Y, offset = Offset, weights = Freq, family = family) fit1 <- glm.fit(X, Y, offset = Offset, family = family, weights = W, start = fit0$coefficients) ## feed geese ans <- geese.fit(X, Y, ID, Offset, weights = W, waves = Waves, family = family, control = control, corstr = corstr, b = fit1$coefficients, scale.fix = TRUE) ans <- c(ans, list(call=scall, formula=formula)) class(ans) <- "geese" ans } geepack/R/geeglm-anova.R0000754000177400001440000002414312771411302014735 0ustar murdochusersanovageePrim2 <- function(m1, m2,...){ mm1 <- model.matrix(m1) mm2 <- model.matrix(m2) P1 <- mm1 %*% solve(t(mm1)%*%mm1) %*% t(mm1) P2 <- mm2 %*% solve(t(mm2)%*%mm2) %*% t(mm2) e2 <- mm2 - P1 %*% mm2 e1 <- mm1 - P2 %*% mm1 m2inm1 <- all(apply(e2,2,var) < 1e-10) m1inm2 <- all(apply(e1,2,var) < 1e-10) if (!any(c(m2inm1,m1inm2))) cat("Models not nested\n") else if (all(c(m2inm1,m1inm2))) cat("Models are identical\n") else { if (m1inm2){ tmp <- m1 m1 <- m2 m2 <- tmp } ## Now mm2 < mm1 mm1 <- model.matrix(m1) mm2 <- model.matrix(m2) ## What is this? I wonder mf1 <- paste(paste(formula(m1))[c(2,1,3)],collapse=" ") mf2 <- paste(paste(formula(m2))[c(2,1,3)],collapse=" ") ## Reparametrize the model mm <- cbind(mm2,mm1) qmm <- qr(mm) qmmq <- qr.Q(qmm) nymm1 <- as.data.frame(qmmq[,1:qmm$rank]) colnames(nymm1) <- paste("parm",1:ncol(nymm1),sep=".") nymm2 <- nymm1[,1:ncol(mm2),drop=FALSE] formula1 <- formula(paste(formula(m1)[[2]],formula(m1)[[1]], paste(c("-1",colnames(nymm1)),collapse="+"),collapse="")) m1call <- m1$call ## BUGFIX provided by Stefan Boehringer ##nymm1[,paste(formula(m1call)[[2]])] <- m1$y nymm1[, paste(formula(m1)[[2]])] <- m1$y nymm1[,paste(m1call$id)] <- m1$id m1call$offset <- m1$offset m1call$weights <- m1$weights m1call$formula <- formula1 m1call$data <- nymm1 m1ny <- eval(m1call) ## Calculate wald statistic beta <- coef(m1ny) vbeta <- summary(m1ny)$cov.unscaled df<- dim(mm1)[2]-dim(mm2)[2] rbeta<-rep(1,length(beta)) rbeta[1:df]<-0 beta0<-rev(rbeta) zeroidx <- beta0==0 X2<-t(beta[zeroidx])%*% solve(vbeta[zeroidx,zeroidx,drop=FALSE])%*%beta[zeroidx] ## Make table with results topnote <- paste("Model 1", mf1,"\nModel 2", mf2) title <- "Analysis of 'Wald statistic' Table\n" table <- data.frame(Df=df, X2=X2,p=1-pchisq(X2,df)) dimnames(table) <- list("1", c("Df", "X2", "P(>|Chi|)")) val <- structure(table, heading = c(title,topnote), class = c("anova", "data.frame")) return(val) } } anova.geeglmlist <- function (object, ..., dispersion = NULL, test = NULL) { responses <- as.character(lapply(object, function(x) { deparse(formula(x)[[2]]) })) sameresp <- responses == responses[1] if (!all(sameresp)) { object <- object[sameresp] warning("Models with response ", deparse(responses[!sameresp]), " removed because response differs from ", "model 1") } ns <- sapply(object, function(x) length(x$residuals)) if (any(ns != ns[1])) stop("models were not all fitted to the same size of dataset") objects <- list(object,...) m1 <- objects[[1]][[1]] if (length(objects[[1]])>1) m2 <- objects[[1]][[2]] else m2 <- NULL value <- anovageePrim2(m1,m2) return(value) } anova.geeglm<-function (object, ..., dispersion = NULL, test = NULL) { dotargs <- list(...) named <- if (is.null(names(dotargs))) rep(FALSE, length(dotargs)) else (names(dotargs) != "") if (any(named)) warning("The following arguments to anova.glm(..) are invalid and dropped: ", paste(deparse(dotargs[named]), collapse = ", ")) dotargs <- dotargs[!named] is.glm <- unlist(lapply(dotargs, function(x) inherits(x, "glm"))) dotargs <- dotargs[is.glm] if (length(dotargs) > 0) return(anova.geeglmlist(c(list(object), dotargs), dispersion = dispersion, test = test)) varlist <- attr(object$terms, "variables") ##print(varlist) x <- if (n <- match("x", names(object), 0)) object[[n]] else model.matrix(object) varseq <- attr(x, "assign") nvars <- max(0, varseq) betaList <- vbetaList <- NULL if (nvars > 1) { method <- object$method if (!is.function(method)) method <- get(method, mode = "function", envir = parent.frame()) for (i in 1:(nvars - 1)) { eprint("calling fit....") ##print(length(object$y)) fit <- method(x = x[, varseq <= i, drop = FALSE], y = object$y, weights = object$prior.weights, corstr = object$corstr, start = object$start, offset = object$offset, id=object$id, family = object$family, control = object$control) betaList <- c(betaList,list(fit$beta)) vbetaList <- c(vbetaList,list(fit$vbeta)) } } betaList <- c(betaList, list( object$geese$beta )) vbetaList <- c(vbetaList, list( object$geese$vbeta )) hasIntercept <- (length(grep("(Intercept)",names(betaList[[1]])))!=0) dimVec <- unlist(lapply(betaList,length)) if (hasIntercept){ dfVec <- dimVec[1]-1 } else { dfVec <- dimVec[1] } if (length(dimVec)>1){ for (i in 2:length(dimVec)) dfVec <- c(dfVec,dimVec[i]-dimVec[i-1]) } ##print(dfVec) X2Vec <- NULL ## Calculate Wald statistics for (i in 1:length(dfVec)){ beta <- betaList[[i]] vbeta <- vbetaList[[i]] beta0 <- rep(1,length(beta)) beta0[1:dfVec[i]] <- 0 beta0 <- rev(beta0) zeroidx <- beta0==0 X2 <- t(beta[zeroidx])%*%solve(vbeta[zeroidx,zeroidx,drop=FALSE])%*%beta[zeroidx] X2Vec <- c(X2Vec,X2) } resdf <- dfVec resdev <- X2Vec table <- data.frame(resdf, resdev, 1-pchisq(resdev,resdf)) tl <- attr(object$terms, "term.labels") #print(table) if (length(tl) == 0) table <- table[1, , drop = FALSE] dimnames(table) <- list(c(tl), c("Df", "X2", "P(>|Chi|)")) title <- paste("Analysis of 'Wald statistic' Table", "\nModel: ", object$family$family, ", link: ", object$family$link, "\nResponse: ", as.character(varlist[-1])[1], "\nTerms added sequentially (first to last)\n", sep = "") structure(table, heading = title, class = c("anova", "data.frame")) } # anova.geeglm <- function(object, ...){ # anovaPgee (object, ...) # } # anovaPgee <- function(object, ...){ # #cat("anova.gee\n") # m1 <- object # objects <- list(object,...) # if (length(objects)>1) # m2 <- objects[[2]] # else # m2 <- NULL # if (is.null(m2)){ # term <- attr(object$terms,"term.labels") # resp <- paste(formula(object))[2] # rhs <- lapply(1:length(term), function(i) paste(term[1:i],collapse=" + ")) # print(rhs) # model.list <- c(paste(resp,"~ 1"), paste(resp,"~", rhs)) # value <- NULL # for (i in 2:length(model.list)){ # if (i==2){ # mf1 <- model.list[i-1] # mf2 <- model.list[i] # ##print(mf1); print(mf2) # #print(mf1) # #print(object) # m1 <- update(object,formula=as.formula(mf1)) # m2 <- update(object,formula=as.formula(mf2)) # } else { # m1 <- m2 # m2 <- update(object,formula=as.formula(model.list[i])) # ##print(formula(m1)[1:3]); print(formula(m2)[1:3]) # } # value <- rbind(value,anovageePrim(m1,m2)) # } # rownames(value) <- term # attr(value,"model1") <- NULL # attr(value,"model2") <- NULL # } else { # value <- anovageePrim(object,m2) # } # value[,3] <- round(value[,3],5) # return(value) # } # anovageePrim <- function(m1, m2,...){ # mm1 <- model.matrix(m1) # mm2 <- model.matrix(m2) # P1 <- mm1 %*% solve(t(mm1)%*%mm1) %*% t(mm1) # P2 <- mm2 %*% solve(t(mm2)%*%mm2) %*% t(mm2) # e2 <- mm2 - P1 %*% mm2 # e1 <- mm1 - P2 %*% mm1 # #print(mm1[c(1:5,100:105),]); print(mm2[c(1:5,100:105),]) # m2inm1 <- all(apply(e2,2,var) < 1e-10) # m1inm2 <- all(apply(e1,2,var) < 1e-10) # #print(apply(e2,2,var)) # #print(apply(e1,2,var)) # #print(m2inm1) # #print(m1inm2) # if (!any(c(m2inm1,m1inm2))) # cat("Models not nested\n") # else # if (all(c(m2inm1,m1inm2))) # cat("Models are identical\n") # else { # if (m1inm2){ # tmp <- m1 # m1 <- m2 # m2 <- tmp # } # mm1 <- model.matrix(m1) # mm2 <- model.matrix(m2) # mf1 <- paste(paste(formula(m1))[c(2,1,3)],collapse=" ") # mf2 <- paste(paste(formula(m2))[c(2,1,3)],collapse=" ") # mm <- cbind(mm2,mm1) # qmm <- qr(mm) # qmmq <- qr.Q(qmm) # nymm1 <- as.data.frame(qmmq[,1:qmm$rank]) # colnames(nymm1) <- paste("parm",1:ncol(nymm1),sep=".") # nymm2 <- nymm1[,1:ncol(mm2),drop=FALSE] # dimDiff <- ncol(nymm1)-ncol(nymm2) # D <- diag(dimDiff) # L <- cbind(matrix(0,ncol=ncol(nymm2),nrow=nrow(D)),D) # formula1 <- formula(paste(formula(m1)[[2]],formula(m1)[[1]], # paste(c("-1",colnames(nymm1)),collapse="+"),collapse="")) # m1call <- m1$call # #print(formula(m1call)[[2]]) # #print(nymm1[1:10,]) # #print(paste(m1call$formula[[2]])) # #nymm1[,paste(m1call$formula[[2]])] <- m1$y # nymm1[,paste(formula(m1call)[[2]])] <- m1$y # nymm1[,paste(m1call$id)] <- m1$id # m1call$offset <- m1$offset # m1call$weights <- m1$weights # m1call$formula <- formula1 # m1call$data <- nymm1 # m1ny <- eval(m1call) # #print(class(m1ny)) # val <- esticon(m1ny,L,joint.test=TRUE) # rownames(val)<-"" # class(val) <- c("anova.gee","data.frame") # attr(val,"model1") <- mf1 # attr(val,"model2") <- mf2 # return(val) # } # } # print.anova.geeglm <- function(x,...){ # cat("Analysis table for GEE models\n\n") # if (!is.null(attr(x,"model1"))){ # cat("Model 1: "); cat(attr(x,"model1"), "\n") # cat("Model 2: "); cat(attr(x,"model2"), "\n\n") # } # print.data.frame(x) # } geepack/R/fixed2Zcor.R0000754000177400001440000000112711327530722014413 0ustar murdochusers## ## Generate zcor vector from ## 1) fixed correlation matrix ## 2) id information ## 3) waves information ## The zcor-vector contrains entries only for clusters ## of size larger than 1 fixed2Zcor <- function(cor.fixed, id, waves){ zcor<-NULL cnt <- 1 uniq.id <- unique(id) for (ii in uniq.id){ cwaves <- waves[id==ii] if (length(cwaves)>1) { for (kk in 1: (length(cwaves)-1)) { for (mm in (kk+1) : length(cwaves)) { vvv <- cor.fixed[cwaves[mm],cwaves[kk]] zcor<-c(zcor,vvv) } } } } zcor }geepack/R/internal.R0000754000177400001440000000267710374256026014226 0ustar murdochuserscrossutri <- function(wave) { n <- length(wave) if (n == 1) return(NULL) ans <- rep(0, n*(n-1)/2) k <- 1 for (i in 1:(n-1)) for (j in (i+1):n) { ans[k] <- paste(wave[i], wave[j], sep=":") k <- k + 1 } ans } genZcor <- function(clusz, waves, corstrv) { if (corstrv == 1) return (matrix(0,0,0)) crs <- clusz * (clusz - 1) / 2 if (corstrv == 2 || corstrv == 3) { ans <- matrix(1, length(clusz), 1) ##ans <- matrix(1, sum(crs), 1) colnames(ans) <- c("alpha") } else { id <- rep(1:length(clusz), clusz) z1 <- unlist(lapply(split(waves, id), crossutri)) z2 <- unlist(crossutri(1:max(clusz))) z <- factor(z1,levels=unique.default(z2)) ans <- model.matrix(~z - 1) znames <- paste("alpha", z2, sep = ".") colnames(ans) <- znames } ans } genZodds <- function(clusz, waves, corstrv, ncat) { if (corstrv == 1) return (matrix(0,0,0)) crs <- clusz * (clusz - 1) / 2 c2 <- ncat * ncat if (corstrv == 2 | corstrv == 3) { ans <- matrix(1, sum(crs) * c2, 1) colnames(ans) <- c("alpha") } else { id <- rep(1:length(clusz), clusz) z1 <- unlist(lapply(split(waves, id), crossutri)) z2 <- unlist(crossutri(1:max(clusz))) z <- factor(z1,levels=unique.default(z2)) z <- model.matrix(~z - 1) ind <- gl(sum(crs), c2) ans <- z[ind,] colnames(ans) <- paste("alpha", 1:dim(ans)[2], sep=".") } ans } geepack/R/geese.R0000754000177400001440000002343011660612772013473 0ustar murdochusersgeese <- function(formula = formula(data), sformula = ~ 1, id, waves = NULL, data = parent.frame(), subset = NULL, na.action = na.omit, contrasts = NULL, weights = NULL, ## zcor is design matrix for alpha, ## corp is known paratemers to correlation coef. rho zcor = NULL, corp = NULL, ## zsca is constructed from sformula ## control parameters control = geese.control(...), ## param b = NULL, alpha = NULL, gm = NULL, ## geestr family = gaussian(), mean.link = NULL, variance = NULL, cor.link = "identity", sca.link = "identity", link.same = TRUE, scale.fix = FALSE, scale.value = 1.0, ## corr corstr = "independence", ...) { scall <- match.call() mnames <- c("", "formula", "data", "offset", "weights", "subset", "na.action", "id", "waves", "corp") cnames <- names(scall) cnames <- cnames[match(mnames,cnames,0)] mcall <- scall[cnames] if (is.null(mcall$id)) mcall$id <- as.name("id") mcall[[1]] <- as.name("model.frame") m <- eval(mcall, parent.frame()) y <- model.extract(m, "response") if (is.null(dim(y))) N <- length(y) else N <- dim(y)[1] mterms <- attr(m, "terms") x <- model.matrix(mterms, m, contrasts) offset <- model.extract(m, "offset") if (is.null(offset)) offset <- rep(0, N) w <- model.extract(m, "weights") if (is.null(w)) w <- rep(1, N) id <- model.extract(m, id) waves <- model.extract(m, "waves") corp <- model.extract(m, "corp") if (is.null(id)) stop("id variable not found.") ##print(control) ## setting up the scale model; ## borrowed idea from S+ function dglm by Gordon Smyth mcall$formula <- formula mcall$formula[3] <- switch(match(length(sformula), c(0,2,3)), 1, sformula[2], sformula[3]) m <- eval(mcall, parent.frame()) terms <- attr(m, "terms") zsca <- model.matrix(terms, m, contrasts) soffset <- model.extract(m, "offset") if (is.null(soffset)) soffset <- rep(0, N) if (is.character(family)) family <- get(family) if (is.function(family)) family <- family() ans <- geese.fit(x, y, id, offset, soffset, w, waves, zsca, zcor, corp, control, b, alpha, gm, family, mean.link, variance, cor.link, sca.link, link.same, scale.fix, scale.value, corstr, ...) ans <- c(ans, list(call=scall, formula=formula)) class(ans) <- "geese" ans } geese.fit <- function(x, y, id, offset=rep(0,N), soffset=rep(0,N), weights=rep(1,N), waves = NULL, zsca = matrix(1,N,1), zcor = NULL, corp = NULL, control = geese.control(...), ## param b = NULL, alpha = NULL, gm = NULL, ## geestr family = gaussian(), mean.link = NULL, variance = NULL, cor.link = "identity", sca.link = "identity", link.same = TRUE, scale.fix = FALSE, scale.value = 1.0, ## corr corstr = "independence", ...) { N <- length(id) ##clusz <- unlist(lapply(split(id, id), length)) clusnew <- c(which(diff(as.numeric(id)) != 0), length(id)) clusz <- c(clusnew[1], diff(clusnew)) maxclsz <- max(clusz) if (is.null(waves)) waves <- unlist(sapply(clusz, function(x) 1:x)) waves <- as.integer(waves) LINKS <- c("identity", "logit", "probit", "cloglog", "log", "inverse", "fisherz", "lwybc2", "lwylog") VARIANCES <- c("gaussian", "binomial", "poisson", "Gamma") ## quasi is not supported yet if (is.null(mean.link)) mean.link <- family$link if (is.null(variance)) variance <- family$family mean.link.v <- pmatch(mean.link, LINKS, -1, TRUE) cor.link.v <- pmatch(cor.link, LINKS, -1, TRUE) sca.link.v <- pmatch(sca.link, LINKS, -1, TRUE) variance.v <- pmatch(variance, VARIANCES, -1, TRUE) if (any(mean.link.v == -1)) stop("mean.link invalid.") if (any(cor.link.v == -1)) stop("cor.link invalid.") if (any(sca.link.v == -1)) stop("sca.link invalid.") if (any(variance.v == -1)) stop("variance invalid.") if (length(mean.link.v) != length(variance.v)) stop("mean.link and variance not same length.") if (length(mean.link.v) != length(sca.link.v)) stop("mean.link and sca.link not same lehgnt.") if (length(id) != length(y)) stop("id and y not same length.") if (length(offset) != length(y)) stop("offset and y not same length") if (length(soffset) != length(y)) stop("sca.offset and y not same length") if (nrow(zsca) != length(y)) stop("nrow(zsca) and length(y) not match") if (link.same) linkwaves <- rep(1, N) else { if (max(waves) != maxclsz) stop("maximum waves and maximum cluster size not equal") if (length(mean.link.v) != maxclsz) stop("length of mean.link not equal to the maximum cluster size.") linkwaves <- waves } linkwaves <- as.integer(linkwaves) geestr <- list(length(mean.link.v), as.integer(mean.link.v), as.integer(variance.v), as.integer(sca.link.v), as.integer(cor.link.v), as.integer(scale.fix)) CORSTRS <- c("independence", "exchangeable", "ar1", "unstructured", "userdefined", "fixed") corstrv <- pmatch(corstr, CORSTRS, -1) if (corstrv == -1) stop("invalid corstr.") corr <- list(as.integer(corstrv), maxclsz) if (is.null(zcor)) { if (corstrv == 5) stop("need zcor matrix for userdefined corstr.") else zcor <- genZcor(clusz, waves, corstrv) } else { if (!is.matrix(zcor)) zcor <- as.matrix(zcor) if (corstrv >= 4 && nrow(zcor) != sum(clusz * (clusz - 1) / 2)) stop("nrow(zcor) need to be equal sum(clusz * (clusz - 1) / 2) for unstructured or userdefined corstr.") if (corstrv %in% c(2,3) && nrow(zcor) != length(clusz)) stop("nrow(zcor) need to be equal to the number of clusters for exchangeable or ar1 corstr.") } if (!is.matrix(zcor)) zcor <- as.matrix(zcor) if (is.null(corp)) corp <- as.double(waves) p <- ncol(x) q <- ncol(zcor) r <- ncol(zsca) ## Initial values setup ## This may fail for binomial model with log link (relative risk) ## fit0 <- glm.fit(x, y, weights=weights, offset=offset, family=family) if (is.null(b)){ ##b <- rep(1,p) fit0 <- glm.fit(x, y, weights=weights, offset=offset, family=family) b <- fit0$coef } if (is.null(alpha)) { if (corstrv == 6) alpha <- 1 else alpha <- rep(0,q) } if (is.null(gm)) { ##gm <- rep(scale.value, r) qlf <- quasi(LINKS[sca.link.v])$linkfun ## pr2 <- (residuals.glm(fit0, type="pearson")) ^ 2 mu <- quasi(LINKS[mean.link.v])$linkinv(x %*% b) pr2 <- (y - mu) ^ 2 / family$variance(mu) gm <- lm.fit(zsca, qlf(pr2), offset = soffset)$coef } param <- list(b, alpha, gm) ans <- .Call("gee_rap", y, x, offset, soffset, weights, linkwaves, zsca, zcor, corp, clusz, geestr, corr, param, control, PACKAGE = "geepack") names(ans) <- c("beta", "alpha", "gamma", "vbeta", "valpha", "vgamma", "vbeta.naiv", "valpha.naiv", "valpha.stab", "vbeta.ajs", "valpha.ajs", "vgamma.ajs", "vbeta.j1s", "valpha.j1s", "vgamma.j1s", "vbeta.fij", "valpha.fij", "vgamma.fij", "error") ans$xnames <- dimnames(x)[[2]] ans$zsca.names <- dimnames(zsca)[[2]] ans$zcor.names <- dimnames(zcor)[[2]] if (is.null(ans$zcor.names)) ans$zcor.names = paste("alpha", 1:ncol(zcor), sep=":") names(ans$beta) <- ans$xnames names(ans$gamma) <- ans$zsca.names if (length(ans$alpha) > 0) names(ans$alpha) <- ans$zcor.names param <- list(ans$beta, ans$alpha, ans$gamma) infls <- .Call("infls_rap", y, x, offset, soffset, weights, linkwaves, zsca, zcor, corp, clusz, geestr, corr, param, control, PACKAGE = "geepack") rownames(infls) <- c(paste("beta", names(ans$beta), sep="_"), if (length(ans$gamma) > 0) paste("gamma", names(ans$gamma), sep="_") else NULL, if (length(ans$alpha) > 0) paste("alpha", names(ans$alpha), sep="_") else NULL) ans <- c(ans, list(infls=infls, clusz=clusz, control=control, model=list(mean.link=mean.link, variance=variance, sca.link=sca.link, cor.link=cor.link, corstr=corstr, scale.fix=scale.fix))) ans } geese.control <- function (epsilon = 1e-04, maxit = 25, trace = FALSE, scale.fix = FALSE, jack = FALSE, j1s = FALSE, fij = FALSE) { if (!is.numeric(epsilon) || epsilon <= 0) stop("value of epsilon must be > 0") if (!is.numeric(maxit) || maxit <= 0) stop("maximum number of iterations must be > 0") list(trace = as.integer(trace), jack = as.integer(jack), j1s = as.integer(j1s), fij = as.integer(fij), maxit = as.integer(maxit), epsilon = epsilon) } ## compare coefficients compCoef <- function(fit0, fit1) { v0 <- names(fit0$beta) v1 <- names(fit1$beta) v0idx <- (1:length(v0))[v0 %in% v1] v1idx <- (1:length(v1))[v1 %in% v0] delta <- fit0$beta[v0idx] - fit1$beta[v1idx] infls <- fit0$infls[v0idx,] - fit1$infls[v1idx,] robvar <- infls %*% t(infls) list(delta = delta, variance = robvar) } geepack/R/geeglm.R0000754000177400001440000004066712771401731013651 0ustar murdochusers eprint <- function(x){ #print(x) } geeglm<- function (formula, family = gaussian, data = parent.frame(), weights, subset, na.action, start = NULL, etastart, mustart, offset, control = geese.control(...), method = "glm.fit", x = FALSE, y = TRUE, contrasts = NULL, id, waves = NULL, zcor = NULL, corstr = "independence", scale.fix = FALSE, scale.value = 1, std.err = "san.se", ...) { STDERRS <- c("san.se", "jack", "j1s", "fij") stderrv <- pmatch(std.err, STDERRS, -1) std.err <- STDERRS[stderrv] jackB <- j1sB <- fijB <- FALSE if (std.err == "jack") jackB <- TRUE if (std.err == "j1s") j1sB <- TRUE if (std.err == "fij") fijB <- TRUE control$jack <- as.integer(jackB) control$j1s <- as.integer(j1sB) control$fij <- as.integer(fijB) CORSTRS <- c("independence", "exchangeable", "ar1", "unstructured", "userdefined","fixed") if (corstr=="fixed" && is.null(zcor)){ stop("When corstr is 'fixed' then 'zcor' must be given\n") } eprint("SHDgeese.fit - corstr") corstrv <- pmatch(corstr, CORSTRS, -1) corstr <- CORSTRS[corstrv] eprint("geeglm is called") call <- match.call(expand.dots = TRUE) glmcall <- call glmcall$id <- glmcall$jack <- glmcall$control <- glmcall$corstr <- glmcall$waves <- glmcall$zcor <- glmcall$std.err <- glmcall$scale.fix <- glmcall$scale.value <- NULL glmcall[[1]] <- as.name("glm") glmFit <- eval(glmcall, parent.frame()) mf <- call mf[[1]] <- as.name("model.frame") modelmat <- model.matrix(glmFit) qqrr <- qr(modelmat) if (qqrr$rank < ncol(modelmat)){ print(head(modelmat)) stop("Model matrix is rank deficient; geeglm can not proceed\n") } mftmp <- mf mftmp$family <- mftmp$corstr <- mftmp$control <- mftmp$zcor <- mftmp$std.err <- NULL mftmp$scale.fix <- NULL mf <- eval(mftmp, parent.frame()) id <- model.extract(mf, id) if (is.null(id)) stop("id variable not found.") waves <- model.extract(mf, waves) if (!is.null(waves)) waves <- as.factor(waves) mt <- attr(mf, "terms") Y <- model.response(mf, "numeric") X <- if (!is.empty.model(mt)) model.matrix(mt, mf, contrasts) else matrix(, NROW(Y), 0) ## Check that factors in model do not have unused levels in data ## (otherwise R crashes). vars <- all.vars(formula) stopIt <- FALSE for(ii in seq_along(vars)){ vv <- vars[ii] if(!is.na(match(vv,names(mf))) && is.factor(mf[,vv])){ if (length(unique(mf[,vv])) != length(levels(mf[,vv]))){ cat("Factors not allowed to have unused levels...\n") cat(" Levels of factor",vv,":", paste(levels(mf[,vv]),sep=' '),"\n") cat(" Used levels of factor",vv,":", paste(unique(mf[,vv]),sep=' '),"\n") stopIt <- TRUE } } } if (stopIt) stop("Can not continue...\n") N <- NROW(Y) yy <- Y xx <- X soffset <- rep(0, N) mnames <- c("", "formula", "data", "offset", "weights", "subset", "na.action") cnames <- names(call) cnames <- cnames[match(mnames, cnames, 0)] mcall <- call[cnames] mcall$drop.unused.levels <- TRUE mcall[[1]] <- as.name("model.frame") mcall$formula <- formula sformula <- ~1 mcall$formula[3] <- switch(match(length(sformula), c(0, 2, 3)), 1, sformula[2], sformula[3]) m <- eval(mcall, parent.frame()) terms <- attr(m, "terms") zsca <- model.matrix(terms, m, contrasts) colnames(zsca) <- c("(Intercept)") w <- model.weights(mf) if (is.null(w)) w <- rep(1, N) offset <- model.offset(mf) if (is.null(offset)) offset <- rep(0, N) if (glmFit$family$family == "binomial") { if (is.matrix(yy) && ncol(yy) == 2) { w <- apply(yy, 1, sum) yy <- yy[, 1]/w } } family <- glmFit$family nacoef <- as.numeric(which(is.na(glmFit$coef))) xx <- as.data.frame(xx) xx[, nacoef] <- NULL xx <- as.matrix(xx) if (is.null(start)) start <- glmFit$coef ans <- geese.fit(xx, yy, id, offset, soffset, w, waves = waves, zsca, zcor = zcor, corp = NULL, control = control, b = start, alpha = NULL, gm = NULL, family, mean.link = NULL, variance = NULL, cor.link = "identity", sca.link = "identity", link.same = TRUE, scale.fix = scale.fix, scale.value = scale.value, corstr, ...) ans <- c(ans, list(call = call, formula = formula)) class(ans) <- "geese" ans$X <- xx ans$id <- id ans$weights <- w value <- glmFit toDelete <- c("R", "deviance", "aic", "null.deviance", "iter", "df.null", "converged", "boundary") value[match(toDelete, names(value))] <- NULL value$method <- "geese.fit" value$geese <- ans value$weights <- ans$weights value$coefficients <- ans$beta value$offset <- offset if (is.null(value$offset)) value$linear.predictors <- ans$X %*% ans$beta else value$linear.predictors <- value$offset + ans$X %*% ans$beta value$fitted.values <- family(value)$linkinv(value$linear.predictors) value$modelInfo <- ans$model value$id <- ans$id value$call <- ans$call value$corstr <- ans$model$corstr value$cor.link <- ans$model$cor.link value$control <- ans$control value$std.err <- std.err class(value) <- c("geeglm", "gee", "glm", "lm") return(value) } summary.geeglm <- function(object,...){ v1 <- summary.geese(object$geese) class(object) <- "glm" value <- summary.glm(object) class(object) <- c("geeglm","glm") class(value) <- "summary.geeglm" toDelete <- c("deviance","aic","null.deviance","iter","df.residual","df.null", "converged","boundary") idx <- match(toDelete,names(value)) value[idx] <- NULL covmat <- switch(object$std.err, 'jack'={object$geese$vbeta.ajs}, 'j1s'={object$geese$vbeta.j1s}, 'fij'={object$geese$vbeta.fij}, object$geese$vbeta ) value$cov.scaled <- value$cov.unscaled <- covmat mean.sum <- data.frame(estimate = object$geese$beta, std.err=sqrt(diag(covmat))) mean.sum$wald <- (mean.sum$estimate / mean.sum$std.err)^2 mean.sum$p <- 1 - pchisq(mean.sum$wald, df=1) ## names(mean.sum) <- c("Estimate", "Std.err", "Wald", "p(>W)") names(mean.sum) <- c("Estimate", "Std.err", "Wald", "Pr(>|W|)") ## Thanks, Achim value$coefficients <- mean.sum covmatgam <- switch(object$std.err, 'jack'={object$geese$vgamma.ajs}, 'j1s'={object$geese$vgamma.j1s}, 'fij'={object$geese$vgamma.fij}, object$geese$vgamma ) scale.sum <- data.frame(Estimate = object$geese$gamma, Std.err=sqrt(diag(covmatgam))) #scale.sum$wald <- (scale.sum$Estimate / scale.sum$Std.err)^2 #scale.sum$p <- 1 - pchisq(scale.sum$wald, df=1) if (!is.null(object$geese$zsca.names)) rownames(scale.sum) <- object$geese$zsca.names value$dispersion <- scale.sum covmatalpha <- switch(object$std.err, 'jack'={object$geese$valpha.ajs}, 'j1s'={object$geese$valpha.j1s}, 'fij'={object$geese$valpha.fij}, object$geese$valpha ) corr.sum <- data.frame(Estimate = object$geese$alpha, Std.err=sqrt(diag(covmatalpha))) #corr.sum$wald <- (corr.sum$Estimate / corr.sum$Std.err)^2 #corr.sum$p <- 1 - pchisq(corr.sum$wald, df=1) #if (nrow(corr.sum) > 0) rownames(corr.sum) <- object$geese$zcor.names value$corr <- corr.sum value$corstr <- object$geese$model$corstr value$scale.fix <- object$geese$model$scale.fix value$cor.link <- object$geese$model$cor.link value$clusz <- v1$clusz value$error <- object$geese$error value$geese <- v1 return(value) } # colnames(mean.sum) <- c("Estimate","Std.Error","ajs.SE","j1s.SE","fij.SE", # "Wald","Pr(>|z|)") print.summary.geeglm <- function (x, digits = max(3, getOption("digits") - 3), quote = FALSE, prefix = "", ...) # Thanks, Achim... #print.summary.geeglm <- function (x, digits = NULL, quote = FALSE, prefix = "", ...) { if (is.null(digits)) digits <- options()$digits else options(digits = digits) cat("\nCall:\n"); print(x$call) cat("\n Coefficients:\n"); ##print(as.matrix(x$coef), digits = digits) printCoefmat(as.matrix(x$coef), digits = digits) ## Thanks, Achim if (x$scale.fix == FALSE) { cat("\nEstimated Scale Parameters:\n") print(x$dispersion[1:2], digits = digits) } else cat("\nScale is fixed.\n") cat("\nCorrelation: Structure =", x$corstr) if (pmatch(x$corstr, "independence", 0) == 0) { cat(" Link =", x$cor.link, "\n") cat("\nEstimated Correlation Parameters:\n") print(x$corr, digits = digits) } cat("Number of clusters: ", length(x$clusz), " Maximum cluster size:", max(x$clusz), "\n") #cat("\nReturned Error Value: ") #cat(x$error, "\n") invisible(x) } print.geeglm <- function (x, digits = NULL, quote = FALSE, prefix = "", ...) { xg <- x$geese if (is.null(digits)) digits <- options()$digits else options(digits = digits) cat("\nCall:\n"); print(x$call) cat("\nCoefficients:\n") print(unclass(x$coefficients), digits = digits) cat("\nDegrees of Freedom:", length(x$y), "Total (i.e. Null); ", x$df.residual, "Residual\n") if (!xg$model$scale.fix) { cat("\nScale Link: ", xg$model$sca.link) cat("\nEstimated Scale Parameters: ") print(as.numeric(unclass(xg$gamma)), digits = digits) } else cat("\nScale is fixed.\n") cat("\nCorrelation: Structure =",xg$model$corstr, " ") if (pmatch(xg$model$corstr, "independence", 0) == 0) { cat(" Link =", xg$model$cor.link, "\n") cat("Estimated Correlation Parameters:\n") print(unclass(xg$alpha), digits = digits) } cat("\nNumber of clusters: ", length(xg$clusz), " Maximum cluster size:", max(xg$clusz), "\n\n") invisible(x) } residuals.geeglm <- function (object, type = c("pearson", "working", "response"), ...) { type <- match.arg(type) y <- object$y r <- object$residuals mu <- object$fitted.values wts <- object$prior.weights res <- switch(type, # deviance = if (object$df.res > 0) { # d.res <- sqrt(pmax((object$family$dev.resids)(y, mu, # wts), 0)) # ifelse(y > mu, d.res, -d.res) # } # else rep.int(0, length(mu)), pearson = (y - mu) * sqrt(wts)/sqrt(object$family$variance(mu)), working = r, response = y - mu, partial = r) if (!is.null(object$na.action)) res <- naresid(object$na.action, res) # if (type == "partial") # res <- res + predict(object, type = "terms") res } plot.geeglm <- function(x,...){ xx <- fitted(x) rp <- residuals(x,"pearson") plot(xx,rp,ylab="Pearson residuals",xlab="Fitted values") abline(h=0) m <- lowess(rp ~ xx) lines(m) } # geeglm <- function (formula, family = gaussian, data=parent.frame(), weights, subset, # na.action, start = NULL, etastart, mustart, offset, # control = geese.control(...), # method = "glm.fit", x = FALSE, y = TRUE, # contrasts = NULL, # id, waves = NULL, # zcor=NULL, # corstr = "independence", # scale.fix = FALSE, # scale.value =1, # std.err = 'san.se', # ...) # { # STDERRS <- c("san.se", "jack", "j1s", "fij") # stderrv <- pmatch(std.err, STDERRS, -1) # std.err <- STDERRS[stderrv] # jackB <- j1sB <- fijB <- FALSE # if (std.err=='jack') jackB <- TRUE # if (std.err=='j1s') j1sB <- TRUE # if (std.err=='fij') fijB <- TRUE # control$jack <- as.integer(jackB) # control$j1s <- as.integer(j1sB) # control$fij <- as.integer(fijB) # CORSTRS <- c("independence", "exchangeable", "ar1", "unstructured", "userdefined") # eprint("SHDgeese.fit - corstr") # corstrv <- pmatch(corstr, CORSTRS, -1) # corstr<-CORSTRS[corstrv] # eprint("geeglm is called") # call <- match.call(expand.dots=TRUE) # glmcall <- call # glmcall$id <- glmcall$jack <- glmcall$control <- glmcall$corstr <- glmcall$waves <- glmcall$zcor<- glmcall$std.err <- glmcall$scale.fix <- glmcall$scale.value <- NULL # glmcall[[1]] <- as.name("glm") # glmFit <- eval(glmcall, parent.frame()) # mf <- call # ##call$data <- mf$data <- na.omit(eval(mf$data)) # mf[[1]] <- as.name("model.frame") # mftmp <- mf # mftmp$family <- mftmp$corstr <- mftmp$control <- mftmp$zcor<- mftmp$std.err <- NULL # mf <- eval(mftmp, parent.frame()) # ### Copy from "geese" starts here # ################################# # id <- model.extract(mf, id) # if (is.null(id)) # stop("id variable not found.") # waves <- model.extract(mf, waves) # if (!is.null(waves)) # waves <- as.factor(waves) # mt <- attr(mf, "terms") # Y <- model.response(mf, "numeric") # X <- if (!is.empty.model(mt)) # model.matrix(mt, mf, contrasts) # else matrix(, NROW(Y), 0) # N <- NROW(Y) # yy <- Y # xx <- X # soffset <- rep(0, N) # mnames <- c("", "formula", "data", "offset", "weights", "subset", "na.action") # cnames <- names(call) # cnames <- cnames[match(mnames, cnames, 0)] # mcall <- call[cnames] # mcall$drop.unused.levels <- TRUE # mcall[[1]] <- as.name("model.frame") # mcall$formula <- formula # sformula <- ~1 # mcall$formula[3] <- # switch(match(length(sformula), # c(0, 2, 3)), 1, sformula[2], sformula[3]) # m <- eval(mcall, parent.frame()) # terms <- attr(m, "terms") # zsca <- model.matrix(terms, m, contrasts) # colnames(zsca) <- c("(Intercept)") # #corstr <- "independence" # w <- model.weights(mf) # if (is.null(w)) # w <- rep(1, N) # offset <- model.offset(mf) # if (is.null(offset)) # offset <- rep(0, N) # if (glmFit$family$family=="binomial"){ # if (is.matrix(yy) && ncol(yy)==2){ # w <- apply(yy,1,sum) # yy<- yy[,1]/w # } # } # family <- glmFit$family # nacoef <- as.numeric(which(is.na(glmFit$coef))) # xx <- as.data.frame(xx) # xx[,nacoef] <- NULL # xx <- as.matrix(xx) # if (is.null(start)) # start <- glmFit$coef # ans <- geese.fit(xx, yy, id, offset, soffset, w, waves=waves, zsca, # zcor=zcor, corp=NULL, control=control, # b=start, # alpha=NULL, gm=NULL, family, mean.link=NULL, # variance=NULL, # cor.link="identity", sca.link="identity", # link.same=TRUE, scale.fix=scale.fix, scale.value=scale.value, # corstr, ...) # ans <- c(ans, list(call = call, formula = formula)) # class(ans) <- "geese" # ### Copy from geese ends here # ############################# # ans$X <- xx # ans$id <- id # ans$weights <- w # value <- glmFit # toDelete <- c("R","deviance","aic","null.deviance","iter","df.null", # "converged","boundary") # value[match(toDelete,names(value))] <- NULL # value$method <- "geese.fit" # value$geese <- ans # value$weights <- ans$weights # value$coefficients <- ans$beta # ## Kludgy.. # value$offset <- offset # if(is.null(value$offset)) # value$linear.predictors <- ans$X %*% ans$beta # else # value$linear.predictors <- value$offset + ans$X %*% ans$beta # value$fitted.values <- family(value)$linkinv(value$linear.predictors) # value$modelInfo <- ans$model # value$id <- ans$id # value$call <- ans$call # value$corstr <- ans$model$corstr # value$cor.link <- ans$model$cor.link # value$control <- ans$control # value$std.err <- std.err # class(value) <- c("geeglm", "gee", "glm") # return(value) # } geepack/R/summary.R0000754000177400001440000001120610273301734014066 0ustar murdochuserssummary.geese <- function(object, ...) { mean.sum <- data.frame(estimate = object$beta, # nai.se = sqrt(diag(object$vbeta.naiv)), san.se = sqrt(diag(object$vbeta)), ajs.se = sqrt(diag(object$vbeta.ajs)), j1s.se = sqrt(diag(object$vbeta.j1s)), fij.se = sqrt(diag(object$vbeta.fij))) mean.sum$wald <- (mean.sum$estimate / mean.sum$san.se)^2 mean.sum$p <- 1 - pchisq(mean.sum$wald, df=1) rownames(mean.sum) <- object$xnames corr.sum <- data.frame(estimate = object$alpha, # nai.se = sqrt(diag(object$valpha.naiv)), san.se = sqrt(diag(object$valpha)), ajs.se = sqrt(diag(object$valpha.ajs)), j1s.se = sqrt(diag(object$valpha.j1s)), fij.se = sqrt(diag(object$valpha.fij))) corr.sum$wald <- (corr.sum$estimate / corr.sum$san.se)^2 corr.sum$p <- 1 - pchisq(corr.sum$wald, df=1) if (nrow(corr.sum) > 0) rownames(corr.sum) <- object$zcor.names scale.sum <- data.frame(estimate = object$gamma, san.se = sqrt(diag(object$vgamma)), ajs.se = sqrt(diag(object$vgamma.ajs)), j1s.se = sqrt(diag(object$vgamma.j1s)), fij.se = sqrt(diag(object$vgamma.fij))) scale.sum$wald <- (scale.sum$estimate / scale.sum$san.se)^2 scale.sum$p <- 1 - pchisq(scale.sum$wald, df=1) if (!is.null(object$zsca.names)) rownames(scale.sum) <- object$zsca.names drop <- ifelse(c(object$control$jack, object$control$j1s, object$control$fij)== 0, TRUE, FALSE) if (any(drop)) { drop <- (3:5)[drop] mean.sum <- mean.sum[,-drop] corr.sum <- corr.sum[,-drop] scale.sum <- scale.sum[,-drop] } ans <- list(mean=mean.sum, correlation=corr.sum, scale=scale.sum, call=object$call, model=object$model, control=object$control, error=object$err, clusz=object$clusz) class(ans) <- "summary.geese" ans } print.geese <- function(x, digits = NULL, quote = FALSE, prefix = "", ...) { if(is.null(digits)) digits <- options()$digits else options(digits = digits) cat("\nCall:\n") dput(x$call) cat("\nMean Model:\n") cat(" Mean Link: ", x$model$mean.link, "\n") cat(" Variance to Mean Relation:", x$model$variance, "\n") cat("\n Coefficients:\n") print(unclass(x$beta), digits = digits) if (!x$model$scale.fix) { cat("\nScale Model:\n") cat(" Scale Link: ", x$model$sca.link, "\n") cat("\n Estimated Scale Parameters:\n") print(unclass(x$gamma), digits = digits) } else cat("\nScale is fixed.\n") cat("\nCorrelation Model:\n") cat(" Correlation Structure: ", x$model$corstr, "\n") if (pmatch(x$model$corstr, c("independence", "fixed"), 0) == 0) { cat(" Correlation Link: ", x$model$cor.link, "\n") cat("\n Estimated Correlation Parameters:\n") print(unclass(x$alpha), digits = digits) } ##cat("\nNumber of observations : ", x$nobs, "\n") ##cat("\nMaximum cluster size : ", x$max.id, "\n") cat("\nReturned Error Value: ") cat(x$error, "\n") cat("Number of clusters: ", length(x$clusz), " Maximum cluster size:", max(x$clusz), "\n\n") invisible(x) } print.summary.geese <- function(x, digits = NULL, quote = FALSE, prefix = "", ... ) { if(is.null(digits)) digits <- options()$digits else options(digits = digits) cat("\nCall:\n") dput(x$call) cat("\nMean Model:\n") cat(" Mean Link: ", x$model$mean.link, "\n") cat(" Variance to Mean Relation:", x$model$variance, "\n") cat("\n Coefficients:\n") print(x$mean, digits = digits) if (x$model$scale.fix == FALSE) { cat("\nScale Model:\n") cat(" Scale Link: ", x$model$sca.link, "\n") cat("\n Estimated Scale Parameters:\n") print(x$scale, digits = digits) } else cat("\nScale is fixed.\n") cat("\nCorrelation Model:\n") cat(" Correlation Structure: ", x$model$corstr, "\n") if (pmatch(x$model$corstr, c("independence", "fixed"), 0) == 0) { cat(" Correlation Link: ", x$model$cor.link, "\n") cat("\n Estimated Correlation Parameters:\n") print(x$corr, digits = digits) } ##cat("\nNumber of observations : ", x$nobs, "\n") ##cat("\nMaximum cluster size : ", x$max.id, "\n") cat("\nReturned Error Value: ") cat(x$error, "\n") cat("Number of clusters: ", length(x$clusz), " Maximum cluster size:", max(x$clusz), "\n\n") invisible(x) } geepack/R/zzz.R0000754000177400001440000000013011660222637013225 0ustar murdochusers## .First.lib <- function(lib, pkg) { ## library.dynam("geepack", pkg, lib) ## } geepack/vignettes/0000755000177400001440000000000012771411433014056 5ustar murdochusersgeepack/vignettes/geepack-manual.Rnw0000754000177400001440000001110612404751253017421 0ustar murdochusers% \VignetteIndexEntry{Users guide to geepack} % \VignetteKeyword{Generalized Estimating Equation} % \VignetteKeyword{Working correlation matrix} \documentclass{article} \usepackage{boxedminipage,color,a4,shortvrb,hyperref} \usepackage[latin1]{inputenc} \usepackage[T1]{fontenc} \MakeShortVerb| \def\pkg#1{{\bf #1}} <>= require( geepack ) prettyVersion <- packageDescription("geepack")$Version prettyDate <- format(Sys.Date()) @ \SweaveOpts{keep.source=T,prefix.string=figures/LSmeans} \title{On the usage of the \texttt{geepack} } \author{S{\o}ren H{\o}jsgaard and Ulrich Halekoh} \date{\pkg{geepack} version \Sexpr{prettyVersion} as of \Sexpr{prettyDate}} \begin{document} \parindent0pt\parskip4pt %% Efter preamble \definecolor{myGray}{rgb}{0.95,0.95,0.95} \makeatletter \renewenvironment{Schunk}{ \begin{lrbox}{\@tempboxa} \begin{boxedminipage} {\columnwidth}\scriptsize} {\end{boxedminipage} \end{lrbox}% \colorbox{myGray}{\usebox{\@tempboxa}} } \makeatother \maketitle \section{Introduction} \label{sec:intro} The primary reference for the |geepack| package is the Halekoh, U., Hjsgaard, S., Yan, J. (2006) -- paper in Journal of Statistical Software, see @ <<>>= library(geepack) citation("geepack") @ %def If you use |geepack| in your own work, please do cite the above reference. This note contains a few extra examples. We illustrate the usage of a the |waves| argument and the |zcor| argument together with a fixed working correlation matrix for the |geeglm()| function. To illustrate these features we simulate some data suitable for a regression model. @ <<>>= library(geepack) timeorder <- rep(1:5, 6) tvar <- timeorder + rnorm(length(timeorder)) idvar <- rep(1:6, each=5) uuu <- rep(rnorm(6), each=5) yvar <- 1 + 2*tvar + uuu + rnorm(length(tvar)) simdat <- data.frame(idvar, timeorder, tvar, yvar) head(simdat,12) @ %def Notice that clusters of data appear together in |simdat| and that observations are ordered (according to |timeorder|) within clusters. We can fit a model with an AR(1) error structure as @ <<>>= mod1 <- geeglm(yvar~tvar, id=idvar, data=simdat, corstr="ar1") mod1 @ %def This works because observations are ordered according to time within each subject in the dataset. \section{Using the \texttt{waves} argument} \label{sec:xxx} If observatios were not ordered according to cluster and time within cluster we would get the wrong result: @ <<>>= set.seed(123) ## library(doBy) simdatPerm <- simdat[sample(nrow(simdat)),] ## simdatPerm <- orderBy(~idvar, simdatPerm) simdatPerm <- simdatPerm[order(simdatPerm$idvar),] head(simdatPerm) @ %def Notice that in |simdatPerm| data is ordered according to subject but the time ordering within subject is random. Fitting the model as before gives @ <<>>= mod2 <- geeglm(yvar~tvar, id=idvar, data=simdatPerm, corstr="ar1") mod2 @ %def Likewise if clusters do not appear contigously in data we also get the wrong result (the clusters are not recognized): @ <<>>= ## simdatPerm2 <- orderBy(~timeorder, data=simdat) simdatPerm2 <- simdat[order(simdat$timeorder),] geeglm(yvar~tvar, id=idvar, data=simdatPerm2, corstr="ar1") @ %def To obtain the right result we must give the |waves| argument: @ <<>>= wav <- simdatPerm$timeorder wav mod3 <- geeglm(yvar~tvar, id=idvar, data=simdatPerm, corstr="ar1", waves=wav) mod3 @ %def \section{Using a fixed correlation matrix and the \texttt{zcor} argument} \label{sec:xxx} Suppose we want to use a fixed working correlation matrix: @ <<>>= cor.fixed <- matrix(c(1 , 0.5 , 0.25, 0.125, 0.125, 0.5 , 1 , 0.25, 0.125, 0.125, 0.25 , 0.25 , 1 , 0.5 , 0.125, 0.125, 0.125, 0.5 , 1 , 0.125, 0.125, 0.125, 0.125, 0.125, 1 ), 5, 5) cor.fixed @ %def Such a working correlation matrix has to be passed to |geeglm()| as a vector in the |zcor| argument. This vector can be created using the |fixed2Zcor()| function: @ <<>>= zcor <- fixed2Zcor(cor.fixed, id=simdatPerm$idvar, waves=simdatPerm$timeorder) zcor @ %def Notice that |zcor| contains correlations between measurements within the same cluster. Hence if a cluster contains only one observation, then there will be generated no entry in |zcor| for that cluster. Now we can fit the model with: @ <<>>= mod4 <- geeglm(yvar~tvar, id=idvar, data=simdatPerm, corstr="fixed", zcor=zcor) mod4 @ %def \end{document} geepack/MD50000644000177400001440000001065512771473736012403 0ustar murdochusers485717a6bcd79cfee5c8130b340b7107 *ChangeLog 8158f7a25a1908fc5a7a1fa8e4f65279 *DESCRIPTION 9b4a39760a174ec40ed5183e8fa9b61e *NAMESPACE 96a6f5b5b46df0f9d3ac6bbc3327eada *R/fixed2Zcor.R 2a5a192949fdf6c226c19a1335a93d7d *R/geeglm-anova.R ce8483fad59bb3a10903f4898a876a02 *R/geeglm.R b94677c4ba59797bb1c64a93764f6bb4 *R/geese.R a5e17a48d8e1196aa1967d5758168a0e *R/internal.R 5d7cd7bfb2a2135f7364dda2382de8f1 *R/ordgee.R acf18753c22de2282b9a8357b7c06688 *R/rrr.R 8abbb54ea36f442f6bd9e47e89f4818b *R/summary.R 4b5e3c63a382021749596cb59f04c62d *R/zzz.R 1f50f1c5c3f2180afad0be4fa010dfc0 *build/vignette.rds 8ef0a085392c2a6431f2f8713c60e5b5 *data/dietox.txt.gz 249971f8780df82504f54fd2b7d62252 *data/koch.txt.gz c0e0807be2abed83152006db8dcbac5e *data/ohio.txt.gz 135f7ab23560843a9c980976a27474f0 *data/respdis.txt.gz 7462d979b12761e97e5bec4cfa5273a3 *data/respiratory.txt.gz d1e03752404477a70ed20c18d257e2d8 *data/seizure.txt.gz 9cb003db408b585e3cb11806f35919a7 *data/sitka89.txt.gz 73402330ab3f5a9b06fdf6343631e87d *data/spruce.txt.gz 35da58fa0c087431c54e28f4a5d27be0 *inst/CITATION c01cea3c88238c320844d0d7649fc72f *inst/doc/geepack-manual.R 3be52b7e7574dc6e40ca55938a8b3069 *inst/doc/geepack-manual.Rnw 3a0bccf41d745a5d12f34922d6a87379 *inst/doc/geepack-manual.pdf eea5c9a7a285257434fb725257ff3b9d *inst/include/famstr.h 98e267ce97f38f2e276b446118670d60 *inst/include/gee2.h e8d36304622f6f1f68c574712205bc5d *inst/include/geese.h 3f2e8af2c1525fb2d75c1edba70454aa *inst/include/geesubs.h 2ce611ce796e5966c28b5a10686fa73c *inst/include/inter.h d52a1fb70e140ffd538c7d4977c9470d *inst/include/ordgee.h 9dc8477a0757b19fdedc684c190f41bd *inst/include/param.h b3184852ad60355ddb93aa6088ef8dec *inst/include/tnt/cholesky.h 44325cd2b27ac5c1f62c46b52beda7ca *inst/include/tnt/cmat.h b907fba24d98fe784c2aca8ba2560bf3 *inst/include/tnt/fcscmat.h 93b348566b39218cc319030f4795e92e *inst/include/tnt/fmat.h 425fea9a2a5c1cc90d52bd82d647c05e *inst/include/tnt/fortran.h fd23423fcafc9674976f83a3298d7d4c *inst/include/tnt/fspvec.h e1242d98de4641c4ea81eaaa4307407c *inst/include/tnt/index.h 6d65338ae44dc7ba0ba2d2cb50dc446f *inst/include/tnt/lapack.h d6a1e7c72db91aabe9a70c48db6328f9 *inst/include/tnt/lu.h fc22a29247a50662cbf783f3d2f97c56 *inst/include/tnt/qr.h e23b5474a726eeca9771728bc526361b *inst/include/tnt/region1d.h d33aaf94a11f3eb04e224cf44d82e393 *inst/include/tnt/region2d.h eb5a346a4fcc85c57261df368a1f7f14 *inst/include/tnt/stopwatch.h 8a5d0a1047ec4a6b3c4ca01f066ca9eb *inst/include/tnt/subscript.h 786cbeafa43084b1ea4011f8ad5857b4 *inst/include/tnt/tnt.h e32f54666091ddaa4a725307e0b1d927 *inst/include/tnt/tntmath.h 0b59b342920f4a04000b127f6e1e717d *inst/include/tnt/tntreqs.h 84820dab16539eca614056afec760cf9 *inst/include/tnt/transv.h 788148ad7103eca77f409145f9179455 *inst/include/tnt/triang.h e7b1ca55079198e0f607290bd695879c *inst/include/tnt/trisolve.h 439dca5c34a0ff0487203cc0942b8299 *inst/include/tnt/vec.h 9272e420c6830350556d1fc75ef8842d *inst/include/tnt/vecadaptor.h eaf9aba61829cfec165700e58b1b797a *inst/include/tnt/version.h 63306aaab6fa232e638cc6fb41c10ae6 *inst/include/tntsupp.h 792414dedc27451611050b16a5873cae *inst/include/utils.h 80a6c7f5d8e2838ccfd860229b06e4d1 *man/DATA-dietox.Rd c38dbc5ef12ef64c2cf49b182b7a4d8a *man/DATA-koch.Rd 1f752daf599bbdee98251e10168d7d21 *man/DATA-ohio.Rd 4c816dc2b88d5d72132bfeb54c6409c2 *man/DATA-respdis.Rd 2cc5aa1fe60a52165a62c84ab35e5707 *man/DATA-respiratory.Rd e27a475274ea0a06fa8b09c5de50c2f6 *man/DATA-seizure.Rd 522ccfa5e3391f24554cf5b292a0dc67 *man/DATA-sitka89.Rd c36faf58200d1c7f9bcf4d6fb2fb6273 *man/DATA-spruce.Rd f5eb9c0b968c541dedd31c4fd440125e *man/SHDgeese-internal.Rd 98ef5da28dd7104a90ad29c2ad0838f2 *man/compCoef.Rd 8a21cebc69dedc7951b8f5267feef640 *man/fixed2Zcor.Rd 42421a2c802e169b2162a8a61151ed90 *man/geeglm.Rd fc96c21e1b768ed26b82a12b1a80b10a *man/geese-internal.Rd 380385b1f9e0dc1ced2542f83bf6b086 *man/geese.Rd 7d7f5ba24d1c68f055eac8ae028b02ee *man/geese.control.Rd 382e1e89608e8f86a90186c62306d6d0 *man/genZcor.Rd 25ef8f9ca91a04270a892c3006c40a42 *man/ordgee.Rd 54b06bbedd91bf0aa774ee7e05a435fc *man/relRisk.Rd 8bb53f14cf0f67b02bdd966aadb484a2 *src/Makevars cdc0cc143af33cd5665ac112d92afdc9 *src/famstr.cc 96ddcb6778b6c316ddf5b9e27d4fcab4 *src/gee2.cc a03f71117e827c1b67df1c8d0b2ebc50 *src/geesubs.cc 6d10b391c5764570271035f55323a6d9 *src/inter.cc a00d55d44890eb2796f6e01d2c778516 *src/ordgee.cc cc4f054a5e831b0dccda7ffe2398143b *src/param.cc aa7d692722f3b034aa4ff9dbe6851947 *src/utils.cc 3be52b7e7574dc6e40ca55938a8b3069 *vignettes/geepack-manual.Rnw geepack/build/0000755000177400001440000000000012771411433013145 5ustar murdochusersgeepack/build/vignette.rds0000644000177400001440000000041112771411433015500 0ustar murdochusersN1ĄH})^ ȵnݬzY(&i;w3&҄U:kg'!{_Լ=V\7\kF́ul Wb67=J7W$ԠEgӀ<<˕ˊ{KhP1:`wcw0ւ:V~IQgj틟1d+U}Ya.-bdM˸&koP y'{5geepack/DESCRIPTION0000754000177400001440000000117712771473736013602 0ustar murdochusersPackage: geepack Version: 1.2-1 Title: Generalized Estimating Equation Package Author: Sren Hjsgaard , Ulrich Halekoh , Jun Yan , Maintainer: Sren Hjsgaard Description: Generalized estimating equations solver for parameters in mean, scale, and correlation structures, through mean link, scale link, and correlation link. Can also handle clustered categorical responses. Encoding: latin1 License: GPL (>= 3) NeedsCompilation: yes Repository: CRAN Date/Publication: 2016-09-24 14:55:58 Packaged: 2016-09-24 05:46:03 UTC; sorenh geepack/ChangeLog0000754000177400001440000001555012771402143013626 0ustar murdochusers2014-09-13 Søren Højsgaard * geeglm objects now inherits from lm also (to prevent warning when calling predict). * Version 1.2-1 uploaded 2014-09-13 Søren Højsgaard * Maintainer of geepack is now Søren Højsgaard * Location of vignette fixed * Version 1.2-0 uploaded 2012-01-27 Jun Yan * Commented out #undef NDEBUG in geesubs.cc. * Added a VecPrint function in utils.cc to print DVector; this replaces usage of cerr. 2012-01-09 Jun Yan * Thank Jeffrey Horner and Cole Beck for fixing the undefined symbol error (see 2011-11-14 entry: _Z5ValidIiEN3TNT6VectorIT_EERS3_RNS1_IiEE). The template function "Valid" (in original geesubs.cc) should actually be in the header file. This may fix the compilation error on ubuntu 11.10 too. 2011-11-21 Jun Yan * Added an example to function relRisk. 2011-11-21 Jun Yan * Added an example to function compCoef. * Changed the JSS paper year from 2005 to 2006 in CITATION. 2011-11-16 Jun Yan * Added function relRisk for relative risk regression --- regression for binary response with log link. * Added function relRisk for relative risk regression --- regression for binary response with log link. * Added function compCoef for comparing coefficients of the same sets of covariates between nested models. This implements the method of Yan, Aseltine, and Harel (2011, JEBS); for independent data, the method reduces to Allison (1995, American Journal of Sociology). * Fixed a bug in c++ code in constructing the working covariance structure using the regression model of scale. Simulation tests show improved efficiency in mean parameter estimation when scale regression is present. 2011-11-15 Soren Hojsgaard * Dependence on the doBy package has been removed. 2011-11-14 Jun Yan * Added NAMESPACE for to comply with the requirement of R-2.14.0. * Removed the "assert" lines in utils.cc in order not to crash R, which is quite rude practice. A "-DNDEBUG" has been added to the cppflags in Makevars for a better solution. Due to many asserts in tnt, we cannot get rid of the NOTE message completely: Found ‘_ZSt4cerr’, possibly from ‘std::cerr’ (C++) Found ‘__assert_fail’, possibly from ‘assert’ (C) * Added quote in statements like extract(m, "response") to get rid of NOTE: geese: no visible binding for global variable ‘response’ * Added a line of #undef NDEBUG to the beginning of geesubs.cc; thank Brian Ripley for the NMU. Still unclear why the error without this line: undefined symbol: _Z5ValidIiEN3TNT6VectorIT_EERS3_RNS1_IiEE 2011-02-23 Søren Højsgaard * In geeglm is checked if the model matrix is rank deficient; if so then geeglm exits. Thanks to Jason D Thorpe for pointing this out. * Bug in anova fixed. Thanks to Stefan Boehringer for pointing this out. * Version 1.0-18 uploaded. 2010-01-26 Søren Højsgaard * fixed2Zcor function has been added. This function makes it easier to work with a fixed correlation matrix (in particular when cluster sizes are not equal). * A vignette on models with unequal cluster size, fixed correlation matrices etc. has been added. * Version 1.0-17 uploaded 2008-12-08 Søren Højsgaard * Bugfix in 1.0.15 caused problem in binomial case using cbind(pos,neg). Thanks to Tobias Verbeke. Fixed now. * Bugfix in 1.0.15 caused problem when using variables derived from gam package call to geeglm. Thanks to Eric Rexstad. Fixed now. * Using scale.fix argument gave problem in geeglm. Thanks to Tobias Verbeke. Fixed now. * Fitting large data set with binomial model and 3 measurements per unit using unstructured correlation crashes R. Thanks to Tobias Verbeke. Problem has *NOT* been solved but a remark has been added to doc file. * Version 1.0-16 uploaded 2008-12-01 Søren Højsgaard * When a factor has unused levels, the underlying C code fails. This is now catured in geeglm. Thanks to Janet Young * tests directory added to package * Version 1.0-15 uploaded 2007-07-13 Søren Højsgaard * Smaller 'standardization' changes implemented. Thanks to Achim * Version 1.0-14 uploaded 2007-03-21 Søren Højsgaard * A remark on fixed correlation structures has been added to the geeglm.Rd doc file. * A Wishlist file has been added * Version 1.0-13 uploaded 2007-03-21 Søren Højsgaard * Bug in geeglm fixed so that it now works with a fixed correlation structure. Thanks to Ulrich Halekoh for the fix. 2006-02-13 Jun Yan * Bug in genZcor and genZodds fixed. Thanks to Chongzhi Di . Previously, the matrice generated by genZcor/genZodds are wrong when the number of unique waves is greater than or equal to 10. 2006-01-24 Søren Højsgaard * Bug in anova.geeglm fixed (showed up when there was only one term on the right hand side of ~). * geeglm only works on complete data. This has been pointed out in the man pages. (At some point of time, a proper na.action should be taken). * All datasets are saved as .txt files (previously some were saved as .rda files but that caused problems in building the package on windows xp). 2005-08-13 Jun Yan * The working correlation structure can now be "fixed". 2005-06-13 Søren Højsgaard * Søren Højsgaard has modified the geeglm function so that it can take the 'waves' argument which is used for explicitely specifying the ordering of repeated measurements on the same unit. geeglm can also take the 'zcor' argument for a user defined working correlation structure. * A documentation file for the genZcor function has been added. * All data sets provided are now saved as text files. * ordgee has been modified to check if the response variable is an ordered factor. * geeglm can now take the argument std.err which specifies the type of variance estimate to be calculated. 2005-05-11 Søren Højsgaard * Søren Højsgaard has modified the anova function to make it calculate the correct degrees of freedom. 2005-04-11 Jun Yan * Søren Højsgaard made some minor changes to geeglm - basically, that geese.control did not work. Now it does. 2005-02-09 Jun Yan * Søren Højsgaard joined the development with geeglm, which "works like" glm and returns an object which is similar to a glm object. Residuals and predicted values can be extracted using the generic functions as with a glm object. * An important feature of geeglm, is that an anova method exists for these models. geepack/man/0000755000177400001440000000000012404310560012611 5ustar murdochusersgeepack/man/DATA-koch.Rd0000754000177400001440000000120411327543465014551 0ustar murdochusers\name{koch} \alias{koch} \non_function{} \title{Ordinal Data from Koch} \usage{data(koch)} \description{ The \code{koch} data frame has 288 rows and 4 columns. } \format{ This data frame contains the following columns: \describe{ \item{trt}{a numeric vector} \item{day}{a numeric vector} \item{y}{an ordered factor with levels: \code{1} < \code{2} < \code{3}} \item{id}{a numeric vector} } } % \details{ % } % \source{ % } % \references{ % } \examples{ data(koch) fit <- ordgee(ordered(y) ~ trt + as.factor(day), id=id, data=koch, corstr="exch") summary(fit) } \keyword{datasets} geepack/man/DATA-sitka89.Rd0000754000177400001440000000106311327543450015116 0ustar murdochusers\name{sitka89} \alias{sitka89} \title{Growth of Sitka Spruce Trees} \description{ Impact of ozone on the growth of sitka spruce trees. } \usage{data(sitka89)} \format{ A dataframe \describe{ \item{size:}{size of the tree measured in \eqn{log(height*diamter^2)}} \item{time:}{days after the 1st january, 1988} \item{tree:}{id number of a tree} \item{treat:}{ozone: grown under ozone environment, control: ozone free} } } % \source{ % } % \references{ % } \examples{ data(sitka89) %attach(sitka89) } \keyword{datasets} geepack/man/ordgee.Rd0000754000177400001440000001205711660761421014365 0ustar murdochusers\name{ordgee} \alias{ordgee} \title{GEE for Clustered Ordinal Responses} \description{ Produces an object of class `geese' which is a Generalized Estimating Equation fit of the clustered ordinal data. } \usage{ ordgee(formula = formula(data), ooffset = NULL, id, waves = NULL, data = parent.frame, subset = NULL, na.action = na.omit, contrasts = NULL, weights = NULL, z = NULL, mean.link = "logit", corstr = "independence", control = geese.control(...), b = NA, alpha = NA, scale.fix = TRUE, scale.val = 1, int.const = TRUE, rev = FALSE,...) } \arguments{ \item{formula}{a formula expression as for \code{glm}, of the form \code{response ~ predictors}. See the documentation of lm and formula for details. As for glm, this specifies the linear predictor for modelling the mean. A term of the form \code{offset(expression)} is allowed. } \item{ooffset}{vector of offset for the odds ratio model.} \item{id}{a vector which identifies the clusters. The length of `id' should be the same as the number of observations. Data are assumed to be sorted so that observations on a cluster are contiguous rows for all entities in the formula.} \item{waves}{an integer vector which identifies components in clusters. The length of \code{waves} should be the same as the number of observation. components with the same \code{waves} value will have the same link functions. } \item{data}{ an optional data frame in which to interpret the variables occurring in the \code{formula}, along with the \code{id} and \code{n} variables. } \item{subset}{ expression saying which subset of the rows of the data should be used in the fit. This can be a logical vector (which is replicated to have length equal to the number of observations), or a numeric vector indicating which observation numbers are to be included, or a character vector of the row names to be included. All observations are included by default. } \item{na.action}{ a function to filter missing data. For \code{gee} only \code{na.omit} should be used here. } \item{contrasts}{ a list giving contrasts for some or all of the factors appearing in the model formula. The elements of the list should have the same name as the variable and should be either a contrast matrix (specifically, any full-rank matrix with as many rows as there are levels in the factor), or else a function to compute such a matrix given the number of levels. } \item{weights}{an optional vector of weights to be used in the fitting process. The length of \code{weights} should be the same as the number of observations. } \item{z}{a design matrix for the odds ratio model. The number of rows of z is \deqn{c^2 \sum n_i(n_i - 1)/2,} where \eqn{n_i} is the cluster size, and \eqn{c} is the number of categories minus 1. } \item{mean.link}{a character string specifying the link function for the means. The following are allowed: \code{"logit"}, \code{"probit"}, and \code{"cloglog"}. } \item{corstr}{a character string specifying the log odds. The following are allowed: \code{"independence"}, \code{"exchangeable"}, \code{"unstructured"}, and \code{"userdefined"}. } \item{control}{a list of iteration and algorithmic constants. See \code{\link{geese.control}} for their names and default values. These can also be set as arguments to \code{geese} itself. } \item{b}{an initial estimate for the mean parameters.} \item{alpha}{an initial estimate for the odds ratio parameters.} \item{scale.fix}{a logical variable indicating if scale is fixed; it is set at TRUE currently (it can not be FALSE yet!).} \item{scale.val}{this argument is ignored currently.} \item{int.const}{a logical variable; if true, the intercepts are constant, and if false, the intercepts are different for different components in the response.} \item{rev}{a logical variable. For example, for a three level ordered response Y = 2, the accumulated indicator is coded as (1, 0, 0) if true and (0, 1, 1) if false.} \item{\dots}{further arguments passed to or from other methods.} } \value{ An object of class \code{"geese"} representing the fit. } \references{ Heagerty, P.J. and Zeger, S.L. (1996) Marginal regression models for clustered ordinal measurements. \emph{JASA}, \bold{91} 1024--1036. } \author{Jun Yan \email{jyan.stat@gmail.com}} \seealso{ \code{\link{glm}}, \code{\link{lm}}, \code{\link{geese}}. } \examples{ data(respdis) resp.l <- reshape(respdis, varying =list(c("y1", "y2", "y3", "y4")), v.names = "resp", direction = "long") resp.l <- resp.l[order(resp.l$id, resp.l$time),] fit <- ordgee(ordered(resp) ~ trt, id=id, data=resp.l, int.const=FALSE) summary(fit) data(ohio) ohio$resp <- ordered(as.factor(ohio$resp)) fit <- ordgee(resp ~ age + smoke + age:smoke, id = id, data=ohio) summary(fit) } \keyword{nonlinear} \keyword{models} geepack/man/DATA-spruce.Rd0000754000177400001440000000310107752013632015117 0ustar murdochusers\name{spruce} \alias{spruce} \non_function{} \title{Log-size of 79 Sitka spruce trees} \usage{data(spruce)} \description{ The \code{spruce} data frame has 1027 rows and 6 columns. The data consists of measurements on 79 sitka spruce trees over two growing seasons. The trees were grown in four controlled environment chambers, of which the first two, containing 27 trees each, were treated with introduced ozone at 70 ppb whilst the remaining two, containing 12 and 13 trees, were controls. } \format{ This data frame contains the following columns: \describe{ \item{chamber}{a numeric vector of chamber numbers} \item{ozone}{a factor with levels \code{enriched} and \code{normal}} \item{id}{a numeric vector of tree id} \item{time}{a numeric vector of the time when the measurements were taken, measured in days since Jan. 1, 1988} \item{wave}{a numeric vector of the measurement number} \item{logsize}{a numeric vector of the log-size} } } \source{ Diggle, P.J., Liang, K.Y., and Zeger, S.L. (1994) Analysis of Longitudinal Data, Clarendon Press. } \examples{ data(spruce) spruce$contr <- ifelse(spruce$ozone=="enriched", 0, 1) sitka88 <- spruce[spruce$wave <= 5,] sitka89 <- spruce[spruce$wave > 5,] fit.88 <- geese(logsize ~ as.factor(wave) + contr + I(time/100*contr) - 1, id=id, data=sitka88, corstr="ar1") summary(fit.88) fit.89 <- geese(logsize ~ as.factor(wave) + contr - 1, id=id, data=sitka89, corstr="ar1") summary(fit.89) } \keyword{datasets} geepack/man/compCoef.Rd0000754000177400001440000000425111662437401014650 0ustar murdochusers\name{compCoef} \alias{compCoef} \title{ Compare Regression Coefficiente between Nested Models } \description{ Comparing regression coefficients between models when one model is nested within another for clustered data. } \usage{ compCoef(fit0, fit1) } \arguments{ \item{fit0}{ a fitted object of class \code{geese} } \item{fit1}{ another fitted object of class \code{geese} } } \value{ a list of two components: \item{delta}{estimated difference in the coefficients of common covariates from \code{fit0} and \code{fit1}} \item{variance}{estimated variance matrix of delta} } \references{ Allison, P. D. (1995). The impact of random predictors on comparisons of coefficients between models: Comment on Clogg, Petkova, and Haritou. \emph{American Journal of Sociology}, \bold{100}(5), 1294--1305. Clogg, C. C., Petkova, E., and Haritou, A. (1995). Statistical methods for comparing regression coefficients between models. \emph{American Journal of Sociology}, \bold{100}(5), 1261--1293. Yan, J., Aseltine, R., and Harel, O. (2011). Comparing Regression Coefficients Between Nested Linear Models for Clustered Data with Generalized Estimating Equations. \emph{Journal of Educational and Behaviorial Statistics}, Forthcoming. } \author{ Jun Yan \email{jyan.stat@gmail.com} } \examples{ ## generate clustered data gendat <- function(ncl, clsz) { ## ncl: number of clusters ## clsz: cluster size (all equal) id <- rep(1:ncl, each = clsz) visit <- rep(1:clsz, ncl) n <- ncl * clsz x1 <- rbinom(n, 1, 0.5) ## within cluster varying binary covariate x2 <- runif(n, 0, 1) ## within cluster varying continuous covariate ## the true correlation coefficient rho for an ar(1) ## correlation structure is 2/3 rho <- 2/3 rhomat <- rho ^ outer(1:4, 1:4, function(x, y) abs(x - y)) chol.u <- chol(rhomat) noise <- as.vector(sapply(1:ncl, function(x) chol.u \%*\% rnorm(clsz))) y <- 1 + 3 * x1 - 2 * x2 + noise dat <- data.frame(y, id, visit, x1, x2) dat } simdat <- gendat(100, 4) fit0 <- geese(y ~ x1, id = id, data = simdat, corstr = "un") fit1 <- geese(y ~ x1 + x2, id = id, data = simdat, corstr = "un") compCoef(fit0, fit1) } \keyword{models} geepack/man/DATA-ohio.Rd0000754000177400001440000000216507752013632014565 0ustar murdochusers\name{ohio} \alias{ohio} \non_function{} \title{Ohio Children Wheeze Status} \usage{data(ohio)} \description{ The \code{ohio} data frame has 2148 rows and 4 columns. The dataset is a subset of the six-city study, a longitudinal study of the health effects of air pollution. } \format{ This data frame contains the following columns: \describe{ \item{resp}{an indicator of wheeze status (1=yes, 0=no)} \item{id}{a numeric vector for subject id} \item{age}{a numeric vector of age, 0 is 9 years old} \item{smoke}{an indicator of maternal smoking at the first year of the study} } } \references{ Fitzmaurice, G.M. and Laird, N.M. (1993) A likelihood-based method for analyzing longitudinal binary responses, \emph{Biometrika} \bold{80}: 141--151. } \examples{ data(ohio) fit <- geese(resp ~ age + smoke + age:smoke, id=id, data=ohio, family=binomial, corstr="exch", scale.fix=TRUE) summary(fit) fit.ar1 <- geese(resp ~ age + smoke + age:smoke, id=id, data=ohio, family=binomial, corstr="ar1", scale.fix=TRUE) summary(fit.ar1) } \keyword{datasets} geepack/man/geeglm.Rd0000754000177400001440000001164111117053054014347 0ustar murdochusers\name{geeglm} \alias{geeglm} %- Also NEED an '\alias' for EACH other topic documented here. \title{Fit Generalized Estimating Equations (GEE)} \description{ The geeglm function fits generalized estimating equations using the 'geese.fit' function of the 'geepack' package for doing the actual computations. geeglm has a syntax similar to glm and returns an object similar to a glm object. An important feature of geeglm, is that an anova method exists for these models. } \usage{ geeglm(formula, family = gaussian, data=parent.frame(), weights, subset, na.action, start = NULL, etastart, mustart, offset, control = geese.control(...), method = "glm.fit", x = FALSE, y = TRUE, contrasts = NULL, id, waves=NULL, zcor=NULL, corstr = "independence", scale.fix = FALSE, scale.value =1, std.err="san.se", ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{See corresponding documentation to \code{glm}} \item{family}{See corresponding documentation to \code{glm}} \item{data}{See corresponding documentation to \code{glm}} \item{weights}{See corresponding documentation to \code{glm}} \item{subset}{See corresponding documentation to \code{glm}} \item{na.action}{No action is taken. Indeed geeglm only works on complete data.} \item{start}{See corresponding documentation to \code{glm}} \item{etastart}{See corresponding documentation to \code{glm}} \item{mustart}{See corresponding documentation to \code{glm}} \item{offset}{See corresponding documentation to \code{glm}} \item{control}{See corresponding documentation to \code{glm}} %\item{model}{See corresponding documentation to \code{glm}} \item{method}{See corresponding documentation to \code{glm}} \item{x}{See corresponding documentation to \code{glm}} \item{y}{See corresponding documentation to \code{glm}} \item{contrasts}{See corresponding documentation to \code{glm}} \item{id}{a vector which identifies the clusters. The length of `id' should be the same as the number of observations. Data are assumed to be sorted so that observations on a cluster are contiguous rows for all entities in the formula. } \item{waves}{Wariable specifying the ordering of repeated mesurements on the same unit. Also used in connection with missing values. See examples below.} \item{zcor}{Used for entering a user defined working correlation structure.} \item{corstr}{a character string specifying the correlation structure. The following are permitted: '"independence"', '"exchangeable"', '"ar1"', '"unstructured"' and '"userdefined"' } \item{scale.fix}{a logical variable; if true, the scale parameter is fixed at the value of 'scale.value'. } \item{scale.value}{numeric variable giving the value to which the scale parameter should be fixed; used only if 'scale.fix == TRUE'.} \item{std.err}{Type of standard error to be calculated. Defualt 'san.se' is the usual robust estimate. Other options are 'jack': if approximate jackknife variance estimate should be computed. 'j1s': if 1-step jackknife variance estimate should be computed. 'fij': logical indicating if fully iterated jackknife variance estimate should be computed. } \item{\dots}{further arguments passed to or from other methods.} } \details{ In the case of corstr="fixed" one must provide the zcor vector if the clusters have unequal sizes. Clusters with size one must not be represented in zcor. } \value{ An object of type 'geeglm' } \references{Liang, K.Y. and Zeger, S.L. (1986) Longitudinal data analysis using generalized linear models. Biometrika, *73* 13-22. Prentice, R.L. and Zhao, L.P. (1991). Estimating equations for parameters in means and covariances of multivariate discrete and continuous responses. Biometrics, *47* 825-839.} \author{Sren Hjsgaard, sorenh@agrsci.dk} \note{See the documentation for the 'geese' function for additional information. geeglm only works for complete data. Thus if there are NA's in data you can specify data=na.omit(mydata). } \section{Warning }{ Use "unstructured" correlation structure only with great care. (It may cause R to crash). } \seealso{\code{\link{geese}}, \code{\link{glm}},\code{\link{anova.geeglm}} } \examples{ data(dietox) dietox$Cu <- as.factor(dietox$Cu) mf <- formula(Weight~Cu*(Time+I(Time^2)+I(Time^3))) gee1 <- geeglm(mf, data=dietox, id=Pig, family=poisson("identity"),corstr="ar1") gee1 summary(gee1) mf2 <- formula(Weight~Cu*Time+I(Time^2)+I(Time^3)) gee2 <- geeglm(mf2, data=dietox, id=Pig, family=poisson("identity"),corstr="ar1") anova(gee2) } \keyword{models}% at least one, from doc/KEYWORDS geepack/man/DATA-dietox.Rd0000754000177400001440000000236010201645264015113 0ustar murdochusers\name{dietox} \alias{dietox} \non_function{} \title{Growth curves of pigs in a 3x3 factorial experiment} \usage{data(dietox)} \description{ The \code{dietox} data frame has 861 rows and 7 columns. } \format{ This data frame contains the following columns: \describe{ \item{Weight}{a numeric vector} \item{Feed}{a numeric vector} \item{Time}{a numeric vector} \item{Pig}{a numeric vector} \item{Evit}{a numeric vector} \item{Cu}{a numeric vector} \item{Litter}{a numeric vector} } } %\details{ % ~~ If necessary, more details than the description above ~~ %} \source{ Lauridsen, C., Hjsgaard, S.,Srensen, M.T. C. (1999) Influence of Dietary Rapeseed Oli, Vitamin E, and Copper on Performance and Antioxidant and Oxidative Status of Pigs. J. Anim. Sci.77:906-916 } %\references{ %~~ possibly secondary sources and usages ~~ %} \examples{ data(dietox) dietox$Cu <- as.factor(dietox$Cu) gee01 <- geeglm (Weight ~ Time + Cu + Cu * Time, id =Pig, data = dietox, family=gaussian,corstr="ex") mf <- formula(Weight~Cu*(Time+I(Time^2)+I(Time^3))) gee1 <- geeglm(mf, data=dietox, id=Pig, family=poisson("identity"),corstr="ar1") summary(gee1) anova(gee1) } \keyword{datasets} geepack/man/geese.control.Rd0000754000177400001440000000312711660761231015664 0ustar murdochusers\name{geese.control} \alias{geese.control} %- Also NEED an `\alias' for EACH other topic documented here. \title{Auxiliary for Controlling GEE Fitting} \description{ Auxiliary function as user interface for `gee' fitting. Only used when calling `geese' or `geese.fit'. } \usage{ geese.control(epsilon = 1e-04, maxit = 25, trace = FALSE, scale.fix = FALSE, jack = FALSE, j1s = FALSE, fij = FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{epsilon}{positive convergence tolerance epsilon; the iterations converge when the absolute value of the difference in parameter estimate is below \code{epsilon}.} \item{maxit}{integer giving the maximal number of Fisher Scoring iteration.} \item{trace}{logical indicating if output should be produced for each iteration.} \item{scale.fix}{logical indicating if the scale should be fixed.} \item{jack}{logical indicating if approximate jackknife variance estimate should be computed.} \item{j1s}{logical indicating if 1-step jackknife variance estimate should be computed.} \item{fij}{logical indicating if fully iterated jackknife variance estimate should be computed.} } \details{ When `trace' is true, output for each iteration is printed to the screen by the c++ code. Hence, `options(digits = *)' does not control the precision. } \value{ A list with the arguments as components. } \author{Jun Yan \email{jyan.stat@gmail.com} } \seealso{`geese.fit', the fitting procedure used by `geese'.} % \examples{ % } \keyword{optimize} \keyword{models} geepack/man/geese.Rd0000754000177400001440000002434211660761323014211 0ustar murdochusers\name{geese} \alias{geese} \alias{geese.fit} \alias{print.geese} \alias{summary.geese} \alias{print.summary.geese} \title{Function to solve a Generalized Estimating Equation Model} \description{ Produces an object of class `geese' which is a Generalized Estimating Equation fit of the data. } \usage{ geese(formula = formula(data), sformula = ~1, id, waves = NULL, data = parent.frame(), subset = NULL, na.action = na.omit, contrasts = NULL, weights = NULL, zcor = NULL, corp = NULL, control = geese.control(...), b = NULL, alpha = NULL, gm = NULL, family = gaussian(), mean.link = NULL, variance = NULL, cor.link = "identity", sca.link = "identity", link.same = TRUE, scale.fix = FALSE, scale.value = 1, corstr = "independence", ...) geese.fit(x, y, id, offset = rep(0, N), soffset = rep(0, N), weights = rep(1,N), waves = NULL, zsca = matrix(1, N, 1), zcor = NULL, corp = NULL, control = geese.control(...), b = NULL, alpha = NULL, gm = NULL, family = gaussian(), mean.link = NULL, variance = NULL, cor.link = "identity", sca.link = "identity", link.same = TRUE, scale.fix = FALSE, scale.value = 1, corstr = "independence", ...) } \arguments{ \item{formula}{a formula expression as for \code{glm}, of the form \code{response ~ predictors}. See the documentation of lm and formula for details. As for glm, this specifies the linear predictor for modeling the mean. A term of the form \code{offset(expression)} is allowed. } \item{sformula}{a formula expression of the form \code{ ~ predictor}, the response being ignored. This specifies the linear predictor for modeling the dispersion. A term of the form \code{offset(expression)} is allowed. } \item{id}{a vector which identifies the clusters. The length of `id' should be the same as the number of observations. Data are assumed to be sorted so that observations on a cluster are contiguous rows for all entities in the formula. } \item{waves}{an integer vector which identifies components in clusters. The length of \code{waves} should be the same as the number of observation. components with the same \code{waves} value will have the same link functions. } \item{data}{ an optional data frame in which to interpret the variables occurring in the \code{formula}, along with the \code{id} and \code{n} variables. } \item{subset}{ expression saying which subset of the rows of the data should be used in the fit. This can be a logical vector (which is replicated to have length equal to the number of observations), or a numeric vector indicating which observation numbers are to be included, or a character vector of the row names to be included. All observations are included by default. } \item{na.action}{ a function to filter missing data. For \code{gee} only \code{na.omit} should be used here. } \item{contrasts}{ a list giving contrasts for some or all of the factors appearing in the model formula. The elements of the list should have the same name as the variable and should be either a contrast matrix (specifically, any full-rank matrix with as many rows as there are levels in the factor), or else a function to compute such a matrix given the number of levels. } \item{weights}{an optional vector of weights to be used in the fitting process. The length of \code{weights} should be the same as the number of observations. This weights is not (yet) the weight as in sas proc genmod, and hence is not recommended to use. } \item{zcor}{a design matrix for correlation parameters.} \item{corp}{known parameters such as coordinates used for correlation coefficients. } \item{control}{a list of iteration and algorithmic constants. See \code{\link{geese.control}} for their names and default values. These can also be set as arguments to \code{geese} itself. } \item{b}{an initial estimate for the mean parameters.} \item{alpha}{an initial estimate for the correlation parameters.} \item{gm}{an initial estimate for the scale parameters.} \item{family}{a description of the error distribution and link function to be used in the model, as for \code{\link{glm}}. } \item{mean.link}{a character string specifying the link function for the means. The following are allowed: \code{"identity"}, \code{"logit"}, \code{"probit"}, \code{"cloglog"}, \code{"log"}, and \code{"inverse"}. The default value is determined from family. } \item{variance}{a character string specifying the variance function in terms of the mean. The following are allowed: \code{"gaussian"}, \code{"binomial"}, \code{"poisson"}, and \code{"gamma"}. The default value is determined from family. } \item{cor.link}{a character string specifying the link function for the correlation coefficients. The following are allowed: \code{"identity"}, and \code{"fisherz"}. } \item{sca.link}{a character string specifying the link function for the scales. The following are allowed: \code{"identity"}, and \code{"log"}. } \item{link.same}{a logical indicating if all the components in a cluster should use the same link. } \item{scale.fix}{ a logical variable; if true, the scale parameter is fixed at the value of \code{scale.value}. } \item{scale.value}{ numeric variable giving the value to which the scale parameter should be fixed; used only if \code{scale.fix == TRUE}. } \item{corstr}{ a character string specifying the correlation structure. The following are permitted: \code{"independence"}, \code{"exchangeable"}, \code{"ar1"}, \code{"unstructured"}, \code{"userdefined"}, and \code{"fixed"} } \item{x, y}{ \code{x} is a design matrix of dimension \code{n * p}, and \code{y} is a vector of observations of length \code{n}. } \item{offset, soffset}{ vector of offset for the mean and for the scale, respectively. } \item{zsca}{ a design matrix of dimension \code{n * r} for the scales. } \item{\dots}{further arguments passed to or from other methods.} } \value{ An object of class \code{"geese"} representing the fit. } \details{ when the correlation structure is \code{fixed}, the specification of \code{Zcor} should be a vector of length \code{sum(clusz * (clusz - 1)) / 2.} } \references{ Yan, J. and J.P. Fine (2004) Estimating Equations for Association Structures. \emph{Statistics in Medicine}, \bold{23}, 859--880. } \author{Jun Yan \email{jyan.stat@gmail.com}} \seealso{ \code{\link{glm}}, \code{\link{lm}}, \code{\link{ordgee}}. } \examples{ data(seizure) ## Diggle, Liang, and Zeger (1994) pp166-168, compare Table 8.10 seiz.l <- reshape(seizure, varying=list(c("base","y1", "y2", "y3", "y4")), v.names="y", times=0:4, direction="long") seiz.l <- seiz.l[order(seiz.l$id, seiz.l$time),] seiz.l$t <- ifelse(seiz.l$time == 0, 8, 2) seiz.l$x <- ifelse(seiz.l$time == 0, 0, 1) m1 <- geese(y ~ offset(log(t)) + x + trt + x:trt, id = id, data=seiz.l, corstr="exch", family=poisson) summary(m1) m2 <- geese(y ~ offset(log(t)) + x + trt + x:trt, id = id, data = seiz.l, subset = id!=49, corstr = "exch", family=poisson) summary(m2) ## Using fixed correlation matrix cor.fixed <- matrix(c(1, 0.5, 0.25, 0.125, 0.125, 0.5, 1, 0.25, 0.125, 0.125, 0.25, 0.25, 1, 0.5, 0.125, 0.125, 0.125, 0.5, 1, 0.125, 0.125, 0.125, 0.125, 0.125, 1), 5, 5) cor.fixed zcor <- rep(cor.fixed[lower.tri(cor.fixed)], 59) m3 <- geese(y ~ offset(log(t)) + x + trt + x:trt, id = id, data = seiz.l, family = poisson, corstr = "fixed", zcor = zcor) summary(m3) data(ohio) fit <- geese(resp ~ age + smoke + age:smoke, id=id, data=ohio, family=binomial, corstr="exch", scale.fix=TRUE) summary(fit) fit.ar1 <- geese(resp ~ age + smoke + age:smoke, id=id, data=ohio, family=binomial, corstr="ar1", scale.fix=TRUE) summary(fit.ar1) ###### simulated data ## a function to generate a dataset gendat <- function() { id <- gl(50, 4, 200) visit <- rep(1:4, 50) x1 <- rbinom(200, 1, 0.6) ## within cluster varying binary covariate x2 <- runif(200, 0, 1) ## within cluster varying continuous covariate phi <- 1 + 2 * x1 ## true scale model ## the true correlation coefficient rho for an ar(1) ## correlation structure is 0.667. rhomat <- 0.667 ^ outer(1:4, 1:4, function(x, y) abs(x - y)) chol.u <- chol(rhomat) noise <- as.vector(sapply(1:50, function(x) chol.u \%*\% rnorm(4))) e <- sqrt(phi) * noise y <- 1 + 3 * x1 - 2 * x2 + e dat <- data.frame(y, id, visit, x1, x2) dat } dat <- gendat() fit <- geese(y ~ x1 + x2, id = id, data = dat, sformula = ~ x1, corstr = "ar1", jack = TRUE, j1s = TRUE, fij = TRUE) summary(fit) #### create user-defined design matrix of unstrctured correlation. #### in this case, zcor has 4*3/2 = 6 columns, and 50 * 6 = 300 rows zcor <- genZcor(clusz = rep(4, 50), waves = dat$visit, "unstr") zfit <- geese(y ~ x1 + x2, id = id, data = dat, sformula = ~ x1, corstr = "userdefined", zcor = zcor, jack = TRUE, j1s = TRUE, fij = TRUE) summary(zfit) #### Now, suppose that we want the correlation of 1-2, 2-3, and 3-4 #### to be the same. Then zcor should have 4 columns. z2 <- matrix(NA, 300, 4) z2[,1] <- zcor[,1] + zcor[,4] + zcor[,6] z2[,2:4] <- zcor[, c(2, 3, 5)] summary(geese(y ~ x1 + x2, id = id, data = dat, sformula = ~ x1, corstr = "userdefined", zcor = z2, jack = TRUE, j1s = TRUE, fij = TRUE)) #### Next, we introduce non-constant cluster sizes by #### randomly selecting 60 percent of the data good <- sort(sample(1:nrow(dat), .6 * nrow(dat))) mdat <- dat[good,] summary(geese(y ~ x1 + x2, id = id, data = mdat, waves = visit, sformula = ~ x1, corstr="ar1", jack = TRUE, j1s = TRUE, fij = TRUE)) } \keyword{nonlinear} \keyword{models} geepack/man/fixed2Zcor.Rd0000754000177400001440000000412011660502541015123 0ustar murdochusers\name{fixed2Zcor} \Rdversion{1.1} \alias{fixed2Zcor} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Construct zcor vector (of fixed correlations) from a fixed working correlation matrix } \description{ Construct zcor vector (of fixed correlations) from a fixed working correlation matrix, a specification of clusters and a specifcation of waves. } \usage{ fixed2Zcor(cor.fixed, id, waves) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{cor.fixed}{ Matrix } \item{id}{ Clusters } \item{waves}{ Vector giving the ordering of observations within clusters. } } %\details{ %% ~~ If necessary, more details than the description above ~~ %} \value{ A vector which can be passed as the zcor argument to geeglm. } %\references{ %% ~put references to the literature/web site here ~ %} \author{ Sren Hjsgaard } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{genZcor}}, \code{\link{geeglm}} } \examples{ timeorder <- rep(1:5, 6) tvar <- timeorder + rnorm(length(timeorder)) idvar <- rep(1:6, each=5) uuu <- rep(rnorm(6), each=5) yvar <- 1 + 2*tvar + uuu + rnorm(length(tvar)) simdat <- data.frame(idvar, timeorder, tvar, yvar) head(simdat,12) simdatPerm <- simdat[sample(nrow(simdat)),] simdatPerm <- simdatPerm[order(simdatPerm$idvar),] head(simdatPerm) cor.fixed <- matrix(c(1 , 0.5 , 0.25, 0.125, 0.125, 0.5 , 1 , 0.25, 0.125, 0.125, 0.25 , 0.25 , 1 , 0.5 , 0.125, 0.125, 0.125, 0.5 , 1 , 0.125, 0.125, 0.125, 0.125, 0.125, 1 ), nrow=5, ncol=5) cor.fixed zcor <- fixed2Zcor(cor.fixed, id=simdatPerm$idvar, waves=simdatPerm$timeorder) zcor mod4 <- geeglm(yvar~tvar, id=idvar, data=simdatPerm, corstr="fixed", zcor=zcor) mod4 } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{regression} geepack/man/DATA-seizure.Rd0000754000177400001440000000557107752013632015321 0ustar murdochusers\name{seizure} \alias{seizure} \non_function{} \title{Epiliptic Seizures} \usage{data(seizure)} \description{ The \code{seizure} data frame has 59 rows and 7 columns. The dataset has the number of epiliptic seizures in each of four two-week intervals, and in a baseline eight-week inverval, for treatment and control groups with a total of 59 individuals. } \format{ This data frame contains the following columns: \describe{ \item{y1}{the number of epiliptic seizures in the 1st 2-week interval} \item{y2}{the number of epiliptic seizures in the 2nd 2-week interval} \item{y3}{the number of epiliptic seizures in the 3rd 2-week interval} \item{y4}{the number of epiliptic seizures in the 4th 2-week interval} \item{trt}{an indicator of treatment} \item{base}{the number of epilitic seizures in a baseline 8-week interval} \item{age}{a numeric vector of subject age} } } \source{ Thall, P.F. and Vail S.C. (1990) Some covariance models for longitudinal count data with overdispersion. \emph{Biometrics} \bold{46}: 657--671. } \references{ Diggle, P.J., Liang, K.Y., and Zeger, S.L. (1994) Analysis of Longitudinal Data. Clarendon Press. } \examples{ data(seizure) ## Diggle, Liang, and Zeger (1994) pp166-168, compare Table 8.10 seiz.l <- reshape(seizure, varying=list(c("base","y1", "y2", "y3", "y4")), v.names="y", times=0:4, direction="long") seiz.l <- seiz.l[order(seiz.l$id, seiz.l$time),] seiz.l$t <- ifelse(seiz.l$time == 0, 8, 2) seiz.l$x <- ifelse(seiz.l$time == 0, 0, 1) m1 <- geese(y ~ offset(log(t)) + x + trt + x:trt, id = id, data=seiz.l, corstr="exch", family=poisson) summary(m1) m2 <- geese(y ~ offset(log(t)) + x + trt + x:trt, id = id, data = seiz.l, subset = id!=49, corstr = "exch", family=poisson) summary(m2) ## Thall and Vail (1990) seiz.l <- reshape(seizure, varying=list(c("y1","y2","y3","y4")), v.names="y", direction="long") seiz.l <- seiz.l[order(seiz.l$id, seiz.l$time),] seiz.l$lbase <- log(seiz.l$base / 4) seiz.l$lage <- log(seiz.l$age) seiz.l$v4 <- ifelse(seiz.l$time == 4, 1, 0) m3 <- geese(y ~ lbase + trt + lbase:trt + lage + v4, sformula = ~ as.factor(time) - 1, id = id, data = seiz.l, corstr = "exchangeable", family=poisson) ## compare to Model 13 in Table 4, noticeable difference summary(m3) ## set up a design matrix for the correlation z <- model.matrix(~ age, data = seizure) # data is not seiz.l ## just to illustrate the scale link and correlation link m4 <- geese(y ~ lbase + trt + lbase:trt + lage + v4, sformula = ~ as.factor(time)-1, id = id, data = seiz.l, corstr = "ar1", family = poisson, zcor = z, cor.link = "fisherz", sca.link = "log") summary(m4) } \keyword{datasets} geepack/man/SHDgeese-internal.Rd0000754000177400001440000000103510371742670016356 0ustar murdochusers\name{SHDgeese-internal} \alias{anova.geeglm} \alias{anovageePrim2} \alias{anova.geeglmlist} \alias{plot.geeglm} \alias{print.geeglm} \alias{eprint} \alias{print.summary.geeglm} \alias{residuals.geeglm} \alias{summary.geeglm} \title{Internal geese functions} \description{ Internal functions called by other functions. } % \usage{ % crossutri(wave) % genZcor(clusz, waves, corstrv) % genZodds(clusz, waves, corstrv, ncat) % } % \details{ % These are not to be called directly by the user. % } \keyword{internal} geepack/man/relRisk.Rd0000754000177400001440000000433611672201174014531 0ustar murdochusers\name{relRisk} \alias{relRisk} \title{ Fit a Relative Risk Model for Binary data with Log Link } \description{ Fit a Relative Risk Model for Binary data with Log Link using the COPY method. } \usage{ relRisk(formula, id, waves = NULL, data = parent.frame(), subset = NULL, contrasts = NULL, na.action = na.omit, corstr = "indep", ncopy = 1000, control = geese.control(), b = NULL, alpha = NULL) } \arguments{ \item{formula}{ same as in \code{geese} } \item{id}{ same as in \code{geese} } \item{waves}{ same as in \code{geese} } \item{data}{ same as in \code{geese} } \item{subset}{ same as in \code{geese} } \item{contrasts}{ same as in \code{geese} } \item{na.action}{ same as in \code{geese} } \item{corstr}{ same as in \code{geese} } \item{ncopy}{ the number of copies of the original data in constructing weight. } \item{control}{ same as in \code{geese} } \item{b}{ initial values for regression coefficients as in \code{geese} but more difficult to obtain due to the log link. } \item{alpha}{ same as in \code{geese} } } \value{ An object of class \code{"geese"} representing the fit. } \references{ Lumley, T., Kornmal, R. and Ma, S. (2006). Relative risk regression in medical research: models, contrasts, estimators, and algorithms. UW Biostatistics Working Paper Series 293, University of Washington. } \author{ Jun Yan \email{jyan.stat@gmail.com} } \examples{ ## this example was used in Yu and Yan (2010, techreport) data(respiratory) respiratory$treat <- relevel(respiratory$treat, ref = "P") respiratory$sex <- relevel(respiratory$sex, ref = "M") respiratory$center <- as.factor(respiratory$center) ## 1 will be the reference level fit <- relRisk(outcome ~ treat + center + sex + age + baseline + visit, id = id, corstr = "ar1", data = respiratory, ncopy=10000) summary(fit) ## fit <- relRisk(outcome ~ treat + center + sex + age + baseline + visit, ## id = id, corstr = "ex", data = respiratory) ## summary(fit) ## fit <- relRisk(outcome ~ treat + center + sex + age + baseline + visit, ## id = id, corstr = "indep", data = respiratory) ## summary(fit) } \keyword{models} geepack/man/genZcor.Rd0000754000177400001440000000401211660761575014531 0ustar murdochusers\name{genZcor} \alias{genZcor} \alias{humbelbee} \title{genZcor} \description{ constructs the design matrix for the correlation structures: independence, echangeable, ar1 and unstructured The user will need this function only as a basis to construct a user defined correlation structure: use genZcor to get the design matrix Z for the unstructured correlation and define the specific correlation structure by linear combinations of the columns of Z. } \usage{ genZcor(clusz, waves, corstrv) } \arguments{ \item{clusz}{integer vector giving the number of observations in each cluster} \item{waves}{integer vector, obervations in the same cluster with values of wave i and j have the correlation \eqn{latex}{sigma_ij}} \item{corstrv}{correlation structures: 1=independence,2=exchangeable,3=ar1, 4=unstructured} } % \details{ % } \value{ \item{}{the design matrix for the correlation structure} } %\references{ a } \author{Jun Yan \email{jyan.stat@gmail.com}} % \note{ } \seealso{\code{\link{fixed2Zcor}} } \examples{ #example to construct a Toeplitz correlation structure # sigma_ij=sigma_|i-j| #data set with 5 clusters and maximally 4 observations (visits) per cluster gendat <- function() { id <- gl(5, 4, 20) visit <- rep(1:4, 5) y <- rnorm(id) dat <- data.frame(y, id, visit)[c(-2,-9),] } set.seed(88) dat<-gendat() #generating the design matrix for the unstructured correlation zcor <- genZcor(clusz = table(dat$id), waves = dat$visit, corstrv=4) # defining the Toeplitz structure zcor.toep<-matrix(NA, nrow(zcor),3) zcor.toep[,1]<-apply(zcor[,c(1,4,6)],1,sum) zcor.toep[,2]<-apply(zcor[,c(2,5)],1,sum) zcor.toep[,3]<-zcor[,3] zfit1 <- geese(y ~ 1,id = id, data = dat, corstr = "userdefined", zcor = zcor.toep) zfit2 <- geeglm(y ~ 1,id = id, data = dat, corstr = "userdefined", zcor = zcor.toep) } \keyword{ regression }% at least one, from doc/KEYWORDS geepack/man/geese-internal.Rd0000754000177400001440000000055510253624504016017 0ustar murdochusers\name{geese-internal} \alias{crossutri} %\alias{genZcor} \alias{genZodds} \title{Internal geese functions} \description{ Internal functions called by other functions. } \usage{ crossutri(wave) genZcor(clusz, waves, corstrv) genZodds(clusz, waves, corstrv, ncat) } \details{ These are not to be called directly by the user. } \keyword{internal} geepack/man/DATA-respdis.Rd0000754000177400001440000000326210253625460015275 0ustar murdochusers\name{respdis} \alias{respdis} \non_function{} \title{Clustered Ordinal Respiratory Disorder} \usage{data(respdis)} \description{ The \code{respdis} data frame has 111 rows and 3 columns. The study described in Miller et. al. (1993) is a randomized clinical trial of a new treatment of respiratory disorder. The study was conducted in 111 patients who were randomly assigned to one of two treatments (active, placebo). At each of four visits during the follow-up period, the response status of each patients was classified on an ordinal scale. } \format{ This data frame contains the following columns: \describe{ \item{y1, y2, y3, y4}{ordered factor measured at 4 visits for the response with levels, \code{1} < \code{2} < \code{3}, 1 = poor, 2 = good, and 3 = excellent} \item{trt}{a factor for treatment with levels, 1 = active, 0 = placebo.} } } \references{ Miller, M.E., David, C.S., and Landis, R.J. (1993) The analysis of longitudinal polytomous data: Generalized estimating equation and connections with weighted least squares, \emph{Biometrics} \bold{49}: 1033-1048. } \examples{ data(respdis) resp.l <- reshape(respdis, varying = list(c("y1", "y2", "y3", "y4")), v.names = "resp", direction = "long") resp.l <- resp.l[order(resp.l$id, resp.l$time),] fit <- ordgee(ordered(resp) ~ trt, id = id, data = resp.l, int.const = FALSE) summary(fit) z <- model.matrix( ~ trt - 1, data = respdis) ind <- rep(1:111, 4*3/2 * 2^2) zmat <- z[ind,,drop=FALSE] fit <- ordgee(ordered(resp) ~ trt, id = id, data = resp.l, int.const = FALSE, z = zmat, corstr = "exchangeable") summary(fit) } \keyword{datasets} geepack/man/DATA-respiratory.Rd0000754000177400001440000000230310217522456016203 0ustar murdochusers\name{respiratory} \alias{respiratory} \alias{respiratoryWide} \docType{data} \title{Data from a clinical trial comparing two treatments for a respiratory illness} \description{ The data are from a clinical trial of patients with respiratory illness, where 111 patients from two different clinics were randomized to receive either placebo or an active treatment. Patients were examined at baseline and at four visits during treatment. At each examination, respiratory status (categorized as 1 = good, 0 = poor) was determined. } \usage{data(respiratory)} \format{ A data frame with 111 observations on the following 7 variables. \describe{ \item{center}{a numeric vector} \item{id}{a numeric vector} \item{age}{a numeric vector} \item{baseline}{a numeric vector} \item{active}{a numeric vector} \item{center2}{a numeric vector} \item{female}{a numeric vector} } } % \details{ % } % \source{ % ~~ reference to a publication or URL from which the data were obtained ~~ % } % \references{ % ~~ possibly secondary sources and usages ~~ % } \examples{ data(respiratory) ## maybe str(respiratory) ; plot(respiratory) ... } \keyword{datasets}