Publish/0000755000176200001440000000000013775125612011671 5ustar liggesusersPublish/NAMESPACE0000755000176200001440000000613713774620017013120 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(as.data.frame,specialFrame) S3method(ci.mean,default) S3method(ci.mean,formula) S3method(plot,ci) S3method(plot,regressionTable) S3method(plot,subgroupAnalysis) S3method(plot,summary.regressionTable) S3method(print,ci) S3method(print,subgroupAnalysis) S3method(print,summary.regressionTable) S3method(print,table2x2) S3method(print,univariateTable) S3method(publish,CauseSpecificCox) S3method(publish,FGR) S3method(publish,MIresult) S3method(publish,Score) S3method(publish,ci) S3method(publish,coxph) S3method(publish,data.frame) S3method(publish,default) S3method(publish,geeglm) S3method(publish,glm) S3method(publish,gls) S3method(publish,htest) S3method(publish,list) S3method(publish,lm) S3method(publish,lme) S3method(publish,matrix) S3method(publish,prodlim) S3method(publish,riskRegression) S3method(publish,subgroupAnalysis) S3method(publish,summary.aov) S3method(publish,summary.prodlim) S3method(publish,survdiff) S3method(publish,table) S3method(publish,univariateTable) S3method(summary,ci) S3method(summary,regressionTable) S3method(summary,subgroupAnalysis) S3method(summary,univariateTable) export(Spaghettiogram) export(Units) export(acut) export(ci.mean) export(coxphSeries) export(fixRegressionTable) export(followupTable) export(formatCI) export(glmSeries) export(labelUnits) export(lazyDateCoding) export(lazyFactorCoding) export(org) export(parseInteractionTerms) export(plotConfidence) export(pubformat) export(publish) export(regressionTable) export(spaghettiogram) export(specialFrame) export(splinePlot.lrm) export(stripes) export(subgroupAnalysis) export(sutable) export(table2x2) export(univariateTable) export(utable) importFrom(data.table,".N") importFrom(data.table,".SD") importFrom(data.table,":=") importFrom(data.table,as.data.table) importFrom(data.table,copy) importFrom(data.table,data.table) importFrom(data.table,is.data.table) importFrom(data.table,melt) importFrom(data.table,rbindlist) importFrom(data.table,set) importFrom(data.table,setcolorder) importFrom(data.table,setkey) importFrom(data.table,setnames) importFrom(data.table,setorder) importFrom(grDevices,dev.size) importFrom(graphics,abline) importFrom(graphics,par) importFrom(graphics,plot) importFrom(graphics,polygon) importFrom(graphics,rect) importFrom(graphics,segments) importFrom(graphics,strwidth) importFrom(prodlim,Hist) importFrom(prodlim,getEvent) importFrom(stats,anova) importFrom(stats,binom.test) importFrom(stats,binomial) importFrom(stats,chisq.test) importFrom(stats,coef) importFrom(stats,confint) importFrom(stats,delete.response) importFrom(stats,fisher.test) importFrom(stats,get_all_vars) importFrom(stats,glm) importFrom(stats,kruskal.test) importFrom(stats,model.frame) importFrom(stats,model.response) importFrom(stats,na.omit) importFrom(stats,na.pass) importFrom(stats,naprint) importFrom(stats,pchisq) importFrom(stats,pt) importFrom(stats,qnorm) importFrom(stats,qt) importFrom(stats,quantile) importFrom(stats,symnum) importFrom(stats,terms) importFrom(stats,update) importFrom(stats,update.formula) importFrom(stats,var) importFrom(survival,Surv) importFrom(survival,coxph) Publish/README.md0000644000176200001440000000075613571203061013145 0ustar liggesusers# Publish R package Publish ## Installation To install the development version of Publish run the following commands from within R ```{r} library(devtools) install_github('tagteam/Publish') ``` ## Trouble shooting To install a package from github you need a program to unzip the download. If you don't have such a program and the install_github above command failed, then you should try ```{r} library(devtools) options(unzip="internal") install_github('tagteam/Publish') ``` ## Examples Publish/data/0000755000176200001440000000000013571203035012570 5ustar liggesusersPublish/data/Diabetes.rda0000744000176200001440000003770613571203035015016 0ustar liggesusersսx6 `( 5$P$@ ! -(%ҋ`""( M GT@@QEkfo="C"˛&.o˛&Md7l&ɦf5_fsk]k]k]k]( %/a̰D$+T;"p #a#dEH?r'."##L x3px1p_'D""99"@''"^!HD%#zO$ DK"aHs'ZADOJ"HINV"D} L4h(DÉF#H4aD$#c.cDdsɠ ;3 1p 37 9|AvgFDfCٔCٔٔmB‰"b$Q*QQ:QQ&QGnDyD݉Ddo6ٛݗl.""۲G=H4hd"/0&۲%")'ɶleN5"o"59P9AD͈9{CzR˥zKu4jS.ٙKv޹:rH|"=|ۏ;K?@$ĊH("UJKw).'J$"J RWڎ+)%JsH^)UJJIV)(DDxQ,#""ye)Dįt.#˲:e2QFqTFXzQ6^JhՌU۪"*ѫ}5~֚" A@t!BD눠%& a*.Q?QꎸID5HP ?rI\0:/+(. S kꕣ"dz'Œjxi=j/}'pTTBJCo%갠OHl/"qtTCv}[o#)%LD/. b;XTM 8t^[vCܕ~TīhSQMeD; d:St>1qq8wP;mM{7&ئ+(v1~<0ކOC %001{ sZrznM–e?rbz}b`3`1ppo9=ZSE8]4;{Z|lw3>};QdĆUؠxsёg){'y`ȸ+]T^vy4tR2U:AkZDO+Ai7As*&6E-l]FA{A뻠uTh0SCVFg'0#a~uF&v?CNgإ6> ]2 7FIz5xctVއNS1Vɠ}P;)|gmz0 <``ztF{{Ŧҙ9bt}x FLM#*B#9:\G6A)g 硝*vs~*&xO>yŠxt)lpރq>=U;7 ~!c}a!l9GW8YC8UMSkU<F\Xؔ\[rZy?a_G1A 2m+Aa +[m_uT{|S.[ :B;wAsl͵GUk:ZhaxuOT*&Rak˰E< 6%z9 lh!+}g`\[ؚJ'pkL/Ng^ $\=Xad;^wNlz 1xչ7kqwj/GjQlRӨmj5t&`G %O-0%x*)9P5\G@^ R|#GM^3x&x'bMʋѰ7qX.!8AHǼ( s1R MPP ydwaF7lEb~<1@pq͡[#>UW|:`l#T#:5eCC5َ!?̆w涆u # ckS1c+j*zlƶƆ} 0i 9&€ ׊]G׺1Ac8$B-150l;Gp6sbmشJ^&P5c ;_20jJtv +Á-Ch Š]*k*]?rnjwxţ-MX5P8\G*d7&# /K$ڀo`{C{aLoaQYlh>p U0WY5Ez۷eeʲHYg߾ݞHbykg?3]`/ xv8xi#8^ƏPC|i~c|ֿW>f|a<a1`2n_l:4>\s{eW6y-8n߬7WO?e-?~7q5`qq=@GWGz~{kqf:|X8?_v0_#_3?/-_//{k~q|!3/Kו5;Z}qgݫq7OCO_tpTKKqp?uuK/xAO1>|y\e-LXCGzsMkqZ`;huzz򌏦5iq=-ݵI-ͿOl絗U˱*h0 5\EG_d='gy 3~~<Cg?-NOU!֯džC}]|xuw~?uKG qT\ygA6 z&)gڲu?ծ&|cl3ko3E Yp8>%){m \yˤ74=h}Wxt=cz7yYHgTI~dՇDqee (^}rKɧRʦuU_m ocpefx/|Z6*8^8?h1.?~h77=fV+ =8/ qڰ7q?Q6<_˻N,z 8ju@kz>zi'_yQ;M`|-#L5 v<Ϝqq ~:UrS~V~[YSg9')kr݇9_'55u'Su liDyּx5X.Bomqxd?b_7Td-u7YK7/%okq}/b_zHYLzw7+?po^W>|Ɠf\1'CM :8vv7:/4Au#p;y}yn̷~Odx}>ux|ԏ:y8ԁܦחj|387^%E&1JW Oq˂*g֫6`گ7p1(,)Rqո򞒥K2눏'2Ca|y]8s/ڹ>jWŲ 5Aݪ.5}yvq:g;Wc|x9Cыn yN#޸Y пeڂ~3%n/;?y]]n@wIV^ 6 fw4wߎV?n}t;?xz¯h6nE#+F+S8p O6Y)8vhaX z8@=,PHa<Р~V8/C Az)Hh( |p^PvfixCjz B=y?8R !C?~-:gB/z"LstCJG6xC,VȈ*/$h }q$zxE=B #M Sݚ@(m]WmȭWKa=蕈k57wCo ~n𩲱f6hS苀4 Wmm zx1IXХz)[X=ŀꃯj낱-WΑ<Xg6a|#xcN a|-æ}|jo1 :uhϲ}ݏ}/@U[Lc9V!1>2^6>TFۚ$l1$rm:_yIXlK5:UXe]x=>9Y <;Dq&na}ϲmOs}v<~yud,v1~;s}*+~d9옲. -RXxqj ]_#;Š nK8~_6d?|5.^X/ 1lr?^X.<)oeR;x sj[q> 0M/oM8Rx0^l[(-l$zr6b[ԇ+ s7D UWxVP/F(zpxd+T\D0d_6:c5_`|2lA ! _ r9C_#']}lbY_Ka|8d S{a{WP2PCl._C$O:?t,Bz+12GEVC ЮY"V0bA-/4s/6n -;*~rf#!׀D|o-<$Ao哹.ξ R·>#/;8*ޗC"zB0*^C߃x ; =j>hm*Wrԇ+6X,իq4me0_ J`TrIa~-ЦV"خbQ9kC)[m> D K s!|Y ?̎A旆U`o']*DB1U8[XVz ~@3 u\O)}N3Ώ`"%` ^^lwjr ])~rK>]}xi{Jt+[]J7m.u;_^WcL]!\cֱuJLA WWx'<]ڧSoʋEWqV|*ˋGWq*\f9Ճ;Wޮ|TtR-6W>O^:^v=ɮL]ؤctSic G*Lcl6/n3)?΄%6qAHS>lt=UX0Sj׽ņ3q> ^K6@;w͇.19<碝nVa2wp܊eSx֜3VefY" 06HSRrծyXa2Ll Ba}bjÐcEɿ恸p,ㅕCS5yI0aQz=J0sa2dd*cmzĸhy68J0g8i=,ufTfQ?>\*A2v}/c<}\fK"aՏ|kҍ˞N=.砊 \fj\WmYtjŹ5Xxke_x%O=Q(_R%POa=MXwu'@1Vᑃ^3}ŧ`La}hڕRHf<| suN^40z(jt蚌,a}tG{a=l] =ڃS hg\38*} +>& +Fi,!צ']b|UXq_GBV|c W'q ~~- bg;tWEKV9`Occ'laU*ez d2I61%pq¸ kO59N9{C R|V\ +.@Xqy)}tcT0b69 !PXt]a+ `eu/RsÅyA6*΃L),rV g[31j6e]sM)"Es\}J 3hMOL`Qk8Wm|\Wc\wq}Yy<.g$˝HI{-M4mvWw]v]Q{|Guf3q_l;mms(=&+l>vz TmeYX݆"an0rIu6kKVtXj;WKlcaK>DkS7w.6yߦs?u}i{[\lV,X岺׋45_c>h͹&ybL1QOwu[x>N湘3ء.|nk#=o['w8a1O_` ѕAIjz)XXg[YqA8HXo"6~~h6sM,N jlf|wC&F$Ba}ּ4@3a95ێ b;lliò!ُ mvE: x ljS#"m7aμByJCs S~.5@Xo5 <5 3~lG3`HXZ>>6V?g g ƆĹy1z#s|0 a~Ks 5!lPq+\fz+eC׭&zjNMf3aŀ3VJ_ \ƅLJB~alsBXPsc=PXocRes>,ZȘ7 pl1̈́G!z3hS#ذcdƣjNS9H67] ̄x F +:ߢW!6LV5 BXq6(\Xo;qr5oKla>\`q럺IVm2?^u[^j ϵj}+g-6X}^Z0 ˜Pa*^8֏qUAǽ4b7V,c"̃xm,?dmg5sHE@6~,qLs ՜D,{.xrG9̵yD +xq>1~5;ca .֟r-7^zqG +#fxBX +CG_8 O .n] ,1`.XS>[xRZ=:/hw)](9'1GP'!y{0ܥS'+T{6K'-18y3;eҹz;ѐM6)tkU^ ,Q׉ébm3 ~YBT67s 3IJEτ&ڰ7ia>}υ Upʟ,~Zv _~o)1~aCXB=/R]%#%Z10o37T쎷bypY9hl@EX/'b+#p0sW8u:`> [Yrsh1cTN^f> vw"d'1a/%6'1^_40wK'3vV;?y)2+ۈ;QkX~Yuf{"{9.b-99ц8T˙sЎzOgd1qꭳVBU`˩VvS8ua.3vA9V~yۛ/ zS:y's]>il[ qWYlvCܮn7urg .~QAmv~=GxC=X}Fv=ute^|73Dl$2ݫ=g{m9sӏ˼ݓz^v|_M_32]?xnZ8~[S˜M~AͱmxM~9,rd={?Of=oZ&od/3E'yyWK>P^,;Va="}KgY$sߎ:tWeܖ)6{|^xf楦^=R?ؙ&a]M>^8:}dYiewt/ϥW.g,2q0+݆seWS s?T%2o lɒ#|XnE޲ҒG۞?)M;.g^o {PyoȬvSƝvꟺ8yva~hSL}~ЏՄZO>]R5}Ji7i]:KEٳ+s?˼fv綨Э@k8((,tj鏜O|Ê3~ktb3nXO[7?\M=X>3;3qqz>q8x_֯JϨSޖ=w v|3w}9N*X9p2dhjo6G|FNz}L9<꘸oC٥5Ȟ3wd=y~FٱY7kb7u6dORZl7zb>N68]$u*yn"S>gʩ?f2}].=9~z_Xu1oYh `t7/olƁg~W̓A*of';u֞73堟ͬY^5q}a?yyͭ0Yg8~ygniO)=WvTqUZ?MܺQf|stǖg}wYXW񸮨<6 lbypVdF֪Ǭ?f{j-u1x\sz.!geǝΛv̂jL\=lďYǜ#^G.˜$܊r[zg>U97[f^p}\{s=z2rFs[c]_L뾰|_s /8q`ڄu^ cz$G;ވ'Sg{Y_^ɬ/s=f9z:YXQ|yqytpyf>y8ds?d\*W8. {D<Ds^_\/o/<ͼu:kOggƾ*{Zṃϐm5m덶~n~e>s]8} xItù'{i}ulfhXŖeNMG*E=6(L?|h21idjKe]*oz_~cdY7{"6<~Zuţ2bM?Ls瓻k]~2앟ve֐ˁ$N~(߯@Fk2gv'叵]Fo2KoL޼LW=e6h ?&Fo2kʩ7e?Y&[̘hKd+K, }'.)ͯ|#Sp]䃗T)GeU+c\tT)ѾX˻n^Y=k\pZ&M[}AB eJߐIw WV#2F2a^cnanXk20G)w6MXq2^!QG&{z ߽e[S|nLܿ[rz2aE_C&[턌5Keb\_pƆdr}EՋ+W/. {wLY_8]u+/#yny?y!orq{a}2\fڲ-=6G&}i`(>oadfmCe>~|Sg˖_aYm粏ޫL~Wks$)PCLïf\%qϓGdꤊ]}IF}3Q ̺7w_Ƥ<ۚ&α +]8I3Ѱe2ӷpv89gӟȸ!y+"/w+ӳI$Z/pέej{gE3=&0Jă2}}@c?"WW72wF̑ }=?dL- 2smLyWl8KXY~4)2ҌT΍ll5rkwy1^翔ig+⬌5.l~Rp^= 7xDY _ve>C x؞KȄ1O:Uͨw+dD]IUk&-oS3߿X)/O漨?>[w3:^it!(e~PpA2Ց7b4,һ2}?asj>+fۛ&>q_}eOzF)Sj0E9 ɄzK{NiTg2?#j n'C|mR)S2=IF/l^}twVcWMj᣻d_z~fq94o72Ϥ/F cս!SzzLjp+eT^mtT&_پ};ȘbErƷܿAoUQ )ݥzƟWsVh=Tڴa2aqqmN(O'o⺾[d/;V*_~tˤw#@xQZ^!Ӳ}1/Z~G3Co֧^b Jd̶o \NN]4b\1{dUX;K:5˄kG=+x>㭫Om^:e^N^H9vq_j_@䓵VHQ42:rW+y>^l)Lo84|:dE/xzףqy~=c>~XdGq~W< i_2O)Ny 29j~۲ҫ[e yS4H&Mz]讣GETЌzN"V{Q 6u񓵯_cfYO9ㇷ>Ĭ3/O鐷+ e'O7a͟x7%f/f"OU5-+Yq}h?ק-,F_qClQwk*Y&V#Hds=dl.3X)+7/.wN2v5o<$fF]#%Cum))}uvZv2搟zTF6އ_ l֒}Ck4+Osu!uUZ鲉1`X//?b/L_ǾAXCOO{eﲊG93ؓG'LH'{[o"\Xbbt:81a¨GKVÒTFN#=4ĎZ OcO|8OǁOX1s">cD<~b=̉xz,uO@Oĺ{'}ϟXM>5{p[dސ0fzP>*fwrMz+834444244444>CCCCCC=o lyНC=wX=wچGrʱ~p/>mK.>TroɛN%SoKU]/[u[A%3ƃIP}AGgܞSD{P|=3YocG)8{(8W/ >h_ ]pX7@k/]BZ),/{ʷPN%Ɗ}`U:'1pA|#GWϋD1u=?:_F?eA>0-s~D gKT_U.q8O /^/V_bS_v}x^z,^@jrnp'ۃɿ^MrYmA0bvj1?YAph2x /6 Oȯ"|c DV9ȷ5[OGd%[V?ȧ_Ax`7} l,Fi`p?ʭs <*A}|Oq3jntܒܦ!ֿۧ'0 /_dRo wA@yX{ g\H;8{ So~ s};Gfy~~OÝ O|1rїm0ϤNI/ʩr]-Q5%edãc:S?Cpnzrk_oW~wb#d%뇂k?vοv?ihmHp{/ED~t+7|NZ9M'W}*`;8vHyd{dM&y+8qpx>N`}ƙW XᔍsN OzΡjio>?L&?92+ɟ jMWNrh_eJ9JCxi"%+FhheՁ)iC|,4s|R?r$iF`*+|>>&H(WTk ZWu I%p5۽; cR$xi3䯘-$E%tEaD!73]"߈ &S.:gyrxy=߿l!W*ޗyH<ۓ1 =g"k99w#|o>;b~/F9C=۪6]WlAö{Ps>xW0v*se<*c2D1n[J㤈r,Bv:.܁=pG#_R^>WI^Fy&s=x 6niyJ}%6z8\n  w \5o?VN+6ÿ|Xr}VBypPO`ӡ^OH0{σ>&{G=[3^]J;y?о9{e6m_{i>7Sn7yX!NPqY|J i./1!^YAuLko󖁹ԯٿSOf_EwɴC~1;M3@ρ))ss~~n9`~rpQu:qgnxCno)%ÿop7]F74a>y~Z7{_Wji'0_zU.gy$+8)_qQ_u9z%Ϲ_`}9ppZ3,%W퀻UYg$9.+"^yqܥa{WS.Uμ[ /=:ОN]4w)8q C MW!VgK^›!#^5CO$G ~oV]/徢7Uȗ2ٔ60m܏Σr ~uヤgloHof{?qs5iߎ|b鈷g:pkmy mne[>`3mZw[ȧ*+AZ `# _y~~QN.~/_9]q[\A>|h<܅wԾ3vN=e/3\lx7Y2^>׭Y.|ODIq~9veyZz y^v]8Vν+ח[B;~0mpӠ/v&[yRHPvS+܍) 93y&}+OK(oǽ6/n glbZ7Үh-ntM|OqPts U&XK{:*iǕR%(uY8pQW1/wCe"|/{wOF{w44ĝo9H~!ҷ}?{,z!o~mp΀p75#};H0 nCew<_~A/Kh"7qnG-Y>ڷABZ/թw%,L'Sx=|/k'|`y9` U\'VӞqޫBg9 af_ݛL5 TE=vFwoB ́pajT+_"iV|,:_J;dXsBG>jliQ,w g鿌;>c{ڡA]~}]_u`e>xv9:ڱ<{aY`?]0JWLm>)j *<_νN׽7=_r$?`e`i/~,eJ~wxõsOxN~O[up1mA򙴃ս2 ٞ^ yAZS}& @W9xS}_%exX|3ynG;e-l-$'O)<^M=l1 9 ۭ;`^8| l>D} ܇`%UKa@%v{!~aK^'vXRx~vދbU빼_|fqMޟ~.sǧJp\)>#3^=hR?z/V责s0,?{r^#^\'uq+]͕t^y<Jgf}VrEOrQ O{\o(W.\.NK^^YW7=4W^WϵePnJ%lB9 껗%'#ĵ'wV7=?<]9G>5x'幹OT=5zXQ~ߙruT񣭗n|'s㧻օsDOWD]P?&szp;[[wt.Wm'C#fW=Ѯv=uxt5:{hXcS.&9/tX?w^nz)\既;7"fЭ/usӹwW+]Wz/<>r)߭lI9~Oki79t,OOD+;5鳈xVlM*?~PXᔏnߡ9 cݣnzBj=Ǽ6)Пuv un#+4z"5u'u뉴\YEOduǾTDz#(єr'ܭ[G=D|'M$=^$rPOWpNQnyO#u- p{GhCD}#?e܇0Z}.㻝۪'Z(jM>NH Oܲ;HW#ƫ%ܚprG+w\As9'X?"^/F%q'GE.+9xIi+D79We::oNHTz_Wcr鯉i~}/DA"+uv'<\w.tϱ[5Bhϑ4y-Da:{U˞ˋG-%n皲>qwH7Z"zj繤˾L'7@.q{Gפ%Ӌv!I w_D{7jН H`u֕U9W뾗kkÜszCͳ>~@:N;lLp'ӳ$S/iO6\tZ#_ ;СO6"bCJpa]:"#I?;! Publish/data/SpaceT.csv0000644000176200001440000000140013571203035014457 0ustar liggesusers"Status";"HR";"Treatment";"ID" "Post";61;1;1 "Post";59;1;2 "Post";47;1;3 "Post";65;1;4 "Post";69;1;5 "Post";50;1;6 "Post";51;1;7 "Post";60;1;8 "Post";57;1;9 "Post";64;1;10 "Post";67;1;11 "Post";69;1;12 "Post";72;1;13 "Post";69;1;14 "Post";72;1;15 "Post";75;1;16 "Post";77;1;17 "Post";61;0;18 "Post";66;0;19 "Post";61;0;20 "Post";68;0;21 "Post";77;0;22 "Post";103;0;23 "Post";77;0;24 "Post";80;0;25 "Post";79;0;26 "Pre";71;1;1 "Pre";65;1;2 "Pre";52;1;3 "Pre";68;1;4 "Pre";69;1;5 "Pre";49;1;6 "Pre";49;1;7 "Pre";57;1;8 "Pre";51;1;9 "Pre";55;1;10 "Pre";58;1;11 "Pre";57;1;12 "Pre";59;1;13 "Pre";53;1;14 "Pre";53;1;15 "Pre";53;1;16 "Pre";48;1;17 "Pre";61;0;18 "Pre";59;0;19 "Pre";52;0;20 "Pre";54;0;21 "Pre";53;0;22 "Pre";78;0;23 "Pre";52;0;24 "Pre";54;0;25 "Pre";52;0;26 Publish/data/traceR.rda0000644000176200001440000005263313571203035014511 0ustar liggesusersͽ Wuګ굍qLvcCl'cg#vUwjjmHc ^0~^B&6fbh섊5&#cp6{A?h׫^O{nR5_Ͽ'kö9v}_~ѻ*h[w]?eMOG}H|~@ Lg{9a?c|/=y{vWGO3w>|ҿA9jߟϮѮa=QLMީW-?%khs>7~jW+0N?'~>I7 צ~̇]>E#\?~S&xc|ӯ}7Wpa~qE:H^.ǃ_*i/'I7;FGd\|]|kh)/{ }3J-K`p7hiGtgY~3&?OP~ϵO_%r'O{~V.݀ .D?G>y5CNip|B1.(_?ZC ;r~8N=O"Sth7_+z#yuУ>ᧈWѾM!*N^G}jÇaߨHgx\~Z_rhc"j !?s)D~W|cUG~QrlGe>: -jQer څrG {(7ZS"_~NW,奜[ڛ?ZI$PA ·q\7u~`hGK}I7xn7\Cђk~/y(q"ٿ91ts o)W#W=_8$ =7U/#՞ahgc 1s?}pW~zG=S_/U79?s 3^5N~AEN9}Ju)8΋hy^{]뽟pR*<\7sy_Qr|/~h -u_Z7~VeHayP#r=sOL兩_={0S}oUN.վa5O',qNЮO!Ca^g<=_zϮ~yOߑǽZ=ӿn>/O_+k#; pO7!|>3^Co= =Ay9?QTHR?\w/IO5ګuy>Gz봎{ueU.Ю>ju,湟=!"_\/ѧ^W\؇rpC|M\θ/%^Q-{y˼>i<뾦e(Yik [D{?3{ +)_)\u/]sq.^B7*G\]8Onp7Qǁֽ{Qy4ΉUg~KrzzP@r~<>A<#~.֥z=c_[k/ȏ>y?}@8O9ϗΧ_R{ sQ7ߓD~d_!?>{7|{?ݯ.C_ׄ+|>}cG ~CqF?G~B}2wޭkU>}7C̿q!uOyy-^_or9_"on8?s (k3|_z;&kX}ȯ= th_d{K~ Dq_pg"0W:ys.YZμ1uK|yUI7f>}'VWC湨WރPo~颍LދP>Bv <|]< 7mjruB;:OV#ܗ]xވbuS|ϊm{T}zqq9^}BOOȺNpx^9GA"q>~x ]: z#n/B<~>WG=UWs jG1~x= <1fjxodzG*[Bz7=.c>F?S?O|ؒ_=b_<_EQaJ9c[ב_Q_AGߺ7[फ़_G5?K??L[xc|Yۭ= ?|b>؊M+GGer_3@O9y xׇr S{} a=+ď6챕9!~-O7[x^~7#AyxB8NzM~[7U+0rOB|9=G!m%{3|3N?.k*Wy7~- >aMO<|}_O<9>x~~M“OzxyI)jNvτuO8~4_DzEٺ?|U×+QzQ/v_hzz,n~k6uzN}K뗈_-?V9|Ѥkr<IW[㤻ݗV?Tf>Ub 5Ly6,w m-mkufv?Ln\ӽNP'VN_m4= 8w{qt7z~˩GrnN?χH뾥8Nj~:XWMpqQǽȺ~6?O>+塈!]|[<7!>ʅ+#A>rg޶r~ur}lC!?[9_ z/Uzø7}r[quW#ү݇p|5r }!6s9j-CіazJα9IjqAzUTG~ 5מjd_/q3 =u{ynW7;_CyH^ȷBo#_W7zv[;gVO ]OEN\NV>_{|s9z7Rsy_c/=QxuٽHƗzNW{BWb0z[S§Gky\PD>}xK|)ߖG j_Ky_ϛjG}^3]<zzUydqoFzg3_Wx)G-֩ra\ΰF~Gr*KZ}-ƒ6sqO zUQnEpaQ/pugy,tߔ>'zYS|^m\qOr<'gU2/=9Y!c_ݗ1x9\^ ֓>&^v/ǹn˺fZq?"PNWq.bx6qߌ[8`x.hk DH7Gυ0*i7r83yCyB9ڹO؟|PYo~~>o5o#_r:Zwi]n_r?{"7z^{Z|`|~Bķ}*e9vL~/է\纍.¸ؽo!]{}[~£٬@#}hh8O:|{9I8{\˿eӍOrs?O"Oӎ{hw[tned"{E^:ANIސ CzX1}yÇC>oxw猗|:Ixq]fi'(|~u/qq3ރB18$HϺ=۽#ӿ7 \_~W=z}x?6oEr}FMی_vz}} h}+ 9: S>v"\;d<"R0n-~ź&*u7sKKWKsI%D#޾9k #lG܀.OoG~Ä'?ߚ7P:/rƾVug^^Qz *z7Pa\su ؆9?dq ;~.-}-v+~CwھK>tߎ<y8~Bʋu7HNxWK /r7 ߌKk9JԗTѾ_Od>)}=~/W9G"J|Ӣ.&^~HhE3']I14{ߤ U.gA.~_"7Vwhi?Zi ﰞryO4>d=82k|)|"?r܁~NҸ~6?Au _Pxj橃NRq\~cG9t}/ħz'79現U.Cy[}'V|~~Mt '=S9ҏx:7_' Ը^9N? ~1O{D݇P'A>s|`s|pڛ| <\޿D\!yU?GkϏz"? r>js/rR.|KBnŸޫK=U./?0$|};=^[}r\Ϥq =O{2U\O5}Ъ\BK`>c[n2#__9uNv?=qB<䯗*Z|;S_ސB~Ep<7!>&o2^%s%>VE@qaKyb\9* u?_{Y}nlW_{yYV9|#/z?ڸ%yO?_ân8r|;r]=oHnHW<*8Ty?$Z pzN"".hc_4~J~8󜞏C q_ssuY_{^&{/?q4{=Egz?unskU>!E\2~ ռ0!qbi'}z%sh5>w[o|N=2~z"NZS~:3.Oܳ3_ߏeޏG]@FQ.X_%G=9h>zoS*<) '򹬯=$?h5FR#=OI=xj7hmz瘵E) xQqް=a#0u_:]Yo]E=NܛSNbɟwX_71~~㉏q?<#1ߗ71@Nf*5B>gs}\joC9m7}kK;K@ӹz% \s/Zx? jZCr~;>k9n<+@#Qǝ?u`uvswA? {9oa<QiTBwn륐$h~>7> 8 Y>>_%>2?S%ߺr܇s%uTɟ\cUS.׹`y?> X~bp Ѝo??_U%<^ML=J~p<}ΎC?ǰu~t>gto|'4tzzr۾ <8^0~?#U1NUu\/Gӻ &3q]: ;Als^]?ٜƯBOh51uBg`΢|g=Oat?B;!퐹[:˪dX< `]7$>__1~#hmzy~\ O;`~N^л;WǠ m@Z]_Gt_}cUC0W>!tw^>ߣX7xl<1+躎\/>pL?ǡS[䓧`#{eUWCNn筘 ro_Ӡy/KWb&p rMN@'w־w08?V s}7-;xp_8x;U }i{8i>oѧ\W@goNU^Wlt;>G`+ÝjX?1nݷb `{{W}tjWg慘w0Zl ٫ ՠcNYܗA&E?+ |f{3r{\p۠;gqp'lG[>\C/1v'//ƚGgh_ Ɯ-<p=_>9K]Pu;9b]ؓ 2 }sӽ ppi@ ~|˪:l֪oqL@7!/5^_>=q;}_ێj蓞cЗ Ɲ*F5G_}@~{A׽ k}_ݏ~%=v :d} }#Zհ>^ b~p%h8ߗT> ^pmk;cۋd?tv?so5unV߫>txo?.#5sh>q,̩wTekܗUCp6x9;VC?b }c5Kyr\Z 떇?_ԇ %q\w`7ۇ̇U0\q=xx]5{8^o.y7wukj#`NqyNt^==kݥA΂g\ݗW.jX5C2?_3;ݗ@_Otx ~z7c-X8yy0>ObjxgY:{?Bvlz< ].}=$yǫ]`5-u^ݿ~ >#'aߕ_|{aMrYry߂//zS.l=dӢ57TXt2oyד9ԎO߶)*giy[WTOGKv7)VoUoUk->J~zTG|NiG6UOJ^).J*Q[OKy[R}-K*A_[]¶TwԿJ%}Lp%-?(=Jz.'DWJ| _Oߕm^\Rhm\?,og|ՖJ?%~5QZ}K~J~NMR*hW/٫/y\DKd#d}茫ǒTWmtJ\tzU|JO\tx↭-~_Z_J*?YS:mK^W>JO}IF*^Jksգ+[j Jj꺶}T^6?Vʛ Qc[=zsmӾSG /[ջ[FJxJTsd[}N|ڿMVzzŧ%;[U|P妜J$KbWS9K%ʡ[Gq|O ^W>zx( W3"GTO•=QKz,m_JbA^]tKOdK/Imy'R|R9Jzl/TmyL6Ɲ׸)})_[/Jx\Ձm~U¯qS'dMIW梁$øm[ro4NؖZOhܔUxA~ҶK@nVdad'd~m|갶|OJpWX:s7H4y$깭(lUo%dߒ|%{i>ůzO•⸔O壄4!*GҾ7x7ΛӒͺ]9i~} 9^ixwm5~HW}$o6%?\6lZ95M7SS_Jz]%Lٴ:&tƒ|jQg;m6xlWw%l쳆i2Ni xx wlbi]غ}/Vg3֟̆g ):Ê7Fs7Ȗ/fT94\oN8h/&zSγ'+|u ctbtr@);k}FrȌtj)-`}o+7˿lS)g6v|30f9?2k4<_I9[vϚ=dmbDŽ]Mc7?9៺~ϴgxrӻ:|3kvY~ucyq[uɔN^kQc;ΙKSUiOS~5לb6fYLy^4]wO7}=l?uk8띷X֕8m9kd.ٟx#Jdzd<|wwstcir޴bqlt-F-_E2>d?4r}"џCݏ$+s_rv~09flܯ_YM O$wL~G%KYe_h9O ?beW%7.?`ߞb;39˶7.Z2YʡSbpS 1?|n6SNe@}4gs<`Y;S.\ritbuNVO,?-b3M_`>[>X6a2c1;D|6ąv{ r̔ɴH+_ T{tgƼ~.?ޗ n\ h~SFsbxlbz,4_|mֲJ'6nkg[?N6:g|eSnӖf2U_KvTwmi懻65->1?7/unZ6Ňcs?3s_KSy2);Ow;_}r$հ'R|awzmjeOp>f}0/1h~1Y1i{ٲdlhzgl&iWg=΄%۟,.vZ5v;s3ji>/&\/Suc)n=/W摟շ&sz]ezcr{giѭ\6=`_x0ՂD4{X^w,&gcu/TLf#{^Idzq:=SOKYv-Nv];Cg|:kx?rSyR mY<۱m||ig~6T+}23+ +])d;K^{~ 1j;s^)CL5s?p[,ﲼb>ޱXUFct1ez_xe^j)/mα˟M8orrghߴ7LݼҔ3a? ;+fYNjjשJЬ" ~7s; 5\@ xMwVTƃ?I/Ҟw}4Lua<#-K>IJ:78]f/N-i;=V:~6=by4ӽD5V;]3}KWӞ ilLwK_{?Of/:G5^geS^ۛy3en׸&۔&ϴwJg񮯵\=g僎 ;mϝxڬcyL|2jsF{љ|{?X9G>=)KO~A.KOw~455a|>N:~țߔ| 7.k.&خoKvswo̸Ϛt|{QyTw؞bб=b=Oy,ε)w-}ؓƦ;!~O3~&ɷYy[ewVDkr̛^Reg͎;]v65ߋ,~eqtGiްdyk1=?˦ד?s/J1}m,L;5ߘIZ>z5jj̏,Loa$Y]ӖOOGJge~޲\;O3&N~~s>R\?]WLl~le˯sWkY[o77=>x_NA Qy̯Jg}ԿI~~J?oOtic]oHwł]+TٮWٜ7KKMwxV@:{{]6WLKJ2k9uZsw8sK/'4_$A;J>R=3|.b`t2ioM6;_jy[iױ~v~E>K)ɲ>>k5o]5O^ֹM;Osz:3{ FN~{tG5vM֕_MgYit sVlA4ŗ=}kp}$VLcVgX>#]ۗvd|Xʝ $IK&xL:kv;5t?d@dbJ ^?}'>kugeP:-ݎ؁ ~HNq?kyirl-/rנ~'iĞ_ 4w20?4?v½f$?X29u~mgX4sвѨeg~9f[~6^˛Nw?+~^gJg-?_uߖP~5gq?D竂L;,o>5k'W,w}iz{ǿ/\"9_gKA۫<\2{d~ r~| =q'Pṫ>z'F_ס!^ӎW=H~(w?#h:rWBhx%;_oϧ\*~U2~sU_z'ړԸ7ml)/ݪ$ʃqՃ_'-{GOU%k!̓C ?/Ar|2QވcxS>G!'} GOW낟{eh?j^~ϐ%_j굖_WKy| ʯ~ym؏Rxꗄ~+UN/?Y/ = 򱷟ASFh{y^r:N~ m?ok{Ѫ"T"_choHGҋs!I~A7!:McQGy~iww׺rhs(\񱏖Ʊz%~9<#*y"WzSz?QCs8˃%}𵷟MR"^y3wJ~t"v^'^NOuE:Qwa\;rrZ-.ry 8?r8"_- V|>;hK~-k 4~봾&|܋!+|9v4闔uxzOO|r8Gb} G/W& _׸er՞ka>-ݯC?H_Pz"_}+z[OP3/DNc^B+(7}kVt^q'rT9ZO.5V/r`|s>Q=Źv9W%8>-}vk̓ZԞU_z¥D=M=q,iPE>{t_q@|ؘ=/zz?+ q_rb>t_(?Q{"j+Ze+_GZ_^r>rq+q\N=0p~y y^a}ԟ=G/k]Vhħ7}*SϏW=-Zߣ]fwlNbzs9J'W}K/NVϕz&״>ܗɺsqOQi2Js_#үk5ǵ#_}T59#G瘗kă>եOs?k}[o8P凌/-4Gے_F\r|z{3|NC*o`=:[奜紸&~>Nuc"hc\UΏ>|qq|j#ANtvhA:3s[x('r^(£v|-j9~g[t{TLs>k ob+{JD.YWۯ^.>Ǐmi/o| q~ȩuW;y'71ku4[~wC=Z]$pzޏs / O|gօn[o!/yڛ|o.=J.ιyWNQxO9i# ?o6^} D }ܱNt(ƁZkQK_&;Y9Wt;JscΦЎkqe%wq:S⽩?%뤶l}\?:ߓ긾&ӤxGd9TŒkgovieυIל3 /m6+EG>g{\Kئ ^YƟA׍o&oⷍqt[Ci J}.x.դ,;Mvi? $LbQ2OQdiןs&G2L3N6[7g W^竓qxMxǡ0Mkǥ? $z(6JW#·I Uǒ'|xPyMަu6MUa\ߪߣ|imI|w[Z`lm g;2w6LG`:26-xt|,ZgױmͣҞ*Tǧ:oM맄n&^•dPM4UlmizS2ăWa#t tK~3@WשgÏvM1mKɶ:$ҔTgvI-鮉&FV?iҧ61ޯ<ld#+@S.nҺR,4T)$woWk&n[TQq\ʿ%%QE}OrlS(O63ʟd+glj&ncSLŢ2_u'(%l)6i?S|= g)5Q&rɨSʃVO%=֯FQ6n⡴?5ũɨ}_ՆoSdZMɯԷJ24٫׳R,٠I>Q9IWQ~5j(jFgmqi8P)Jy46*c_mᦽIqqct"[ld6UdҾ0N{Mo4'|[Mu[nc]s&|%?kۣ>jI|WM5|F鴤\R~QZ{\75YiSc붼[m4J-TR\LZ3_5w}GOSmKtFgOiv:}Nv{Sgᓇ!}3¿/TOim}i~\: {|_ΕW*.v^kc\>џ\/I_vR>J?{㱄mBS?m?Ci݅W|M Ox&\KҹXvPjK|?K_|sl\>.V](~Jx.?_>Jq~Tʃ:_׿&]6. Se6/QmB qSׅI\bKSI;iǤ\@.zPt*~Byu=_;*\ۺϤw DmB\+_kcR=~峍&_%ʏտ']Χät]l?~`.:V7P_6ũKX_mY3lV>iKJisZ%۵/h7>DgNhjIͶm|7a;=j~dӣv\:q4.m:mK?C_DZ8=n̵$>&oQv{jQDZרXO'ǶlQ:%(*ٲqcMQ0$J6mmjQ2Gt0ljFKmrY [\ fRٸ=Qg}ln}6GΒ=G(J1m6g&qQIr.q:FQvbMMxơDs|[L;iۦQ=81:_eT ݨX46DZC_$0MvTW8qF7F5lY$4'G.G,8p%~9O'6}r1FyT kIZQ8J%8:)(}w~S:rUz[,yCz';Ϝ>tȝ'uɴdK_0ԡ;}K㷝aﶳ{O?t;8q8};=}d枣=}ЙNN3'200 mg/day";200;0;2989;1;1;1;NA "Metropolol";"3 months";"3 months";"<100 mg/day";64.6;25.8;25049;1.038;0.978;1.101;0.2178 "Metropolol";"3 months";"";"101-199 mg/day";144.3;10.5;4929;1.066;0.994;1.142;0.0721 "Carvedilol";"3 months";"Carvedilol";"<12.5 mg/day";10.2;3;3915;1.098;1.016;1.187;0.0184 "Carvedilol";"3 months";"3 months";"12.6-49 mg/day";26.3;6;3155;0.949;0.871;1.033;0.2251 "Carvedilol";"3 months";"";">50 mg/day";54.9;11.3;1957;0.887;0.8;0.984;0.0237 "Bisoprolol";"3 months";"Bisoprolol";"<5 mg/day";4.5;1;1700;1.058;0.967;1.157;0.2179 "Bisoprolol";"3 months";"3 months";"6-9 mg/day";7.5;0.29;337;1.068;0.906;1.26;0.4336 "Bisoprolol";"3 months";"";">10 mg/day";14.3;4.2;831;1.127;1.003;1.266;0.0435 "Metropolol";"6 months";"Metropolol";">200 mg/day";200;0;2927;1;1;1;NA "Metropolol";"6 months";"6 months";"<100 mg/day";67.4;26.3;19561;0.998;0.934;1.065;0.9441 "Metropolol";"6 months";"";"101-199 mg/day";144.3;10.5;3863;1.026;0.948;1.11;0.5214 "Carvedilol";"6 months";"Carvedilol";"<12.5 mg/day";10.4;2.9;2879;1.122;1.03;1.223;0.0087 "Carvedilol";"6 months";"6 months";"12.6-49 mg/day";27.5;6.6;3687;0.919;0.824;1.003;0.0594 "Carvedilol";"6 months";"";">50 mg/day";53.9;9.8;2844;0.865;0.784;0.954;0.0039 "Bisoprolol";"6 months";"Bisoprolol";"<5 mg/day";4.3;1.1;1334;1.099;0.994;1.214;0.0656 "Bisoprolol";"6 months";"2 years";"6-9 mg/day";7.5;0.3;357;0.939;0.79;1.116;0.4749 "Bisoprolol";"6 months";"";">10 mg/day";12.6;3.7;818;0.93;0.816;1.06;0.2793 "Metropolol";"2 years";"Metropolol";">200 mg/day";200;0;2559;1;1;1;NA "Metropolol";"2 years";"2 years";"<100 mg/day";66.6;27.5;14190;1.086;0.997;1.182;0.0572 "Metropolol";"2 years";"";"101-199 mg/day";145.3;9.8;2133;1.149;1.031;1.281;0.0121 "Carvedilol";"2 years";"Carvedilol";"<12.5 mg/day";10.5;2.9;1634;1.233;1.099;1.384;0.0004 "Carvedilol";"2 years";"2 years";"12.6-49 mg/day";28.3;6.9;2747;1.017;0.909;1.136;0.7731 "Carvedilol";"2 years";"";">50 mg/day";53.6;9.4;3336;0.972;0.868;1.089;0.6233 "Bisoprolol";"2 years";"Bisoprolol";"<5 mg/day";4.3;1.1;1144;1.055;0.931;1.195;0.4017 "Bisoprolol";"2 years";"2 years";"6-9 mg/day";7.5;0.3;170;1.252;0.977;1.605;0.076 "Bisoprolol";"2 years";"";">10 mg/day";11.9;3.4;774;1.134;0.972;1.322;0.1097 Publish/data/Diabetes.csv0000644000176200001440000015466713571203035015050 0ustar liggesusers"id","chol","stab.glu","hdl","ratio","glyhb","location","age","gender","height","weight","frame","bp.1s","bp.1d","bp.2s","bp.2d","waist","hip","time.ppn","AgeGroups","height.europe","weight.europe","BMI" 1000,203,82,56,3.5999999,4.30999994,"Buckingham",46,"female",62,121,"medium",118,59,NA,NA,29,38,720,"40-50",1.5748,54.8847409,22.1309881732667 1001,165,97,24,6.9000001,4.44000006,"Buckingham",29,"female",64,218,"large",112,68,NA,NA,46,48,360,"<40",1.6256,98.8832522,37.4192742794665 1002,228,92,37,6.19999981,4.63999987,"Buckingham",58,"female",61,256,"large",190,92,185,92,49,57,180,"50-60",1.5494,116.1197824,48.3703366546749 1003,78,93,12,6.5,4.63000011,"Buckingham",67,"male",67,119,"large",110,50,NA,NA,33,38,480,"60-70",1.7018,53.9775551,18.6378653900101 1005,249,90,28,8.89999962,7.71999979,"Buckingham",64,"male",68,183,"medium",138,80,NA,NA,44,41,300,"60-70",1.7272,83.0075007,27.8248017752523 1008,248,94,69,3.5999999,4.80999994,"Buckingham",34,"male",71,190,"large",132,86,NA,NA,36,42,195,"<40",1.8034,86.182651,26.4993803246881 1011,195,92,41,4.80000019,4.84000015,"Buckingham",30,"male",69,191,"medium",161,112,161,112,46,49,720,"<40",1.7526,86.6362439,28.2055128371967 1015,227,75,44,5.19999981,3.94000006,"Buckingham",37,"male",59,170,"medium",NA,NA,NA,NA,34,39,1020,"<40",1.4986,77.110793,34.3355266285367 1016,177,87,49,3.5999999,4.84000015,"Buckingham",45,"male",69,166,"large",160,80,128,86,34,40,300,"40-50",1.7526,75.2964214,24.5136917852076 1022,263,89,40,6.5999999,5.78000021,"Buckingham",55,"female",63,202,"small",108,72,NA,NA,45,50,240,"50-60",1.6002,91.6257658,35.7823686143719 1024,242,82,54,4.5,4.76999998,"Louisa",60,"female",65,156,"medium",130,90,130,90,39,45,300,"50-60",1.651,70.7604924,25.9595225036604 1029,215,128,34,6.30000019,4.96999979,"Louisa",38,"female",58,195,"medium",102,68,NA,NA,42,50,90,"<40",1.4732,88.4506155,40.7546754525733 1030,238,75,36,6.5999999,4.46999979,"Louisa",27,"female",60,170,"medium",130,80,NA,NA,35,41,720,"<40",1.524,77.110793,33.2005467205379 1031,183,79,46,4,4.59000015,"Louisa",40,"female",59,165,"medium",NA,NA,NA,NA,37,43,60,"<40",1.4986,74.8428285,33.3256581982857 1035,191,76,30,6.4000001,4.67000008,"Louisa",36,"male",69,183,"medium",100,66,NA,NA,36,40,225,"<40",1.7526,83.0075007,27.0241301005601 1036,213,83,47,4.5,3.41000009,"Louisa",33,"female",65,157,"medium",130,90,120,96,37,41,240,"<40",1.651,71.2140853,26.1259296991967 1037,255,78,38,6.69999981,4.32999992,"Louisa",50,"female",65,183,"medium",130,100,NA,NA,37,43,180,"40-50",1.651,83.0075007,30.4525167831401 1041,230,112,64,3.5999999,4.53000021,"Louisa",20,"male",67,159,"medium",100,90,NA,NA,31,39,1440,"<40",1.7018,72.1212711,24.9026940925345 1045,194,81,36,5.4000001,5.28000021,"Louisa",36,"male",64,126,"medium",110,76,NA,NA,30,34,120,"<40",1.6256,57.1527054,21.627653941343 1250,196,206,41,4.80000019,11.2399998,"Buckingham",62,"female",65,196,"large",178,90,NA,NA,46,51,540,"60-70",1.651,88.9042084,32.6158103251118 1252,186,97,50,3.70000005,6.48999977,"Buckingham",70,"male",67,178,"large",148,88,148,84,42,41,1020,"60-70",1.7018,80.7395362,27.8784877262336 1253,234,65,76,3.0999999,4.67000008,"Buckingham",47,"male",67,230,"large",137,100,149,110,45,46,480,"40-50",1.7018,104.326367,36.0227650395154 1254,203,299,43,4.69999981,12.7399998,"Buckingham",38,"female",69,288,"large",136,83,NA,NA,48,55,240,"<40",1.7526,130.6347552,42.5297785189143 1256,281,92,41,6.9000001,5.55999994,"Buckingham",66,"female",62,185,"large",158,88,160,88,48,44,285,"60-70",1.5748,83.9146865,33.8366348103664 1271,228,66,45,5.0999999,4.61000013,"Buckingham",24,"female",61,113,"medium",100,70,110,70,33,38,210,"<40",1.5494,51.2559977,21.3509689139776 1277,179,80,92,1.89999998,4.17999983,"Buckingham",41,"female",72,118,"small",144,112,NA,NA,28,36,780,"40-50",1.8288,53.5239622,16.0035315074488 1280,232,87,30,7.69999981,5.0999999,"Buckingham",37,"male",68,252,"large",140,95,NA,NA,43,47,420,"<40",1.7272,114.3054108,38.3161204773967 1281,NA,74,NA,NA,4.28000021,"Buckingham",48,"male",68,100,"small",120,85,NA,NA,27,33,510,"40-50",1.7272,45.35929,15.2048097132526 1282,254,84,52,4.9000001,4.51999998,"Buckingham",43,"female",62,145,"medium",125,70,NA,NA,31,38,720,"40-50",1.5748,65.7709705,26.5206056621791 1285,215,72,42,5.0999999,4.36999989,"Louisa",40,"male",70,189,"medium",180,122,170,112,37,39,450,"<40",1.778,85.7290581,27.1184297582881 1301,177,101,36,4.9000001,5.11000013,"Buckingham",42,"female",65,174,"medium",146,94,139,89,37,40,540,"40-50",1.651,78.9251646,28.9548520233135 1303,182,85,43,4.19999981,4.46999979,"Buckingham",52,"male",68,139,"large",130,90,NA,NA,29,35,780,"50-60",1.7272,63.0494131,21.1346855014212 1304,265,330,34,7.80000019,15.5200005,"Buckingham",61,"male",74,191,"medium",170,88,168,80,39,41,225,"60-70",1.8796,86.6362439,24.5227258250353 1305,182,85,37,4.9000001,5.65999985,"Buckingham",61,"female",69,174,"medium",176,86,180,90,49,43,330,"60-70",1.7526,78.9251646,25.6950745218441 1309,199,87,63,3.20000005,3.67000008,"Buckingham",25,"male",66,118,"medium",120,78,NA,NA,32,34,720,"<40",1.6764,53.5239622,19.0455250997738 1312,183,81,60,3.0999999,4.03000021,"Buckingham",47,"female",66,186,"medium",140,97,NA,NA,39,44,780,"40-50",1.6764,84.3682794,30.0209124454062 1313,194,86,67,2.9000001,2.68000007,"Buckingham",35,"male",66,159,"medium",115,64,NA,NA,31,35,720,"<40",1.6764,72.1212711,25.6630380581698 1314,190,107,32,5.9000001,3.55999994,"Buckingham",46,"male",72,205,"medium",NA,NA,NA,NA,46,49,240,"40-50",1.8288,92.9865445,27.8027454154831 1315,173,80,57,3,6.21000004,"Buckingham",57,"male",71,145,"medium",124,64,NA,NA,31,36,30,"50-60",1.8034,65.7709705,20.2232113004198 1316,182,206,43,4.19999981,7.90999985,"Buckingham",70,"male",69,214,"large",158,90,160,96,45,48,840,"60-70",1.7526,97.0688806,31.6019882050266 1317,136,81,51,2.70000005,4.57999992,"Buckingham",22,"female",66,160,"large",105,85,NA,NA,35,40,720,"<40",1.6764,72.574864,25.8244408132526 1321,218,68,46,4.69999981,3.8900001,"Buckingham",52,"female",62,170,"medium",142,79,NA,NA,40,43,720,"50-60",1.5748,77.110793,31.0931238797961 1323,225,83,42,5.4000001,4.38000011,"Buckingham",36,"male",67,192,"large",149,89,136,88,40,42,30,"<40",1.7018,87.0898368,30.0711777721172 1326,262,84,38,6.9000001,NA,"Buckingham",43,"male",75,253,"large",124,80,NA,NA,43,49,300,"40-50",1.905,114.7590037,31.6225442646441 1500,213,76,40,5.30000019,5.96000004,"Buckingham",72,"female",59,137,"large",130,60,NA,NA,40,40,90,">70",1.4986,62.1422273,27.6703949888796 1501,243,52,59,4.0999999,4.40999985,"Buckingham",37,"female",64,233,"medium",110,82,NA,NA,49,57,90,"<40",1.6256,105.6871457,39.9939949867693 1502,148,193,14,10.6000004,6.13999987,"Buckingham",54,"female",67,165,"medium",140,65,NA,NA,42,42,150,"50-60",1.7018,74.8428285,25.8424183979132 2004,128,223,24,5.30000019,10.8999996,"Buckingham",60,"male",67,196,"medium",110,68,NA,NA,42,43,450,"50-60",1.7018,88.9042084,30.6976606423696 2750,169,85,51,3.29999995,6.13999987,"Buckingham",40,"female",65,180,"medium",106,82,NA,NA,40,44,780,"<40",1.651,81.646722,29.9532951965312 2753,157,74,47,3.29999995,5.57000017,"Buckingham",55,"female",66,219,"medium",150,82,142,78,43,52,360,"50-60",1.6764,99.3368451,35.3472033631395 2754,196,82,58,3.4000001,4.25,"Buckingham",76,"male",65,154,NA,158,78,140,84,37,41,120,">70",1.651,69.8533066,25.6267081125878 2756,237,87,41,5.80000019,5.3499999,"Buckingham",43,"female",64,181,"medium",104,90,NA,NA,36,46,240,"40-50",1.6256,82.1003149,31.0682965347864 2757,212,97,45,4.69999981,6.32999992,"Buckingham",65,"female",61,187,"large",158,94,149,96,43,47,360,"60-70",1.5494,84.8218723,35.3330193532196 2758,233,92,39,6,4.55999994,"Buckingham",45,"female",64,167,"large",124,86,NA,NA,39,44,270,"40-50",1.6256,75.7500143,28.6652238746372 2762,289,111,50,5.80000019,9.39000034,"Buckingham",70,"female",60,220,"medium",126,80,NA,NA,51,54,780,"60-70",1.524,99.790438,42.965413403049 2763,193,106,63,3.0999999,6.3499999,"Buckingham",20,"female",68,274,"small",165,110,153,100,49,58,60,"<40",1.7272,124.2844546,41.6611786143123 2765,204,128,61,3.29999995,5.19999981,"Buckingham",62,"male",68,180,"large",141,81,NA,NA,38,41,540,"60-70",1.7272,81.646722,27.3686574838548 2770,165,94,69,2.4000001,4.98000002,"Buckingham",92,"female",62,217,"large",160,82,NA,NA,51,51,180,">70",1.5748,98.4296593,39.6894581289163 2773,237,233,58,4.0999999,13.6999998,"Buckingham",49,"female",62,189,"large",130,90,NA,NA,43,47,195,"40-50",1.5748,85.7290581,34.5682377251851 2774,218,88,39,5.5999999,NA,"Buckingham",44,"female",66,191,"large",138,79,NA,NA,40,45,720,"40-50",1.6764,86.6362439,30.8279262208203 2775,296,262,60,4.9000001,10.9300003,"Buckingham",74,"female",63,183,"large",159,99,160,103,42,48,300,">70",1.6002,83.0075007,32.4167002793567 2777,178,78,59,3,5.23000002,"Buckingham",36,"male",70,161,"medium",130,79,NA,NA,34,40,720,"<40",1.778,73.0284569,23.1008846089121 2778,443,185,23,19.2999992,14.3100004,"Buckingham",51,"female",70,235,"medium",158,98,148,88,43,48,420,"50-60",1.778,106.5943315,33.7186825036915 2780,145,85,29,5,3.99000001,"Buckingham",38,"female",NA,125,NA,NA,NA,NA,NA,31,35,120,"<40",NA,56.6991125,NA 2784,234,80,63,3.70000005,NA,"Buckingham",31,"male",70,165,"medium",121,71,NA,NA,35,39,720,"<40",1.778,74.8428285,23.6748196302515 2785,146,77,60,2.4000001,4.26999998,"Buckingham",28,"female",64,126,"small",120,90,NA,NA,28,32,180,"<40",1.6256,57.1527054,21.627653941343 2787,223,75,85,2.5999999,4.25,"Buckingham",22,"female",62,137,"medium",120,70,NA,NA,28,35,960,"<40",1.5748,62.1422273,25.0573998325416 2791,213,203,75,2.79999995,11.4099998,"Buckingham",71,"female",63,165,"medium",150,80,145,80,34,42,960,">70",1.6002,74.8428285,29.2281723830266 2793,173,131,69,2.5,4.44000006,"Buckingham",76,"female",61,102,"medium",160,60,160,60,31,33,1020,">70",1.5494,46.2664758,19.272556010847 2794,232,184,114,2,8.39999962,"Buckingham",91,"female",61,127,NA,170,82,NA,NA,35,38,120,">70",1.5494,57.6062983,23.9962216997801 2795,171,92,54,3.20000005,4.59000015,"Buckingham",40,"male",71,214,"medium",138,94,140,80,41,39,240,"<40",1.8034,97.0688806,29.8466704709644 3250,164,86,40,4.0999999,5.23000002,"Buckingham",23,"female",69,245,"large",126,75,NA,NA,44,47,420,"<40",1.7526,111.1302605,36.1798463094931 3750,170,69,64,2.70000005,4.38999987,"Buckingham",20,"female",64,161,"medium",108,70,NA,NA,37,40,120,"<40",1.6256,73.0284569,27.6353355917161 3751,180,84,69,2.5999999,5.19999981,"Buckingham",40,"female",68,264,"medium",142,98,130,92,43,54,240,"<40",1.7272,119.7485256,40.140697642987 3752,204,57,74,2.79999995,6.11000013,"Buckingham",52,"male",75,142,"small",140,90,NA,NA,31,35,300,"50-60",1.905,64.4101918,17.7486216821323 4000,209,113,65,3.20000005,7.44000006,"Buckingham",76,"female",60,143,"large",156,78,144,76,35,40,1200,">70",1.524,64.8637847,27.9275187119819 4500,242,108,53,4.5999999,5.46999979,"Buckingham",46,"female",62,183,"medium",130,86,NA,NA,37,45,180,"40-50",1.5748,83.0075007,33.470833352957 4501,134,105,42,3.20000005,4.28999996,"Buckingham",48,"male",70,173,"large",178,120,182,110,36,40,240,"40-50",1.778,78.4715717,24.8226896729304 4506,217,81,60,3.5999999,3.93000007,"Buckingham",22,"female",71,223,"medium",120,75,NA,NA,46,50,210,"<40",1.8034,101.1512167,31.1019042758181 4515,251,94,36,7,6.96000004,"Buckingham",58,"female",63,154,"large",174,75,NA,NA,38,41,180,"50-60",1.6002,69.8533066,27.2796275574914 4517,217,88,40,5.4000001,4.84000015,"Buckingham",34,"male",73,219,"medium",145,100,NA,NA,41,42,270,"<40",1.8542,99.3368451,28.8933041564713 4750,300,103,44,6.80000019,5.17999983,"Louisa",61,"female",67,169,"small",138,78,NA,NA,40,44,10,"60-70",1.7018,76.6572001,26.4689012681656 4751,218,87,38,5.69999981,5.51999998,"Louisa",40,"male",73,200,"small",120,76,NA,NA,38,41,210,"<40",1.8542,90.71858,26.38657913833 4753,189,96,47,4,4.38000011,"Louisa",28,"female",64,200,"medium",136,52,NA,NA,38,45,60,"<40",1.6256,90.71858,34.3296094307032 4758,185,84,52,3.5999999,5.28000021,"Louisa",53,"female",61,145,"medium",147,72,NA,NA,37,40,420,"50-60",1.5494,65.7709705,27.397260995812 4759,206,85,46,4.5,4.82000017,"Louisa",67,"male",67,178,"large",119,68,NA,NA,37,41,780,"60-70",1.7018,80.7395362,27.8784877262336 4760,218,182,54,4,10.5500002,"Louisa",51,"female",NA,215,"large",139,69,NA,NA,42,53,720,"50-60",NA,97.5224735,NA 4761,189,75,72,2.5999999,4.86000013,"Louisa",49,"female",62,205,"medium",120,80,NA,NA,40,49,840,"40-50",1.5748,92.9865445,37.4946493844601 4763,229,95,74,3.0999999,4.86000013,"Louisa",65,"female",62,151,"medium",125,64,NA,NA,37,42,660,"60-70",1.5748,68.4925279,27.6180100344072 4767,228,76,53,4.30000019,4.11000013,"Louisa",54,"male",66,170,"large",121,62,NA,NA,36,41,420,"50-60",1.6764,77.110793,27.4384683640809 4770,159,88,43,3.70000005,5.01999998,"Louisa",38,"male",68,169,"large",138,79,NA,NA,34,40,690,"<40",1.7272,76.6572001,25.696128415397 4771,249,197,44,5.69999981,9.17000008,"Louisa",64,"female",63,159,"medium",151,85,148,79,33,41,1140,"60-70",1.6002,72.1212711,28.1653297509165 4772,170,106,42,4,5.11000013,"Louisa",41,"female",61,110,"small",103,64,NA,NA,29,30,120,"40-50",1.5494,49.895219,20.7841290313056 4776,174,125,44,4,5.07000017,"Louisa",67,"male",68,198,"large",119,72,NA,NA,36,43,60,"60-70",1.7272,89.8113942,30.1055232322402 4780,204,62,70,2.9000001,4.84000015,"Louisa",27,"female",67,185,"medium",110,90,NA,NA,35,44,10,"<40",1.7018,83.9146865,28.9748327491754 4783,203,84,75,2.70000005,4.0999999,"Louisa",21,"female",63,142,"medium",125,85,117,68,28,39,900,"<40",1.6002,64.4101918,25.1539422932713 4786,241,86,63,3.79999995,4.78999996,"Louisa",41,"female",59,139,"medium",112,72,NA,NA,29,39,1560,"40-50",1.4986,63.0494131,28.07434236098 4787,245,120,39,6.30000019,7.78999996,"Louisa",47,"female",63,156,"medium",142,102,156,106,35,39,120,"40-50",1.6002,70.7604924,27.6339084348615 4789,143,91,37,3.9000001,5.1500001,"Louisa",61,"female",65,220,"large",160,92,150,98,40,50,20,"60-70",1.651,99.790438,36.6095830179826 4790,224,341,33,6.80000019,10.1499996,"Louisa",65,"male",67,197,"medium",160,80,158,80,42,43,390,"60-70",1.7018,89.3578013,30.8542813599327 4792,168,69,45,3.70000005,4.17000008,"Louisa",28,"female",63,200,"large",111,65,NA,NA,42,46,780,"<40",1.6002,90.71858,35.4280877370019 4793,184,79,39,4.69999981,4.05000019,"Louisa",41,"male",69,154,"large",136,96,130,94,34,39,600,"40-50",1.7526,69.8533066,22.7416176802528 4794,199,130,48,4.0999999,5.44000006,"Louisa",37,"female",61,203,"large",136,84,NA,NA,42,51,10,"<40",1.5494,92.0793587,38.3561653941368 4795,158,91,48,3.29999995,4.30999994,"Louisa",50,"male",71,180,"medium",136,90,126,84,36,40,45,"40-50",1.8034,81.646722,25.1046760970729 4796,209,176,55,3.79999995,9.77000046,"Louisa",57,"female",61,150,"small",115,68,NA,NA,36,39,780,"50-60",1.5494,68.038935,28.3419941335986 4801,214,111,59,3.5999999,3.8900001,"Louisa",28,"male",68,204,"medium",130,90,NA,NA,40,41,60,"<40",1.7272,92.5329516,31.0178118150354 4802,293,85,94,3.0999999,5.17000008,"Louisa",31,"female",67,200,"medium",110,90,NA,NA,41,42,240,"<40",1.7018,90.71858,31.3241435126221 4803,227,105,44,5.19999981,5.71000004,"Louisa",83,"female",59,125,"medium",150,90,156,88,35,40,300,">70",1.4986,56.6991125,25.246710756277 4805,292,235,55,5.30000019,7.86999989,"Buckingham",79,"male",70,165,NA,170,90,170,100,39,41,240,">70",1.778,74.8428285,23.6748196302515 4808,218,80,71,3.0999999,NA,"Buckingham",68,"male",70,170,"large",130,73,NA,NA,37,42,720,"60-70",1.778,77.110793,24.3922384069258 4813,244,101,36,6.80000019,4.65999985,"Buckingham",32,"male",70,212,NA,132,90,NA,NA,39,44,NA,"<40",1.778,96.1616948,30.4185561309898 4818,283,83,74,3.79999995,4.21999979,"Louisa",26,"male",72,227,"large",158,104,158,108,41,44,330,"<40",1.8288,102.9655883,30.7864546795837 4821,186,74,76,2.4000001,5.17000008,"Louisa",36,"male",69,150,"small",138,82,NA,NA,31,38,60,"<40",1.7526,68.038935,22.1509263119345 4822,273,94,49,5.5999999,3.75999999,"Louisa",53,"female",64,174,"medium",160,96,162,96,34,43,30,"50-60",1.6256,78.9251646,29.8667602047118 4823,193,77,49,3.9000001,4.30999994,"Louisa",19,"female",61,119,"small",118,70,NA,NA,32,38,300,"<40",1.5494,53.9775551,22.4846486793215 4825,194,80,34,5.69999981,4.61000013,"Buckingham",63,"male",73,175,"medium",131,88,NA,NA,34,39,30,"60-70",1.8542,79.3787575,23.0882567460387 4826,231,105,61,3.79999995,NA,"Buckingham",58,"female",63,230,"large",141,99,NA,NA,39,48,30,"50-60",1.6002,104.326367,40.7423008975522 4827,217,78,48,4.5,NA,"Buckingham",53,"female",63,158,"medium",139,79,NA,NA,33,40,720,"50-60",1.6002,71.6676782,27.9881893122315 4833,174,173,34,5.0999999,5.3499999,"Buckingham",50,"male",70,263,"large",159,99,150,89,51,64,210,"40-50",1.778,119.2949327,37.7362276530676 4835,225,84,82,2.70000005,4.36000013,"Buckingham",41,"male",71,156,"small",150,80,NA,NA,31,40,120,"40-50",1.8034,70.7604924,21.7573859507965 4840,268,85,51,5.30000019,4.40999985,"Louisa",48,"male",70,120,"small",150,105,150,100,32,35,120,"40-50",1.778,54.431148,17.2180506401829 4841,195,108,46,4.19999981,8.44999981,"Louisa",59,"female",67,172,"small",150,102,150,100,38,43,300,"50-60",1.7018,78.0179788,26.938763420855 4842,179,70,52,3.4000001,3.98000002,"Louisa",34,"male",72,170,"medium",138,82,NA,NA,31,39,1170,"<40",1.8288,77.110793,23.0559352225958 4843,215,119,44,3.9000001,9.76000023,"Louisa",63,"female",63,158,"medium",160,68,158,74,34,42,240,"60-70",1.6002,71.6676782,27.9881893122315 10000,185,76,58,3.20000005,4.82999992,"Buckingham",23,"male",76,164,"small",124,78,NA,NA,32,40,720,"<40",1.9304,74.3892356,19.9625252401474 10001,132,99,34,3.9000001,4.01000023,"Buckingham",21,"female",65,169,"large",112,62,NA,NA,39,43,180,"<40",1.651,76.6572001,28.1228160456321 10012,175,91,42,4.19999981,3.83999991,"Louisa",23,"female",65,235,"medium",110,80,NA,NA,44,50,10,"<40",1.651,106.5943315,39.1056909510269 10014,179,81,35,5.0999999,4.94999981,"Buckingham",36,"female",63,125,"medium",110,76,NA,NA,33,36,240,"<40",1.6002,56.6991125,22.1425548356262 10016,228,115,61,3.70000005,6.38999987,"Buckingham",71,"female",63,244,"large",170,92,NA,NA,48,51,660,">70",1.6002,110.6766676,43.2222670391423 10020,181,177,24,7.5,7.53000021,"Buckingham",64,"male",71,225,"large",130,66,NA,NA,44,47,180,"60-70",1.8034,102.0584025,31.3808451213411 12002,160,100,36,4.4000001,4.61999989,"Louisa",43,"female",64,140,"small",180,110,210,110,37,40,225,"40-50",1.6256,63.503006,24.0307266014923 12004,188,77,45,4.19999981,4.78999996,"Louisa",31,"female",67,227,"medium",122,70,NA,NA,47,53,140,"<40",1.7018,102.9655883,35.552902886826 12005,168,101,59,2.79999995,5.09000015,"Louisa",44,"female",64,160,"small",130,88,NA,NA,40,43,60,"40-50",1.6256,72.574864,27.4636875445626 12006,318,270,108,2.9000001,6.51000023,"Louisa",60,"female",65,167,"medium",132,72,NA,NA,38,44,30,"50-60",1.651,75.7500143,27.7900016545595 12501,192,109,44,4.4000001,4.86000013,"Buckingham",43,"female",64,325,"large",141,79,NA,NA,53,62,60,"40-50",1.6256,147.4176925,55.7856153248928 12502,209,87,34,6.0999999,4.40999985,"Buckingham",48,"female",63,121,"small",111,62,NA,NA,32,38,855,"40-50",1.6002,54.8847409,21.4339930808861 12506,129,110,42,3.0999999,6.13000011,"Buckingham",56,"male",74,151,"small",140,75,NA,NA,34,38,90,"50-60",1.8796,68.4925279,19.3870764375933 12507,160,122,41,3.9000001,6.48999977,"Buckingham",55,"female",67,223,"medium",136,83,NA,NA,43,48,960,"50-60",1.7018,101.1512167,34.9264200165736 12509,160,196,33,4.80000019,7.51000023,"Buckingham",49,"male",71,266,"large",150,98,NA,NA,49,45,90,"40-50",1.8034,120.6557114,37.0991324545633 12751,211,48,34,6.19999981,6.96999979,"Louisa",58,"male",67,177,"medium",162,78,156,82,38,43,315,"50-60",1.7018,80.2859433,27.7218670086705 12754,262,93,43,6.0999999,4.9000001,"Louisa",33,"female",63,170,"medium",110,68,NA,NA,33,46,210,"<40",1.6002,77.110793,30.1138745764516 12760,201,81,87,2.29999995,4.80999994,"Buckingham",48,"female",68,146,"small",145,95,NA,NA,32,41,600,"40-50",1.7272,66.2245634,22.1990221813489 12761,263,82,92,2.9000001,4.57999992,"Buckingham",66,"female",66,121,"small",104,64,NA,NA,31,33,30,"60-70",1.6764,54.8847409,19.5297333650223 12763,219,112,73,3,9.18000031,"Buckingham",59,"male",66,170,"medium",146,92,168,98,37,40,120,"50-60",1.6764,77.110793,27.4384683640809 12765,191,83,88,2.20000005,5.46000004,"Buckingham",45,"female",67,151,"small",130,90,NA,NA,33,38,1320,"40-50",1.7018,68.4925279,23.6497283520297 12766,171,97,69,2.5,4.03999996,"Buckingham",52,"male",71,159,"small",125,72,NA,NA,33,39,750,"50-60",1.8034,72.1212711,22.1757972190811 12768,219,112,73,3,5.23000002,"Buckingham",76,"male",64,105,"medium",125,82,NA,NA,29,33,60,">70",1.6256,47.6272545,18.0230449511192 12769,347,197,42,8.30000019,6.34000015,"Buckingham",36,"male",70,277,"large",140,86,NA,NA,51,49,900,"<40",1.778,125.6452333,39.7450002277556 12772,269,73,34,7.9000001,5.36999989,"Buckingham",41,"female",62,160,"medium",126,90,NA,NA,39,41,390,"40-50",1.5748,72.574864,29.2641165927493 12778,164,71,63,2.5999999,4.51000023,"Buckingham",20,"male",72,145,"small",108,78,NA,NA,29,36,1080,"<40",1.8288,65.7709705,19.6653565133905 13250,181,255,26,7,9.57999992,"Buckingham",50,"male",71,320,"large",140,86,NA,NA,56,49,30,"40-50",1.8034,145.149728,44.6305352836851 13254,190,84,44,4.30000019,5.55000019,"Buckingham",43,"female",62,163,"large",135,88,NA,NA,40,45,720,"40-50",1.5748,73.9356427,29.8128187788634 13500,255,112,34,7.5,5.5999999,"Louisa",82,"male",66,163,NA,179,89,172,91,37,43,60,">70",1.6764,73.9356427,26.3086490785011 13501,218,126,32,6.80000019,4.86999989,"Louisa",35,"male",69,169,"medium",139,90,136,86,39,41,720,"<40",1.7526,76.6572001,24.9567103114462 13503,223,90,48,4.5999999,5.5999999,"Buckingham",47,"female",65,232,"large",120,86,NA,NA,46,54,900,"40-50",1.651,105.2335528,38.606469364418 13505,254,342,37,6.9000001,12.9700003,"Buckingham",75,"male",68,210,"large",151,87,NA,NA,44,45,15,">70",1.7272,95.254509,31.9301003978306 14756,236,102,36,6.5999999,5.63000011,"Buckingham",62,"male",76,160,"large",150,80,NA,NA,35,39,270,"60-70",1.9304,72.574864,19.4756343806316 14758,176,92,55,3.20000005,4.5,"Buckingham",31,"female",62,145,"small",110,72,NA,NA,36,42,720,"<40",1.5748,65.7709705,26.5206056621791 15007,158,91,31,5.0999999,5.55999994,"Louisa",50,"male",70,215,"large",138,89,137,79,40,45,720,"40-50",1.778,97.5224735,30.8490073969944 15008,181,83,44,4.0999999,4.03000021,"Louisa",39,"female",66,255,"medium",140,98,NA,NA,46,54,210,"<40",1.6764,115.6661895,41.1577025461213 15010,151,85,48,3.0999999,4.38000011,"Louisa",33,"male",69,308,"large",110,90,NA,NA,52,58,300,"<40",1.7526,139.7066132,45.4832353605056 15012,115,239,36,3.20000005,13.6000004,"Louisa",58,"male",69,NA,"medium",125,69,NA,NA,30,37,10,"50-60",1.7526,NA,NA 15013,271,121,40,6.80000019,4.57000017,"Louisa",81,"female",64,158,"medium",146,76,NA,NA,36,43,10,">70",1.6256,71.6676782,27.1203914502556 15016,190,92,44,4.30000019,4.65999985,"Louisa",27,"female",65,210,"medium",150,106,160,116,39,47,60,"<40",1.651,95.254509,34.9455110626198 15017,118,95,39,3,4.71000004,"Louisa",47,"female",64,123,"small",140,76,NA,NA,30,36,300,"40-50",1.6256,55.7919267,21.1127097998825 15250,168,82,44,3.79999995,4.4000001,"Buckingham",33,"female",66,118,"small",98,66,NA,NA,29,35,150,"<40",1.6764,53.5239622,19.0455250997738 15252,254,121,39,6.5,9.25,"Buckingham",67,"male",68,167,"large",161,118,151,111,36,39,60,"60-70",1.7272,75.7500143,25.3920322211319 15260,193,77,45,4.30000019,4.73999977,"Buckingham",42,"female",75,186,"medium",125,90,NA,NA,37,46,60,"40-50",1.905,84.3682794,23.2481945977225 15264,187,84,64,2.9000001,4.4000001,"Buckingham",21,"female",63,158,"small",138,88,NA,NA,39,43,180,"<40",1.6002,71.6676782,27.9881893122315 15271,212,79,49,4.30000019,5.48999977,"Buckingham",51,"female",65,145,"small",230,120,235,120,38,42,60,"50-60",1.651,65.7709705,24.1290433527613 15274,170,76,60,2.79999995,3.44000006,"Buckingham",27,"female",63,119,"small",122,86,NA,NA,28,37,270,"<40",1.6002,53.9775551,21.0797122035161 15276,215,110,36,6,9.81999969,"Louisa",51,"female",67,282,"medium",142,78,136,84,52,59,420,"50-60",1.7018,127.9131978,44.1670423527971 15277,199,85,59,3.4000001,4.96000004,"Louisa",71,"male",69,171,"large",136,86,NA,NA,38,40,240,">70",1.7526,77.5643859,25.2520559956054 15278,140,385,31,4.5,11.5900002,"Louisa",50,"male",69,172,"large",138,66,NA,NA,37,41,210,"40-50",1.7526,78.0179788,25.3997288376849 15279,216,79,46,4.69999981,4.40999985,"Louisa",54,"female",65,138,"small",132,80,NA,NA,33,39,990,"50-60",1.651,62.5958202,22.9641929840073 15500,204,113,35,5.80000019,4.44000006,"Buckingham",59,"male",73,187,"medium",148,76,148,78,38,37,90,"50-60",1.8542,84.8218723,24.6714514943385 15501,193,248,24,8,7.13999987,"Buckingham",59,"female",66,189,"medium",140,90,NA,NA,38,45,90,"50-60",1.6764,85.7290581,30.5051207106546 15502,267,133,34,7.9000001,8.81000042,"Louisa",40,"female",59,204,"small",118,69,NA,NA,40,47,780,"<40",1.4986,92.5329516,41.2026319542441 15512,201,106,53,3.79999995,5.3499999,"Louisa",58,"male",66,215,"large",186,102,190,110,46,44,360,"50-60",1.6764,97.5224735,34.7015923428082 15513,204,120,44,4.5999999,4.69000006,"Louisa",72,"male",65,167,"large",140,72,NA,NA,45,46,480,">70",1.651,75.7500143,27.7900016545595 15514,246,104,62,4,7.4000001,"Louisa",66,"female",66,189,"medium",200,94,208,90,45,46,195,"60-70",1.6764,85.7290581,30.5051207106546 15515,229,91,43,5.30000019,4.73000002,"Louisa",23,"male",72,180,"small",110,78,NA,NA,34,41,60,"<40",1.8288,81.646722,24.4121667062779 15516,172,101,46,3.70000005,4.51999998,"Louisa",42,"female",65,165,"small",118,68,NA,NA,33,45,150,"40-50",1.651,74.8428285,27.457187263487 15517,197,120,37,5.30000019,4.94999981,"Louisa",43,"male",71,179,"medium",146,98,136,96,37,44,30,"40-50",1.8034,81.1931291,24.9652056743114 15518,205,79,32,6.4000001,4.21000004,"Louisa",75,"male",69,204,"large",136,90,NA,NA,44,42,120,">70",1.7526,92.5329516,30.125259784231 15519,219,106,50,4.4000001,4.55999994,"Louisa",65,"female",63,233,"large",140,90,136,86,40,53,45,"60-70",1.6002,105.6871457,41.2737222136072 15520,174,90,36,4.80000019,5.3499999,"Louisa",34,"male",71,210,"medium",142,92,148,98,37,43,90,"<40",1.8034,95.254509,29.2887887799184 15521,192,89,30,6.4000001,4.03999996,"Louisa",37,"male",71,195,"medium",136,96,130,98,36,43,630,"<40",1.8034,88.4506155,27.1967324384956 15522,206,94,44,4.69999981,5.48999977,"Louisa",61,"female",63,199,"medium",180,96,176,94,41,47,720,"60-70",1.6002,90.2649871,35.2509472983169 15527,160,71,44,3.5999999,4.63999987,"Louisa",36,"female",64,185,"medium",110,80,NA,NA,39,45,300,"<40",1.6256,83.9146865,31.7548887234005 15529,216,109,86,2.5,4.4000001,"Louisa",45,"female",67,147,"medium",140,102,148,102,32,38,80,"40-50",1.7018,66.6781563,23.0232454817772 15540,236,111,82,2.9000001,5.23999977,"Louisa",68,"female",61,119,"small",142,96,140,86,29,37,135,"60-70",1.5494,53.9775551,22.4846486793215 15542,205,88,41,5,NA,"Louisa",57,"male",66,171,"medium",132,82,NA,NA,37,40,210,"50-60",1.6764,77.5643859,27.5998711191637 15545,206,112,33,6.19999981,4.03000021,"Louisa",41,"female",62,184,"small",104,80,NA,NA,39,44,10,"40-50",1.5748,83.4610936,33.6537340816617 15546,143,371,46,3.0999999,4.80999994,"Louisa",68,"male",67,158,"small",138,82,NA,NA,37,43,90,"60-70",1.7018,71.6676782,24.7460733749714 15757,173,83,37,4.69999981,4.30999994,"Buckingham",40,"female",NA,130,"small",122,76,NA,NA,37,38,360,"<40",NA,58.967077,NA 15758,235,91,37,6.4000001,5.23000002,"Buckingham",79,"female",65,134,"small",142,70,NA,NA,34,38,240,">70",1.651,60.7814486,22.2985642018621 15760,169,95,29,5.80000019,5.21999979,"Buckingham",62,"male",66,251,"large",118,72,NA,NA,50,47,720,"60-70",1.6764,113.8518179,40.51209152579 15761,283,145,39,7.30000019,8.25,"Buckingham",63,"female",61,200,"medium",190,110,170,90,44,48,720,"60-70",1.5494,90.71858,37.7893255114648 15762,174,93,77,2.29999995,4.94999981,"Buckingham",55,"male",70,140,"medium",118,86,NA,NA,32,33,120,"50-60",1.778,63.503006,20.0877257468801 15763,271,103,90,3,4.01000023,"Buckingham",55,"female",63,114,"small",180,105,165,105,30,37,15,"50-60",1.6002,51.7095906,20.1940100100911 15766,203,94,62,3.29999995,4.67000008,"Buckingham",27,"female",67,209,"medium",140,80,NA,NA,34,43,780,"<40",1.7018,94.8009161,32.7337299706901 15773,188,174,24,7.80000019,6.17000008,"Louisa",66,"male",68,210,"large",160,78,158,84,45,48,60,"60-70",1.7272,95.254509,31.9301003978306 15777,293,87,120,2.4000001,4.76000023,"Louisa",63,"female",64,179,"medium",142,80,142,90,47,45,30,"60-70",1.6256,81.1931291,30.7250004404794 15779,215,80,100,2.20000005,4.65999985,"Louisa",78,"male",65,109,"small",170,88,180,100,33,34,435,">70",1.651,49.4416261,18.138384313455 15782,207,77,46,4.5,4.82000017,"Buckingham",68,"male",55,130,"small",199,115,190,99,29,33,120,"60-70",1.397,58.967077,30.2145957515056 15787,179,77,72,2.5,4.96999979,"Buckingham",31,"male",66,145,"medium",131,79,NA,NA,33,38,150,"<40",1.6764,65.7709705,23.4033994870102 15792,202,81,55,3.70000005,5.5,"Buckingham",64,"female",62,167,"medium",190,118,NA,NA,44,47,120,"60-70",1.5748,75.7500143,30.5444216936821 15795,211,98,40,5.30000019,3.54999995,"Buckingham",40,"female",68,179,"small",110,76,NA,NA,37,43,60,"<40",1.7272,81.1931291,27.2166093867222 15797,211,225,29,7.30000019,10.0900002,"Buckingham",61,"female",63,144,"medium",190,100,170,86,40,42,120,"60-70",1.6002,65.3173776,25.5082231706414 15798,151,74,47,3.20000005,4.01000023,"Buckingham",28,"male",69,130,"small",135,75,NA,NA,29,35,720,"<40",1.7526,58.967077,19.1974694703433 15799,171,85,61,2.79999995,5.0999999,"Buckingham",34,"female",63,164,"medium",120,80,NA,NA,34,43,60,"<40",1.6002,74.3892356,29.0510319443415 15800,342,251,48,7.0999999,12.6700001,"Buckingham",63,"female",65,201,"medium",178,88,160,82,45,46,180,"60-70",1.651,91.1721729,33.4478463027932 15801,179,236,63,2.79999995,12.0699997,"Buckingham",55,"male",75,186,"medium",122,74,NA,NA,38,38,180,"50-60",1.905,84.3682794,23.2481945977225 15802,155,58,69,2.20000005,4.17000008,"Buckingham",26,"male",73,174,"small",110,76,NA,NA,30,35,180,"<40",1.8542,78.9251646,22.9563238503471 15805,197,92,46,4.30000019,4.75,"Buckingham",36,"female",64,136,"small",NA,NA,NA,NA,32,37,NA,"<40",1.6256,61.6886344,23.3441344128782 15812,200,56,51,3.9000001,3.54999995,"Buckingham",40,"female",62,105,"small",125,64,NA,NA,26,33,720,"<40",1.5748,47.6272545,19.2045765139917 15813,237,96,52,4.5999999,NA,"Buckingham",45,"male",69,130,"small",137,74,NA,NA,33,35,720,"40-50",1.7526,58.967077,19.1974694703433 15814,198,118,46,4.30000019,4.44000006,"Buckingham",68,"female",63,124,"medium",130,70,NA,NA,32,38,60,"60-70",1.6002,56.2455196,21.9654143969412 15815,240,88,49,4.9000001,4.92000008,"Buckingham",82,"female",63,170,"medium",180,86,NA,NA,41,46,720,">70",1.6002,77.110793,30.1138745764516 15816,192,56,42,4.5999999,4.59000015,"Buckingham",60,"female",62,134,"small",130,70,NA,NA,31,40,90,"50-60",1.5748,60.7814486,24.5086976464276 15818,145,84,54,2.70000005,4.73000002,"Buckingham",30,"female",65,165,"small",102,56,NA,NA,33,42,720,"<40",1.651,74.8428285,27.457187263487 15820,269,59,66,4.0999999,5.13999987,"Buckingham",41,"male",67,191,"large",130,73,NA,NA,38,41,240,"40-50",1.7018,86.6362439,29.9145570545541 15821,240,96,57,4.19999981,5.73999977,"Buckingham",54,"female",65,175,"medium",152,100,140,100,37,43,60,"50-60",1.651,79.3787575,29.1212592188498 15827,205,83,42,4.9000001,4.86999989,"Buckingham",72,"female",61,180,NA,170,90,150,100,39,47,240,">70",1.5494,81.646722,34.0103929603183 15828,266,82,54,4.9000001,5.40999985,"Buckingham",47,"male",68,142,"medium",118,78,NA,NA,35,39,120,"40-50",1.7272,64.4101918,21.5908297928188 16000,188,88,51,3.70000005,5.13000011,"Buckingham",50,"female",61,147,"large",160,66,150,80,34,41,720,"40-50",1.5494,66.6781563,27.7751542509266 16001,222,82,87,2.5999999,4.63999987,"Buckingham",51,"female",66,110,"small",150,110,150,90,28,37,270,"50-60",1.6764,49.895219,17.7543030591112 16003,142,155,25,5.69999981,6.96000004,"Buckingham",45,"male",69,204,"large",165,115,160,96,40,43,720,"40-50",1.7526,92.5329516,30.125259784231 16004,268,90,48,5.5999999,5.36000013,"Buckingham",38,"female",63,181,"medium",142,100,144,110,38,46,210,"<40",1.6002,82.1003149,32.0624194019867 16005,174,105,117,1.5,5.53000021,"Buckingham",20,"male",70,187,"medium",132,86,NA,NA,37,41,210,"<40",1.778,84.8218723,26.8314622476184 16016,214,87,35,6.0999999,5.38000011,"Buckingham",44,"female",NA,190,"large",140,75,NA,NA,38,44,720,"40-50",NA,86.182651,NA 17002,194,54,57,3.4000001,4.26000023,"Louisa",63,"male",70,181,"large",184,76,180,84,37,42,60,"60-70",1.778,82.1003149,25.9705597156092 17751,196,115,62,3.20000005,4.34000015,"Louisa",50,"male",67,140,"medium",176,110,150,102,35,37,60,"40-50",1.7018,63.503006,21.9269004588354 17752,207,187,46,4.5,8.56999969,"Louisa",44,"female",67,201,"large",150,74,146,76,46,49,30,"40-50",1.7018,91.1721729,31.4807642301852 17754,204,89,56,3.5999999,5.01999998,"Louisa",48,"male",68,196,"medium",170,96,178,96,38,42,90,"40-50",1.7272,88.9042084,29.8014270379752 17755,189,84,46,4.0999999,4.36000013,"Louisa",41,"female",63,153,"medium",130,80,NA,NA,32,40,15,"40-50",1.6002,69.3997137,27.1024871188064 17756,179,77,50,3.5999999,3.32999992,"Buckingham",29,"male",68,170,"small",122,68,NA,NA,38,39,300,"<40",1.7272,77.110793,25.8481765125295 17757,159,100,54,2.9000001,4.17999983,"Buckingham",76,"male",66,188,"large",116,53,NA,NA,40,41,180,">70",1.6764,85.2754652,30.3437179555718 17760,260,68,60,4.30000019,4.78000021,"Buckingham",69,"female",59,179,"large",158,98,159,80,45,48,180,"60-70",1.4986,81.1931291,36.1532898029887 17762,228,79,37,6.19999981,4.73999977,"Buckingham",26,"male",72,259,"large",122,90,NA,NA,48,49,720,"<40",1.8288,117.4805611,35.1263954273665 17765,242,74,55,4.4000001,3.97000003,"Buckingham",70,"female",66,200,"medium",140,65,NA,NA,41,47,180,"60-70",1.6764,90.71858,32.2805510165658 17766,227,98,66,3.4000001,6.42000008,"Buckingham",25,"male",71,162,"medium",123,82,NA,NA,35,39,900,"<40",1.8034,73.4820498,22.5942084873656 17767,208,122,51,4.0999999,6.48000002,"Buckingham",42,"female",62,141,"large",118,78,NA,NA,33,40,720,"40-50",1.5748,63.9565989,25.7890027473603 17771,208,95,32,6.5,5.5999999,"Buckingham",56,"male",68,183,"medium",131,75,NA,NA,36,39,20,"50-60",1.7272,83.0075007,27.8248017752523 17772,209,89,43,4.9000001,4.8499999,"Buckingham",31,"female",67,160,"medium",108,58,NA,NA,30,44,240,"<40",1.7018,72.574864,25.0593148100977 17773,163,83,57,2.9000001,4.61000013,"Buckingham",31,"female",65,120,"small",136,86,NA,NA,29,40,240,"<40",1.651,54.431148,19.9688634643541 17776,201,100,46,4.4000001,4.0999999,"Buckingham",27,"female",65,145,"small",121,75,NA,NA,32,35,60,"<40",1.651,65.7709705,24.1290433527613 17781,237,118,45,5.30000019,7.51000023,"Buckingham",73,"female",64,174,"large",162,75,NA,NA,38,44,300,">70",1.6256,78.9251646,29.8667602047118 17784,176,90,34,5.19999981,4.23999977,"Buckingham",32,"female",63,252,"medium",100,72,NA,NA,45,58,180,"<40",1.6002,114.3054108,44.6393905486224 17790,146,79,41,3.5999999,4.76000023,"Buckingham",19,"female",60,135,"medium",108,58,NA,NA,33,40,240,"<40",1.524,61.2350415,26.3651400427801 17791,231,70,110,2.0999999,3.75,"Buckingham",71,"female",63,155,"small",150,78,NA,NA,33,41,900,">70",1.6002,70.3068995,27.4567679961765 17794,241,92,40,6,5.03999996,"Buckingham",27,"female",63,179,"medium",120,75,NA,NA,40,42,720,"<40",1.6002,81.1931291,31.7081385246167 17795,305,91,44,6.9000001,5.34000015,"Buckingham",31,"male",71,211,"large",100,60,NA,NA,40,45,540,"<40",1.8034,95.7081019,29.4282592026799 17800,149,77,49,3,4.5,"Buckingham",20,"female",62,115,"small",105,82,NA,NA,31,37,720,"<40",1.5748,52.1631835,21.0335838010386 17802,183,69,51,3.5999999,4.36999989,"Buckingham",31,"female",66,190,"medium",125,70,NA,NA,41,47,720,"<40",1.6764,86.182651,30.6665234657375 17805,235,109,59,4,7.48000002,"Buckingham",62,"female",63,290,"large",175,80,152,102,55,62,300,"60-70",1.6002,131.541941,51.3707272186527 17808,244,101,39,6.30000019,4.36000013,"Buckingham",44,"male",71,168,"medium",140,89,NA,NA,36,39,720,"40-50",1.8034,76.2036072,23.4310310239347 17813,199,153,77,2.5999999,4.73999977,"Buckingham",36,"female",66,255,"large",118,66,NA,NA,47,52,360,"<40",1.6764,115.6661895,41.1577025461213 17814,224,85,30,7.5,5.26000023,"Buckingham",36,"male",69,205,"medium",150,99,130,80,37,41,360,"<40",1.7526,92.9865445,30.2729326263105 17816,173,225,31,5.5999999,10.4700003,"Buckingham",47,"male",73,260,"medium",150,98,142,90,42,47,60,"40-50",1.8542,117.934154,34.302552879829 17817,192,124,31,5.5999999,5.17000008,"Buckingham",30,"male",72,250,"medium",142,79,NA,NA,43,51,120,"<40",1.8288,113.398225,33.9057870920526 17818,157,91,34,4.5999999,5.69999981,"Buckingham",63,"male",69,166,"large",106,82,NA,NA,39,38,420,"60-70",1.7526,75.2964214,24.5136917852076 17819,172,117,56,3.0999999,3.58999991,"Buckingham",48,"female",63,170,"medium",130,82,NA,NA,35,42,240,"40-50",1.6002,77.110793,30.1138745764516 17828,170,67,33,5.19999981,6.42000008,"Buckingham",65,"male",69,182,"large",140,65,NA,NA,42,39,270,"60-70",1.7526,82.5539078,26.8764572584806 17829,215,97,46,4.69999981,5.03000021,"Buckingham",59,"female",63,176,"large",140,70,NA,NA,34,44,60,"50-60",1.6002,79.8323504,31.1767172085617 17830,214,67,47,4.5999999,4.40999985,"Buckingham",37,"female",64,145,"medium",108,76,NA,NA,34,42,90,"<40",1.6256,65.7709705,24.8889668372598 17834,195,171,29,6.69999981,5.67999983,"Buckingham",78,"male",66,172,"large",130,82,NA,NA,40,40,60,">70",1.6764,78.0179788,27.7612738742466 17835,230,86,37,6.19999981,4.38999987,"Buckingham",23,"male",71,277,"large",150,99,150,85,50,49,840,"<40",1.8034,125.6452333,38.6333071049399 17841,206,90,38,5.4000001,4.07000017,"Buckingham",38,"female",69,167,"medium",138,90,NA,NA,36,47,90,"<40",1.7526,75.7500143,24.6613646272871 17846,147,86,34,4.30000019,4.61999989,"Buckingham",38,"male",69,205,"small",130,96,130,90,39,41,480,"<40",1.7526,92.9865445,30.2729326263105 17849,234,78,54,4.30000019,3.70000005,"Buckingham",41,"male",67,183,"medium",122,96,126,96,38,40,NA,"40-50",1.7018,83.0075007,28.6615913140492 20254,135,88,34,4,3.96000004,"Buckingham",29,"female",65,123,"small",118,61,NA,NA,26,37,240,"<40",1.651,55.7919267,20.468085050963 20258,226,68,83,2.70000005,NA,"Buckingham",49,"female",63,128,"small",121,75,NA,NA,31,36,720,"40-50",1.6002,58.0598912,22.6739761516812 20260,179,75,36,5,4.75,"Buckingham",23,"female",65,183,"medium",120,80,NA,NA,43,45,720,"<40",1.651,83.0075007,30.4525167831401 20261,163,69,48,3.4000001,4.30999994,"Buckingham",29,"female",62,99,"small",125,60,NA,NA,30,36,720,"<40",1.5748,44.9056971,18.1071721417636 20267,191,74,33,5.80000019,5.3499999,"Louisa",40,"male",72,270,"large",136,70,NA,NA,45,49,150,"<40",1.8288,122.470083,36.6182500594168 20271,138,95,40,3.5,4.80000019,"Louisa",38,"female",60,138,"small",140,90,NA,NA,31,39,330,"<40",1.524,62.5958202,26.9510320437308 20272,184,92,36,5.0999999,4.80999994,"Louisa",40,"female",63,285,"large",142,98,142,96,50,60,690,"<40",1.6002,129.2739765,50.4850250252277 20274,181,101,44,4.0999999,4.88000011,"Louisa",29,"male",68,180,"medium",130,78,NA,NA,38,42,720,"<40",1.7272,81.646722,27.3686574838548 20275,224,98,44,5.0999999,5.05000019,"Louisa",78,"female",63,160,"large",150,81,NA,NA,36,45,300,">70",1.6002,72.574864,28.3424701896015 20278,293,115,54,5.4000001,4.86999989,"Buckingham",50,"male",71,170,"medium",131,75,NA,NA,34,39,120,"40-50",1.8034,77.110793,23.7099718694577 20279,147,78,42,3.5,4.67000008,"Buckingham",23,"female",61,185,NA,127,71,NA,NA,43,47,600,"<40",1.5494,83.9146865,34.9551260981049 20288,198,92,62,3.20000005,4.42999983,"Louisa",60,"male",70,163,"medium",126,78,NA,NA,36,40,795,"50-60",1.778,73.9356427,23.3878521195818 20289,152,103,32,4.80000019,4.26999998,"Louisa",40,"female",52,187,"medium",148,82,158,80,38,49,135,"<40",1.3208,84.8218723,48.6221024457582 20290,277,119,62,4.5,5.03000021,"Louisa",60,"female",61,128,"small",140,86,128,74,33,39,240,"50-60",1.5494,58.0598912,24.1851683273375 20292,219,105,63,3.5,4.4000001,"Louisa",40,"female",62,153,"small",106,82,NA,NA,36,44,10,"<40",1.5748,69.3997137,27.9838114918165 20293,182,74,44,4.0999999,4.67000008,"Louisa",30,"female",62,125,"medium",132,80,NA,NA,31,39,480,"<40",1.5748,56.6991125,22.8625910880854 20294,135,88,47,2.9000001,4.21000004,"Louisa",21,"male",69,155,"small",110,68,NA,NA,31,39,10,"<40",1.7526,70.3068995,22.8892905223324 20298,277,88,45,6.19999981,5.23999977,"Louisa",63,"female",64,223,"medium",220,100,202,98,45,54,375,"60-70",1.6256,101.1512167,38.2775145152341 20306,212,82,68,3.0999999,4.61000013,"Louisa",63,"male",70,161,"medium",180,110,190,114,37,40,30,"60-70",1.778,73.0284569,23.1008846089121 20308,162,76,40,4.0999999,4.4000001,"Louisa",43,"male",67,216,"large",100,70,NA,NA,41,44,30,"40-50",1.7018,97.9760664,33.8300749936318 20309,207,102,43,4.80000019,5.01000023,"Louisa",46,"female",63,179,"medium",212,114,210,112,38,46,150,"40-50",1.6002,81.1931291,31.7081385246167 20312,255,100,34,7.5,6.05999994,"Louisa",64,"male",68,227,"medium",134,74,NA,NA,44,47,270,"60-70",1.7272,102.9655883,34.5149180490835 20313,404,206,33,12.1999998,10.75,"Louisa",56,"male",69,159,"medium",162,88,150,80,38,39,570,"50-60",1.7526,72.1212711,23.4799818906506 20314,239,97,55,4.30000019,4.69000006,"Louisa",35,"male",74,170,"small",122,62,NA,NA,32,38,720,"<40",1.8796,77.110793,21.8265098966283 20315,220,95,58,3.79999995,5.63000011,"Louisa",59,"female",66,138,"small",138,80,NA,NA,32,38,30,"50-60",1.6764,62.5958202,22.2735802014304 20318,165,76,46,3.5999999,3.69000006,"Louisa",22,"female",63,114,"small",112,78,NA,NA,28,35,120,"<40",1.6002,51.7095906,20.1940100100911 20325,243,74,42,5.80000019,3.8499999,"Louisa",43,"female",64,239,"medium",128,90,138,90,48,53,330,"40-50",1.6256,108.4087031,41.0238832696904 20329,149,138,50,3,4.09000015,"Louisa",26,"female",62,174,"medium",148,92,138,84,38,46,10,"<40",1.5748,78.9251646,31.8247267946149 20332,178,64,52,3.4000001,4.0999999,"Louisa",41,"female",65,188,"small",130,76,NA,NA,35,46,5,"40-50",1.651,85.2754652,31.2845527608215 20335,190,228,57,3.29999995,9.27999973,"Louisa",43,"female",65,198,"small",110,64,NA,NA,40,49,60,"40-50",1.651,89.8113942,32.9486247161843 20337,226,97,70,3.20000005,3.88000011,"Louisa",20,"female",64,114,"small",122,64,NA,NA,31,39,90,"<40",1.6256,51.7095906,19.5678773755008 20340,132,83,40,3.29999995,5.69999981,"Louisa",28,"female",68,225,"medium",136,86,NA,NA,41,52,105,"<40",1.7272,102.0584025,34.2108218548185 20343,160,82,41,3.9000001,2.8499999,"Louisa",30,"female",63,143,"medium",172,124,176,124,33,40,30,"<40",1.6002,64.8637847,25.3310827319563 20346,204,173,37,5.5,13.0600004,"Louisa",66,"male",67,146,"medium",138,78,NA,NA,36,48,1260,"60-70",1.7018,66.2245634,22.8666247642141 20350,164,91,67,2.4000001,3.97000003,"Louisa",20,"female",70,141,"small",122,86,NA,NA,32,39,390,"<40",1.778,63.9565989,20.2312095022149 20352,155,81,70,2.20000005,3.02999997,"Louisa",32,"female",65,151,"small",120,68,NA,NA,33,40,420,"<40",1.651,68.4925279,25.127486525979 20355,251,118,38,6.5999999,5.51000023,"Louisa",38,"female",64,248,"medium",110,80,NA,NA,49,58,15,"<40",1.6256,112.4910392,42.568715694072 20361,198,86,66,3,5.67999983,"Louisa",61,"male",74,152,"small",138,76,NA,NA,33,38,420,"60-70",1.8796,68.9461208,19.5154676722794 20365,179,90,60,3,4.19999981,"Louisa",26,"female",60,130,"small",138,84,NA,NA,32,40,270,"<40",1.524,58.967077,25.388653374529 20367,223,88,42,5.30000019,6.44000006,"Louisa",74,"female",62,165,"medium",250,100,NA,NA,41,46,60,">70",1.5748,74.8428285,30.1786202362727 20368,207,71,41,5,9.61999989,"Louisa",72,"male",70,180,"medium",138,88,NA,NA,39,40,45,">70",1.778,81.646722,25.8270759602744 20369,244,89,92,2.70000005,4.53999996,"Louisa",21,"male",71,163,"medium",116,76,NA,NA,34,39,180,"<40",1.8034,73.9356427,22.7336789101271 20750,245,119,26,9.39999962,7.51000023,"Louisa",36,"male",66,179,"large",150,92,130,86,37,42,390,"<40",1.6764,81.1931291,28.8910931598264 20754,191,81,53,3.5999999,5.63000011,"Louisa",42,"female",61,156,"medium",138,84,NA,NA,36,42,150,"40-50",1.5494,70.7604924,29.4756738989425 20761,221,120,83,2.70000005,5.76999998,"Louisa",66,"female",64,130,"small",110,64,NA,NA,31,38,15,"60-70",1.6256,58.967077,22.3142461299571 20762,300,65,59,5.0999999,4.55999994,"Louisa",34,"female",NA,160,"small",120,60,NA,NA,40,47,300,"<40",NA,72.574864,NA 20765,173,85,58,3,4.4000001,"Buckingham",43,"female",69,210,"medium",130,75,NA,NA,44,47,720,"40-50",1.7526,95.254509,31.0112968367084 20768,138,81,45,3.0999999,4.69999981,"Buckingham",57,"male",73,164,"small",148,81,NA,NA,31,37,240,"50-60",1.8542,74.3892356,21.6369948934306 20773,203,71,78,2.5999999,2.8499999,"Louisa",45,"male",66,115,"small",135,88,NA,NA,30,34,15,"40-50",1.6764,52.1631835,18.5613168345253 20774,260,67,46,5.69999981,5.34000015,"Louisa",44,"female",62,159,"small",140,94,130,95,36,43,330,"40-50",1.5748,72.1212711,29.0812158640446 20775,166,77,68,2.4000001,4.94999981,"Louisa",27,"male",72,141,"small",110,58,NA,NA,33,38,120,"<40",1.8288,63.9565989,19.1228639199177 20782,180,92,34,5.30000019,3.58999991,"Buckingham",63,"male",69,169,"small",145,72,142,70,35,39,30,"60-70",1.7526,76.6572001,24.9567103114462 20783,159,172,28,5.69999981,8.22999954,"Buckingham",65,"male",70,181,"large",142,81,NA,NA,43,49,480,"60-70",1.778,82.1003149,25.9705597156092 20784,207,75,44,4.69999981,5.05999994,"Buckingham",30,"male",72,180,"small",118,62,NA,NA,35,41,180,"<40",1.8288,81.646722,24.4121667062779 20787,298,84,50,6,NA,"Buckingham",28,"male",66,209,"medium",131,111,130,80,42,46,300,"<40",1.6764,94.8009161,33.7331758123112 20790,203,104,36,5.5999999,NA,"Buckingham",41,"male",71,210,NA,140,112,138,89,37,42,30,"40-50",1.8034,95.254509,29.2887887799184 21254,191,155,58,3.29999995,8.06000042,"Buckingham",31,"female",62,237,"large",140,87,NA,NA,53,56,240,"<40",1.5748,107.5015173,43.3474727030099 21255,231,84,91,2.5,4.9000001,"Buckingham",33,"male",69,163,"small",140,70,NA,NA,35,38,150,"<40",1.7526,73.9356427,24.0706732589689 21257,184,76,42,4.4000001,4.71000004,"Buckingham",66,"male",74,185,"medium",130,75,NA,NA,40,41,180,"60-70",1.8796,83.9146865,23.752378416919 21281,164,94,58,2.79999995,3.79999995,"Buckingham",28,"female",67,180,"small",128,94,124,96,39,43,270,"<40",1.7018,81.646722,28.1917291613599 21284,134,101,36,3.70000005,4.67000008,"Buckingham",25,"female",63,245,NA,142,78,141,80,47,58,10,"<40",1.6002,111.1302605,43.3994074778273 21298,220,60,66,3.29999995,10.9700003,"Buckingham",26,"male",70,150,"small",136,88,NA,NA,33,39,300,"<40",1.778,68.038935,21.5225633002286 21318,180,76,46,3.9000001,4.42999983,"Louisa",40,"female",64,146,"medium",128,82,NA,NA,37,43,240,"<40",1.6256,66.2245634,25.0606148844134 21320,216,155,30,7.19999981,5.90999985,"Louisa",38,"male",68,145,"medium",110,60,NA,NA,34,37,20,"<40",1.7272,65.7709705,22.0469740842163 21321,158,74,64,2.5,2.73000002,"Louisa",30,"female",62,142,"medium",108,68,NA,NA,NA,NA,330,"<40",1.5748,64.4101918,25.971903476065 21322,261,101,83,3.0999999,5.11999989,"Louisa",52,"female",64,198,"medium",152,92,162,92,42,49,20,"50-60",1.6256,89.8113942,33.9863133363962 21323,172,70,36,4.80000019,3.77999997,"Louisa",22,"female",64,148,"small",90,48,NA,NA,35,38,240,"<40",1.6256,67.1317492,25.4039109787204 21329,249,81,28,8.89999962,5.11999989,"Louisa",51,"female",65,200,"medium",122,90,NA,NA,43,46,150,"50-60",1.651,90.71858,33.2814391072569 21333,189,80,40,4.69999981,3.61999989,"Louisa",45,"male",69,190,"large",140,75,NA,NA,39,44,300,"40-50",1.7526,86.182651,28.0578399951171 21334,225,74,36,6.30000019,4.65999985,"Louisa",53,"female",63,182,"large",126,80,NA,NA,38,46,540,"50-60",1.6002,82.5539078,32.2395598406717 21338,193,75,49,3.9000001,5.01000023,"Louisa",21,"female",61,220,"small",130,82,NA,NA,40,52,240,"<40",1.5494,99.790438,41.5682580626113 21341,219,78,67,3.29999995,3.75,"Louisa",53,"female",64,179,"medium",135,100,170,98,39,47,150,"50-60",1.6256,81.1931291,30.7250004404794 21343,156,86,34,4.5999999,4.55000019,"Louisa",37,"female",67,212,"small",122,74,NA,NA,48,51,150,"<40",1.7018,96.1616948,33.2035921233794 21345,224,71,42,5.30000019,4.92000008,"Louisa",34,"female",60,165,"medium",135,80,NA,NA,34,46,30,"<40",1.524,74.8428285,32.2240600522868 21346,181,77,46,3.9000001,4.09000015,"Louisa",30,"female",66,257,"medium",162,108,158,110,47,55,60,"<40",1.6764,116.5733753,41.480508056287 21347,306,92,56,5.5,5.57999992,"Louisa",74,"male",69,184,"large",140,72,NA,NA,39,41,195,">70",1.7526,83.4610936,27.1718029426397 21357,122,82,43,2.79999995,3.98000002,"Louisa",36,"female",71,183,NA,110,80,NA,NA,41,45,90,"<40",1.8034,83.0075007,25.5230873653574 21359,219,130,44,5,7.21999979,"Louisa",45,"male",67,218,"large",172,110,168,108,41,45,180,"40-50",1.7018,98.8832522,34.143316428758 40251,150,80,38,3.9000001,3.97000003,"Louisa",35,"male",73,179,"medium",138,92,135,88,32,37,450,"<40",1.8542,81.1931291,23.6159883288053 40253,185,67,59,3.0999999,4.6500001,"Louisa",50,"female",64,228,"medium",142,90,142,92,42,54,225,"40-50",1.6256,103.4191812,39.1357547510017 40500,226,100,65,3.5,4.82999992,"Louisa",27,"male",69,289,"large",130,100,170,114,48,51,75,"<40",1.7526,131.0883481,42.6774513609939 40501,206,83,68,3,4.88000011,"Louisa",52,"male",69,153,"small",140,98,142,102,36,40,195,"50-60",1.7526,69.3997137,22.5939448381732 40502,199,81,36,5.5,4.92999983,"Louisa",42,"female",67,235,"large",178,100,170,96,47,52,210,"40-50",1.7018,106.5943315,36.8058686273309 40751,239,85,63,3.79999995,5.15999985,"Louisa",39,"male",60,144,"medium",162,90,152,90,33,42,180,"<40",1.524,65.3173776,28.1228160456321 40754,235,106,37,6.4000001,6.78000021,"Louisa",73,"male",65,183,"large",134,78,NA,NA,43,46,195,">70",1.651,83.0075007,30.4525167831401 40755,184,99,36,5.0999999,4.15999985,"Louisa",28,"male",67,154,"small",124,94,110,74,35,38,330,"<40",1.7018,69.8533066,24.119590504719 40762,242,297,34,7.0999999,12.1599998,"Louisa",53,"male",69,216,"large",142,96,142,98,43,45,285,"50-60",1.7526,97.9760664,31.8973338891857 40764,307,87,58,5.30000019,4.28000021,"Louisa",49,"male",67,181,"small",120,80,NA,NA,41,42,240,"40-50",1.7018,82.1003149,28.348349878923 40772,204,94,54,3.79999995,4.15999985,"Louisa",55,"female",66,202,"small",140,90,140,90,43,47,150,"50-60",1.6764,91.6257658,32.6033565267314 40773,212,88,36,5.9000001,5.21999979,"Louisa",37,"female",64,160,"small",124,82,NA,NA,37,45,15,"<40",1.6256,72.574864,27.4636875445626 40774,203,90,51,4,14.9399996,"Louisa",60,"female",59,123,"medium",130,72,NA,NA,36,41,60,"50-60",1.4986,55.7919267,24.8427633841766 40775,219,173,31,7.0999999,10.1599998,"Louisa",56,"female",65,197,"small",100,50,NA,NA,41,50,210,"50-60",1.651,89.3578013,32.7822175206481 40784,226,279,52,4.30000019,10.0699997,"Louisa",84,"female",60,192,"small",144,88,146,82,41,48,210,">70",1.524,87.0898368,37.4970880608428 40785,217,75,54,4,3.66000009,"Louisa",20,"female",67,187,"medium",110,72,NA,NA,40,45,1440,"<40",1.7018,84.8218723,29.2880741843016 40786,157,92,47,3.29999995,6.48000002,"Louisa",80,"male",71,212,"medium",156,88,158,86,47,48,390,">70",1.8034,96.1616948,29.5677296254414 40787,235,102,42,5.5999999,4.9000001,"Louisa",60,"male",69,186,"medium",148,98,130,100,40,42,900,"50-60",1.7526,84.3682794,27.4671486267988 40789,252,161,87,2.9000001,11.1800003,"Louisa",80,"female",62,162,"small",160,100,160,100,44,41,1440,">70",1.5748,73.4820498,29.6299180501587 40792,204,71,55,3.70000005,4.32999992,"Louisa",29,"female",64,120,"small",110,70,NA,NA,33,38,90,"<40",1.6256,54.431148,20.5977656584219 40797,188,84,46,4.0999999,3.75,"Louisa",43,"female",66,152,"small",122,80,NA,NA,37,41,260,"40-50",1.6764,68.9461208,24.53321877259 40799,194,95,36,5.4000001,4.96999979,"Louisa",63,"female",58,210,"medium",140,100,136,100,44,53,240,"60-70",1.4732,95.254509,43.8896504873866 40803,215,64,84,2.5999999,4.03999996,"Louisa",37,"female",59,148,"medium",140,100,136,92,32,42,270,"<40",1.4986,67.1317492,29.892105535432 40804,179,105,60,3,4.67999983,"Louisa",20,"female",58,170,"medium",140,100,138,82,34,46,270,"<40",1.4732,77.110793,35.5297170612177 40805,202,84,33,6.0999999,4.17000008,"Louisa",44,"male",68,157,"small",125,80,NA,NA,33,37,180,"40-50",1.7272,71.2140853,23.8715512498067 41000,194,87,65,3,4.13999987,"Louisa",54,"male",69,129,"small",170,96,160,94,30,37,15,"50-60",1.7526,58.5134841,19.0497966282637 41001,227,85,26,8.69999981,4.98000002,"Louisa",58,"male",70,211,"large",144,82,144,80,38,43,480,"50-60",1.778,95.7081019,30.275072375655 41003,337,85,62,5.4000001,4.65999985,"Louisa",35,"male",72,189,"medium",124,84,NA,NA,36,44,240,"<40",1.8288,85.7290581,25.6327750415918 41004,255,83,90,2.79999995,4.28999996,"Louisa",52,"male",70,120,"medium",170,110,166,108,30,33,780,"50-60",1.778,54.431148,17.2180506401829 41021,162,90,46,3.5,5.55999994,"Louisa",60,"female",63,121,"medium",110,64,NA,NA,32,34,300,"50-60",1.6002,54.8847409,21.4339930808861 41023,322,87,92,3.5,4.44999981,"Louisa",43,"female",56,120,NA,120,98,122,100,32,41,60,"40-50",1.4224,54.431148,26.9032041252858 41029,289,267,38,7.5999999,11.4099998,"Louisa",59,"male",68,169,"large",142,79,NA,NA,36,38,900,"50-60",1.7272,76.6572001,25.696128415397 41034,217,87,40,5.4000001,4.07000017,"Louisa",33,"female",62,186,"small",140,90,138,84,42,46,40,"<40",1.5748,84.3682794,34.0195355390711 41035,209,91,36,5.80000019,5.01000023,"Louisa",37,"male",70,262,"medium",130,94,130,88,42,48,450,"<40",1.778,118.8413398,37.5927438977327 41036,214,77,48,4.5,4.48000002,"Louisa",40,"male",72,222,"medium",120,84,NA,NA,40,44,1020,"<40",1.8288,100.6976238,30.1083389377427 41037,302,81,57,5.30000019,4.6500001,"Louisa",38,"female",67,222,"medium",128,82,NA,NA,41,51,210,"<40",1.7018,100.6976238,34.7697992990105 41039,179,85,52,3.4000001,4.05000019,"Louisa",32,"female",62,179,"medium",140,96,148,100,37,47,60,"<40",1.5748,81.1931291,32.7392304381383 41041,279,270,40,7,8.10999966,"Louisa",60,"female",68,224,"large",174,90,174,84,48,50,180,"50-60",1.7272,101.6048096,34.0587737576859 41055,144,81,28,5.0999999,4.13000011,"Louisa",30,"male",72,165,"small",118,78,NA,NA,31,38,180,"<40",1.8288,74.8428285,22.3778194807547 41063,270,73,40,6.80000019,3.57999992,"Louisa",42,"male",66,185,"large",146,94,149,94,39,41,30,"40-50",1.6764,83.9146865,29.8595096903233 41065,196,120,67,2.9000001,9.36999989,"Louisa",52,"female",62,147,"medium",144,94,142,92,34,42,480,"50-60",1.5748,66.6781563,26.8864071195884 41075,221,126,48,4.5999999,5.53000021,"Louisa",59,"female",62,177,"medium",130,78,NA,NA,39,45,60,"50-60",1.5748,80.2859433,32.3734289807289 41078,210,81,81,2.5999999,4.96000004,"Louisa",78,"male",66,145,"large",110,70,NA,NA,38,39,540,">70",1.6764,65.7709705,23.4033994870102 41253,192,85,69,2.79999995,4.38000011,"Louisa",51,"male",65,146,"large",130,110,170,118,NA,NA,60,"50-60",1.651,66.2245634,24.2954505482975 41254,169,104,58,2.9000001,4.82000017,"Louisa",25,"female",60,154,"medium",140,95,130,94,40,42,60,"<40",1.524,69.8533066,30.0757893821343 41500,179,85,50,3.5999999,4.98999977,"Louisa",37,"male",66,136,"medium",190,94,172,100,33,39,480,"<40",1.6764,61.6886344,21.9507746912647 41501,216,84,64,3.4000001,NA,"Louisa",54,"female",66,168,"medium",132,90,126,80,38,42,330,"50-60",1.6764,76.2036072,27.1156628539152 41503,301,90,118,2.5999999,4.28000021,"Louisa",89,"female",61,115,"medium",218,90,238,90,31,41,210,">70",1.5494,52.1631835,21.7288621690923 41506,296,369,46,6.4000001,16.1100006,"Louisa",53,"male",69,173,"medium",138,94,130,94,35,39,210,"50-60",1.7526,78.4715717,25.5474016797645 41507,284,89,54,5.30000019,4.38999987,"Louisa",51,"female",63,154,"medium",140,100,146,102,32,43,180,"50-60",1.6002,69.8533066,27.2796275574914 41510,194,269,38,5.0999999,13.6300001,"Louisa",29,"female",69,167,"small",120,70,NA,NA,33,40,20,"<40",1.7526,75.7500143,24.6613646272871 41752,199,76,52,3.79999995,4.48999977,"Louisa",41,"female",63,197,"medium",120,78,NA,NA,41,48,255,"40-50",1.6002,89.3578013,34.8966664209469 41756,159,88,79,2,NA,"Louisa",68,"female",64,220,"medium",100,72,NA,NA,49,58,900,"60-70",1.6256,99.790438,37.7625703737736 Publish/man/0000755000176200001440000000000013745462067012451 5ustar liggesusersPublish/man/publish.coxph.Rd0000755000176200001440000000471413603644022015521 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.coxph.R \name{publish.coxph} \alias{publish.coxph} \title{Tabulize hazard ratios with confidence intervals and p-values.} \usage{ \method{publish}{coxph}( object, confint.method, pvalue.method, print = TRUE, factor.reference = "extraline", units = NULL, probindex = FALSE, ... ) } \arguments{ \item{object}{A \code{coxph} object.} \item{confint.method}{See \code{regressionTable}} \item{pvalue.method}{See \code{regressionTable}} \item{print}{If \code{FALSE} do not print results.} \item{factor.reference}{See \code{regressionTable}} \item{units}{See \code{regressionTable}} \item{probindex}{Logical. If \code{TRUE} show coefficients on probabilistic index scale instead of hazard ratio scale.} \item{...}{passed to \code{summary.regressionTable} and also to \code{labelUnits}.} } \value{ Table with hazard ratios, confidence intervals and p-values. } \description{ Tabulize the part of the result of a Cox regression analysis which is commonly shown in publications. } \details{ Transforms the log hazard ratios to hazard ratios and returns them with confidence limits and p-values. If explanatory variables are log transformed or log2 transformed, a scaling factor is multiplied to both the log-hazard ratio and its standard-error. } \examples{ library(survival) data(pbc) pbc$edema <- factor(pbc$edema, levels=c("0","0.5","1"), labels=c("0","0.5","1")) fit = coxph(Surv(time,status!=0)~age+sex+edema+log(bili)+log(albumin), data=na.omit(pbc)) publish(fit) ## forest plot plot(publish(fit),cex=1.3) publish(fit,ci.digits=2,pvalue.eps=0.01,pvalue.digits=2,pvalue.stars=TRUE) publish(fit,ci.digits=2,ci.handler="prettyNum",pvalue.eps=0.01, pvalue.digits=2,pvalue.stars=TRUE) publish(fit, ci.digits=2, ci.handler="sprintf", pvalue.eps=0.01, pvalue.digits=2,pvalue.stars=TRUE, ci.trim=FALSE) fit2 = coxph(Surv(time,status!=0)~age+sex+edema+log(bili,base=2)+log(albumin)+log(protime), data=na.omit(pbc)) publish(fit2) # with cluster variable fit3 = coxph(Surv(time,status!=0)~age+cluster(sex)+edema+log(bili,base=2) +log(albumin)+log(protime), data=na.omit(pbc)) publish(fit3) # with strata and cluster variable fit4 = coxph(Surv(time,status!=0)~age+cluster(sex)+strata(edema)+log(bili,base=2) +log(albumin)+log(protime), data=pbc) publish(fit4) } \author{ Thomas Alexander Gerds } Publish/man/publish.Rd0000755000176200001440000000120213571203036014366 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.R \name{publish} \alias{publish} \title{Publishing tables and figures} \usage{ publish(object, ...) } \arguments{ \item{object}{object to be published} \item{...}{Passed to method.} } \value{ Tables and figures } \description{ Publish provides summary functions for data and results of statistical analysis in ready-for-publication design } \details{ Some warnings are currently suppressed. } \seealso{ publish.CauseSpecificCox publish.ci publish.coxph publish.glm publish.riskRegression publish.survdiff } \author{ Thomas A. Gerds } Publish/man/regressionTable.Rd0000644000176200001440000001115113761464755016073 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/regressionTable.R \name{regressionTable} \alias{regressionTable} \title{Regression table} \usage{ regressionTable( object, param.method = "coef", confint.method = c("default", "profile", "robust", "simultaneous"), pvalue.method = c("default", "robust", "simultaneous"), factor.reference = "extraline", intercept = 0L, units = NULL, noterms = NULL, probindex = 0L, ... ) } \arguments{ \item{object}{Fitted regression model obtained with \code{lm}, \code{glm} or \code{coxph}.} \item{param.method}{Method to obtain model coefficients.} \item{confint.method}{Method to obtain confidence intervals. Default is 'default' which leads to Wald type intervals using the model based estimate of standard error. 'profile' yields profile likelihood confidence intervals, available from library MASS for \code{lm} and \code{glm} objects. 'robust' uses the sandwich form standard error to construct Wald type intervals (see \code{lava::estimate.default}). 'simultaneous' calls \code{multcomp::glht} to obtain simultaneous confidence intervals.} \item{pvalue.method}{Method to obtain p-values. If \code{'default'} show raw p-values. If \code{'robust'} use p-value corresponding to robust standard error as provided by \code{lava::estimate.default}. If \code{'simultaneous'} call \code{multcomp::glht} to obtain p-values.} \item{factor.reference}{Style for showing results for categorical variables. If \code{'extraline'} show an additional line for the reference category. If \code{'inline'} display as level vs. reference.} \item{intercept}{Logical. If \code{FALSE} suppress intercept.} \item{units}{List of units for continuous variables. See examples.} \item{noterms}{Position of terms that should be ignored. E.g., for a Cox model with a cluster(id) term, there will be no hazard ratio for variable id.} \item{probindex}{Logical. If \code{TRUE} show coefficients on probabilistic index scale instead of hazard ratio scale.} \item{...}{Not yet used} } \value{ List of regression blocks } \description{ Tabulate the results of a regression analysis. } \details{ The basic use of this function is to generate a near publication worthy table from a regression object. As with summary(object) reference levels of factor variables are not included. Expansion of the table with such values can be performed using the "fixRegressionTable" function. Forest plot can be added to the output with "plotRegressionTable". regressionTable produces an object (list) with the parameters deriveds. The summary function creates a data frame which can be used as a (near) publication ready table. The table shows changes in mean for linear regression, odds ratios for logistic regression (family = binomial) and hazard ratios for Cox regression. } \examples{ # linear regression data(Diabetes) f1 <- glm(bp.1s~age+gender+frame+chol,data=Diabetes) summary(regressionTable(f1)) summary(regressionTable(f1,units=list("chol"="mmol/L","age"="years"))) ## with interaction f2 <- glm(bp.1s~age*gender+frame+chol,data=Diabetes) summary(regressionTable(f2)) #Add reference values summary(regressionTable(f2)) f3 <- glm(bp.1s~age+gender*frame+chol,data=Diabetes) publish(f3) regressionTable(f3) # logistic regression Diabetes$hyp1 <- factor(1*(Diabetes$bp.1s>140)) l1 <- glm(hyp1~age+gender+frame+chol,data=Diabetes,family="binomial") regressionTable(l1) publish(l1) plot(regressionTable(l1)) ## with interaction l2 <- glm(hyp1~age+gender+frame*chol,data=Diabetes,family="binomial") regressionTable(l2) l3 <- glm(hyp1~age*gender+frame*chol,data=Diabetes,family="binomial") regressionTable(l3) # Cox regression library(survival) data(pbc) pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) c1 <- coxph(Surv(time,status!=0)~log(bili)+age+protime+sex+edema,data=pbc) regressionTable(c1) # with interaction c2 <- coxph(Surv(time,status!=0)~log(bili)+age+protime*sex+edema,data=pbc) regressionTable(c2) c3 <- coxph(Surv(time,status!=0)~edema*log(bili)+age+protime+sex+edema+edema:sex,data=pbc) regressionTable(c3) if (requireNamespace("nlme",quietly=TRUE)){ ## gls regression library(lava) library(nlme) m <- lvm(Y ~ X1 + gender + group + Interaction) distribution(m, ~gender) <- binomial.lvm() distribution(m, ~group) <- binomial.lvm(size = 2) constrain(m, Interaction ~ gender + group) <- function(x){x[,1]*x[,2]} d <- sim(m, 1e2) d$gender <- factor(d$gender, labels = letters[1:2]) d$group <- factor(d$group) e.gls <- gls(Y ~ X1 + gender*group, data = d, weights = varIdent(form = ~1|group)) regressionTable(e.gls) summary(regressionTable(e.gls)) } } \author{ Thomas A. Gerds } Publish/man/labelUnits.Rd0000644000176200001440000000202413571203036015022 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/labelUnits.R \name{labelUnits} \alias{labelUnits} \title{labelUnits} \usage{ labelUnits(x, ...) } \arguments{ \item{x}{A matrix obtained with \code{univariateTable}.} \item{...}{not used} } \value{ The re-labeled matrix } \description{ Label output tables } \details{ Modify labels and values of variables in summary tables } \examples{ data(Diabetes) tab <- summary(univariateTable(gender~AgeGroups+chol+waist,data=Diabetes)) publish(tab) ltab <- labelUnits(tab,"chol"="Cholesterol (mg/dL)","<40"="younger than 40") publish(ltab) ## pass labels immediately to utable utable(gender~AgeGroups+chol+waist,data=Diabetes, "chol"="Cholesterol (mg/dL)","<40"="younger than 40") ## sometimes useful to state explicitly which variables value ## should be re-labelled utable(gender~AgeGroups+chol+waist,data=Diabetes, "chol"="Cholesterol (mg/dL)","AgeGroups.<40"="younger than 40") } \seealso{ univariateTable } \author{ Thomas A. Gerds } Publish/man/summary.ci.Rd0000644000176200001440000000307113603644022015012 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary.ci.R \name{summary.ci} \alias{summary.ci} \title{Summarize confidence intervals} \usage{ \method{summary}{ci}(object, format = "[u;l]", se = FALSE, print = TRUE, ...) } \arguments{ \item{object}{Object of class ci containing point estimates and the corresponding confidence intervals} \item{format}{A string which indicates the format used for confidence intervals. The string is passed to \code{\link{formatCI}} with two arguments: the lower and the upper limit. For example \code{'(l;u)'} yields confidence intervals with round parenthesis in which the upper and the lower limits are separated by semicolon.} \item{se}{If \code{TRUE} add standard error.} \item{print}{Logical: if \code{FALSE} do not actually print confidence intervals but just return them invisibly.} \item{...}{used to control formatting of numbers} } \value{ Formatted confidence intervals } \description{ Summarize confidence intervals } \details{ This format of the confidence intervals is user-manipulable. } \examples{ library(lava) m <- lvm(Y~X) m <- categorical(m,Y~X,K=4) set.seed(4) d <- sim(m,24) ci.mean(Y~X,data=d) x <- summary(ci.mean(Y~X,data=d),digits=2) x x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=2) x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,se=TRUE) x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,handler="format") x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,handler="prettyNum") } \seealso{ ci plot.ci format.ci } \author{ Thomas A. Gerds } Publish/man/publish.Score.Rd0000644000176200001440000000270413761463045015456 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.Score.R \name{publish.Score} \alias{publish.Score} \title{Publish predictive accuracy results} \usage{ \method{publish}{Score}(object, metrics, score = TRUE, contrasts = TRUE, level = 3, ...) } \arguments{ \item{object}{Object obtained with \code{riskRegression::Score}} \item{metrics}{Which metrics to put into tables. Defaults to \code{object$metrics}.} \item{score}{Logical. If \code{TRUE} print the score elements, i.e., metric applied to the risk prediction models.} \item{contrasts}{Logical. If \code{TRUE} print the contrast elements (if any). These compare risk prediction models according to metrics.} \item{level}{Level of subsection headers, i.e., ** for level 2 and *** for level 3 (useful for emacs org-users). Default is plain subsection headers no stars. A negative value will suppress subjection headers.} \item{...}{Passed to publish} } \value{ Results of Score in tabular form } \description{ Write output of \code{riskRegression::Score} in tables } \details{ Collect prediction accuracy results in tables } \examples{ if (requireNamespace("riskRegression",quietly=TRUE)){ library(riskRegression) library(survival) learn = sampleData(100) val= sampleData(100) f1=CSC(Hist(time,event)~X1+X8,data=learn) f2=CSC(Hist(time,event)~X1+X5+X6+X8,learn) xs=Score(list(f1,f2),data=val,formula=Hist(time,event)~1) publish(xs) } } \author{ Thomas A. Gerds } Publish/man/print.subgroupAnalysis.Rd0000644000176200001440000000120513571203036017425 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print.subgroupAnalysis.R \name{print.subgroupAnalysis} \alias{print.subgroupAnalysis} \title{Printing univariate tables} \usage{ \method{print}{subgroupAnalysis}(x, ...) } \arguments{ \item{x}{- An object obtained with \code{subgroupAnalysis}} \item{...}{Passed to summary.subgroupAnalysis} } \value{ The result of \code{summary.subgroupAnalysis(x)} } \description{ Print function for subgroupAnalysis } \details{ This function is simply calling \code{summary.subgroupAnalysis} } \seealso{ \code{subgroupAnalysis} } \author{ Christian Torp-Pedersen (ctp@heart.dk) } Publish/man/print.univariateTable.Rd0000644000176200001440000000117013571203036017173 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print.univariateTable.R \name{print.univariateTable} \alias{print.univariateTable} \title{Printing univariate tables} \usage{ \method{print}{univariateTable}(x, ...) } \arguments{ \item{x}{An object obtained with \code{univariateTable}} \item{...}{Passed to summary.univariateTable} } \value{ The result of \code{summary.univariateTable(x)} } \description{ Print function for univariate tables } \details{ This function is simply calling \code{summary.univariateTable} } \seealso{ \code{univariateTable} } \author{ Thomas A. Gerds } Publish/man/lazyDateCoding.Rd0000644000176200001440000000212513571203036015623 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lazyDateCoding.R \name{lazyDateCoding} \alias{lazyDateCoding} \title{Efficient coding of date variables} \usage{ lazyDateCoding(data, format, pattern, varnames, testlength = 10) } \arguments{ \item{data}{Data frame in which to search for date variables.} \item{format}{passed to as.Date} \item{pattern}{match date variables} \item{varnames}{variable names} \item{testlength}{how many rows of data should be evaluated to guess the format.} } \value{ R-code one line for each variable. } \description{ This function eases the process of generating date variables. All variables in a data.frame which match a regular expression are included } \details{ The code needs to be copy-and-pasted from the R-output buffer into the R-code buffer. This can be customized for the really efficiently working people, e.g., in emacs. } \examples{ d <- data.frame(x0="190101",x1=c("12/8/2019"),x2="12-8-2019",x3="20190812",stringsAsFactors=FALSE) lazyDateCoding(d,pattern="x") lazyDateCoding(d,pattern="3") } \author{ Thomas Alexander Gerds } Publish/man/summary.univariateTable.Rd0000755000176200001440000000475613603644022017554 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary.univariateTable.R \name{summary.univariateTable} \alias{summary.univariateTable} \title{Preparing univariate tables for publication} \usage{ \method{summary}{univariateTable}( object, n = "inNames", drop.reference = FALSE, pvalue.stars = FALSE, pvalue.digits = 4, show.missing = c("ifany", "always", "never"), show.pvalues, show.totals, ... ) } \arguments{ \item{object}{\code{univariateTable} object as obtained with function \code{univariateTable}.} \item{n}{If not missing, show the number of subjects in each column. If equal to \code{"inNames"}, show the numbers in parentheses in the column names. If missing the value \code{object$n} is used.} \item{drop.reference}{Logical or character (vector). Decide if line with reference level should be suppressed for factors. If \code{TRUE} or \code{"all"} suppress for all categorical factors. If \code{'binary'} suppress only for binary variables. Can be character vector in which case reference lines are suppressed for variables that are included in the vector.} \item{pvalue.stars}{If TRUE use \code{symnum} to parse p-values otherwise use \code{format.pval}.} \item{pvalue.digits}{Passed to \code{format.pval}.} \item{show.missing}{Decides if number of missing values are shown in table. Defaults to \code{"ifany"}, and can also be set to \code{"always"} or \code{"never"}.} \item{show.pvalues}{Logical. If set to \code{FALSE} the column \code{p-values} is removed. If missing the value \code{object$compare.groups[[1]]==TRUE} is used.} \item{show.totals}{Logical. If set to \code{FALSE} the column \code{Totals} is removed. If missing the value \code{object$show.totals} is used.} \item{...}{passed on to \code{labelUnits}. This overwrites labels stored in \code{object$labels}} } \value{ Summary table } \description{ Summary function for univariate table } \details{ Collects results of univariate table in a matrix. } \examples{ data(Diabetes) u <- univariateTable(gender~age+location+Q(BMI)+height+weight, data=Diabetes) summary(u) summary(u,n=NULL) summary(u,pvalue.digits=2,"age"="Age (years)","height"="Body height (cm)") u2 <- univariateTable(location~age+AgeGroups+gender+height+weight, data=Diabetes) summary(u2) summary(u2,drop.reference=TRUE) ## same but more flexible summary(u2,drop.reference=c("binary")) ## same but even more flexible summary(u2,drop.reference=c("gender")) } \author{ Thomas A. Gerds } Publish/man/print.table2x2.Rd0000644000176200001440000000131213571203036015475 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print.table2x2.R \name{print.table2x2} \alias{print.table2x2} \title{print results of 2x2 contingency table analysis} \usage{ \method{print}{table2x2}(x, digits = 1, ...) } \arguments{ \item{x}{object obtained with table2x2} \item{digits}{rounding digits} \item{...}{not used} } \value{ invisible x } \description{ print results of 2x2 contingency table analysis } \examples{ table2x2(table("marker"=rbinom(100,1,0.4),"response"=rbinom(100,1,0.1))) table2x2(matrix(c(71,18,38,8),ncol=2),stats="table") table2x2(matrix(c(71,18,38,8),ncol=2),stats=c("rr","fisher")) } \seealso{ table2x2 } \author{ Thomas A. Gerds } Publish/man/pubformat.Rd0000644000176200001440000000202213571203036014715 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pubformat.R \name{pubformat} \alias{pubformat} \title{Format numbers for publication} \usage{ pubformat(x, digits = 2, nsmall = digits, handler = "sprintf", ...) } \arguments{ \item{x}{numeric vector} \item{digits}{number of digits} \item{nsmall}{see handler} \item{handler}{String specififying the name of the function which should perform the formatting. See \code{sprintf}, \code{format} and \code{prettyNum}.} \item{...}{Passed to handler function if applicable, i.e., not to \code{sprintf}.} } \value{ Formatted number } \description{ Format numbers according to a specified handler function. Currently supported are sprintf, format and prettyNum. } \examples{ pubformat(c(0.000143,12.8,1)) pubformat(c(0.000143,12.8,1),handler="format") pubformat(c(0.000143,12.8,1),handler="format",trim=TRUE) pubformat(c(0.000143,12.8,1),handler="prettyNum") } \seealso{ \code{sprintf}, \code{format}, \code{prettyNum} } \author{ Thomas A. Gerds } Publish/man/spaghettiogram.Rd0000644000176200001440000000356113603644022015745 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Spaghettiogram.R \name{spaghettiogram} \alias{spaghettiogram} \alias{Spaghettiogram} \title{Spaghettiogram} \usage{ spaghettiogram( formula, data, xlim, ylim, xlab = "", ylab = "", axes = TRUE, col, lwd, lty, pch, legend = FALSE, add = FALSE, background = TRUE, ... ) } \arguments{ \item{formula}{A formula which specifies the variables for the spaghettiograms. If Y ~ X + id(Z) then for each value of Z the spaghettiogram is the graph (X,Y) in the subset defined by the value of Z. Data are expected to be in the "long" format. Y is a numeric vector and X is a factor whose levels define the X-axis. Each level of the id-vector corresponds to one line (spaghetti) in the plot.} \item{data}{data set in which variables X, Y and Z are defined.} \item{xlim}{Limits for x-axis} \item{ylim}{Limits for y-axis} \item{xlab}{Label for x-axis} \item{ylab}{Label for x-axis} \item{axes}{Logical indicating if axes should be drawn.} \item{col}{Colors for the spaghettiograms} \item{lwd}{Widths for the spaghettiograms} \item{lty}{Type for the spaghettiograms} \item{pch}{Point-type for the spaghettiograms} \item{legend}{If \code{TRUE} add a legend. Argument A of legend is controlled as legend.A. E.g., when \code{legend.cex=2} legend will be called with argument cex=2.} \item{add}{If \code{TRUE} add to existing plot device.} \item{background}{Control the background color of the graph.} \item{...}{used to transport arguments which are passed to the following subroutines: \code{"plot"}, \code{"lines"}, \code{"legend"}, \code{"background"}, \code{"axis1"}, \code{"axis2"}.} } \value{ List with data of each subject } \description{ A spaghettiogram is showing repeated measures (longitudinal data) } \examples{ data(SpaceT) Spaghettiogram(HR~Status+id(ID), data=SpaceT) } Publish/man/coxphSeries.Rd0000755000176200001440000000322613571203036015224 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coxphSeries.R \name{coxphSeries} \alias{coxphSeries} \title{Run a series of Cox regression models} \usage{ coxphSeries(formula, data, vars, ...) } \arguments{ \item{formula}{The fixed part of the regression formula. For univariate analyses this is simply \code{Surv(time,status)~1} where \code{Surv(time,status)} is the outcome variable. When the aim is to control the effect of \code{vars} in each element of the series by a fixed set of variables it is \code{Surv(time,status)~x1+x2} where again Surv(time,status) is the outcome and x1 and x2 are confounders.} \item{data}{A \code{data.frame} in which the \code{formula} gets evaluated.} \item{vars}{A list of variable names, the changing part of the regression formula.} \item{...}{passed to publish.coxph} } \value{ matrix with results } \description{ Run a series of Cox regression analyses for a list of predictor variables and summarize the results in a table. The Cox models can be adjusted for a fixed set of covariates This function runs on \code{coxph} from the survival package. } \examples{ library(survival) data(pbc) ## collect hazard ratios from three univariate Cox regression analyses pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) uni.hr <- coxphSeries(Surv(time,status==2)~1,vars=c("edema","bili","protime"),data=pbc) uni.hr ## control the logistic regression analyses for age and gender ## but collect only information on the variables in `vars'. controlled.hr <- coxphSeries(Surv(time,status==2)~age+sex,vars=c("edema","bili","protime"),data=pbc) controlled.hr } \author{ Thomas Alexander Gerds } Publish/man/parseInteractionTerms.Rd0000644000176200001440000000631413745514054017263 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parseInteractionTerms.R \name{parseInteractionTerms} \alias{parseInteractionTerms} \title{Parse interaction terms} \usage{ parseInteractionTerms( terms, xlevels, units, format.factor, format.contrast, format.scale, format.scale.unit, sep = ": ", ... ) } \arguments{ \item{terms}{Terms of a formula} \item{xlevels}{Factor levels corresponding to the variables in \code{terms}} \item{units}{named list with unit labels. names should match variable names in formula.} \item{format.factor}{For categorical variables. A string which specifies the print format for factor labels. The string has to contain the keywords \code{"var"} and \code{"level"} which will be replaced by the name of the variable and the current level, respectively. Default is \code{"var(level)"}.} \item{format.contrast}{For categorical variables. A string which specifies the print format for constrast statements. The string has to contain the keywords \code{"var"}, \code{"level"} and \code{"ref"} which will be replaced by the name of the variable, the current level and the reference level, respectively.} \item{format.scale}{A string which specifies the print format for continuous variables without units. The string has to contain the keyword \code{"var"} which will be replaced by the name of the variable and the unit, respectively. Default is \code{"var"}.} \item{format.scale.unit}{A string which specifies the print format for continuous variables with units. The string has to contain the keywords \code{"var"} and \code{"unit"} which will be replaced by the name of the variable and the unit, respectively. Default is \code{"var(unit)"}.} \item{sep}{a character string to separate the terms. Default is \code{": "}.} \item{...}{Not yet used} } \value{ List of contrasts which can be passed to \code{lava::estimate}. } \description{ Parse interaction terms for regression tables } \details{ Prepare a list of contrasts which combines regression coefficients to describe statistical interactions. } \examples{ tt <- terms(formula(SBP~age+sex*BMI)) xlev <- list(sex=c("male","female"),BMI=c("normal","overweight","obese")) parseInteractionTerms(terms=tt,xlevels=xlev) parseInteractionTerms(terms=tt,xlevels=xlev,format.factor="var level") parseInteractionTerms(terms=tt,xlevels=xlev,format.contrast="var(level:ref)") tt2 <- terms(formula(SBP~age*factor(sex)+BMI)) xlev2 <- list("factor(sex)"=c("male","female")) parseInteractionTerms(terms=tt2,xlevels=xlev2) parseInteractionTerms(terms=tt2,xlevels=xlev2,units=list(age="yrs")) data(Diabetes) fit <- glm(bp.2s~age*factor(gender)+BMI,data=Diabetes) parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels, format.scale="var -- level:ref",units=list("age"='years')) parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels, format.scale.unit="var [unit]",units=list("age"='years')) it <- parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels) ivars <- unlist(lapply(it,function(x)attr(x,"variables"))) lava::estimate(fit,function(p)lapply(unlist(it),eval,envir=sys.parent(-1))) } \seealso{ lava::estimate } \author{ Thomas A. Gerds } Publish/man/publish.riskRegression.Rd0000644000176200001440000000202713761463045017412 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.riskRegression.R \name{publish.riskRegression} \alias{publish.riskRegression} \title{Publishing results of riskRegression} \usage{ \method{publish}{riskRegression}(object, digits = c(2, 4), print = TRUE, ...) } \arguments{ \item{object}{object of class riskRegression as obtained with functions ARR and LRR.} \item{digits}{Number of digits for regression coefficients} \item{print}{If \code{FALSE} do not print the results} \item{...}{passed to \code{\link{publish.matrix}}} } \value{ Table with regression coefficients, confidence intervals and p-values } \description{ Preparing a publishable table from riskRegression results } \examples{ if (requireNamespace("riskRegression",quietly=TRUE)){ library(riskRegression) library(prodlim) library(lava) library(survival) set.seed(20) d <- SimCompRisk(20) f <- ARR(Hist(time,event)~X1+X2,data=d,cause=1) publish(f) publish(f,digits=c(1,3)) } } \seealso{ ARR LRR } \author{ Thomas A. Gerds } Publish/man/lazyFactorCoding.Rd0000755000176200001440000000177613571203036016202 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/lazyFactorCoding.R \name{lazyFactorCoding} \alias{lazyFactorCoding} \title{Efficient coding of factor levels} \usage{ lazyFactorCoding(data, max.levels = 10) } \arguments{ \item{data}{Data frame in which to search for categorical variables.} \item{max.levels}{Treat non-factor variables only if the number of unique values less than max.levels. Defaults to 10.} } \value{ R-code one line for each variable. } \description{ This function eases the process of generating factor variables with relevant labels. All variables in a data.frame with less than a user set number of levels result in a line which suggests levels and labels. The result can then be modified for use. } \details{ The code needs to be copy-and-pasted from the R-output buffer into the R-code buffer. This can be customized for the really efficiently working people e.g. in emacs. } \examples{ data(Diabetes) lazyFactorCoding(Diabetes) } \author{ Thomas Alexander Gerds } Publish/man/publish.summary.aov.Rd0000644000176200001440000000142413603644022016651 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.summary.aov.R \name{publish.summary.aov} \alias{publish.summary.aov} \title{Format summary table of aov results} \usage{ \method{publish}{summary.aov}( object, print = TRUE, handler = "sprintf", digits = c(2, 4), nsmall = digits, ... ) } \arguments{ \item{object}{glm object} \item{print}{Logical. Decide about whether or not to print the results.} \item{handler}{see \code{pubformat}} \item{digits}{see \code{pubformat}} \item{nsmall}{see \code{pubformat}} \item{...}{used to transport further arguments} } \description{ Format summary table of aov results } \examples{ data(Diabetes) f <- glm(bp.1s~age+chol+gender+location,data=Diabetes) publish(summary(aov(f)),digits=c(1,2)) } Publish/man/plot.subgroupAnalysis.Rd0000644000176200001440000000267713745461717017304 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.subgroupAnalysis.R \name{plot.subgroupAnalysis} \alias{plot.subgroupAnalysis} \title{plot.subgroupAnalysis} \usage{ \method{plot}{subgroupAnalysis}(x, ...) } \arguments{ \item{x}{- a subgroupAnalysis object} \item{...}{- passed on to plotConfidence} } \description{ This function operates on a "subgroupAnalysis" object to produce a formatted table and a forest plot } \details{ This function produces a formatted table of a subgroupAnalysis object and adds a forest plot. If further details needs attention before plotting is is advisable use adjust the table produced by the summary function and then plotting with the plotConfidence function } \examples{ #load libraries library(Publish) library(survival) library(data.table) data(traceR) #get dataframe traceR setDT(traceR) traceR[,':='(wmi2=factor(wallMotionIndex<0.9,levels=c(TRUE,FALSE), labels=c("bad","good")), abd2=factor(abdominalCircumference<95, levels=c(TRUE,FALSE), labels=c("slim","fat")), sex=factor(sex))] fit_cox <- coxph(Surv(observationTime,dead)~treatment,data=traceR) # Selected subgroups - univariable analysis sub_cox <- subgroupAnalysis(fit_cox,traceR,treatment="treatment", subgroup=c("smoking","sex","wmi2","abd2")) # subgroups as character string plot(sub_cox) } \seealso{ subgroupAnalysis, plotConfidence } \author{ Christian Torp-Pedersen } Publish/man/summary.subgroupAnalysis.Rd0000644000176200001440000000377213603644022020001 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary.subgroupAnalysis.R \name{summary.subgroupAnalysis} \alias{summary.subgroupAnalysis} \title{summary.subgroupAnalysis} \usage{ \method{summary}{subgroupAnalysis}( object, digits = 3, eps = 0.001, subgroup.p = FALSE, keep.digital = FALSE, ... ) } \arguments{ \item{object}{- a subgroupAnalysis object} \item{digits}{- number of digits for risk ratios} \item{eps}{- lowest value of p to be shown exactly, others will be " } Publish/man/print.ci.Rd0000644000176200001440000000166313571203036014456 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/print.ci.R \name{print.ci} \alias{print.ci} \title{Print confidence intervals} \usage{ \method{print}{ci}(x, se = FALSE, print = TRUE, ...) } \arguments{ \item{x}{Object containing point estimates and the corresponding confidence intervals} \item{se}{If \code{TRUE} add the standard error.} \item{print}{Logical: if \code{FALSE} do not actually print confidence intervals but just return them invisibly.} \item{...}{passed to summary.ci} } \value{ A string: the formatted confidence intervals } \description{ Print confidence intervals } \details{ This format of the confidence intervals is user-manipulable. } \examples{ library(lava) m <- lvm(Y~X) m <- categorical(m,Y~X,K=4) set.seed(4) d <- sim(m,24) ci.mean(Y~X,data=d) x <- ci.mean(Y~X,data=d) print(x,format="(l,u)") } \seealso{ ci plot.ci formatCI summary.ci } \author{ Thomas A. Gerds } Publish/man/plot.ci.Rd0000644000176200001440000000412013571203036014267 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.ci.R \name{plot.ci} \alias{plot.ci} \title{Plot confidence intervals} \usage{ \method{plot}{ci}(x, xlim, xlab = "", labels, ...) } \arguments{ \item{x}{List, data.frame or other object of this form containing point estimates (first element) and the corresponding confidence intervals as elements lower and upper.} \item{xlim}{Limit of the x-axis} \item{xlab}{Label for the y-axis} \item{labels}{labels} \item{...}{Used to transport arguments to \code{plotConfidence}.} } \description{ Function to plot confidence intervals } \details{ Function to plot means and other point estimates with confidence intervals } \examples{ data(Diabetes) x=ci.mean(bp.2s~AgeGroups,data=Diabetes) plot(x,title.labels="Age groups",xratio=c(0.4,0.3)) x=ci.mean(bp.2s/500~AgeGroups+gender,data=Diabetes) plot(x,xratio=c(0.4,0.2)) plot(x,xratio=c(0.4,0.2), labels=split(x$labels[,"AgeGroups"],x$labels[,"gender"]), title.labels="Age groups") \dontrun{ plot(x, leftmargin=0, rightmargin=0) plotConfidence(x, leftmargin=0, rightmargin=0) data(CiTable) with(CiTable,plotConfidence(x=list(HazardRatio), lower=lower, upper=upper, labels=CiTable[,2:6], factor.reference.pos=c(1,10,19), format="(u-l)", points.col="blue", digits=2)) with(CiTable,Publish::plot.ci(x=list(HazardRatio), lower=lower, upper=upper, labels=CiTable[,2:6], factor.reference.pos=c(1,10,19), format="(u-l)", points.col="blue", digits=2, leftmargin=-2, title.labels.cex=1.1, labels.cex=0.8,values.cex=0.8)) } } \author{ Thomas A. Gerds } Publish/man/fixRegressionTable.Rd0000755000176200001440000000245413603644022016531 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/fixRegressionTable.R \name{fixRegressionTable} \alias{fixRegressionTable} \title{Expand regression coefficient table} \usage{ fixRegressionTable( x, varnames, reference.value, reference.style = NULL, factorlevels, scale = NULL, nmiss, intercept ) } \arguments{ \item{x}{object resulting from \code{lm}, \code{glm} or \code{coxph}.} \item{varnames}{Names of variables} \item{reference.value}{Reference value for reference categories} \item{reference.style}{Style for showing results for categorical variables. If \code{"extraline"} show an additional line for the reference category.} \item{factorlevels}{Levels of the categorical variables.} \item{scale}{Scale for some or all of the variables} \item{nmiss}{Number of missing values} \item{intercept}{Intercept} } \value{ a table with regression coefficients } \description{ Expand regression coefficient table } \details{ This function expands results from "regressionTable" with extralines and columns For factor variables the reference group is shown. For continuous variables the units are shown and for transformed continuous variables also the scale. For all variables the numbers of missing values are added. } \author{ Thomas Alexander Gerds } Publish/man/plotConfidence.Rd0000644000176200001440000004324013603644022015661 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plotConfidence.R \name{plotConfidence} \alias{plotConfidence} \title{Plot confidence intervals} \usage{ plotConfidence( x, y.at, lower, upper, pch = 16, cex = 1, lwd = 1, col = 4, xlim, xlab, labels, title.labels, values, title.values, section.pos, section.sep, section.title = NULL, section.title.x, section.title.offset, order, leftmargin = 0.025, rightmargin = 0.025, stripes, factor.reference.pos, factor.reference.label = "Reference", factor.reference.pch = 16, refline = 1, title.line = TRUE, xratio, y.offset = 0, y.title.offset, digits = 2, format, extremearrows.length = 0.05, extremearrows.angle = 30, add = FALSE, layout = TRUE, xaxis = TRUE, ... ) } \arguments{ \item{x}{Either a vector containing the point estimates or a list whose first element contains the point estimates. Further list elements can contain the confidence intervals and labels. In this case the list needs to have names 'lower' and 'upper' to indicate the values of the lower and the upper limits of the confidence intervals, respectively, and may have an element 'labels' which is a vector or matrix or list with labels.} \item{y.at}{Optional vector of y-position for the confidence intervals and corresponding values and labels.} \item{lower}{Lower confidence limits. Used if object \code{x} is a vector and if \code{x} is a list \code{lower} overwrites element \code{x$lower}.} \item{upper}{Upper confidence limits. Used if object \code{x} is a vector and if \code{x} is a list \code{upper} overwrites element \code{x$upper}.} \item{pch}{Symbol for points.} \item{cex}{Defaults size of all figures and plotting symbol. Single elements are controlled separately. See \code{...}.} \item{lwd}{Default width of all lines Single elements are controlled separately. See \code{...}.} \item{col}{Default colour of confidence intervals.} \item{xlim}{Plotting limits for the confidence intervals. See also \code{xratio} on how to control the layout.} \item{xlab}{Label for the x-axis.} \item{labels}{Vector or matrix or list with \code{labels}. Used if object \code{x} is a vector and if \code{x} is a list it overwrites element \code{x$labels}. To avoid drawing of labels, set \code{labels=FALSE}.} \item{title.labels}{Main title for the column which shows the \code{labels}. If \code{labels} is a matrix or list \code{title.labels} should be a vector with as many elements as labels has columns or elements.} \item{values}{Either logical or vector, matrix or list with values. If \code{values=TRUE} values are constructed according to \code{format} from \code{lower} and \code{upper} overwrites constructed values. If \code{values=FALSE} do not draw values.} \item{title.values}{Main title for the column \code{values}. If \code{values} is a matrix or list \code{title.labels} should be a vector with as many elements as values has columns or elements.} \item{section.pos}{Vector with y-axis posititions for section.titles.} \item{section.sep}{Amount of space between paragraphs (applies only if \code{labels} is a named list)} \item{section.title}{Intermediate section headings.} \item{section.title.x}{x-position for section.titles} \item{section.title.offset}{Y-offset for section.titles} \item{order}{Order of the three columns: labels, confidence limits, values. See examples.} \item{leftmargin}{Percentage of plotting region used for leftmargin. Default is 0.025. See also Details.} \item{rightmargin}{Percentage of plotting region used for rightmargin. Default is 0.025. See also Details.} \item{stripes}{Vector of up to three Logicals. If \code{TRUE} draw stripes into the background. The first applies to the labels, the second to the graphical presentation of the confidence intervals and the third to the values. Thus, stripes} \item{factor.reference.pos}{Position at which factors attain reference values.} \item{factor.reference.label}{Label to use at \code{factor.reference.pos} instead of values.} \item{factor.reference.pch}{Plotting symbol to use at \code{factor.reference.pos}} \item{refline}{Position of a vertical line to indicate the null hypothesis. Default is 1 which would work for odds ratios and hazard ratios.} \item{title.line}{Position of a horizontal line to separate the title line from the plot} \item{xratio}{One or two values between 0 and 1 which determine how to split the plot window in horizontal x-direction. If there are two columns (labels, CI) or (CI, values) only one value is used and the default is 0.618 (goldener schnitt) which gives the graphical presentation of the confidence intervals 38.2 % of the graph. The remaining 61.8 % are used for the labels (or values). If there are three columns (labels, CI, values), xratio has two values which default to fractions of 0.7 according to the relative widths of labels and values, thus by default only 0.3 are used for the graphical presentation of the confidence intervals. The remaining 30 % are used for the graphical presentation of the confidence intervals. See examles.} \item{y.offset}{Either a single value or a vector determining the vertical offset of all rows. If it is a single value all rows are shifted up (or down if negative) by this value. This can be used to add a second set of confidence intervals to an existing graph or to achieve a visual grouping of rows that belong together. See examples.} \item{y.title.offset}{Numeric value by which to vertically shift the titles of the labels and values.} \item{digits}{Number of digits, passed to \code{pubformat} and \code{formatCI}.} \item{format}{Format for constructing values of confidence intervals. Defaults to '(u;l)' if there are negative lower or upper values and to '(u-l)' otherwise.} \item{extremearrows.length}{Length of the arrows in case of confidence intervals that stretch beyond xlim.} \item{extremearrows.angle}{Angle of the arrows in case of confidence intervals that stretch beyond xlim.} \item{add}{Logical. If \code{TRUE} do not draw labels or values and add confidence intervals to existing plot.} \item{layout}{Logical. If \code{FALSE} do not call layout. This is useful when several plotConfidence results should be combined in one graph and hence layout is called externally.} \item{xaxis}{Logical. If \code{FALSE} do not draw x-axis.} \item{...}{Used to control arguments of the following subroutines: \code{plot}: Applies to plotting frame of the graphical presentation of confidence intervals. Use arguments of \code{plot}, e.g., \code{plot.main="Odds ratio"}. \code{points}, \code{arrows}: Use arguments of \code{points} and \code{arrows}, respectively. E.g., \code{points.pch=8} and \code{arrows.lwd=2}. \code{refline}: Use arguments of \code{segments}, e.g., \code{refline.lwd=2}. See \link{segments}. \code{labels}, \code{values}, \code{title.labels}, \code{title.values}: Use arguments of \code{text}, e.g., \code{labels.col="red"} or \code{title.values.cex=1.8}. \code{xaxis}: Use arguments of \code{axis}, e.g., \code{xaxis.at=c(-0.3,0,0.3)} \code{xlab}: Use arguments of \code{mtext}, e.g., \code{xlab.line=2}. \code{stripes}: Use arguments of \code{stripes}. See examples. See examples for usage.} } \value{ List of dimensions and coordinates } \description{ Function to plot confidence intervals with their values and additional labels. One anticipated use of this function involves first the generation of a regression object, then arrangement of a result table with "regressionTable", further arrangment of table with with e.g. "fixRegressionTable" and various user defined changes - and then finally table along with forest plot using the current function. } \details{ Function to plot means and other point estimates with confidence intervals, their values and additional labels . Horizonal margins as determined by par()$mar are ignored. Instead layout is used to divide the plotting region horizontally into two or three parts plus leftmargin and rightmargin. When values is FALSE there are only two parts. The default order is labels on the left confidence intervals on the right. When no labels are given or labels is FALSE there are only two parts. The default order is confidence intervals on the left values on the right. The default order of three parts from left to right is labels, confidence intervals, values. The order can be changed as shown by the examples below. The relative widths of the two or three parts need to be adapted to the actual size of the text of the labels. This depends on the plotting device and the size of the font and figures and thus has to be adjusted manually. Oma can be used to further control horizontal margins, e.g., par(oma=c(0,4,0,4)). If confidence limits extend beyond the range determined by xlim, then arrows are drawn at the x-lim borders to indicate that the confidence limits continue. } \examples{ library(Publish) data(CiTable) ## A first draft version of the plot is obtained as follows plotConfidence(x=CiTable[,c("HazardRatio","lower","upper","p")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")]) ## if argument labels is a named list the table is subdivided: labellist <- split(CiTable[,c("Dose","Time","Mean","SD","n")],CiTable[,"Drug"]) labellist ## the data need to be ordered accordingly CC= data.table::rbindlist(split(CiTable[,c("HazardRatio","lower","upper")],CiTable[,"Drug"])) plotConfidence(x=CC, labels=labellist) ## The graph consist of at most three columns: ## ## column 1: labels ## column 2: printed values of the confidence intervals ## column 3: graphical presentation of the confidence intervals ## ## NOTE: column 3 appears always, the user decides if also ## column 1, 2 should appear ## ## The columns are arranged with the function layout ## and the default order is 1,3,2 such that the graphical ## display of the confidence intervals appears in the middle ## ## the order of appearance of the three columns can be changed as follows plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], order=c(1,3,2)) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], order=c(2,3,1)) ## if there are only two columns the order is 1, 2 plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], values=FALSE, order=c(2,1)) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], values=FALSE, order=c(1,2)) ## The relative size of the columns needs to be controlled manually ## by using the argument xratio. If there are only two columns plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xratio=c(0.4,0.15)) ## The amount of space on the left and right margin can be controlled ## as follows: plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xratio=c(0.4,0.15), leftmargin=0.1,rightmargin=0.00) ## The actual size of the current graphics device determines ## the size of the figures and the space between them. ## The sizes and line widths are increased as follows: plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], xlab="Hazard ratio", labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], points.cex=3, cex=2, lwd=3, xaxis.lwd=1.3, xaxis.cex=1.3) ## Note that 'cex' of axis ticks is controlled via 'par' but ## cex of the label via argument 'cex' of 'mtext'. ## The sizes and line widths are decreased as follows: plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], cex=0.8, lwd=0.8, xaxis.lwd=0.8, xaxis.cex=0.8) ## Another good news is that all figures can be controlled separately ## The size of the graphic device can be controlled in the usual way, e.g.: \dontrun{ pdf("~/tmp/testCI.pdf",width=8,height=8) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")]) dev.off() } ## More control of the x-axis and confidence intervals that ## stretch outside the x-range end in an arrow. ## the argument xlab.line adjusts the distance of the x-axis ## label from the graph plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], xlab="Hazard ratio", xlab.line=1.8, xaxis.at=c(0.8,1,1.3), labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlim=c(0.8,1.3)) ## log-scale plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], xlab="Hazard ratio", xlab.line=1.8, xaxis.at=c(0.8,1,1.3), labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlim=c(0.8,1.3),plot.log="x") ## More pronounced arrows ## Coloured xlab expression plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], xlab=expression(HR[1](s)), xlab.line=1.8, xlab.col="darkred", extremearrows.angle=50, extremearrows.length=0.1, labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlim=c(0.8,1.3)) ## Controlling the labels and their titles ## and the values and their titles plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlab="Hazard ratio", title.values=expression(bold(HR (CI[95]))), title.labels=c("Drug/Time","Dose","Mean","St.dev.","N"), factor.reference.pos=c(1,10,19), factor.reference.pch=16, cex=1.3, xaxis.at=c(0.75,1,1.25,1.5,2)) ## For factor reference groups, one may want to replace the ## confidence intervals by the word Reference, as in the previous example. ## To change the word 'Reference' we use the argument factor.reference.label: ## To change the plot symbol for the reference lines factor.reference.pch ## To remove the plot symbol in the reference lines use 'NA' as follows: plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlab="Hazard ratio", factor.reference.label="Ref", title.values=expression(bold(HR (CI[95]))), title.labels=c("Drug/Time","Dose","Mean","St.dev.","N"), factor.reference.pos=c(1,10,19), factor.reference.pch=NA, cex=1.3, xaxis.at=c(0.75,1,1.25,1.5,2)) ## changing the style of the graphical confidence intervals plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], xlab="Hazard ratio", factor.reference.pos=c(1,10,19), points.pch=15, points.col=rainbow(27), points.cex=2, arrows.col="darkblue", cex=1.3, order=c(1,3,2), xaxis.at=c(0.75,1,1.25,1.5)) ## the values column of the graph can have multiple columns as well ## to illustrate this we create the confidence intervals ## before calling the function and then cbind them ## to the pvalues HR <- pubformat(CiTable[,6]) CI95 <- formatCI(lower=CiTable[,7],upper=CiTable[,8],format="(l-u)") pval <- format.pval(CiTable[,9],digits=3,eps=10^{-3}) pval[pval=="NA"] <- "" plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], values=list("HR"=HR,"CI-95"=CI95,"P-value"=pval), cex=1.2, xratio=c(0.5,0.3)) ## Finally, vertical columns can be delimited with background color ## NOTE: this may slow things down and potentially create ## large figures (many bytes) col1 <- rep(c(prodlim::dimColor("green",density=22), prodlim::dimColor("green")),length.out=9) col2 <- rep(c(prodlim::dimColor("orange",density=22), prodlim::dimColor("orange")),length.out=9) col3 <- rep(c(prodlim::dimColor("blue",density=22), prodlim::dimColor("blue")),length.out=9) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], stripes=c(1,0,1), stripes.col=c(col1,col2,col3)) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], stripes=c(1,1,1), stripes.col=c(col1,col2,col3)) threegreens <- c(prodlim::dimColor("green",density=55), prodlim::dimColor("green",density=33), prodlim::dimColor("green",density=22)) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], values=FALSE, xlim=c(0.75,1.5), stripes=c(1,1,1), xratio=c(0.5,0.15), stripes.horizontal=c(0,9,18,27)+0.5, stripes.col=threegreens) # combining multiple plots into one layout(t(matrix(1:5))) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=CiTable[,c("Mean","n")], layout=FALSE) plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], layout=FALSE) } \author{ Thomas A. Gerds } Publish/man/publish.ci.Rd0000644000176200001440000000214013571203036014757 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.ci.R \name{publish.ci} \alias{publish.ci} \title{Publish tables with confidence intervals} \usage{ \method{publish}{ci}(object, format = "[u;l]", se = FALSE, ...) } \arguments{ \item{object}{Object of class ci containing point estimates and the corresponding confidence intervals} \item{format}{A string which indicates the format used for confidence intervals. The string is passed to \code{\link{formatCI}} with two arguments: the lower and the upper limit. For example \code{'(l;u)'} yields confidence intervals with round parenthesis in which the upper and the lower limits are separated by semicolon.} \item{se}{If \code{TRUE} add standard error.} \item{...}{passed to \code{publish}} } \value{ table with confidence intervals } \description{ Publish tables with confidence intervals } \details{ This function calls summary.ci with print=FALSE and then publish } \examples{ data(Diabetes) publish(ci.mean(chol~location+gender,data=Diabetes),org=TRUE) } \seealso{ summary.ci } \author{ Thomas A. Gerds } Publish/man/summary.regressionTable.Rd0000644000176200001440000000317613603644022017555 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/summary.regressionTable.R \name{summary.regressionTable} \alias{summary.regressionTable} \alias{print.summary.regressionTable} \title{Formatting regression tables} \usage{ \method{summary}{regressionTable}(object, show.missing = "ifany", print = TRUE, ...) } \arguments{ \item{object}{object obtained with \code{regressionTable} or \code{summary.regressionTable}.} \item{show.missing}{Decide if number of missing values are shown. Either logical or character. If \code{'ifany'} then number missing values are shown if there are some.} \item{print}{If \code{TRUE} print results.} \item{...}{Used to control formatting of parameter estimates, confidence intervals and p-values. See examples.} } \value{ List with two elements: \itemize{ \item regressionTable: the formatted regression table (a data.frame) \item rawTable: table with the unformatted values (a data.frame) } } \description{ Preparing regression results for publication } \examples{ library(survival) data(pbc) pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) fit = coxph(Surv(time,status!=0)~age+sex+edema+log(bili)+log(albumin)+log(protime), data=pbc) u=summary(regressionTable(fit)) u$regressionTable u$rawTable summary(regressionTable(fit),handler="prettyNum") summary(regressionTable(fit),handler="format") summary(regressionTable(fit),handler="sprintf",digits=c(2,2),pValue.stars=TRUE) summary(regressionTable(fit),handler="sprintf",digits=c(2,2),pValue.stars=TRUE,ci.format="(l,u)") } \seealso{ publish.glm publish.coxph } \author{ Thomas A. Gerds } Publish/man/SpaceT.Rd0000644000176200001440000000212713671612701014107 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{data} \name{SpaceT} \alias{SpaceT} \title{A study was made of all 26 astronauts on the first eight space shuttle flights (Bungo et.al., 1985). On a voluntary basis 17 astronauts consumed large quantities of salt and fluid prior to landing as a countermeasure to space deconditioning, while nine did not.} \format{ A data frame with 52 observations on the following 4 variables: \describe{ \item{Status}{Factor with levels Post (after flight) and Pre (before flight)} \item{HR}{Supine heart rate(beats per minute)} \item{Treatment}{Countermeasure salt/fluid (1= yes, 0=no)} \item{ID}{Person id} } } \description{ A study was made of all 26 astronauts on the first eight space shuttle flights (Bungo et.al., 1985). On a voluntary basis 17 astronauts consumed large quantities of salt and fluid prior to landing as a countermeasure to space deconditioning, while nine did not. } \examples{ data(SpaceT) } \references{ Altman, Practical statistics for medical research, Page 223, Ex. 9.1. Bungo et.al., 1985 } Publish/man/trace.Rd0000644000176200001440000000262613671612701014032 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{data} \name{trace} \alias{trace} \title{trace data} \format{ A data frame with 1832 observations on the following 6 variables. \describe{ \item{Time}{Time after myocardial infarction, in 6 months intervals} \item{smoking}{Smoking status. A factor with levels (Never, Current, Previous)} \item{sex}{A factor with levels (Female, Male)} \item{age}{Age in years at the time of myocardial infarction} \item{ObsTime}{Cumulative risk time in each split} \item{dead}{Count of deaths} } } \description{ These data are from screening to the TRACE study, a comparison between the angiotensin converting enzyme inhibitor trandolapril and placebo ford large myocardial infarctions. A total of 6676 patients were screened for the study. Survival has been followed for the screened population for 16 years. The current data has been prepared for a poisson regression to examine survival. The data has been "split" in 0.5 year intervals (plitLexis function from Epi package) and then collapsed on all variables (aggregate function). } \examples{ data(trace) Units(trace,list("age"="years")) fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) rtf <- regressionTable(fit,factor.reference = "inline") summary(rtf) publish(fit) } \references{ Kober et al 1995 Am. J. Cardiol 76,1-5 } \keyword{datasets} Publish/man/org.Rd0000755000176200001440000000057513571203036013523 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/org.R \name{org} \alias{org} \title{Wrapper function for publish with output format org} \usage{ org(x, ...) } \arguments{ \item{x}{object to format as org} \item{...}{passed to publish} } \value{ See publish } \description{ Wrapper for \code{publish(...,org=TRUE)} } \author{ Thomas Alexander Gerds } Publish/man/CiTable.Rd0000644000176200001440000000127513671612672014245 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{data} \name{CiTable} \alias{CiTable} \title{CiTable data} \format{ A data frame with 27 observations on the following 9 variables. \describe{ \item{Drug}{} \item{Time}{} \item{Drug.Time}{} \item{Dose}{} \item{Mean}{} \item{SD}{} \item{n}{} \item{HazardRatio}{} \item{lower}{} \item{upper}{} \item{p}{} } } \description{ These data are used for testing Publish package functionality. } \examples{ data(CiTable) labellist <- split(CiTable[,c("Dose","Mean","SD","n")],CiTable[,"Drug"]) labellist plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=labellist) } \keyword{datasets} Publish/man/specialFrame.Rd0000644000176200001440000000707613603644022015327 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/specialFrame.R \name{specialFrame} \alias{specialFrame} \title{Special frame} \usage{ specialFrame( formula, data, unspecials.design = TRUE, specials, specials.factor = TRUE, specials.design = FALSE, strip.specials = TRUE, strip.arguments = NULL, strip.alias = NULL, strip.unspecials = NULL, drop.intercept = TRUE, response = TRUE, na.action = options()$na.action ) } \arguments{ \item{formula}{Formula whose left hand side specifies the event history, i.e., either via Surv() or Hist().} \item{data}{Data frame in which the formula is interpreted} \item{unspecials.design}{Passed as is to \code{\link{model.design}}.} \item{specials}{Character vector of special function names. Usually the body of the special functions is function(x)x but e.g., \code{\link{strata}} from the survival package does treat the values} \item{specials.factor}{Passed as is to \code{\link{model.design}}.} \item{specials.design}{Passed as is to \code{\link{model.design}}} \item{strip.specials}{Passed as \code{specials} to \code{\link{strip.terms}}} \item{strip.arguments}{Passed as \code{arguments} to \code{\link{strip.terms}}} \item{strip.alias}{Passed as \code{alias.names} to \code{\link{strip.terms}}} \item{strip.unspecials}{Passed as \code{unspecials} to \code{\link{strip.terms}}} \item{drop.intercept}{Passed as is to \code{\link{model.design}}} \item{response}{If FALSE do not get response data.} \item{na.action}{Decide what to do with missing values.} } \value{ A list which contains - the response - the design matrix (see \code{\link{model.design}}) - one entry for each special (see \code{\link{model.design}}) } \description{ Extract data and design matrix including specials from call } \details{ Obtain a list with the data used for event history regression analysis. This function cannot be used directly on the user level but inside a function to prepare data for survival analysis. } \examples{ ## Here are some data with an event time and no competing risks ## and two covariates X1 and X2. ## Suppose we want to declare that variable X1 is treated differently ## than variable X2. For example, X1 could be a cluster variable, or ## X1 should have a proportional effect on the outcome. d <- data.frame(y=1:7, X2=c(2.24,3.22,9.59,4.4,3.54,6.81,5.05), X3=c(1,1,1,1,0,0,1), X4=c(44.69,37.41,68.54,38.85,35.9,27.02,41.84), X1=factor(c("a","b","a","c","c","a","b"), levels=c("c","a","b"))) ## define special functions prop and cluster prop <- function(x)x cluster <- function(x)x ## We pass a formula and the data e <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, data=d, specials=c("prop","cluster")) ## The first element is the response e$response ## The other elements are the design, i.e., model.matrix for the non-special covariates e$design ## and a data.frame for the special covariates e$prop ## The special covariates can be returned as a model.matrix e2 <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, data=d, specials=c("prop","cluster"), specials.design=TRUE) e2$prop ## and the non-special covariates can be returned as a data.frame e3 <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, data=d, specials=c("prop","cluster"), specials.design=TRUE, unspecials.design=FALSE) e3$design } \seealso{ model.frame model.design Hist } \author{ Thomas A. Gerds } Publish/man/publish.htest.Rd0000644000176200001440000000154013571203036015516 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.htest.R \name{publish.htest} \alias{publish.htest} \title{Pretty printing of test results.} \usage{ \method{publish}{htest}(object, title, ...) } \arguments{ \item{object}{Result of \code{t.test} or \code{wilcox.test}} \item{title}{Decoration also used to name output} \item{...}{Used to transport arguments \code{ci.arg} and \code{pvalue.arg} to subroutines \code{format.pval} and \code{formatCI}. See also \code{prodlim::SmartControl}.} } \description{ Pretty printing of test results. } \examples{ data(Diabetes) publish(t.test(bp.2s~gender,data=Diabetes)) publish(wilcox.test(bp.2s~gender,data=Diabetes)) publish(with(Diabetes,t.test(bp.2s,bp.1s,paired=TRUE))) publish(with(Diabetes,wilcox.test(bp.2s,bp.1s,paired=TRUE))) } \author{ Thomas A. Gerds } Publish/man/traceR.Rd0000644000176200001440000000235013671612701014146 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{data} \name{traceR} \alias{traceR} \title{traceR data} \format{ A data frame with 1749 observations on the following variables. \describe{ \item{weight}{Weight in kilo} \item{height}{Height in meters} \item{abdominalCircumference}{in centimeters} \item{seCreatinine}{in mmol per liter} \item{wallMotionIndex}{left ventricular function 0-2, 0 worst, 2 normal} \item{observationTime}{time to death or censor} \item{age}{age in years} \item{sex}{0=female,1=male} \item{smoking}{0=never,1=prior,2=current} \item{dead}{0=censor,1=dead} \item{treatment}{placebo or trandolapril} } } \description{ These data are from the TRACE randomised trial, a comparison between the angiotensin converting enzyme inhibitor trandolapril and placebo ford large myocardial infarctions. In all, 1749 patients were randomised. The current data are from a 15 year follow-up. } \examples{ data(trace) Units(trace,list("age"="years")) fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) rtf <- regressionTable(fit,factor.reference = "inline") summary(rtf) publish(fit) } \references{ Kober et al 1995 NEJM 333,1670 } \keyword{datasets} Publish/man/publish.matrix.Rd0000644000176200001440000000524713734301206015702 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.matrix.R \name{publish.matrix} \alias{publish.matrix} \title{Publishing a matrix in raw, org, latex, or muse format} \usage{ \method{publish}{matrix}( object, title, colnames = TRUE, rownames = TRUE, col1name = "", digits = 4, try.convert = TRUE, sep = " ", endhead, endrow, style, inter.lines, latex = FALSE, wiki = FALSE, org = FALSE, markdown = FALSE, tabular = TRUE, latex.table.format = NA, latex.hline = 1, latex.nodollar = FALSE, ... ) } \arguments{ \item{object}{Matrix to be published} \item{title}{Title for table, only in wiki and muse format} \item{colnames}{If \code{TRUE} show column names} \item{rownames}{If \code{TRUE} show row names} \item{col1name}{Name for first column} \item{digits}{Numbers are rounded according to digits} \item{try.convert}{Logical. If \code{TRUE} try to convert also non-numeric formats such as character to numeric before rounding. Default is \code{TRUE}.} \item{sep}{Field separator when style is \code{"none"}} \item{endhead}{String to be pasted at the end of the first row (header)} \item{endrow}{String to be pasted at the end of each row} \item{style}{Table style for export to \code{"latex"}, \code{"org"}, \code{"markdown"}, \code{"wiki"}, \code{"none"}. Overwritten by argments below.} \item{inter.lines}{A named list which contains strings to be placed between the rows of the table. An element with name \code{"0"} is used to place a line before the first column, elements with name \code{"r"} are placed between line r and r+1.} \item{latex}{If \code{TRUE} use latex table format} \item{wiki}{If \code{TRUE} use mediawiki table format} \item{org}{If \code{TRUE} use emacs orgmode table format} \item{markdown}{If \code{TRUE} use markdown table format} \item{tabular}{For style \code{latex} only: if \code{TRUE} enclose the table in begin/end tabular environement.} \item{latex.table.format}{For style \code{latex} only: format of the tabular environement.} \item{latex.hline}{For style \code{latex} only: if \code{TRUE} add hline statements add the end of each line.} \item{latex.nodollar}{For style \code{latex} only: if \code{TRUE} do not enclose numbers in dollars.} \item{...}{Used to transport arguments. Currently supports \code{wiki.class}.} } \description{ This is the heart of the Publish package } \examples{ x <- matrix(1:12,ncol=3) publish(x) # rounding the numeric part of data mixtures y <- cbind(matrix(letters[1:12],ncol=3),x,matrix(rnorm(12),ncol=3)) publish(y,digits=1) publish(x,inter.lines=list("1"="text between line 1 and line 2", "3"="text between line 3 and line 4")) } Publish/man/subgroupAnalysis.Rd0000644000176200001440000001166613761464262016321 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/subgroupAnalysis.R \name{subgroupAnalysis} \alias{subgroupAnalysis} \title{Subgroup Analysis - Interactions and estimates} \usage{ subgroupAnalysis(object,data,treatment, subgroups, confint.method="default",factor.reference="extraline") } \arguments{ \item{object}{- glm, coxph or cph object for which subgroups should be analyzed.} \item{data}{- Dataset including all relevant variables} \item{treatment}{- Must be numeric - 0/1} \item{subgroups}{- A vector of variable names presenting the factor variables where subgroups should be formed. These variables should all be "factors"} \item{confint.method}{"default" creates Wald type confidence interval, "robust", creates creates robust standard errors - see regressionTable function.} \item{factor.reference}{"extraline" creates an extraline for the reference, "inline" avoids this line.} } \value{ A data.frame with subsgroup specifications, number in each subgroup, parameter estimates and p-value for interaction. A forest plot can be obtained with "plotConfidence". } \description{ The function can examine Cox regression, logistic regression and Poisson regression (Poisson regression for survival analysis) where the effect of one variable is of particular interest. This function systematically checks for effect modification with a list of other variables. In randomised studies the main regression analysis is often univariate and includes only the exposure of interest. In observational studies the main regression analysis can readily be adjusted for other variables including those which may modify the effect of the variable of interest. } \details{ The function can only handle a bivariate treatment, which MUST coded as zero or one. The p-value for interaction is obtained with a likelihood ratio test comparing the main regression analysis with the interaction model. There are plot and print functions available for the function see helppages for plot.subgroupAnalysis and print.subgroupAnalysis } \examples{ #load libraries library(data.table) library(Publish) library(survival) data(traceR) #get dataframe traceR data.table::setDT(traceR) traceR[,':='(wmi2=factor(wallMotionIndex<0.9,levels=c(TRUE,FALSE), labels=c("bad","good")), abd2=factor(abdominalCircumference<95, levels=c(TRUE,FALSE), labels=c("slim","fat")))] traceR[,sex:=as.factor(sex)] # all subgroup variables needs to be factor traceR[observationTime==0,observationTime:=1] # remove missing covariate values traceR=na.omit(traceR) # univariate analysis of smoking in subgroups of age and sex # Main regression analysis is a simple/univariate Cox regression fit_cox <- coxph(Surv(observationTime,dead)~treatment,data=traceR) sub_cox <- subgroupAnalysis(fit_cox,traceR,treatment="treatment", subgroups=c("smoking","sex","wmi2","abd2")) sub_cox # to see how the results are obtained consider the variable: smoking fit_cox_smoke <- coxph(Surv(observationTime,dead)~treatment*smoking,data=traceR) # the last three rows of the following output: publish(fit_cox_smoke) # are included in the first 3 rows of the result of the sub group analysis: sub_cox[1:3,] # the p-value is obtained as: fit_cox_smoke_add <- coxph(Surv(observationTime,dead)~treatment+smoking,data=traceR) anova(fit_cox_smoke_add,fit_cox_smoke,test="Chisq") # Note that a real subgroup analysis would be to subset the data fit_cox1a <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="never"]) fit_cox1b <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="current"]) fit_cox1c <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="prior"]) ## when the main analysis is already adjusted fit_cox_adj <- coxph(Surv(observationTime,dead)~treatment+smoking+sex+wmi2+abd2, data=traceR) sub_cox_adj <- subgroupAnalysis(fit_cox_adj,traceR,treatment="treatment", subgroups=c("smoking","sex","wmi2","abd2")) # subgroups as character string sub_cox_adj # When both start and end are in the Surv statement: traceR[,null:=0] fit_cox2 <- coxph(Surv(null,observationTime,dead)~treatment+smoking+sex+wmi2+abd2,data=traceR) summary(regressionTable(fit_cox)) sub_cox2 <- subgroupAnalysis(fit_cox2,traceR,treatment="treatment", subgroups=c("smoking","sex","wmi2","abd2")) # Analysis with Poisson - and the unrealistic assumption of constant hazard # and adjusted for age in all subgroups fit_p <- glm(dead~treatment+age+offset(log(observationTime)),family="poisson", data=traceR) sub_pois <- subgroupAnalysis(fit_p,traceR,treatment="treatment", subgroups=~smoking+sex+wmi2+abd2) # Analysis with logistic regression - and very wrongly ignoring censoring fit_log <- glm(dead~treatment+age,family="binomial",data=traceR) sub_log <- subgroupAnalysis(fit_log,traceR,treatment="treatment", subgroups=~smoking+sex+wmi2+abd2, factor.reference="inline") } \seealso{ coxph, glm, plotConfidence } \author{ Christian Torp-Pedersen } Publish/man/stripes.Rd0000644000176200001440000000346113603644022014417 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stripes.R \name{stripes} \alias{stripes} \title{Background and grid color control.} \usage{ stripes( xlim, ylim, col = "white", lwd = 1, gridcol = "gray77", fill = "white", horizontal = NULL, vertical = NULL, border = "black", xpd = FALSE ) } \arguments{ \item{xlim}{Limits for the horizontal x-dimension. Defaults to par("usr")[1:2].} \item{ylim}{Limits for the vertical y-dimension.} \item{col}{Colors use for the stripes. Can be a vector of colors which are then repeated appropriately.} \item{lwd}{Line width} \item{gridcol}{Color of grid lines} \item{fill}{Color to fill the background rectangle given by par("usr").} \item{horizontal}{Numerical values at which to show horizontal grid lines, and at which to change the color of the stripes.} \item{vertical}{Numerical values at which to show vertical grid lines.} \item{border}{If a fill color is provided, the color of the border around the background.} \item{xpd}{From \code{help(par)}: A logical value or NA. If FALSE, all plotting is clipped to the plot region, if TRUE, all plotting is clipped to the figure region, and if NA, all plotting is clipped to the device region. See also \code{clip}.} } \description{ Some users like background colors, and it may be helpful to have grid lines to read off e.g. probabilities from a Kaplan-Meier graph. Both things can be controlled with this function. However, it mainly serves \code{\link{plot.prodlim}}. } \examples{ plot(0,0) backGround(bg="beige",fg="red",vertical=0,horizontal=0) plot(0,0) stripes(col=c("yellow","green"),gridcol="red",xlim=c(-1,1),horizontal=seq(0,1,.1)) stripes(col=c("yellow","green"),gridcol="red",horizontal=seq(0,1,.1)) } \author{ Thomas Alexander Gerds } \keyword{survival} Publish/man/splinePlot.lrm.Rd0000644000176200001440000000330113671612701015645 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/splinePlot.lrm.R \name{splinePlot.lrm} \alias{splinePlot.lrm} \title{Plot predictions of logistic regression} \usage{ splinePlot.lrm( object, xvar, xvalues, xlim = range(xvalues), ylim, xlab = xvar, ylab = scale[[1]], col = 1, lty = 1, lwd = 3, confint = TRUE, newdata = NULL, scale = c("risk", "odds"), add = FALSE, ... ) } \arguments{ \item{object}{Logistic regression model fitted with \code{rms::lrm}} \item{xvar}{Name of the variable to show on x-axis} \item{xvalues}{Sequence of \code{xvar} values} \item{xlim}{x-axis limits} \item{ylim}{y-axis limits} \item{xlab}{x-axis labels} \item{ylab}{y-axis labels} \item{col}{color of the line} \item{lty}{line style} \item{lwd}{line width} \item{confint}{Logical. If \code{TRUE} show confidence shadows} \item{newdata}{How to adjust} \item{scale}{Character string that determines the outcome scale (y-axis). Choose between \code{"risk"} and \code{"odds"}.} \item{add}{Logical. If \code{TRUE} add lines to an existing graph} \item{...}{Further arguments passed to \code{plot}. Only if \code{add} is \code{FALSE}.} } \description{ Plotting the prediction of a logistic regression model with confidence bands against one continuous variable. } \details{ Function which extracts from a logistic regression model fitted with \code{rms::lrm} the predicted risks or odds. } \examples{ data(Diabetes) Diabetes$hypertension= 1*(Diabetes$bp.1s>140) library(rms) uu <- datadist(Diabetes) options(datadist="uu") fit=lrm(hypertension~rcs(age)+gender+hdl,data=Diabetes) splinePlot.lrm(fit,xvar="age",xvalues=seq(30,50,1)) } \author{ Thomas A. Gerds } Publish/man/Diabetes.Rd0000644000176200001440000000463213671612701014453 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{data} \name{Diabetes} \alias{Diabetes} \title{Diabetes data of Dr John Schorling} \format{ A data frame with 205 observations on the following 12 variables. \describe{ \item{id}{subject id} \item{chol}{Total Cholesterol} \item{stab.glu}{Stabilized Glucose} \item{hdl}{High Density Lipoprotein} \item{ratio}{Cholesterol/HDL Ratio} \item{glyhb}{Glycosolated Hemoglobin} \item{location}{a factor with levels (Buckingham,Louisa)} \item{age}{age (years)} \item{gender}{male or female} \item{height}{height (inches)} \item{height.europe}{height (cm)} \item{weight}{weight (pounds)} \item{weight.europe}{weight (kg)} \item{frame}{a factor with levels (small,medium,large)} \item{bp.1s}{First Systolic Blood Pressure} \item{bp.1d}{First Diastolic Blood Pressure} \item{bp.2s}{Second Diastolic Blood Pressure} \item{bp.2d}{Second Diastolic Blood Pressure} \item{waist}{waist in inches} \item{hip}{hip in inches} \item{time.ppn}{Postprandial Time when Labs were Drawn in minutes} \item{AgeGroups}{Categorized age} \item{BMI}{Categorized BMI} } } \source{ \url{http://192.38.117.59/~tag/Teaching/share/data/Diabetes.html} } \description{ These data are courtesy of Dr John Schorling, Department of Medicine, University of Virginia School of Medicine. The data consist of 19 variables on 403 subjects from 1046 subjects who were interviewed in a study to understand the prevalence of obesity, diabetes, and other cardiovascular risk factors in central Virginia for African Americans. According to Dr John Hong, Diabetes Mellitus Type II (adult onset diabetes) is associated most strongly with obesity. The waist/hip ratio may be a predictor in diabetes and heart disease. DM II is also agssociated with hypertension - they may both be part of "Syndrome X". The 403 subjects were the ones who were actually screened for diabetes. Glycosolated hemoglobin > 7.0 is usually taken as a positive diagnosis of diabetes. } \examples{ data(Diabetes) } \references{ Willems JP, Saunders JT, DE Hunt, JB Schorling: Prevalence of coronary heart disease risk factors among rural blacks: A community-based study. Southern Medical Journal 90:814-820; 1997 Schorling JB, Roach J, Siegel M, Baturka N, Hunt DE, Guterbock TM, Stewart HL: A trial of church-based smoking cessation interventions for rural African Americans. Preventive Medicine 26:92-101; 1997. } \keyword{datasets} Publish/man/followupTable.Rd0000644000176200001440000000324413571203036015544 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/followupTable.R \name{followupTable} \alias{followupTable} \title{Summary tables for a given followup time point.} \usage{ followupTable(formula, data, followup.time, compare.groups, ...) } \arguments{ \item{formula}{Formula A formula whose left hand side is a \code{Hist} object. In some special cases it can also be a \code{Surv} response object. The right hand side is as in \code{\link{utable}}.} \item{data}{A data.frame in which all the variables of \code{formula} can be interpreted.} \item{followup.time}{Time point at which to evaluate outcome status.} \item{compare.groups}{Method for comparing groups.} \item{...}{Passed to \code{utable}. All arguments of \code{utable} can be controlled in this way except for \code{compare.groups} which is set to \code{"Cox"}. See details.} } \value{ Summary table. } \description{ Summarize baseline variables in groups defined by outcome at a given followup time point } \details{ If \code{compare.groups!=FALSE}, p-values are obtained from stopped Cox regression, i.e., all events are censored at follow-up time. A univariate Cox regression model is fitted to assess the effect of each variable on the right hand side of the formula on the event hazard and shown is the p-value of \code{anova(fit)}, see \code{\link{anova.coxph}}. } \examples{ library(survival) data(pbc) pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) pbc$sex <- factor(pbc$sex,levels=c("m","f"),labels=c("m","f")) followupTable(Hist(time,status)~age+edema+sex,data=pbc,followup.time=1000) } \seealso{ univariateTable } \author{ Thomas A. Gerds } Publish/man/ci.mean.default.Rd0000755000176200001440000000163413603644022015666 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ci.mean.default.R \name{ci.mean.default} \alias{ci.mean.default} \title{Compute mean values with confidence intervals} \usage{ \method{ci.mean}{default}( x, alpha = 0.05, normal = TRUE, na.rm = TRUE, statistic = "arithmetic", ... ) } \arguments{ \item{x}{numeric vector} \item{alpha}{level of significance} \item{normal}{If \code{TRUE} use quantile of t-distribution else use normal approximation and quantile of normal approximation. Do you think this is confusing?} \item{na.rm}{If \code{TRUE} remove missing values from \code{x}.} \item{statistic}{Decide which mean to compute: either \code{"arithmetic"} or \code{"geometric"}} \item{...}{not used} } \value{ a list with mean values and confidence limits } \description{ Compute mean values with confidence intervals } \details{ Normal approximation } \author{ Thomas Gerds } Publish/man/ci.mean.Rd0000755000176200001440000000065613571203036014246 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/ci.mean.R \name{ci.mean} \alias{ci.mean} \title{Compute mean values with confidence intervals} \usage{ ci.mean(x, ...) } \arguments{ \item{x}{object passed to methods} \item{...}{passed to methods} } \value{ a list with mean values and confidence limits } \description{ Compute mean values with confidence intervals } \details{ Normal approximation } Publish/man/publish.survdiff.Rd0000644000176200001440000000141613571203036016221 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.survdiff.R \name{publish.survdiff} \alias{publish.survdiff} \title{Alternative summary of survdiff results} \usage{ \method{publish}{survdiff}(object, digits = c(2, 4), print = TRUE, ...) } \arguments{ \item{object}{Object obtained with \code{survival::survdiff}.} \item{digits}{Vector with digits for rounding numbers: the second for pvalues, the first for all other numbers.} \item{print}{If \code{FALSE} do not print results.} \item{...}{Not (yet) used.} } \description{ Alternative summary of survdiff results } \examples{ library(survival) data(pbc) sd <- survdiff(Surv(time,status!=0)~sex,data=pbc) publish(sd) publish(sd,digits=c(3,2)) } \author{ Thomas A. Gerds } Publish/man/Publish-package.Rd0000644000176200001440000000050713571203036015723 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish-package.R \docType{package} \name{Publish-package} \alias{Publish-package} \title{Publish package} \description{ This package processes results of descriptive statistcs and regression analysis into final tables and figures of a manuscript } Publish/man/plot.regressionTable.Rd0000644000176200001440000000275713571203036017042 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.regressionTable.R \name{plot.regressionTable} \alias{plot.regressionTable} \title{Plotting regression coefficients with confidence limits} \usage{ \method{plot}{regressionTable}(x, xlim, xlab, style = 1, ...) } \arguments{ \item{x}{regression table obtained with regressionTable} \item{xlim}{Limits for x-axis} \item{xlab}{Label for x-axis} \item{style}{Determines how to arrange variable names and their corresponding units} \item{...}{passed to plotConfidence} } \description{ Plotting regression coefficients with confidence limits } \examples{ ## linear regression data(Diabetes) f <- glm(bp.1s~AgeGroups+chol+gender+location,data=Diabetes) rtf <- regressionTable(f,factor.reference = "inline") plot(rtf,cex=1.3) ## logistic regression data(Diabetes) f <- glm(I(BMI>25)~bp.1s+AgeGroups+chol+gender+location,data=Diabetes,family=binomial) rtf <- regressionTable(f,factor.reference = "inline") plot(rtf,cex=1.3) ## Poisson regression data(trace) fit <- glm(dead ~ smoking+ sex+ age+Time+offset(log(ObsTime)), family = poisson,data=trace) rtab <- regressionTable(fit,factor.reference = "inline") plot(rtab,xlim=c(0.85,1.15),cex=1.8,xaxis.cex=1.5) ## Cox regression library(survival) data(pbc) coxfit <- coxph(Surv(time,status!=0)~age+log(bili)+log(albumin)+factor(edema)+sex,data=pbc) pubcox <- publish(coxfit) plot(pubcox,cex=1.5,xratio=c(0.4,0.2)) } \seealso{ regressionTable } \author{ Thomas A. Gerds } Publish/man/publish.CauseSpecificCox.Rd0000644000176200001440000000357113761462710017564 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.CauseSpecificCox.R \name{publish.CauseSpecificCox} \alias{publish.CauseSpecificCox} \title{Tabulizing cause-specific hazard ratio from all causes with confidence limits and Wald test p-values.} \usage{ \method{publish}{CauseSpecificCox}( object, cause, confint.method, pvalue.method, factor.reference = "extraline", units = NULL, print = TRUE, ... ) } \arguments{ \item{object}{Cause-specific hazard model obtained with \code{CSC}.} \item{cause}{Show a table for this cause. If omitted, list all causes.} \item{confint.method}{See \code{regressionTable}} \item{pvalue.method}{See \code{regressionTable}} \item{factor.reference}{See \code{regressionTable}} \item{units}{See \code{regressionTable}} \item{print}{If \code{TRUE} print the table(s).} \item{...}{passed on to control formatting of parameters, confidence intervals and p-values. See \code{summary.regressionTable}.} } \value{ Table with cause-specific hazard ratios, confidence limits and p-values. } \description{ Publish cause-specific Cox models } \details{ The cause-specific hazard ratio's are combined into one table. } \examples{ if (requireNamespace("riskRegression",quietly=TRUE)){ library(riskRegression) library(prodlim) library(survival) data(Melanoma,package="riskRegression") fit1 <- CSC(list(Hist(time,status)~sex,Hist(time,status)~invasion+epicel+age), data=Melanoma) publish(fit1) publish(fit1,pvalue.stars=TRUE) publish(fit1,factor.reference="inline",units=list("age"="years")) # wide format (same variables in both Cox regression formula) fit2 <- CSC(Hist(time,status)~invasion+epicel+age, data=Melanoma) publish(fit2) # with p-values x <- publish(fit2,print=FALSE) table <- cbind(x[[1]]$regressionTable, x[[2]]$regressionTable[,-c(1,2)]) } } \author{ Thomas Alexander Gerds } Publish/man/publish.MIresult.Rd0000644000176200001440000001056213761463045016150 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.MIresult.R \name{publish.MIresult} \alias{publish.MIresult} \title{Present logistic regression and Cox regression obtained with mitools::MIcombine based on smcfcs::smcfcs multiple imputation analysis} \usage{ \method{publish}{MIresult}( object, confint.method, pvalue.method, digits = c(2, 4), print = TRUE, factor.reference = "extraline", intercept, units = NULL, fit, data, ... ) } \arguments{ \item{object}{Object obtained with mitools::MIcombine based on smcfcs::smcfcs multiple imputation analysis} \item{confint.method}{No options here. Only Wald type confidence intervals.} \item{pvalue.method}{No options here. Only Wald type tests.} \item{digits}{Rounding digits for all numbers but the p-values.} \item{print}{If \code{FALSE} suppress printing of the results} \item{factor.reference}{Style for showing results for categorical. See \code{regressionTable}.} \item{intercept}{See \code{regressionTable}.} \item{units}{See \code{regressionTable}.} \item{fit}{One fitted model using the same formula as \code{object}. This can be the fit to the complete case data or the fit to one of the completed data. It is used to get xlevels, formula and terms. For usage see examples. is used to fit} \item{data}{Original data set which includes the missing values} \item{...}{passed to summary.regressionTable, labelUnits and publish.default.} } \description{ Regression tables after multiple imputations } \details{ Show results of smcfcs based multiple imputations of missing covariates in publishable format } \examples{ \dontrun{ if (requireNamespace("riskRegression",quietly=TRUE) & requireNamespace("mitools",quietly=TRUE) & requireNamespace("smcfcs",quietly=TRUE)){ library(riskRegression) library(mitools) library(smcfcs) ## continuous outcome: linear regression # lava some data with missing values set.seed(7) d=sampleData(78) ## generate missing values d[X1==1,X6:=NA] d[X2==1,X3:=NA] d=d[,.(X8,X4,X3,X6,X7)] sapply(d,function(x)sum(is.na(x))) # multiple imputation (should set m to a large value) set.seed(17) f= smcfcs(d,smtype="lm", smformula=X8~X4+X3+X6+X7, method=c("","","logreg","norm",""),m=3) ccfit=lm(X8~X4+X3+X6+X7,data=d) mifit=MIcombine(with(imputationList(f$impDatasets), lm(X8~X4+X3+X6+X7))) publish(mifit,fit=ccfit,data=d) publish(ccfit) ## binary outcome # lava some data with missing values set.seed(7) db=sampleData(78,outcome="binary") ## generate missing values db[X1==1,X6:=NA] db[X2==1,X3:=NA] db=db[,.(Y,X4,X3,X6,X7)] sapply(db,function(x)sum(is.na(x))) # multiple imputation (should set m to a large value) set.seed(17) fb= smcfcs(db,smtype="logistic", smformula=Y~X4+X3+X6+X7, method=c("","","logreg","norm",""),m=2) ccfit=glm(Y~X4+X3+X6+X7,family="binomial",data=db) mifit=MIcombine(with(imputationList(fb$impDatasets), glm(Y~X4+X3+X6+X7,family="binomial"))) publish(mifit,fit=ccfit) publish(ccfit) ## survival: Cox regression library(survival) # lava some data with missing values set.seed(7) ds=sampleData(78,outcome="survival") ## generate missing values ds[X5==1,X6:=NA] ds[X2==1,X3:=NA] ds=ds[,.(time,event,X4,X3,X6,X7)] sapply(ds,function(x)sum(is.na(x))) set.seed(17) fs= smcfcs(ds,smtype="coxph", smformula="Surv(time,event)~X4+X3+X6+X7", method=c("","","","logreg","norm",""),m=2) ccfit=coxph(Surv(time,event)~X4+X3+X6+X7,data=ds) mifit=MIcombine(with(imputationList(fs$impDatasets), coxph(Surv(time,event)~X4+X3+X6+X7))) publish(mifit,fit=ccfit,data=ds) publish(ccfit) ## competing risks: Cause-specific Cox regression library(survival) # lava some data with missing values set.seed(7) dcr=sampleData(78,outcome="competing.risks") ## generate missing values dcr[X5==1,X6:=NA] dcr[X2==1,X3:=NA] dcr=dcr[,.(time,event,X4,X3,X6,X7)] sapply(dcr,function(x)sum(is.na(x))) set.seed(17) fcr= smcfcs(dcr,smtype="compet", smformula=c("Surv(time,event==1)~X4+X3+X6+X7", "Surv(time,event==2)~X4+X3+X6+X7"), method=c("","","","logreg","norm",""),m=2) ## cause 2 ccfit2=coxph(Surv(time,event==2)~X4+X3+X6+X7,data=dcr) mifit2=MIcombine(with(imputationList(fcr$impDatasets), coxph(Surv(time,event==2)~X4+X3+X6+X7))) publish(mifit2,fit=ccfit2,data=dcr) publish(ccfit2) } } } \author{ Thomas A. Gerds } Publish/man/formatCI.Rd0000644000176200001440000000462613745464047014454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/formatCI.R \name{formatCI} \alias{formatCI} \title{Formatting confidence intervals} \usage{ formatCI( x, lower, upper, show.x = FALSE, handler = "sprintf", format = "[l;u]", degenerated = "asis", digits = 2, nsmall = digits, sep = "", reference.pos, reference.label = "", ... ) } \arguments{ \item{x}{not used (for compatibility with format)} \item{lower}{Numeric vector of lower limits} \item{upper}{Numeric vector of upper limits} \item{show.x}{Logical. If \code{TRUE} show value of x in front of confidence interval.} \item{handler}{Function to format numeric values. Default is \code{sprintf}, also supported are \code{format} and \code{prettyNum}} \item{format}{Character string in which \code{l} will be replaced by the value of the lower limit (argument lower) and \code{u} by the value of the upper upper limit. For example, \code{(l,u)} yields confidence intervals in round parenthesis in which the upper and lower limits are comma separated. Default is \code{[l;u]}.} \item{degenerated}{String to show when lower==upper. Default is '--'} \item{digits}{If handler \code{format} or \code{prettyNum} used format numeric vectors.} \item{nsmall}{If handler \code{format} or \code{prettyNum} used format numeric vectors.} \item{sep}{Field separator} \item{reference.pos}{Position of factor reference} \item{reference.label}{Label for factor reference} \item{...}{passed to handler} } \value{ String vector with confidence intervals } \description{ Format confidence intervals } \details{ The default format for confidence intervals is [lower; upper]. } \examples{ x=ci.mean(rnorm(10)) formatCI(lower=x[3],upper=x[4]) formatCI(lower=c(0.001,-2.8413),upper=c(1,3.0008884)) # change format formatCI(lower=c(0.001,-2.8413),upper=c(1,3.0008884),format="(l, u)") # show x formatCI(x=x$mean,lower=x$lower,upper=x$upper,format="(l, u)",show.x=TRUE) # change of handler function l <- c(-0.0890139,0.0084736,144.898333,0.000000001) u <- c(0.03911392,0.3784706,3338944.8821221,0.00001) cbind(format=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="format"), prettyNum=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="prettyNum"), sprintf=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="sprintf")) } \seealso{ plot.ci ci.mean } \author{ Thomas A. Gerds } Publish/man/publish.glm.Rd0000755000176200001440000000641713761464755015203 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/publish.glm.R \name{publish.glm} \alias{publish.glm} \title{Tabulize regression coefficients with confidence intervals and p-values.} \usage{ \method{publish}{glm}( object, confint.method, pvalue.method, digits = c(2, 4), print = TRUE, factor.reference = "extraline", intercept = ifelse((is.null(object$family) || object$family$family == "gaussian"), 1L, 0L), units = NULL, ... ) } \arguments{ \item{object}{A \code{glm} object.} \item{confint.method}{See \code{regressionTable}.} \item{pvalue.method}{See \code{regressionTable}.} \item{digits}{A vector of two integer values. These determine how to round numbers (first value) and p-values (second value). E.g., c(1,3) would mean 1 digit for all numbers and 3 digits for p-values. The actual rounding is done by \code{summary.regressionTable}.} \item{print}{If \code{FALSE} do not print results.} \item{factor.reference}{Style for showing results for categorical. See \code{regressionTable}.} \item{intercept}{See \code{regressionTable}.} \item{units}{See \code{regressionTable}.} \item{...}{passed to \code{summary.regressionTable} and also to \code{labelUnits}.} \item{reference}{Style for showing results for categorical variables. If \code{"extraline"} show an additional line for the reference category.} } \value{ Table with regression coefficients, confidence intervals and p-values. } \description{ Tabulate the results of a generalized linear regression analysis. } \details{ The table shows changes in mean for linear regression and odds ratios for logistic regression (family = binomial). } \examples{ data(Diabetes) ## Linear regression f = glm(bp.2s~frame+gender+age,data=Diabetes) publish(f) publish(f,factor.reference="inline") publish(f,pvalue.stars=TRUE) publish(f,ci.format="(l,u)") ### interaction fit = glm(bp.2s~frame+gender*age,data=Diabetes) summary(fit) publish(fit) Fit = glm(bp.2s~frame*gender+age,data=Diabetes) publish(Fit) ## Logistic regression Diabetes$hyper1 <- factor(1*(Diabetes$bp.1s>140)) lrfit <- glm(hyper1~frame+gender+age,data=Diabetes,family=binomial) publish(lrfit) ### interaction lrfit1 <- glm(hyper1~frame+gender*age,data=Diabetes,family=binomial) publish(lrfit1) lrfit2 <- glm(hyper1~frame*gender+age,data=Diabetes,family=binomial) publish(lrfit2) ## Poisson regression data(trace) trace <- Units(trace,list("age"="years")) fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) rtf <- regressionTable(fit,factor.reference = "inline") summary(rtf) publish(fit) ## gls regression if (requireNamespace("nlme",quietly=TRUE)){ requireNamespace("lava",quietly=TRUE) library(lava) library(nlme) m <- lvm(Y ~ X1 + gender + group + Interaction) distribution(m, ~gender) <- binomial.lvm() distribution(m, ~group) <- binomial.lvm(size = 2) constrain(m, Interaction ~ gender + group) <- function(x){x[,1]*x[,2]} d <- sim(m, 1e2) d$gender <- factor(d$gender, labels = letters[1:2]) d$group <- factor(d$group) e.gls <- gls(Y ~ X1 + gender*group, data = d, weights = varIdent(form = ~1|group)) publish(e.gls) ## lme fm1 <- lme(distance ~ age*Sex, random = ~1|Subject, data = Orthodont) res <- publish(fm1) } } \author{ Thomas Alexander Gerds } Publish/man/table2x2.Rd0000644000176200001440000000161713603644022014352 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/table2x2.R \name{table2x2} \alias{table2x2} \title{2x2 table calculus for teaching} \usage{ table2x2( x, digits = 1, stats = c("table", "rd", "rr", "or", "chisq", "fisher") ) } \arguments{ \item{x}{2x2 table} \item{digits}{rounding digits} \item{stats}{subset or all of \code{c("table","rd","or","rr","chisq","fisher")} where rd= risk difference, rr = risk ratio, or = odds ratio, chisq = chi-square test, fisher= fisher's exact test and table = the 2x2 table} } \value{ see example } \description{ 2x2 table calculus for teaching } \details{ 2x2 table calculus for teaching } \examples{ table2x2(table("marker"=rbinom(100,1,0.4),"response"=rbinom(100,1,0.1))) table2x2(matrix(c(71,18,38,8),ncol=2),stats="table") table2x2(matrix(c(71,18,38,8),ncol=2),stats=c("rr","fisher")) } \author{ Thomas A. Gerds } Publish/man/univariateTable.Rd0000755000176200001440000001631013734301206016044 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/univariateTable.R \name{univariateTable} \alias{univariateTable} \alias{utable} \title{Univariate table} \usage{ univariateTable( formula, data = parent.frame(), summary.format = "mean(x) (sd(x))", Q.format = "median(x) [iqr(x)]", freq.format = "count(x) (percent(x))", column.percent = TRUE, digits = c(1, 1, 3), big.mark = ",", short.groupnames, compare.groups = TRUE, show.totals = TRUE, n = "inNames", outcome = NULL, ... ) } \arguments{ \item{formula}{Formula specifying the grouping variable (strata) on the left hand side (can be omitted) and on the right hand side the variables for which to obtain (descriptive) statistics.} \item{data}{Data set in which formula is evaluated} \item{summary.format}{Format for the numeric (non-factor) variables. Default is mean (SD). If different formats are desired, either special Q can be used or the function is called multiple times and the results are rbinded. See examples.} \item{Q.format}{Format for quantile summary of numerical variables: Default is median (inter quartile range).} \item{freq.format}{Format for categorical variables. Default is count (percentage).} \item{column.percent}{Logical, if \code{TRUE} and the default freq.format is used then column percentages are given instead of row percentages for categorical variables (factors).} \item{digits}{Number of digits} \item{big.mark}{For formatting large numbers (i.e., greater than 1,000). \code{""} turn this off.} \item{short.groupnames}{If \code{TRUE} group names are abbreviated.} \item{compare.groups}{Method used to compare groups. If \code{"logistic"} and there are exactly two groups logistic regression is used instead of t-tests and Wilcoxon rank tests to compare numeric variables across groups.} \item{show.totals}{If \code{TRUE} show a column with totals.} \item{n}{If \code{TRUE} show the number of subjects as a separate row. If equal to \code{"inNames"}, show the numbers in parentheses in the column names. If \code{FALSE} do not show number of subjects.} \item{outcome}{Outcome data used to calculate p-values when compare groups method is \code{'logistic'} or \code{'cox'}.} \item{...}{saved as part of the result to be passed on to \code{labelUnits}} } \value{ List with one summary table element for each variable on the right hand side of formula. The summary tables can be combined with \code{rbind}. The function \code{summary.univariateTable} combines the tables, and shows p-values in custom format. } \description{ Categorical variables are summarized using counts and frequencies and compared . } \details{ This function can generate the baseline demographic characteristics that forms table 1 in many publications. It is also useful for generating other tables of univariate statistics. The result of the function is an object (list) which containe the various data generated. In most applications the \code{summary} function should be applied which generates a data.frame with a (nearly) publication ready table. Standard manipulation can be used to modify, add or remove columns/rows and for users not accustomed to R the table generated can be exported to a text file which can be read by other software, e.g., via write.csv(table,file="path/to/results/table.csv") By default, continuous variables are summarized by means and standard deviations and compared with t-tests. When continuous variables are summarized by medians and interquartile ranges the Deviations from the above defaults are obtained when the arguments summary.format and freq.format are combined with suitable summary functions. } \examples{ data(Diabetes) library(data.table) univariateTable(~age,data=Diabetes) univariateTable(~gender,data=Diabetes) univariateTable(~age+gender+ height+weight,data=Diabetes) ## same thing but less typing utable(~age+gender+ height+weight,data=Diabetes) ## summary by location: univariateTable(location~Q(age)+gender+height+weight,data=Diabetes) ## continuous variables marked with Q() are (by default) summarized ## with median (IQR) and kruskal.test (with two groups equivalent to wilcox.test) ## variables not marked with Q() are (by default) summarized ## with mean (sd) and anova.glm(...,test="Chisq") ## the p-value of anova(glm()) with only two groups is similar ## but not exactly equal to that of a t.test ## categorical variables are (by default) summarized by count ## (percent) and chi-square tests (\code{chisq.test}). When \code{compare.groups ='logistic'} ## anova(glm(...,family=binomial,test="Chisq")) is used to calculate p-values. ## export result to csv table1 = summary(univariateTable(location~age+gender+height+weight,data=Diabetes), show.pvalues=FALSE) # write.csv(table1,file="~/table1.csv",rownames=FALSE) ## change labels and values utable(location~age+gender+height+weight,data=Diabetes, age="Age (years)",gender="Sex", gender.female="Female", gender.male="Male", height="Body height (inches)", weight="Body weight (pounds)") ## Use quantiles and rank tests for some variables and mean and standard deviation for others univariateTable(gender~Q(age)+location+Q(BMI)+height+weight, data=Diabetes) ## Factor with more than 2 levels Diabetes$AgeGroups <- cut(Diabetes$age, c(19,29,39,49,59,69,92), include.lowest=TRUE) univariateTable(location~AgeGroups+gender+height+weight, data=Diabetes) ## Row percent univariateTable(location~gender+age+AgeGroups, data=Diabetes, column.percent=FALSE) ## change of frequency format univariateTable(location~gender+age+AgeGroups, data=Diabetes, column.percent=FALSE, freq.format="percent(x) (n=count(x))") ## changing Labels u <- univariateTable(location~gender+AgeGroups+ height + weight, data=Diabetes, column.percent=TRUE, freq.format="count(x) (percent(x))") summary(u,"AgeGroups"="Age (years)","height"="Height (inches)") ## more than two groups Diabetes$frame=factor(Diabetes$frame,levels=c("small","medium","large")) univariateTable(frame~gender+BMI+age,data=Diabetes) Diabetes$sex=as.numeric(Diabetes$gender) univariateTable(frame~sex+gender+BMI+age, data=Diabetes,freq.format="count(x) (percent(x))") ## multiple summary formats ## suppose we want for some reason mean (range) for age ## and median (range) for BMI. ## method 1: univariateTable(frame~Q(age)+BMI, data=Diabetes, Q.format="mean(x) (range(x))", summary.format="median(x) (range(x))") ## method 2: u1 <- summary(univariateTable(frame~age, data=na.omit(Diabetes), summary.format="mean(x) (range(x))")) u2 <- summary(univariateTable(frame~BMI, data=na.omit(Diabetes), summary.format="median(x) (range(x))")) publish(rbind(u1,u2),digits=2) ## Large number format (big.mark) Diabetes$AGE <- 1000*Diabetes$age u3 <- summary(univariateTable(frame~AGE, data=Diabetes,big.mark="'")) } \seealso{ summary.univariateTable, publish.univariateTable } \author{ Thomas A. Gerds } Publish/man/glmSeries.Rd0000755000176200001440000000320013571203036014652 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/glmSeries.R \name{glmSeries} \alias{glmSeries} \title{Run a series of generalized linear regression analyses} \usage{ glmSeries(formula, data, vars, ...) } \arguments{ \item{formula}{The fixed part of the regression formula. For univariate analyses this is simply \code{y~1} where \code{y} is the outcome variable. When the aim is to control the effect of \code{vars} in each element of the series by a fixed set of variables it is \code{y~x1+x2} where again y is the outcome and x1 and x2 are confounders.} \item{data}{A \code{data.frame} in which we evaluate the formula.} \item{vars}{A list of variable names, the changing part of the regression formula.} \item{...}{passed to glm} } \value{ Matrix with regression coefficients, one for each element of \code{vars}. } \description{ Run a series of generalized linear regression analyses for a list of predictor variables and summarize the results in a table. The regression models can be adjusted for a fixed set of covariates. } \examples{ data(Diabetes) Diabetes$hyper1 <- factor(1*(Diabetes$bp.1s>140)) ## collect odds ratios from three univariate logistic regression analyses uni.odds <- glmSeries(hyper1~1,vars=c("chol","hdl","location"),data=Diabetes,family=binomial) uni.odds ## control the logistic regression analyses for age and gender ## but collect only information on the variables in `vars'. controlled.odds <- glmSeries(hyper1~age+gender, vars=c("chol","hdl","location"), data=Diabetes, family=binomial) controlled.odds } \author{ Thomas Alexander Gerds } Publish/DESCRIPTION0000644000176200001440000000250013775125612013374 0ustar liggesusersPackage: Publish Type: Package Title: Format Output of Various Routines in a Suitable Way for Reports and Publication Description: A bunch of convenience functions that transform the results of some basic statistical analyses into table format nearly ready for publication. This includes descriptive tables, tables of logistic regression and Cox regression results as well as forest plots. Version: 2020.12.23 Authors@R: c(person("Thomas A.", "Gerds", role = c("aut", "cre"), email = "tag@biostat.ku.dk"), person("Christian", "Torp-Pedersen", role = "ctb"), person("Klaus", "K Holst", role = "ctb"), person("Brice", "Ozenne", role = "aut", email = "broz@sund.ku.dk")) Maintainer: Thomas A. Gerds Depends: prodlim (>= 1.5.4) Imports: survival (>= 2.38), data.table (>= 1.10.4), lava (>= 1.5.1), multcomp (>= 1.4) Suggests: riskRegression (>= 2020.09.07), testthat, smcfcs (>= 1.4.1), rms (>= 6.1.0), mitools (>= 2.4), nlme (>= 3.1-131) License: GPL (>= 2) RoxygenNote: 7.1.1 NeedsCompilation: no Packaged: 2021-01-04 14:02:56 UTC; tag Author: Thomas A. Gerds [aut, cre], Christian Torp-Pedersen [ctb], Klaus K Holst [ctb], Brice Ozenne [aut] Repository: CRAN Date/Publication: 2021-01-05 18:10:18 UTC Publish/tests/0000755000176200001440000000000013774620020013023 5ustar liggesusersPublish/tests/test-univariateTable.R0000644000176200001440000000714513571203061017246 0ustar liggesusers### test-univariateTable.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: May 9 2015 (07:55) ## Version: ## last-updated: Oct 22 2017 (17:33) ## By: Thomas Alexander Gerds ## Update #: 8 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: library(testthat) library(prodlim) library(Publish) data(Diabetes) test_that("univariateTable no groups",{ u1 <- univariateTable(~age +gender + height + weight,data=Diabetes) a <- summary(u1,show.missing=1L) expect_equal(NROW(a),9) b <- summary(u1,show.missing=0L) expect_equal(NROW(b),5) u2 <- univariateTable(~age,data=Diabetes) u3 <- univariateTable(~gender,data=Diabetes) a1 <- publish(univariateTable(~age+gender+ height+weight,data=Diabetes)) a2 <- publish(summary(univariateTable(~age+gender+ height+weight,data=Diabetes))) expect_equal(a1,a2) }) test_that("Univariate table with groups and missing values and labels with special characters",{ Diabetes$AgeGroups <- cut(Diabetes$age, c(19,29,39,49,59,69,92), include.lowest=TRUE) univariateTable(location~age+gender+height+weight+AgeGroups,data=Diabetes) publish(summary(univariateTable(location~age+gender+height+weight, data=Diabetes)),org=TRUE) v <- univariateTable(gender ~age+height,data=Diabetes) sv <- summary(v,show.missing="always") univariateTable(location~factor(AgeGroups)+gender+height+weight, data=Diabetes, summary.format="median(x) {iqr(x)}") levels(Diabetes$frame) <- c("+large","medi()um=.<",">8") expect_output(publish(summary(univariateTable(frame~age+gender+height+weight+location, data=Diabetes)),org=TRUE)) expect_output(publish(summary(univariateTable(location~age+gender+height+weight+frame, data=Diabetes)),org=TRUE)) }) test_that("Univariate table with row percent",{ a <- summary(univariateTable(frame~gender+location, data=Diabetes,column.percent=TRUE)) b <- summary(univariateTable(frame~gender+location, data=Diabetes,column.percent=FALSE)) expect_equal(as.numeric(colSums(a[a$Variable=="gender"]==b[b$Variable=="gender"])),c(4,0)) }) if (FALSE){ test_that("Univariate table with stupid function",{ stupid <- function(x){ if (mean(x)>47) "large" else "small" } univariateTable(location~age+height+weight, data=Diabetes, summary.format="Mean: mean(x) stupid's distance: (stupid(x))") publish(summary(univariateTable(location~age+height+weight, data=Diabetes, summary.format="Mean: mean(x) stupid's distance: (stupid(x))")), org=TRUE) MeanSe <- function(x){ paste("Mean=",round(mean(x),1)," Standard.error=",round(sd(x)/sqrt(length(x)),3),sep="") } expect_output(publish(univariateTable(location~age+height+weight,data=Diabetes,summary.format="MeanSe(x)"))) ux <- univariateTable(location~gender+age+AgeGroups, data=Diabetes, column.percent=FALSE, freq.format="count(x)") sux <- summary(ux) publish(sux,org=TRUE) }) } #---------------------------------------------------------------------- ### test-univariateTable.R ends here Publish/tests/test-publish-mi.R0000644000176200001440000000124213571203061016170 0ustar liggesuserslibrary(testthat) library(Publish) library(mitools) library(smcfcs) library(riskRegression) test_that("multiple imputation",{ set.seed(71) d=sampleData(100) ## generate missing values d[X1==1,X6:=NA] d[X2==1,X3:=NA] d=d[,.(X8,X4,X3,X6,X7)] sapply(d,function(x)sum(is.na(x))) d[,X4:=factor(X4,levels=c("0","1"),labels=c("0","1"))] set.seed(17) f= smcfcs(d,smtype="lm",smformula=X8~X4*X3+X6+X7,method=c("","","logreg","norm",""),m=3) ccfit=lm(X8~X4*X3+X6+X7,data=d) impobj <- imputationList(f$impDatasets) models <- with(impobj,lm(X8~X4*X3+X6+X7)) mifit <- MIcombine(models) a <- publish(mifit,fit=ccfit,data=d) }) Publish/tests/TestBaselineTable.pdf0000744000176200001440000006241513571203061017056 0ustar liggesusers%PDF-1.4 % 1 0 obj << /S /GoTo /D [2 0 R /Fit ] >> endobj 4 0 obj << /Length 329 /Filter /FlateDecode >> stream x}P=O0+<:">|JJeHݒw:w5j~>G ZD;ZJ& `w}.nΘ>w0RI„i9fX< b4`P&Mc(-X)Rȥ4f yir<s L 0-Hی!ZwuRwX~H' |&~.<2xaW+/a5:J.ѷn~ꬔ5CJ;r.w^E~aa0^cc endstream endobj 2 0 obj << /Type /Page /Contents 4 0 R /Resources 3 0 R /MediaBox [0 0 612 792] /Parent 12 0 R >> endobj 5 0 obj << /D [2 0 R /XYZ 124.798 700.078 null] >> endobj 6 0 obj << /D [2 0 R /XYZ 125.798 662.217 null] >> endobj 10 0 obj << /D [2 0 R /XYZ 125.798 489.951 null] >> endobj 3 0 obj << /Font << /F18 7 0 R /F19 8 0 R /F45 9 0 R /F16 11 0 R >> /ProcSet [ /PDF /Text ] >> endobj 13 0 obj << /Length 198 /Filter /FlateDecode >> stream xڝ 0Eoq(PhP+AAQPQO}i,:IΔܓh4 b֜ 9yЙBf%HYAj͡&5}RłہTr@*MzKE΀N@F x-%08W\g-21鐹WZu2sw[Z,巷EVE\'hbD[ endstream endobj 14 0 obj << /Length 199 /Filter /FlateDecode >> stream xڝO @Bx @ػ@N( rԪEAEAKQt#ps}x4'cZ{RTYpH*}K@ ]6XV /a& +̌Sv47fUEc]~s|lm[sIaU].Gz]H||-scL endstream endobj 15 0 obj << /Length 108 /Filter /FlateDecode >> stream x373T0P0U5W03U05VH1*2 (Aes<L-=\ %E\N \. ц \. l 0Fszrr/#4 endstream endobj 16 0 obj << /Length 132 /Filter /FlateDecode >> stream x=ɱ 0  :t AG˛i "~1WOjŊ/|:=PM-_Ul[Q6<*]+a˃.&dR 1YG$ endstream endobj 17 0 obj << /Length 95 /Filter /FlateDecode >> stream x3234R0PbC KCB.K &r9yr+Xr{O_T.}gC.}hCX.Oz 0X [x endstream endobj 18 0 obj << /Length 101 /Filter /FlateDecode >> stream x373T0P0U04V03U06VH1*2 (Aes<L-=\ %E\N \. ц \. !f`.WO@.}1 endstream endobj 19 0 obj << /Length 123 /Filter /FlateDecode >> stream x313R0P0W05R0P03PH1*26PA Dr.'~BIQi*S!BA, 2,?`A7801pzrr<; endstream endobj 20 0 obj << /Length 210 /Filter /FlateDecode >> stream xڕѽ @ G0opz'A+AAA>Zѡܙ^2T)dJh-Q6/.w\ehd--gd;z=74b4)bΘ|!T0' 4, L*0V}Uv~ݷ'CdxxJDv5vwԁ?/uҹ |.uB)&) endstream endobj 21 0 obj << /Length 175 /Filter /FlateDecode >> stream x333T0P0bS33#CB.S# I$r9yr+q{E=}JJS ]  b<]J쁢 ??0BC0eB} B1PG@\ٹ+ ` (V9(P$ endstream endobj 22 0 obj << /Length 266 /Filter /FlateDecode >> stream xeϽJ@HMګ̾rw y),J--Gˣ#݂ˍ39TWEn0 *L2~5,'itvck]pXgͥy}y{:ۚ[t 6vZ5'@O6a&~`QLɤ䀄hADDND(An%=٨X }d*;Ad|HףMH+>o ߄k endstream endobj 23 0 obj << /Length 158 /Filter /FlateDecode >> stream x3332W0P0b3#J1*2" \.'O.pS .}(BIQi*S!BA,0`0?do `L3c ` }L3 D3@hQ'bDc&@ endstream endobj 24 0 obj << /Length 294 /Filter /FlateDecode >> stream x]AK0+^= O`, Ƀzh(=P|It'RVۥ~/Nي/OiTm[UEs?T֥*Y5["v?p=w,~F&rX Bv{[.*:ob}LƔ= ihO[ z<;=J> P/%jBE_R.T, yƞ 3 tiԃf endstream endobj 25 0 obj << /Length 251 /Filter /FlateDecode >> stream x1K@-f݀,b?B_T|ÿ%t_ endstream endobj 26 0 obj << /Length 213 /Filter /FlateDecode >> stream xmο@/, ShuqZZ(ښ<$y<–!q,䎁 1v<qƖ혭᭡ٌcfiNmFzƤw>;Ռ 9ξ(35 !+PLpW.Pe@"Qmڢ i"1Ŕ"?OVHnqLUOUo*D6i|UԴiMעL endstream endobj 27 0 obj << /Length 210 /Filter /FlateDecode >> stream xڽн @ B>Bzm=(vtr'utPvIK: #=vDzAmHJ]t9UgnHbR2pĻ~E;G3=hNa1/kFˈ܉Slx`p:FlTveV`9zTbr^MRV R':q@&x endstream endobj 28 0 obj << /Length 210 /Filter /FlateDecode >> stream xڽ= @ )sĬSZYZZDo7hB\gwJ)|浂F3"$;ԎhbR0 9IbcɄE:ŐdH 5:Pi=uek=BЫjn_t+k-JffLWn噞\y U;3ygz? endstream endobj 29 0 obj << /Length 204 /Filter /FlateDecode >> stream xuο 0/t(`_@轀:YAAAMj-#8viQp0?K|6隌Nc8Sje57 N-鉌IS>N[ِ҃ / '+*F PWR7HU8##;o\]>K-AZ//>L^T^('N"nhAUhwdZ#=d# r!I endstream endobj 30 0 obj << /Length 143 /Filter /FlateDecode >> stream x3233V0P0bcc3CB.c1s< =\ %E\N @QhX.O ?00``?<3c:f 1%P}Pszrr_ endstream endobj 31 0 obj << /Length 165 /Filter /FlateDecode >> stream x3532T0P0b 3cCB.S I$r9yr+r{E=}JJS ]ry(0`$;dt"H @҆ 3g`D\$3ؑr y endstream endobj 32 0 obj << /Length 124 /Filter /FlateDecode >> stream x3234R0Pc#3CCB.CK I$r9yr+Zr{E=}JJS|hCX.O  P001aqzrrHT endstream endobj 33 0 obj << /Length 109 /Filter /FlateDecode >> stream x3234R0Pcc3cCB.#rAɹ\N\ F\@Q.}O_T.}gC.}hCX.O a0\=W endstream endobj 34 0 obj << /Length 186 /Filter /FlateDecode >> stream xб 0  Ej3:9::( NGˣ:4qqé8Hķ)tJRWI8^0(v$kgfAuFX lYhFAQJ*˂Yu*>P'sx'`‚ʷs3 endstream endobj 35 0 obj << /Length 154 /Filter /FlateDecode >> stream x3532T0P0b CB.S I$r9yr+r{E=}JJS ]ry(0` iH~`~ ?3 !d; \\\ep endstream endobj 36 0 obj << /Length 188 /Filter /FlateDecode >> stream xڍ1 ` _qVdV8h֣;5I䅼Dq><Y>X:SwN'Js2c2 K^nG2jƖL[H5pG %BxʃAxNӃX:>ŴI=JRh4 V\_螡yNkPM endstream endobj 37 0 obj << /Length 145 /Filter /FlateDecode >> stream x3634S0P0bccCB.c4H$r9yr+p{E=}JJS ]  b<]?~x?̟0~g 0cH`3szrrM[ endstream endobj 38 0 obj << /Length 203 /Filter /FlateDecode >> stream x-AjP?d70sBtB[ܙʷyŷqRq,Q^i4d6Wd4&S/y&3[ْYqgc$Ovw x 4tHB8tmԨuUupAD#r&iNBKZӚ.8W endstream endobj 39 0 obj << /Length 151 /Filter /FlateDecode >> stream x3634S0P0R5T06P05SH1*22 \.'O.p#s.}0BIQi*S!BA,Vl+313C1#T8fq{v r wSM6 endstream endobj 40 0 obj << /Length 160 /Filter /FlateDecode >> stream x3532T0P0R5T0P01PH1*21 (Bds<LL=\ %E\N @B4РX.O `G%00a`f$Н l0A?? $@?P'W rjy endstream endobj 41 0 obj << /Length 239 /Filter /FlateDecode >> stream x]J@; x%'S~\#^/4Iq1w-}<9&{@ 7lz P@?[VqtPA8.=փdFDb+8w:+cw9<<#Oʬj\ԯR*ٕmm`giM?AP endstream endobj 42 0 obj << /Length 191 /Filter /FlateDecode >> stream xڽ1 @EL2͚DL!he!Vjih'(9B -)fsofyH0d@iNjő!5T>'.&Ien(@*/SC^^$N-8b,(p OA-iU۹*m_ ڰ^!c9- @m endstream endobj 43 0 obj << /Length 126 /Filter /FlateDecode >> stream x313R0Pbc 3CCB.#K I$r9yr+Yr{E=}JJS|hCX.O @@\ <yP\=sU endstream endobj 44 0 obj << /Length 185 /Filter /FlateDecode >> stream xڕϱ @ BP:w> /FirstChar 3 /LastChar 121 /Widths 45 0 R /Encoding 46 0 R /CharProcs 47 0 R >> endobj 45 0 obj [45.2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 35.16 35.16 0 70.29 25.12 0 25.12 0 45.2 45.2 0 0 45.2 0 0 0 0 0 0 0 0 70.29 0 0 0 0 64 0 0 0 0 0 0 0 0 0 0 0 0 0 61.49 0 0 50.21 65.27 0 0 0 67.75 67.75 0 0 0 0 0 0 0 45.2 50.21 0 50.21 40.18 27.63 0 50.21 25.12 0 0 25.12 75.31 50.21 45.2 0 0 35.16 35.66 35.16 50.21 0 0 0 47.71 ] endobj 46 0 obj << /Type /Encoding /Differences [3/a3 4/.notdef 40/a40/a41 42/.notdef 43/a43/a44 45/.notdef 46/a46 47/.notdef 48/a48/a49 50/.notdef 52/a52 53/.notdef 61/a61 62/.notdef 66/a66 67/.notdef 80/a80 81/.notdef 83/a83/a84 85/.notdef 88/a88/a89 90/.notdef 97/a97/a98 99/.notdef 100/a100/a101/a102 103/.notdef 104/a104/a105 106/.notdef 108/a108/a109/a110/a111 112/.notdef 114/a114/a115/a116/a117 118/.notdef 121/a121] >> endobj 47 0 obj << /a3 19 0 R /a40 13 0 R /a41 14 0 R /a43 15 0 R /a44 16 0 R /a46 17 0 R /a48 42 0 R /a49 43 0 R /a52 44 0 R /a61 18 0 R /a66 20 0 R /a80 21 0 R /a83 22 0 R /a84 23 0 R /a88 24 0 R /a89 25 0 R /a97 26 0 R /a98 27 0 R /a100 28 0 R /a101 29 0 R /a102 30 0 R /a104 31 0 R /a105 32 0 R /a108 33 0 R /a109 34 0 R /a110 35 0 R /a111 36 0 R /a114 37 0 R /a115 38 0 R /a116 39 0 R /a117 40 0 R /a121 41 0 R >> endobj 48 0 obj << /Length 338 /Filter /FlateDecode >> stream x͓?N@gC6QڸHaRK vF8%^0 Z-;;3|qvrXЧhsJL6~Em*iS^o*\R[}OT@WdR;Ȉ,QG9Ci 7rXK0A@$s;:>GOÔ11PVGG { r(ܑ  J}1*7S($;SheIL>oC^fi0ӤIΧ C4qHGnJ谬cC +{7Z۶> ࿢*E!en/ endstream endobj 49 0 obj << /Length 244 /Filter /FlateDecode >> stream xڅJ1g"0M!`Dy[ZYZZ(ںy}<•aǙP1|?IO :1H=>cTPc;Ocw!^_[^ʙ;V8?dmgPj\Rq :dĄ* |Vbn;gE d1o( ؁ahDBc!D[o1En %in6N:\Z` æ]H_I<?y뭜 endstream endobj 50 0 obj << /Length 184 /Filter /FlateDecode >> stream xѱ@ & &]xHLtr0NUy{ጃ zw6d4JBGqlfiG{1+P)QEz@-ibc|!Pi ౮!`{.TV6ߡA_y48+po endstream endobj 51 0 obj << /Length 231 /Filter /FlateDecode >> stream xڵ0kHnЂ0 &2`A3<#02^KL%!_s{I!.qa@CT9 +@P% 7 v+@x0> stream x]1N@4;ۊB$\ Q%ڬ\vY)yTk.拊57 UIJ/Kn6O\k*ybx[~|nXp8HDF#々~7'QȔ^;LKZ+45qj@.dtv!"ieh֔j]dV絳Su ?hgcfKxhGZ endstream endobj 53 0 obj << /Length 186 /Filter /FlateDecode >> stream x3534S0P0R5T01Q07SH1*21 (Cds<L =\ %E\N @QhX.OON2bH$;&=A$3?8HAN7PJ`$H `( E` qzrr:p endstream endobj 9 0 obj << /Type /Font /Subtype /Type3 /Name /F45 /FontMatrix [0.00836 0 0 0.00836 0 0] /FontBBox [ 2 -1 88 83 ] /Resources << /ProcSet [ /PDF /ImageB ] >> /FirstChar 67 /LastChar 116 /Widths 54 0 R /Encoding 55 0 R /CharProcs 56 0 R >> endobj 54 0 obj [95.01 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 59.81 0 0 0 0 0 0 0 0 73.08 65.77 0 0 0 51.89 51.16 ] endobj 55 0 obj << /Type /Encoding /Differences [67/a67 68/.notdef 101/a101 102/.notdef 110/a110/a111 112/.notdef 115/a115/a116] >> endobj 56 0 obj << /a67 48 0 R /a101 49 0 R /a110 50 0 R /a111 51 0 R /a115 52 0 R /a116 53 0 R >> endobj 57 0 obj << /Length 136 /Filter /FlateDecode >> stream x323P0PP5T02P04PH1*24(YBs< =\ %E\N @QhX.O9   fv6> $'W  ' endstream endobj 58 0 obj << /Length 296 /Filter /FlateDecode >> stream xŒj0OxܢGн@kg!M ԡm-@^[^[WI qUutqE+ z+̟00=}c~ =T`!gA@jT, 8_=eCAMF^ |:I *@=N` ڝ 垻ḱ69&>0s!of &jɤbu gϫC0IF)Zm* endstream endobj 59 0 obj << /Length 258 /Filter /FlateDecode >> stream x}J1 ] {-(tdibVp> stream x3731R0P0b3s3 CB.31s<̌=\ %E\N \. ц \. A70``a~@ m :y 4!B3  4'W +q endstream endobj 61 0 obj << /Length 229 /Filter /FlateDecode >> stream xuϱJAba yh+RPK E;1 tƽpS|?;?xžjs3TC=-r+SrgkkrKyrM͒a{ծlB-`a:`u)xuwGW2&e˯ɦnh huaǨk} [ bԪob"EzONoɌla endstream endobj 62 0 obj << /Length 203 /Filter /FlateDecode >> stream xڝ 0OKдv vtrAPGAEA0G#8:ANȹ-Lp;"dJ Z_V[UglJ#IWc>NҽIs-0pu@܀_x vZհu/{#ҡ^EA^UzN4 E A2;Wa V4'VhLr endstream endobj 63 0 obj << /Length 212 /Filter /FlateDecode >> stream xڽϱ0$7 x/$N$ &:9'utf,ƣ Fp $K8q b~bNe/DF4AFGi[?2%72byg6Nh:]hBQ֩L)϶?$nId[XmFiǞzՊuA63` ^j endstream endobj 64 0 obj << /Length 210 /Filter /FlateDecode >> stream xu1j0g<7 41'z(S$ MHXGQ|JW\(T 7uN3uki1}.Gq%Cf&u#U])Yϧz\R׹fi WOp_PI! I@*#f%#~,K{ǏT#,ΰq`(nYsLޖF^V2 endstream endobj 65 0 obj << /Length 167 /Filter /FlateDecode >> stream xα @ ;:'zx: 7:9: *:{G;s]!3pck8YǸh PsNA^/r9E l BuL[VeTɎdÞ@`_wV| 䈚 oafaosK endstream endobj 66 0 obj << /Length 203 /Filter /FlateDecode >> stream x=@H\@ȜM B0X({+ba8垫|>2Pԏ~?Ѥ$|@jRRod5Ԍ;*gX@l$u8lSyEȞn!X#xiTCƩFHjODO'0vBJ#n $"&ݏ endstream endobj 67 0 obj << /Length 209 /Filter /FlateDecode >> stream xڝ= @GR2MtbSZYZZ(ډr2EH|((v̛ݝGa_ endstream endobj 68 0 obj << /Length 144 /Filter /FlateDecode >> stream x36׳4R0P0a3CB.c HrW06r{*r;8+r(D*ry(0`?l(g?6g u@lC{ pP endstream endobj 69 0 obj << /Length 213 /Filter /FlateDecode >> stream xMͱN@б\DTd""R.HE) h!kfg:[\ꗺXS)Ks"Z;׌oY2=7Ro0ͬ&a8YZi4 %:1X[z83L̺E[y!8}?+O2dWtm8 \\ղuY endstream endobj 70 0 obj << /Length 207 /Filter /FlateDecode >> stream xڽ P FҡмVn?`A'qRGE7f}>BŚނ*3$|9VuQۀ}+5͞1%kTڤ|18Ux*%V738 \A&rOP deyܿ>X ?c\%#'q(IfNĴ) endstream endobj 71 0 obj << /Length 131 /Filter /FlateDecode >> stream x337U0PbC33CB.c# I$r9yr+q{E=}JJS ]  b<] >00013 A9 CaՓ+ t^@ endstream endobj 72 0 obj << /Length 259 /Filter /FlateDecode >> stream x]J@Of!"." E0pA.Z v |˝gH0??pNNmnҮwYUϹ勧7wk"nssa q[{_AꭅBaD4%;>#p{%*édlW]HO˷df 3ÂױtK҇FoMfl=o,"E"pLΉ~WhFF*4& !3DWZnvj endstream endobj 8 0 obj << /Type /Font /Subtype /Type3 /Name /F19 /FontMatrix [0.01004 0 0 0.01004 0 0] /FontBBox [ 3 -19 84 70 ] /Resources << /ProcSet [ /PDF /ImageB ] >> /FirstChar 44 /LastChar 115 /Widths 73 0 R /Encoding 74 0 R /CharProcs 75 0 R >> endobj 73 0 obj [27.08 0 0 0 48.75 48.75 48.75 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 76.5 0 0 0 0 0 89.34 0 0 0 0 0 0 70.42 0 0 0 0 0 0 0 0 0 0 0 0 48.75 0 43.33 54.17 43.33 0 0 54.17 0 0 0 0 81.25 0 48.75 0 0 37.92 38.46 ] endobj 74 0 obj << /Type /Encoding /Differences [44/a44 45/.notdef 48/a48/a49/a50 51/.notdef 71/a71 72/.notdef 77/a77 78/.notdef 84/a84 85/.notdef 97/a97 98/.notdef 99/a99/a100/a101 102/.notdef 104/a104 105/.notdef 109/a109 110/.notdef 111/a111 112/.notdef 114/a114/a115] >> endobj 75 0 obj << /a44 57 0 R /a48 70 0 R /a49 71 0 R /a50 72 0 R /a71 58 0 R /a77 59 0 R /a84 60 0 R /a97 61 0 R /a99 62 0 R /a100 63 0 R /a101 64 0 R /a104 65 0 R /a109 66 0 R /a111 67 0 R /a114 68 0 R /a115 69 0 R >> endobj 76 0 obj << /Length 265 /Filter /FlateDecode >> stream xڽn@ 2D@ހp\hT$R3 bF"1Ti-rUO9$fo=> stream xڽ=j@W0LsDZT)+' R(:J&xݑ:y;v&DZgЦ3p)ڱ ,rHYH|I'$%nlkcLCsb@D$*cz$Xp3C0_^")@lR{Ö;"r{H=ϩt.:/d[%K*e?#W~'7  endstream endobj 78 0 obj << /Length 233 /Filter /FlateDecode >> stream xڳ437R0PaSK CB.s3 I$r9yr+q{E=}JJS ]  b<]>@?7@Y - DBX`,v8bƪ@3nfd_b?̰⇇<`,x> stream xڕѽN0> stream xӻJ@8Mބ VK E[7e $2E8gfA0%s' $iH&t#[eVw8134?LJ[L'd V$/%K DsХ0Gbڷ鲁fV [1>8Q.݄y4T1b<[. | ء ; \t~ۜ9AƧÇr:sLnʝrn7Іbӄ/ǵi H endstream endobj 81 0 obj << /Length 219 /Filter /FlateDecode >> stream x37ѳT0P0bsCCCB.33JrW03 s{*r;8+r(D*ry(00`P"0C=~d3@@C P?P 8xq83qe0w`0H+p32> f qՓ+ P endstream endobj 82 0 obj << /Length 142 /Filter /FlateDecode >> stream x3631R0P0bcCKSCB.#1s<L=\ %E\N \. ц \.  30oAr 5 T @;af f!`` ȘՓ+ > stream x3631R0P0bc#CCB.#3JrW02 s{*r;8+r(D*ry(070o`G1 d endstream endobj 84 0 obj << /Length 185 /Filter /FlateDecode >> stream x? P ,dМVt* ίGQzN:xȗ@ iDrj* CDJbCbqNjILjn߮#r)o̙-S/XSeFԕ+^+k۪d%A3vX}X~ö"7iӊ^Ds. endstream endobj 85 0 obj << /Length 281 /Filter /FlateDecode >> stream xu1N0G\o$"-D $(PR[mr⛐#Lvq v '33n"O'5sj<=x/5j֝){S^˵)x|1jSn衦t8z[d yDbDΰt=ZbM΢yqPje^5X*>YY:#BIj!MlG-ƨH]$?r>Pc6A٠~I"vfD7(0l@/]3wׄ endstream endobj 86 0 obj << /Length 203 /Filter /FlateDecode >> stream xҿAr $7/eQII\!R Q,'s0eQ"ܟ3?(%V U Вn(6Y4n+|א<>ȭh\ E&tj8 endstream endobj 87 0 obj << /Length 335 /Filter /FlateDecode >> stream x}K0Wz(@œ`<'(LQo/w(/h3&ORH}Ev4d|ѫ7X%7Β~|dqwqOXZk z Ūe & 'NMpL7Vh2zeBC(,JX:6t%`֩FWC`ڃv1Kǚ ֒!KtQN6G%A>"10:@|yefx~x }P@QS@C))NIG%SԦHS ]W%O endstream endobj 7 0 obj << /Type /Font /Subtype /Type3 /Name /F18 /FontMatrix [0.00697 0 0 0.00697 0 0] /FontBBox [ 2 -36 85 107 ] /Resources << /ProcSet [ /PDF /ImageB ] >> /FirstChar 40 /LastChar 121 /Widths 88 0 R /Encoding 89 0 R /CharProcs 90 0 R >> endobj 88 0 obj [52.41 52.41 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 91.72 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 67.4 74.89 0 0 0 0 0 74.89 37.42 0 0 37.42 0 0 0 0 0 52.41 53.16 0 74.89 0 0 0 71.14 ] endobj 89 0 obj << /Type /Encoding /Differences [40/a40/a41 42/.notdef 80/a80 81/.notdef 97/a97/a98 99/.notdef 104/a104/a105 106/.notdef 108/a108 109/.notdef 114/a114/a115 116/.notdef 117/a117 118/.notdef 121/a121] >> endobj 90 0 obj << /a40 76 0 R /a41 77 0 R /a80 78 0 R /a97 79 0 R /a98 80 0 R /a104 81 0 R /a105 82 0 R /a108 83 0 R /a114 84 0 R /a115 85 0 R /a117 86 0 R /a121 87 0 R >> endobj 12 0 obj << /Type /Pages /Count 1 /Kids [2 0 R] >> endobj 91 0 obj << /Names [(Doc-Start) 6 0 R (page.1) 5 0 R (section*.1) 10 0 R] /Limits [(Doc-Start) (section*.1)] >> endobj 92 0 obj << /Dests 91 0 R >> endobj 93 0 obj << /Type /Catalog /Pages 12 0 R /Names 92 0 R /PageMode/UseOutlines /OpenAction 1 0 R >> endobj 94 0 obj << /Author()/Title()/Subject()/Creator(Emacs Org-mode version 7.8.03)/Producer(pdfTeX-1.40.10)/Keywords() /CreationDate (D:20120322064133+01'00') /ModDate (D:20120322064133+01'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-1.40.10-2.2 (TeX Live 2009/Debian) kpathsea version 5.0.0) >> endobj xref 0 95 0000000000 65535 f 0000000015 00000 n 0000000471 00000 n 0000000751 00000 n 0000000063 00000 n 0000000576 00000 n 0000000634 00000 n 0000022300 00000 n 0000017550 00000 n 0000012415 00000 n 0000000692 00000 n 0000009029 00000 n 0000023167 00000 n 0000000853 00000 n 0000001131 00000 n 0000001410 00000 n 0000001598 00000 n 0000001810 00000 n 0000001985 00000 n 0000002166 00000 n 0000002369 00000 n 0000002659 00000 n 0000002914 00000 n 0000003260 00000 n 0000003498 00000 n 0000003872 00000 n 0000004203 00000 n 0000004496 00000 n 0000004786 00000 n 0000005076 00000 n 0000005360 00000 n 0000005583 00000 n 0000005828 00000 n 0000006032 00000 n 0000006221 00000 n 0000006487 00000 n 0000006721 00000 n 0000006989 00000 n 0000007214 00000 n 0000007497 00000 n 0000007728 00000 n 0000007968 00000 n 0000008287 00000 n 0000008558 00000 n 0000008764 00000 n 0000009270 00000 n 0000009646 00000 n 0000010074 00000 n 0000010493 00000 n 0000010911 00000 n 0000011235 00000 n 0000011499 00000 n 0000011810 00000 n 0000012149 00000 n 0000012659 00000 n 0000012802 00000 n 0000012934 00000 n 0000013033 00000 n 0000013249 00000 n 0000013625 00000 n 0000013963 00000 n 0000014203 00000 n 0000014512 00000 n 0000014795 00000 n 0000015087 00000 n 0000015377 00000 n 0000015624 00000 n 0000015907 00000 n 0000016196 00000 n 0000016420 00000 n 0000016713 00000 n 0000017000 00000 n 0000017211 00000 n 0000017795 00000 n 0000018021 00000 n 0000018296 00000 n 0000018517 00000 n 0000018862 00000 n 0000019199 00000 n 0000019512 00000 n 0000019879 00000 n 0000020252 00000 n 0000020551 00000 n 0000020773 00000 n 0000020976 00000 n 0000021241 00000 n 0000021602 00000 n 0000021885 00000 n 0000022546 00000 n 0000022776 00000 n 0000022994 00000 n 0000023225 00000 n 0000023344 00000 n 0000023380 00000 n 0000023485 00000 n trailer << /Size 95 /Root 93 0 R /Info 94 0 R /ID [<428DDD11D3F4566748E052E05F1E68DD> <428DDD11D3F4566748E052E05F1E68DD>] >> startxref 23812 %%EOF Publish/tests/test-regressionTable.R0000644000176200001440000000272413571203061017255 0ustar liggesusers### test-regressionTable.R --- #---------------------------------------------------------------------- ## Author: Thomas Alexander Gerds ## Created: Aug 13 2017 (07:39) ## Version: ## Last-Updated: Nov 3 2019 (19:32) ## By: Thomas Alexander Gerds ## Update #: 6 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: library(testthat) library(Publish) data(Diabetes) test_that("regressiontable: transformed variables and factor levels",{ Diabetes$hyp1 <- factor(1*(Diabetes$bp.1s>140)) Diabetes$ofak <- ordered(sample(letters[1:11],size=NROW(Diabetes),replace=1L)) levels(Diabetes$frame) <- c("+large","medi()um=.<",">8") f <- glm(hyp1~frame+gender+log(age)+I(chol>245)+ofak,data=Diabetes,family="binomial") regressionTable(f) summary(regressionTable(f)) }) test_that("plot.regressionTable",{ Diabetes$hyp1 <- factor(1*(Diabetes$bp.1s>140)) Diabetes$ofak <- ordered(sample(letters[1:11],size=NROW(Diabetes),replace=1L)) levels(Diabetes$frame) <- c("+large","medi()um=.<",">8") f <- glm(hyp1~frame+gender+log(age)+I(chol>245)+ofak,data=Diabetes,family="binomial") f <- glm(hyp1~log(age)+I(chol>245),data=Diabetes,family="binomial") u <- regressionTable(f) plot(u) }) ###################################################################### ### test-regressionTable.R ends here Publish/tests/test-glmSeries.R0000644000176200001440000000214713571203061016056 0ustar liggesusers### test-glmSeries.R --- #---------------------------------------------------------------------- ## Author: Thomas Alexander Gerds ## Created: Feb 10 2018 (12:44) ## Version: ## Last-Updated: Feb 10 2018 (18:37) ## By: Thomas Alexander Gerds ## Update #: 2 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: library(testthat) library(Publish) library(data.table) data(Diabetes) test_that("glmSeries missing data, data.table ",{ Diabetes <- as.data.frame(Diabetes) Diabetes$hypertension <- factor(Diabetes$bp.1s>140) a <- glmSeries(vars=c("bp.2s","frame","weight","age"),formula=hypertension~gender,data=Diabetes,family=binomial) expect_equal(a$Missing,c(262,12,"","","1","0")) setDT(Diabetes) b <- glmSeries(vars=c("bp.2s","frame","weight","age"),formula=hypertension~gender,data=Diabetes,family=binomial) expect_equal(a,b) }) ###################################################################### ### test-glmSeries.R ends here Publish/tests/test-publish.R0000644000176200001440000000160413571203061015567 0ustar liggesusers### test-publish.R --- #---------------------------------------------------------------------- ## author: Brice Ozenne ## created: apr 6 2017 (10:04) ## Version: ## last-updated: Aug 14 2017 (19:29) ## By: Thomas Alexander Gerds ## Update #: 10 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: library(testthat) library(Publish) context("publish: default and matrix") test_that("publish rounding of a matrix with NA", { set.seed(7) y0 <- cbind(a=rnorm(2),b=1:2,c=letters[1:2]) y1 <- y0 y1[1,1] <- NA y1[2,2] <- NA b <- publish(y1,digits=1) expect_equal(c(b),c(" NA","-1.2","1.0"," NA","a","b")) }) #---------------------------------------------------------------------- ### test-publish.R ends here Publish/tests/TestBaselineTable.tex0000744000176200001440000000143313571203061017076 0ustar liggesusers% Created 2012-03-22 Thu 06:41 \documentclass[11pt]{article} \usepackage[utf8]{inputenc} \usepackage[T1]{fontenc} \usepackage{fixltx2e} \usepackage{graphicx} \usepackage{longtable} \usepackage{float} \usepackage{wrapfig} \usepackage{soul} \usepackage{textcomp} \usepackage{marvosym} \usepackage{wasysym} \usepackage{latexsym} \usepackage{amssymb} \usepackage{hyperref} \tolerance=1000 \providecommand{\alert}[1]{\textbf{#1}} \title{library(Publish)} \author{Thomas Gerds} \date{\today} \hypersetup{ pdfkeywords={}, pdfsubject={}, pdfcreator={Emacs Org-mode version 7.8.03}} \begin{document} \maketitle \setcounter{tocdepth}{3} \tableofcontents \vspace*{1cm} library(Publish) d=data.frame(Y=rnorm(10),X=rbinom(10,1,.4),S=X=rbinom(10,1,.4)) BaselineTable(S\~{}Y+X,data=d) \end{document}Publish/tests/test-publish-gls.R0000644000176200001440000000402013761465522016362 0ustar liggesusers### test-publish-gls.R --- #---------------------------------------------------------------------- ## Author: Thomas Alexander Gerds ## Created: Aug 14 2017 (18:56) ## Version: ## Last-Updated: Dec 1 2020 (17:12) ## By: Thomas Alexander Gerds ## Update #: 6 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: if (requireNamespace("nlme",quietly=TRUE)){ library(testthat) context("publish: gls regression") ## simulation library(nlme) library(Publish) library(lava) m <- lvm(Y ~ X1 + gender + group + Interaction) distribution(m, ~gender) <- binomial.lvm() distribution(m, ~group) <- binomial.lvm(size = 2) constrain(m, Interaction ~ gender + group) <- function(x){x[,1]*x[,2]} d <- sim(m, 1e2) d$gender <- factor(d$gender, labels = letters[1:2]) d$group <- factor(d$group) ## model test_that("publish matches gls", { e.gls <- gls(Y ~ X1 + gender+group, data = d, weights = varIdent(form = ~1|group)) res <- summary(regressionTable(e.gls)) Sgls <- summary(e.gls)$tTable expect_equal(res$rawTable[c(1,3,5,6),"Coefficient"], unname(Sgls[c("X1","genderb","group1","group2"),"Value"])) expect_equal(res$rawTable[c(1,3,5,6),"Pvalue"], unname(Sgls[c("X1","genderb","group1","group2"),"p-value"])) }) context("publish: lme regression") data("Orthodont") test_that("publish matches lme", { fm1 <- lme(distance ~ age+Sex, random = ~1|Subject, data = Orthodont) res <- publish(fm1) # main effects expect_equal(as.double(res$rawTable[c(1:2,4),"Coefficient"]), as.double(fixef(fm1)[1:3])) expect_equal(as.double(res$rawTable[c(1:2,4),"Pvalue"]), as.double(summary(fm1)$tTable[1:3,5])) }) } ###################################################################### ### test-publish-gls.R ends here Publish/R/0000755000176200001440000000000013774620003012063 5ustar liggesusersPublish/R/parseInteractionTerms.R0000644000176200001440000002432713745517700016552 0ustar liggesusers##' Parse interaction terms for regression tables ##' ##' Prepare a list of contrasts which combines regression coefficients ##' to describe statistical interactions. ##' @title Parse interaction terms ##' @param terms Terms of a formula ##' @param xlevels Factor levels corresponding to the variables in ##' \code{terms} ##' @param units named list with unit labels. names should match variable names in formula. ##' @param format.factor For categorical variables. A string which specifies the print format for factor labels. ##' The string has to contain the keywords \code{"var"} and \code{"level"} which will be ##' replaced by the name of the variable and the current level, respectively. ##' Default is \code{"var(level)"}. ##' @param format.contrast For categorical variables. A string which specifies the print format for constrast statements. ##' The string has to contain the keywords \code{"var"}, \code{"level"} and \code{"ref"} which will be ##' replaced by the name of the variable, the current level and the reference level, respectively. ##' @param format.scale A string which specifies the print format for continuous variables without units. ##' The string has to contain the keyword \code{"var"} which will be ##' replaced by the name of the variable and the unit, respectively. ##' Default is \code{"var"}. ##' @param format.scale.unit A string which specifies the print format for continuous variables with units. ##' The string has to contain the keywords \code{"var"} and \code{"unit"} which will be ##' replaced by the name of the variable and the unit, respectively. ##' Default is \code{"var(unit)"}. ##' @param sep a character string to separate the terms. Default is \code{": "}. ##' @param ... Not yet used ##' @return List of contrasts which can be passed to ##' \code{lava::estimate}. ##' @seealso lava::estimate ##' @examples ##' ##' tt <- terms(formula(SBP~age+sex*BMI)) ##' xlev <- list(sex=c("male","female"),BMI=c("normal","overweight","obese")) ##' parseInteractionTerms(terms=tt,xlevels=xlev) ##' parseInteractionTerms(terms=tt,xlevels=xlev,format.factor="var level") ##' parseInteractionTerms(terms=tt,xlevels=xlev,format.contrast="var(level:ref)") ##' ##' tt2 <- terms(formula(SBP~age*factor(sex)+BMI)) ##' xlev2 <- list("factor(sex)"=c("male","female")) ##' parseInteractionTerms(terms=tt2,xlevels=xlev2) ##' parseInteractionTerms(terms=tt2,xlevels=xlev2,units=list(age="yrs")) ##' ##' ##' data(Diabetes) ##' fit <- glm(bp.2s~age*factor(gender)+BMI,data=Diabetes) ##' parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels, ##' format.scale="var -- level:ref",units=list("age"='years')) ##' parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels, ##' format.scale.unit="var [unit]",units=list("age"='years')) ##' it <- parseInteractionTerms(terms=terms(fit$formula),xlevels=fit$xlevels) ##' ivars <- unlist(lapply(it,function(x)attr(x,"variables"))) ##' lava::estimate(fit,function(p)lapply(unlist(it),eval,envir=sys.parent(-1))) ##' ##' ##' @export ##' @author Thomas A. Gerds parseInteractionTerms <- function(terms, xlevels, units, format.factor, format.contrast, format.scale, format.scale.unit, sep=": ", ...){ if(any(attr(terms,"order")>2)) stop("Interaction terms with order greater than 2 are not supported.") ilabs <- attr(terms,"term.labels")[attr(terms,"order")==2] inter.list <- strsplit(ilabs,":") intervars <- unique(unlist(inter.list)) if (missing(units)) units <- NULL if (length(inter.list)>0){ if (missing(format.factor)){ format.factor <- "var(level)" }else{ stopifnot(length(grep("var",format.factor))>0) stopifnot(length(grep("level",format.factor))>0) } if (missing(format.scale.unit)){ format.scale.unit <- "var(unit)" }else{ stopifnot(length(grep("var",format.scale.unit))>0) stopifnot(length(grep("unit",format.scale.unit))>0) } if (missing(format.scale)){ format.scale <- "var" }else{ stopifnot(length(grep("var",format.scale))>0) } if (missing(format.contrast)){ format.contrast <- "var(level vs ref)" }else{ stopifnot(length(grep("var",format.contrast))>0) stopifnot(length(grep("level",format.contrast))>0) stopifnot(length(grep("ref",format.contrast))>0) } format.factor <- sub("var","%s",format.factor) format.factor <- sub("level","%s",format.factor) format.contrast <- sub("level","%s",format.contrast) format.contrast <- sub("ref","%s",format.contrast) format.contrast <- sub("var","%s",format.contrast) format.scale <- sub("var","%s",format.scale) format.scale.unit <- sub("var","%s",format.scale.unit) format.scale.unit <- sub("unit","%s",format.scale.unit) iterms <- lapply(inter.list,function(vv){ v1 <- vv[1] ref1 <- xlevels[[v1]][[1]] v2 <- vv[2] ref2 <- xlevels[[v2]][[1]] if (is.null(ref1)){ if (is.null(ref2)){ stop(paste("Can only handle interactions when at least one variable is a factor.\nBut argument xlevels contains no entry for either", v1, "or", v2)) } else{ ## v1 is continuous, v2 is a factor ## model includes coef for one-unit change of v1 at ref2 ## need to ask for coef for one-unit change of v1 at other levs levs2 <- xlevels[[v2]] u1 <- units[[v1]] if (is.null(u1)) { labs <- sapply(levs2,function(l){ paste(sprintf(format.scale,v1),sprintf(format.factor,v2,l),sep=sep) }) }else{ labs <- sapply(levs2,function(l){ paste(sprintf(format.scale.unit,v1,u1),sprintf(format.factor,v2,l),sep=sep) }) } ## collect the corresponding coefficients contrast <- lapply(1:length(levs2),function(l){ if (l==1) x <- bquote(p[.(v1)]) else bquote(p[.(v1)]+p[.(paste(v1,":",paste(v2,levs2[[l]],sep=""),sep=""))]) }) names(contrast) <- labs attr(contrast,"variables") <- c(v1,v2) return(contrast) } }else{ if (is.null(ref2)){ ## v2 is continuous, v1 is a factor ## model includes coef for one-unit change of v2 at ref1 ## need to ask for coef for one-unit change of v2 at other levs levs1 <- xlevels[[v1]] u2 <- units[[v2]] if (is.null(u2)) { labs <- sapply(levs1,function(l){ paste(sprintf(format.scale,v2),sprintf(format.factor,v1,l),sep=sep) }) }else{ labs <- sapply(levs1,function(l){ paste(sprintf(format.scale.unit,v2,u2),sprintf(format.factor,v1,l),sep=sep) }) } ## collect the corresponding coefficients contrast <- lapply(1:length(levs1),function(l){ if (l==1) bquote(p[.(v2)]) else bquote(p[.(v2)]+p[.(paste(paste(v1,levs1[[l]],sep=""),":",v2,sep=""))]) }) names(contrast) <- labs attr(contrast,"variables") <- c(v1,v2) return(contrast) } else{ ## both are factors levs1 <- xlevels[[v1]] levs2 <- xlevels[[v2]] labs1 <- paste(rep(sprintf(format.factor,v1,levs1),rep(length(levs2)-1,length(levs1))), sprintf(format.contrast,v2,levs2[-1],levs2[1]),sep=sep) contrast1 <- unlist(lapply(1:length(levs1),function(l1){ if (l1==1) lapply(2:(length(levs2)),function(l2){bquote(p[.(paste(v2,levs2[l2],sep=""))])}) else lapply(2:(length(levs2)),function(l2){ bquote(p[.(paste(v2,levs2[l2],sep=""))]+p[.(paste(paste(v1,levs1[l1],sep=""),":",paste(v2,levs2[l2],sep=""),sep=""))]) }) })) names(contrast1) <- labs1 labs2 <- paste(rep(sprintf(format.factor,v2,levs2),rep(length(levs1)-1,length(levs2))), sprintf(format.contrast,v1,levs1[-1],levs1[1]),sep=sep) contrast2 <- unlist(lapply(1:length(levs2),function(l2){ if (l2==1) lapply(2:(length(levs1)),function(l1){bquote(p[.(paste(v1,levs1[l1],sep=""))])}) else lapply(2:(length(levs1)),function(l1){ ## need to reverse order in name of interaction term bquote(p[.(paste(v1,levs1[l1],sep=""))]+p[.(paste(paste(v1,levs1[l1],sep=""),":",paste(v2,levs2[l2],sep=""),sep=""))]) }) })) names(contrast2) <- labs2 contrast <- c(contrast1,contrast2) attr(contrast,"variables") <- c(v1,v2) return(contrast) } } }) names(iterms) <- ilabs iterms } } Publish/R/publish.subgroupAnalysis.R0000644000176200001440000000014513571203035017222 0ustar liggesusers##' @export publish.subgroupAnalysis <- function(object,...){ publish(summary(object,...),...) } Publish/R/summary.univariateTable.R0000744000176200001440000001771513664136424017044 0ustar liggesusers##' Summary function for univariate table ##' ##' Collects results of univariate table in a matrix. ##' @title Preparing univariate tables for publication ##' @param object \code{univariateTable} object as obtained with ##' function \code{univariateTable}. ##' @param n If not missing, show the number of subjects in each ##' column. If equal to \code{"inNames"}, show the numbers in ##' parentheses in the column names. If missing the value ##' \code{object$n} is used. ##' @param drop.reference Logical or character (vector). Decide if line with reference ##' level should be suppressed for factors. If \code{TRUE} or \code{"all"} ##' suppress for all categorical factors. If \code{'binary'} suppress only for binary variables. ##' Can be character vector in which case reference lines are suppressed for variables ##' that are included in the vector. ##' @param pvalue.stars If TRUE use \code{symnum} to parse p-values ##' otherwise use \code{format.pval}. ##' @param pvalue.digits Passed to \code{format.pval}. ##' @param show.missing Decides if number of missing values are shown in table. ##' Defaults to \code{"ifany"}, and can also be set to \code{"always"} or \code{"never"}. ##' @param show.pvalues Logical. If set to \code{FALSE} the column ##' \code{p-values} is removed. If missing the value ##' \code{object$compare.groups[[1]]==TRUE} is used. ##' @param show.totals Logical. If set to \code{FALSE} the column ##' \code{Totals} is removed. If missing the value ##' \code{object$show.totals} is used. ##' @param ... passed on to \code{labelUnits}. This overwrites labels ##' stored in \code{object$labels} ##' @export ##' @return Summary table ##' @author Thomas A. Gerds ##' @examples ##' data(Diabetes) ##' u <- univariateTable(gender~age+location+Q(BMI)+height+weight, ##' data=Diabetes) ##' summary(u) ##' summary(u,n=NULL) ##' summary(u,pvalue.digits=2,"age"="Age (years)","height"="Body height (cm)") ##' ##' u2 <- univariateTable(location~age+AgeGroups+gender+height+weight, ##' data=Diabetes) ##' summary(u2) ##' summary(u2,drop.reference=TRUE) ##' ## same but more flexible ##' summary(u2,drop.reference=c("binary")) ##' ## same but even more flexible ##' summary(u2,drop.reference=c("gender")) ##' ##' summary.univariateTable <- function(object, n="inNames", drop.reference=FALSE, pvalue.stars=FALSE, pvalue.digits=4, show.missing=c("ifany","always","never"), show.pvalues, show.totals, ...){ if (missing(show.totals)) show.totals <- object$show.totals if (missing(n)) n <- object$n if (missing(show.pvalues)) show.pvalues <- object$compare.groups[[1]]==TRUE # {{{missing and n if (!missing(show.missing)) if (is.logical(show.missing) || is.numeric(show.missing)) if (show.missing==1L) show.missing <- "always" else show.missing <- "never" show.missing <- match.arg(show.missing,c("ifany","always","never"),several.ok=FALSE) # }}} # {{{ pvalues if (show.pvalues && !is.null(object$p.values)){ if (pvalue.stars==TRUE) px <- symnum(object$p.values,corr = FALSE,na = FALSE,cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),symbols = c("***", "**", "*", ".", " ")) else px <- format.pval(object$p.values,eps=10^{-pvalue.digits},digits=pvalue.digits) names(px) <- names(object$p.values) } # }}} # {{{ order the table according to formula if (is.null(object$groups)){ XX <- all.vars(object$formula) } else{ XX <- all.vars(object$formula)[-1] } order <- match(XX,names(object$summary.groups)) ordered.summary <- object$summary.groups[order] # }}} XXtab <- NULL # {{{ loop across table elements for (s in names(ordered.summary)){ if (!is.null(object$groups)){ sum <- as.matrix(ordered.summary[[s]]) if (show.totals) sum <- cbind(sum,Total=object$summary.totals[[s]]) } else{ if (show.totals) sum <- data.frame(Total=object$summary.totals[[s]],stringsAsFactors = FALSE) } if ((show.missing!="never") && (show.missing=="always" || any(object$missing$totals[[s]]>0))){ if (!show.totals){ if (is.null(object$groups)){ miss <- object$missing$totals[[s]] }else{ miss <- unlist(object$missing$group[[s]]) } } else{ miss <- c(unlist(object$missing$group[[s]]),object$missing$totals[[s]]) } } else{ miss <- NULL } sum <- rbind(sum,miss) if (object$vartype[[s]]=="factor"){ lev <- object$xlevels[[s]] if ((is.logical(drop.reference) && drop.reference[1]==TRUE) || (is.character(drop.reference) && (s %in% drop.reference)) || (is.character(drop.reference) && drop.reference[1]=="binary" && length(lev)==2) || (is.character(drop.reference) && drop.reference[1]=="all")){ ## remove redundant line for reference level lev <- lev[-1] sum <- sum[-1,,drop=FALSE] } } else{ if (object$vartype[[s]]=="Q") lev <- gsub("\\(x\\)","",object$Q.format) else lev <- gsub("\\(x\\)","",object$summary.format) } if (!is.null(miss)) lev <- c(lev,"missing") if (show.pvalues && !is.null(object$p.values)){ p <- px[[s]] if (NROW(sum)>2 && NROW(p)==(NROW(sum)-1)){ sum <- cbind(sum,rbind(rep("",NROW(sum)-1),p=px[[s]])) colnames(sum)[NCOL(sum)] <- "p" } else{ if (is.null(miss)){ p <- c(rep("",NROW(sum)-1),px[[s]]) } else{ p <- c(rep("",NROW(sum)-2),px[[s]],"") } sum <- cbind(sum,p) } } ## fac <- c(s,rep("",NROW(sum)-1)) fac <- c(s,rep("",length(lev)-1)) sum <- cbind(unlist(fac),lev,sum) ## if (NROW(sum)>2) sumXX <- data.frame(sum,stringsAsFactors=FALSE,row.names=1:NROW(sum)) rownames(sumXX) <- NULL XXtab <- rbind(XXtab,sumXX) } # }}} # {{{ column names and n if (length(n)>0 && !(is.null(object$groups))){ if (n=="inNames"){ object$groups <- paste(object$groups," (n=",object$n.groups[-length(object$n.groups)],")",sep="") } else{ XXtab <- rbind(c("n","",object$n.groups,""),XXtab) } } if (is.null(object$groups)){ colnames(XXtab) <- c("Variable","Levels","Value") XXtab$Variable <- as.character(XXtab$Variable) XXtab$Levels <- as.character(XXtab$Levels) totalName <- "Total" pname <- NULL } else{ if ((show.pvalues==TRUE) && !is.null(object$p.values)){ if (tolower(as.character(object$compare.groups)) %in% c("cox","logistic")) pname <- paste("p-value ","(",object$compare.groups,")",sep="") else pname <- "p-value" }else pname <- NULL if (show.totals[[1]]==TRUE){ if (length(n)>0 && (n=="inNames")) totalName <- paste("Total"," (n=",object$n.groups[length(object$n.groups)],")",sep="") else totalName <- "Total" } else totalName <- NULL } colnames(XXtab) <- c("Variable","Level",object$groups,totalName,pname) # }}} # {{{ labels & units class(XXtab) <- c("summary.univariateTable","data.frame") XXtab <- do.call(labelUnits,c(list(x=XXtab),list(...),object$labels)) # }}} rownames(XXtab) <- NULL XXtab } Publish/R/specialFrame.R0000644000176200001440000001441613664136424014616 0ustar liggesusers##' Extract data and design matrix including specials from call ##' ##' Obtain a list with the data used for event history regression analysis. This ##' function cannot be used directly on the user level but inside a function ##' to prepare data for survival analysis. ##' @title Special frame ##' @param formula Formula whose left hand side specifies the event ##' history, i.e., either via Surv() or Hist(). ##' @param data Data frame in which the formula is interpreted ##' @param unspecials.design Passed as is to ##' \code{\link{model.design}}. ##' @param specials Character vector of special function names. ##' Usually the body of the special functions is function(x)x but ##' e.g., \code{\link{strata}} from the survival package does treat ##' the values ##' @param specials.factor Passed as is to \code{\link{model.design}}. ##' @param specials.design Passed as is to \code{\link{model.design}} ##' @param strip.specials Passed as \code{specials} to ##' \code{\link{strip.terms}} ##' @param strip.arguments Passed as \code{arguments} to ##' \code{\link{strip.terms}} ##' @param strip.alias Passed as \code{alias.names} to ##' \code{\link{strip.terms}} ##' @param strip.unspecials Passed as \code{unspecials} to ##' \code{\link{strip.terms}} ##' @param drop.intercept Passed as is to \code{\link{model.design}} ##' @param response If FALSE do not get response data. ##' @param na.action Decide what to do with missing values. ##' @return A list which contains ##' - the response ##' - the design matrix (see \code{\link{model.design}}) ##' - one entry for each special (see \code{\link{model.design}}) ##' @seealso model.frame model.design Hist ##' @examples ##' ##' ## Here are some data with an event time and no competing risks ##' ## and two covariates X1 and X2. ##' ## Suppose we want to declare that variable X1 is treated differently ##' ## than variable X2. For example, X1 could be a cluster variable, or ##' ## X1 should have a proportional effect on the outcome. ##' d <- data.frame(y=1:7, ##' X2=c(2.24,3.22,9.59,4.4,3.54,6.81,5.05), ##' X3=c(1,1,1,1,0,0,1), ##' X4=c(44.69,37.41,68.54,38.85,35.9,27.02,41.84), ##' X1=factor(c("a","b","a","c","c","a","b"), ##' levels=c("c","a","b"))) ##' ## define special functions prop and cluster ##' prop <- function(x)x ##' cluster <- function(x)x ##' ## We pass a formula and the data ##' e <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, ##' data=d, ##' specials=c("prop","cluster")) ##' ## The first element is the response ##' e$response ##' ## The other elements are the design, i.e., model.matrix for the non-special covariates ##' e$design ##' ## and a data.frame for the special covariates ##' e$prop ##' ## The special covariates can be returned as a model.matrix ##' e2 <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, ##' data=d, ##' specials=c("prop","cluster"), ##' specials.design=TRUE) ##' e2$prop ##' ## and the non-special covariates can be returned as a data.frame ##' e3 <- specialFrame(y~prop(X1)+X2+cluster(X3)+X4, ##' data=d, ##' specials=c("prop","cluster"), ##' specials.design=TRUE, ##' unspecials.design=FALSE) ##' e3$design ##' @export ##' @author Thomas A. Gerds specialFrame <- function(formula, data, unspecials.design=TRUE, specials, specials.factor=TRUE, specials.design=FALSE, strip.specials=TRUE, strip.arguments=NULL, strip.alias=NULL, strip.unspecials=NULL, drop.intercept=TRUE, response=TRUE, na.action=options()$na.action){ # {{{ get all variables and remove missing values ## get_all_vars fails when data.frame contains labelled variables (Hmisc) ## if (na.action %in% c("na.omit","na.fail","na.exclude") || is.function(na.action)) ## mm <- do.call(na.action,list(object=get_all_vars(formula,data))) ## else ## mm <- get_all_vars(formula,data) # }}} # {{{call model.frame ## data argument is used to resolve '.' see help(terms.formula) if (!is.null(strip.specials)){ ## eval without the data to avoid evaluating special specials # Terms <- terms(x=formula, specials=unique(c(specials,unlist( strip.alias)))) Terms <- terms(x=formula, specials=specials) Terms <- prodlim::strip.terms(Terms, specials=strip.specials, arguments= strip.arguments, alias.names= strip.alias, unspecials= strip.unspecials) }else{ ## data argument is used to resolve '.' see help(terms.formula) Terms <- terms(x=formula, specials=specials, data = data) } ## mm <- na.omit(get_all_vars(formula(Terms),data)) mm <- do.call(na.action,list(get_all_vars(formula(Terms),data))) #mm <- model.frame(formula=formula(Terms),data=data,na.action=na.action) if (NROW(mm) == 0) stop("No (non-missing) observations") # {{{ extract response if (response==TRUE && attr(Terms,"response")!=0){ response <- model.frame(update(formula,".~1"), data=mm,na.action="na.pass") }else response <- NULL # }}} # {{{ design design <- prodlim::model.design(Terms, data=mm, maxOrder=1, dropIntercept=drop.intercept, unspecialsDesign=unspecials.design, specialsFactor=specials.factor, specialsDesign=specials.design) # }}} out <- c(list(response=response), design[sapply(design,length)>0]) attr(out,"Terms") <- Terms attr(out,"na.action") <- attr(mm,"na.action") class(out) <- "specialFrame" out } ##' @export as.data.frame.specialFrame <- function(x,...){ Y <- data.frame(unclass(x$response)) X <- do.call("cbind",x[-1]) cbind(Y,X) } Publish/R/print.regressionTable.R0000644000176200001440000000022513571203035016465 0ustar liggesusersprint.regressionTable <- function(x,...){ Rtab <- summary(x,print=FALSE,...) ## rownames(Rtab) <- NULL print.listof(Rtab,...) Rtab } Publish/R/fixRegressionTable.R0000755000176200001440000001252513571203035016012 0ustar liggesusers##' Expand regression coefficient table ##' ##' This function expands results from "regressionTable" with ##' extralines and columns ##' ##' For factor variables the reference group is shown. ##' For continuous variables the units are shown and ##' for transformed continuous variables also the scale. ##' For all variables the numbers of missing values are added. ##' @title Expand regression coefficient table ##' @param x object resulting from \code{lm}, \code{glm} or \code{coxph}. ##' @param varnames Names of variables ##' @param reference.value Reference value for reference categories ##' @param reference.style Style for showing results for categorical ##' variables. If \code{"extraline"} show an additional line for the ##' reference category. ##' @param factorlevels Levels of the categorical variables. ##' @param scale Scale for some or all of the variables ##' @param nmiss Number of missing values ##' @param intercept Intercept ##' @return a table with regression coefficients ##' @author Thomas Alexander Gerds ##' @export fixRegressionTable <- function(x, varnames, reference.value, reference.style=NULL, factorlevels, scale=NULL, nmiss, intercept){ if (missing(nmiss)) nmiss <- NULL some.scaled <- sum(scale!="")>0 ## for some reason logical value variables, ie with levels ## TRUE, FALSE do not get xlevels in the output of glm loc <- grep("TRUE$",rownames(x),value=TRUE) if (length(loc)>0){ locvars <- lapply(loc,function(l){ substring(l,1,nchar(l)-4) }) names(locvars) <- locvars factorlevels <- c(factorlevels, lapply(locvars,function(l){c("FALSE","TRUE")})) } factornames <- names(factorlevels) ## for some reason ordinal variables get strange labels ord <- grep("\\.L$",rownames(x),value=TRUE) if (length(ord)>0){ orderednames <- unlist(strsplit(ord,"\\.L$")) }else{orderednames <- ""} blocks <- lapply(varnames,function(vn){ isfactor <- match(vn,factornames,nomatch=0) isordered <- match(vn,orderednames,nomatch=0) ## the regexp is supposed to catch the term `age' in ## age and I(age^2 and interaction(age,sex) and ## interaction(sex,age) and fun(age) if (isfactor){ if (isordered){ vn.regexp <- paste("^",vn,".[LCQ]$","|","",vn,"\\^[0-9]+$",sep="") }else{ levs.regexp <- paste("(",paste(factorlevels[[isfactor]],collapse="|"),")",sep="") vn.regexp <- paste("^",vn,levs.regexp,"$","|","I\\(",vn,".*",levs.regexp,"|",vn,"\\)",".*",levs.regexp,sep="") } } else{ vn.regexp <- paste("^",vn,"$",sep="") } parms <- grep(vn.regexp,rownames(x)) block <- x[parms,,drop=FALSE] Scale <- NULL Missing <- NULL # {{{ discrete variables if (isfactor){ if (reference.style=="inline"){ Variable <- c(vn,rep("",NROW(block)-1)) Units <- paste(factorlevels[[isfactor]][-1], "vs", factorlevels[[isfactor]][1]) if (some.scaled){ Scale <- rep("",NROW(block)) } if (!is.null(nmiss)){ Missing <- c(nmiss[vn],rep("",NROW(block)-1)) } } else { Variable <- c(vn,rep("",NROW(block))) Units <- factorlevels[[isfactor]] if (some.scaled){ Scale <- rep("",NROW(block)+1) } if (!is.null(nmiss)){ Missing <- c(nmiss[vn],rep("",NROW(block))) } block <- rbind(c(reference.value,rep("",NCOL(block)-1)),block) } } else{ # }}} # {{{numeric variables Variable <- vn Units <- "" if (!is.null(nmiss)){ Missing <- nmiss[vn] } if (some.scaled){ Scale <- scale[[vn]] } } if (some.scaled){ do.call("cbind",list(Variable=Variable, Scale=Scale, Units=Units, Missing=as.character(Missing), block)) }else{ do.call("cbind",list(Variable=Variable, Units=Units, Missing=as.character(Missing), block)) } # }}} }) out <- do.call("rbind",blocks) out$Variable <- as.character(out$Variable) out$Missing <- as.character(out$Missing) out$Units <- as.character(out$Units) rownames(out) <- 1:NROW(out) # {{{ add intercept if it is wanted if (intercept!=0 && (found <- match("(Intercept)",rownames(x),nomatch=0))){ inter <- x[found,,drop=FALSE] out <- rbind(unlist(c(Variable="Intercept", Units="", Missing="", inter))[colnames(out)], out) } rownames(out) <- 1:NROW(out) # }}} out } Publish/R/canbe.numeric.R0000744000176200001440000000033113571203035014712 0ustar liggesuserscanbe.numeric <- function(x){ if (!is.character(x)) x <- as.character(x) u <- x[!is.na(x) & x!="NA"] test <- suppressWarnings(as.numeric(u)) if (any(is.na(test))) FALSE else TRUE } Publish/R/publish.data.frame.R0000755000176200001440000000013313571203035015652 0ustar liggesusers##' @export publish.data.frame <- function(object,...){ publish(as.matrix(object),...) } Publish/R/publish.FGR.R0000755000176200001440000000135013571203035014270 0ustar liggesusers##' @author Thomas Alexander Gerds ##' ##' @export publish.FGR <- function(object,digits=4,print=TRUE,...){ sum <- summary(object$crrFit) p <- sum$coef[,5,drop=TRUE] subHR <- pubformat(sum$coef[,2,drop=TRUE],handler="sprintf",digits=digits) ci <- sum$conf.int[,3:4] colnames(ci) <- c("lower","upper") ci <- formatCI(x=subHR, ci[,"lower"], ci[,"upper"], show.x=0L) out <- data.table::data.table(cbind(Variable=rownames(sum$coef), subHR, ci, p)) if (print==TRUE) publish(out,digits=digits,...) invisible(out) } Publish/R/plot.regressionTable.R0000644000176200001440000000663213571203035016317 0ustar liggesusers### plot.regressionTable.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Feb 2 2015 (06:55) ## Version: ## last-updated: May 13 2018 (14:36) ## By: Thomas Alexander Gerds ## Update #: 103 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Plotting regression coefficients with confidence limits ##' ##' ##' @title Plotting regression coefficients with confidence limits ##' @param x regression table obtained with regressionTable ##' @param xlim Limits for x-axis ##' @param xlab Label for x-axis ##' @param style Determines how to arrange variable names and their corresponding units ##' @param ... passed to plotConfidence ##' @return NULL ##' @seealso regressionTable ##' @examples ##' ## linear regression ##' data(Diabetes) ##' f <- glm(bp.1s~AgeGroups+chol+gender+location,data=Diabetes) ##' rtf <- regressionTable(f,factor.reference = "inline") ##' plot(rtf,cex=1.3) ##' ##' ## logistic regression ##' data(Diabetes) ##' f <- glm(I(BMI>25)~bp.1s+AgeGroups+chol+gender+location,data=Diabetes,family=binomial) ##' rtf <- regressionTable(f,factor.reference = "inline") ##' plot(rtf,cex=1.3) ##' ##' ## Poisson regression ##' data(trace) ##' fit <- glm(dead ~ smoking+ sex+ age+Time+offset(log(ObsTime)), family = poisson,data=trace) ##' rtab <- regressionTable(fit,factor.reference = "inline") ##' plot(rtab,xlim=c(0.85,1.15),cex=1.8,xaxis.cex=1.5) ##' ##' ## Cox regression ##' library(survival) ##' data(pbc) ##' coxfit <- coxph(Surv(time,status!=0)~age+log(bili)+log(albumin)+factor(edema)+sex,data=pbc) ##' pubcox <- publish(coxfit) ##' plot(pubcox,cex=1.5,xratio=c(0.4,0.2)) ##' ##' @export ##' @author Thomas A. Gerds plot.regressionTable <- function(x,xlim,xlab,style=1,...){ plot(summary(x,print=FALSE),xlim=xlim,xlab=xlab,style=style,...) } ##' @export plot.summary.regressionTable <- function(x,xlim,xlab,style=1,...){ X <- x$rawTable X <- labelUnits(X,...) if (sum(X$Units=="")>0) X[X$Units=="",]$Units <- "1 unit" model <- x$model if (missing(xlab)) xlab <- switch(model, "Linear regression"="Difference", "Logistic regression"="Odds ratio", "Poisson regression"="Hazard ratio", "Cox regression"="Hazard ratio") Coef <- X[,grep("OddsRatio|HazardRatio|ProbIndex|Coefficient",colnames(X))] Lower <- X$Lower Upper <- X$Upper if (missing(xlim)) xlim <- c(min(Lower),max(Upper)) U <- X$Units V <- X$Variable if (style==1){ Labs <- split(U,rep(1:length(x$blocks),x$blocks)) names(Labs) <- names(x$blocks) labels <- list(...) keys <- names(labels) Flabels <- labels[match(keys,names(Labs),nomatch=0)!=0] if (length(Flabels)>0) names(Labs)[match(keys,names(Labs),nomatch=0)] <- Flabels } else { Labs <- data.frame(Variable=V,Units=U) } plotConfidence(list(Coef,lower=Lower,upper=Upper), xlim=xlim, labels=Labs, xlab=xlab, refline=1*(model!="Linear regression"), ...) } #---------------------------------------------------------------------- ### plot.regressionTable.R ends here Publish/R/summary.ci.R0000644000176200001440000000524013571203035014273 0ustar liggesusers##' Summarize confidence intervals ##' ##' This format of the confidence intervals is user-manipulable. ##' @title Summarize confidence intervals ##' @param object Object of class ci containing point estimates and the ##' corresponding confidence intervals ##' @param format A string which indicates the format used for ##' confidence intervals. The string is passed to ##' \code{\link{formatCI}} with two arguments: the lower and the upper ##' limit. For example \code{'(l;u)'} yields confidence intervals with ##' round parenthesis in which the upper and the lower limits are ##' separated by semicolon. ##' @param se If \code{TRUE} add standard error. ##' @param print Logical: if \code{FALSE} do not actually print ##' confidence intervals but just return them invisibly. ##' @param ... used to control formatting of numbers ##' @return Formatted confidence intervals ##' @seealso ci plot.ci format.ci ##' @examples ##' library(lava) ##' m <- lvm(Y~X) ##' m <- categorical(m,Y~X,K=4) ##' set.seed(4) ##' d <- sim(m,24) ##' ci.mean(Y~X,data=d) ##' x <- summary(ci.mean(Y~X,data=d),digits=2) ##' x ##' x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=2) ##' x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,se=TRUE) ##' x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,handler="format") ##' x <- summary(ci.mean(Y~X,data=d),format="(u,l)",digits=1,handler="prettyNum") #' @export ##' @author Thomas A. Gerds summary.ci <- function(object,format="[u;l]",se=FALSE,print=TRUE,...){ pynt <- getPyntDefaults(list(...),names=list("digits"=c(2,3),"handler"="sprintf",nsmall=NULL)) digits <- pynt$digits handler <- pynt$handler if (length(digits)==1) digits <- rep(digits,2) if (length(pynt$nsmall)>0) nsmall <- pynt$nsmall else nsmall <- pynt$digits if (missing(format) || is.null(format)) format <- "[u;l]" if (is.null(object$level)) level <- 0.05 else level <- object$level parm <- pubformat(object[[1]],handler=handler,digits=digits,nsmall=nsmall) ci <- formatCI(lower=object[["lower"]],upper=object[["upper"]],format=format,handler=handler,digits=digits,nsmall=nsmall) if (match("se",names(object)) && se==TRUE){ se <- pubformat(object[[2]],handler=handler,digits=digits,nsmall=nsmall) pci <- cbind(parm,se,ci) colnames(pci) <- c(names(object)[1:2],paste("CI-",as.character(100*(1-level)),"%",sep="")) }else{ pci <- cbind(parm,ci) colnames(pci) <- c(names(object)[1],paste("CI-",as.character(100*(1-level)),"%",sep="")) } pci <- cbind(object$labels,pci) rownames(pci) <- rep("",nrow(pci)) if (print==TRUE) print(pci,right=FALSE,quote=FALSE,...) invisible(pci) } Publish/R/getSummary.R0000744000176200001440000000500213571203035014336 0ustar liggesusersgetSummary <- function(matrix, varnames, groupvar, groups, labels, stats, format, digits,big.mark){ iqr <- function(x)quantile(x,c(0.25,0.75)) minmax <- function(x)quantile(x,c(0,1)) CI.95 <- function(x,sep=";",big.mark=big.mark,...){ m <- ci.mean.default(x,...) paste(format(m$lower,digits=digits,nsmall=digits,bigmark=big.mark), sep," ", format(m$upper,digits=digits,nsmall=digits,bigmark=big.mark),sep="") } totals <- vector(NCOL(matrix),mode="list") names(totals) <- varnames groupsummary <- vector(NCOL(matrix),mode="list") names(groupsummary) <- varnames for (v in varnames){ vv <- matrix[,v] missing.v <- is.na(vv) vvv <- vv[!missing.v] totals.values <- lapply(stats,function(s){ do.call(s,list(vvv)) }) specialUnlist <- function(list){ if (any(sapply(list,function(l){length(l)})>1)){ ll <- lapply(list,function(x){ if (length(x)>1) as.list(x) else x }) return(as.list(unlist(ll,recursive=FALSE))) } else{ return(list) } } totals.values <- lapply(totals.values,function(x){ a <- sprintf(fmt=paste("%1.",digits,"f",sep=""),x) if (big.mark!="") a <- format(as.numeric(a),big.mark=big.mark,scientific=FALSE) a }) totals[[v]] <- do.call("sprintf",c(format,specialUnlist(totals.values))) if (!is.null(groupvar) && !missing(groupvar) && length(groupvar)==NROW(matrix)){ ggg <- factor(groupvar[!missing.v],levels=groups) gsum.v <- lapply(groups,function(g){ values <- lapply(stats,function(s){ do.call(s,list(vvv[ggg==g])) }) values <- lapply(values,function(x){ a <- sprintf(fmt=paste("%1.",digits,"f",sep=""),x) if (big.mark!="") a <- format(as.numeric(a),big.mark=big.mark,scientific=FALSE) a }) do.call("sprintf",c(format, specialUnlist(values))) }) names(gsum.v) <- labels groupsummary[[v]] <- do.call("cbind", gsum.v) } } list(totals=totals,groupsummary=groupsummary) } Publish/R/subgroupAnalysis.R0000644000176200001440000002644013761463620015574 0ustar liggesusers#' @title Subgroup Analysis - Interactions and estimates #' @description #' #' The function can examine Cox regression, logistic regression #' and Poisson regression (Poisson regression for survival analysis) #' where the effect of one variable is of particular interest. This function #' systematically checks for effect modification with a list of other variables. #' #' In randomised studies the main regression analysis is often univariate and #' includes only the exposure of interest. In #' observational studies the main regression analysis can readily be adjusted for #' other variables including those which may modify the effect of the variable #' of interest. #' #' @author Christian Torp-Pedersen #' @usage #' subgroupAnalysis(object,data,treatment, #' subgroups, confint.method="default",factor.reference="extraline") #' @param object - glm, coxph or cph object for which subgroups should be #' analyzed. #' @param data - Dataset including all relevant variables #' @param treatment - Must be numeric - 0/1 #' @param subgroups - A vector of variable names presenting the factor variables #' where subgroups should be formed. These variables should #' all be "factors" #' @param confint.method "default" creates Wald type confidence interval, "robust", #' creates creates robust standard errors - see regressionTable function. #' @param factor.reference "extraline" creates an extraline for the reference, #' "inline" avoids this line. #' @details #' The function can only handle a bivariate treatment, which MUST coded as #' zero or one. The p-value for interaction is obtained with a likelihood ratio test #' comparing the main regression analysis with the interaction model. #' #' There are plot and print functions available for the function #' see helppages for plot.subgroupAnalysis and print.subgroupAnalysis #' @return A data.frame with subsgroup specifications, number in each subgroup, #' parameter estimates and p-value for interaction. A forest plot #' can be obtained with "plotConfidence". #' @seealso coxph, glm, plotConfidence #' @export #' @examples #' #load libraries #' library(data.table) #' library(Publish) #' library(survival) #' data(traceR) #get dataframe traceR #' data.table::setDT(traceR) #' traceR[,':='(wmi2=factor(wallMotionIndex<0.9,levels=c(TRUE,FALSE), #' labels=c("bad","good")), #' abd2=factor(abdominalCircumference<95, levels=c(TRUE,FALSE), #' labels=c("slim","fat")))] #' traceR[,sex:=as.factor(sex)] # all subgroup variables needs to be factor #' traceR[observationTime==0,observationTime:=1] #' # remove missing covariate values #' traceR=na.omit(traceR) #' # univariate analysis of smoking in subgroups of age and sex #' # Main regression analysis is a simple/univariate Cox regression #' fit_cox <- coxph(Surv(observationTime,dead)~treatment,data=traceR) #' sub_cox <- subgroupAnalysis(fit_cox,traceR,treatment="treatment", #' subgroups=c("smoking","sex","wmi2","abd2")) #' sub_cox #' #' # to see how the results are obtained consider the variable: smoking #' fit_cox_smoke <- coxph(Surv(observationTime,dead)~treatment*smoking,data=traceR) #' # the last three rows of the following output: #' publish(fit_cox_smoke) #' # are included in the first 3 rows of the result of the sub group analysis: #' sub_cox[1:3,] #' # the p-value is obtained as: #' fit_cox_smoke_add <- coxph(Surv(observationTime,dead)~treatment+smoking,data=traceR) #' anova(fit_cox_smoke_add,fit_cox_smoke,test="Chisq") #' #' # Note that a real subgroup analysis would be to subset the data #' fit_cox1a <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="never"]) #' fit_cox1b <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="current"]) #' fit_cox1c <- coxph(Surv(observationTime,dead)~treatment,data=traceR[smoking=="prior"]) #' #' #' ## when the main analysis is already adjusted #' fit_cox_adj <- coxph(Surv(observationTime,dead)~treatment+smoking+sex+wmi2+abd2, #' data=traceR) #' sub_cox_adj <- subgroupAnalysis(fit_cox_adj,traceR,treatment="treatment", #' subgroups=c("smoking","sex","wmi2","abd2")) # subgroups as character string #' sub_cox_adj #' #' # When both start and end are in the Surv statement: #' traceR[,null:=0] #' fit_cox2 <- coxph(Surv(null,observationTime,dead)~treatment+smoking+sex+wmi2+abd2,data=traceR) #' summary(regressionTable(fit_cox)) #' sub_cox2 <- subgroupAnalysis(fit_cox2,traceR,treatment="treatment", #' subgroups=c("smoking","sex","wmi2","abd2")) #' # Analysis with Poisson - and the unrealistic assumption of constant hazard #' # and adjusted for age in all subgroups #' fit_p <- glm(dead~treatment+age+offset(log(observationTime)),family="poisson", #' data=traceR) #' sub_pois <- subgroupAnalysis(fit_p,traceR,treatment="treatment", #' subgroups=~smoking+sex+wmi2+abd2) #' # Analysis with logistic regression - and very wrongly ignoring censoring #' fit_log <- glm(dead~treatment+age,family="binomial",data=traceR) #' sub_log <- subgroupAnalysis(fit_log,traceR,treatment="treatment", #' subgroups=~smoking+sex+wmi2+abd2, factor.reference="inline") subgroupAnalysis <- function(object, # glm, lrm, coxph or cph object data, # data with all variables treatment, # max 2 values subgroups, # Character vector or Formula. Factor list of subgroups variables confint.method="default", # Wald type confidence interval factor.reference="extraline"){ level=tail=Variable=NULL if(!(class(object)[1] %in% c("coxph","cph","glm"))) stop ("Error - Object must be coxph, cph or glm") if(!(class(treatment)[1]=="character")) stop("Error - Variable treament must be character") if(class(subgroups)[1]=="formula") subgroups <- all.vars(subgroups) else if(!(class(subgroups)[1]=="character")) stop ("Error - subgroups must be formula or character") if (!(class(data)[1] %in% c("data.frame","data.table"))) stop ("Error - data must be data.frame og data.table") else{ datt <- data.table::copy(data) data.table::setDT(datt) } classes <- sapply(datt,class) if (!classes[treatment] =="factor") stop("Error - treatment must be a factor variable") for(i in 1:length(subgroups)) if (!classes[subgroups[i]]=="factor") stop("Error - subgroups must be a factor variables") ## if (!all(stats::complete.cases(data[,.SD,.SDcols=c(subgroups,all.vars(object$formula),treatment)]))) ## warning("data has missing values in columns used, may cause problems") if (!treatment %in% all.vars(object$formula)) stop("Error - treatment must be in the formula") #Define type of analysis if (class(object)[1] %in% c("coxph","cph")) model<-"cox" else if (class(object)[1]=="glm"){ if(object$family$family=="binomial") model<-"logistic" else if (object$family$family=="poisson") model<-"poisson" # Poisson no offset else stop("Error - type of study not an option or misspecified") } #subgroups variables should not be in the models ## for (i in all.vars(object$formula)) if (i %in% subgroups) ## stop("Subgroups variables should not be part of every model") Result <- rbindlist(lapply(subgroups,function(var){ ff1 <- update.formula(object$formula, paste("~ . +",var, "*", treatment)) #with interaction ff2 <- update.formula(object$formula, paste("~ . +",var, "+", treatment)) #without interaction if (model=='cox'){ fit1 <- coxph(ff1,data=datt) fit2 <- coxph(ff2,data=datt) pinteraction <- anova(fit1,fit2)[4][2,] lhs <- all.vars(object$formula[[2]]) if(!class(datt[,eval(parse(text=lhs[2]))]) %in% c("numeric","integer")) stop("Outcome must be provided as 0/1 numeric") if (length(lhs)==2){ # time fixed model eventtime <- datt[,list(sample=.N, event=sum(eval(parse(text=lhs[2])),na.rm=TRUE), time=sum(eval(parse(text=lhs[1])),na.rm=TRUE)), by=c(var,treatment)] } else{ # Time varying model if(!class(datt[,eval(parse(text=lhs[3]))]) %in% c("numeric","integer")) stop("Outcome must be provided as 0/1 numeric") eventtime <- datt[,list(sample=.N, event=sum(eval(parse(text=lhs[3])),na.rm=TRUE), time=sum(eval(parse(text=lhs[2]))-eval(parse(text=lhs[1])),na.rm=TRUE)), by=c(var,treatment)] } eventtime <- data.table::dcast(eventtime,paste(var,"~",treatment), value.var=list("sample","event","time")) } else if(model=="poisson"){ if (!is.null(object$offset)){ fit1 <- glm(ff1,family="poisson",data=datt) fit2 <- glm(ff2,family="poisson",data=datt) tt1 <- terms(ff1) timevar <- all.vars(ff1)[[attributes(tt1)$offset]] if(!class(datt[,eval(parse(text=all.vars(object$formula)[[1]]))]) %in% c("numeric","integer")) stop("Outcome must be provided as 0/1 numeric") eventtime <- datt[,list(sample=.N, event=sum(eval(parse(text=all.vars(object$formula)[[1]])),na.rm=TRUE), time=sum(eval(parse(text=timevar))),na.rm=TRUE), by=c(var,treatment)] eventtime <- data.table::dcast(eventtime,paste(var,"~",treatment), value.var=list("sample","event","time")) } else{ #no offset if(!class(datt[,eval(parse(text=all.vars(object$formula)[[1]]))]) %in% c("numeric","integer")) stop("Outcome must be provided as 0/1 numeric") fit1 <- glm(ff1,family="poisson",data=datt) fit2 <- glm(ff2,family="poisson",data=datt) eventtime <- datt[,list(sample=.N, event=sum(eval(parse(text=all.vars(object$formula)[[1]])),na.rm=TRUE)), by=c(var,treatment)] eventtime <- data.table::dcast(eventtime,paste(var,"~",treatment), value.var=list("sample","event")) } pinteraction <- anova(fit1,fit2,test="Chisq")$"Pr(>Chi)"[2] } else if(model=="logistic"){ fit1 <- glm(ff1,family="binomial",data=datt) fit2 <- glm(ff2,family="binomial",data=datt) if(!class(datt[,eval(parse(text=all.vars(object$formula)[[1]]))]) %in% c("numeric","integer")) stop("Outcome must be provided as 0/1 numeric") eventtime <- datt[,list(sample=.N, event=sum(eval(parse(text=all.vars(object$formula)[[1]])),na.rm=TRUE)), by=c(var,treatment)] eventtime <- data.table::dcast(eventtime,paste(var,"~",treatment), value.var=list("sample","event")) pinteraction <- anova(fit1,fit2,test="Chisq")$"Pr(>Chi)"[2] } setnames(eventtime,var,"level") eventtime <- eventtime[!(level=="")] length <- dim(eventtime)[1] variable <- data.table(subgroups=rep(var,length)) rt <- suppressMessages(data.table::setDT(summary(regressionTable(fit1),print=FALSE)$rawTable)[,tail(.SD,length)]) rt <- rt[,Variable:=NULL] OUT <- cbind(variable,eventtime,rt,pinteraction) OUT } ) ,fill=TRUE) # end rbindlist class(Result) <- c("subgroupAnalysis","data.frame","data.table") Result } Publish/R/acut.R0000644000176200001440000002141613745461717013163 0ustar liggesusers##' A version of \code{cut} that easily formats the labels and places breaks by default. ##' ##' The formats are supplied by specifiyng the text around the lower (\%l) and upper (\%l) value (see examples). ##' If user specified breaks are supplied, the default labels from \code{cut} are used. ##' If automatic breaks are used, the default labels are a slight modification at the end point of the default from \code{cut} ##' All this can of course be adjusted manually through the format functionality (see below). ##' ##' By default, 5 breaks are constructed according to the quantiles with of the input \code{x}. ##' The number of breaks can be adjusted, and default specifying breaks (as in \code{cut}) can be supplied instead. ##' ##' If \code{type} is changed from "\code{default}" to another option, a different formatting template is used. ##' For now the only other option is "\code{age}", which is designed to be well suited to easily group age variables. ##' When \code{type}="\code{age}" only the \code{breaks} argument is used, and it behaves different from otherwise. ##' If a single number is supplied, intervals of length \code{breaks} will automatically be constructed (starting from 0). ##' If a vector is supplied, the intervals are used as in \code{cut} but formatted differently, see examples. ##' @title Automatic selection and formatting of breaks in \code{cut} ##' @param x a numeric vector which is to be converted to a factor by cutting (passed directly to \code{cut}). ##' @param n number of bins to create based on the empirical quantiles of x. This will be overruled if \code{breaks} is supplied. ##' @param type a high-level formatting option. For now, the only other option than the default setting is "\code{age}". See details and examples. ##' @param format string used to make labels. \%l and \%u identifies the lower and upper value of the breaks respectively. See examples. ##' @param format.low string used specifically on the lowest label. ##' @param format.high string used specifically on the highest label. ##' @param dig.lab integer which is used when labels are not given. It determines the number of digits used in formatting the break numbers. (Passed directly to \code{cut}.) ##' @param right logical, indicating if the intervals should be closed on the right (and open on the left) or vice versa (passed directly to \code{cut}). ##' @param breaks specify breaks manually as in \code{cut}. ##' @param labels logical, indicating whether or not to make labels or simply use ordered numbers. If TRUE, the labels are constructed as discribed above. ##' @param ... further arguments passed to \code{cut}. ##' @return same as for cut. A vector of 'factors' is created, unless 'labels=FALSE'. ##' @examples ##' data(Diabetes) # load dataset ##' ##' ## The default uses format similar to cut ##' chol.groups <- acut(Diabetes$chol) ##' table(chol.groups) ##' ##' ## The formatting can easily be changed ##' chol.groups <- acut(Diabetes$chol,format="%l-%u",n=5) ##' table(chol.groups) ##' ##' ## The default is to automatic place the breaks, so the number of this can easily be changed. ##' chol.groups <- acut(Diabetes$chol,n=7) ##' table(chol.groups) ##' ##' ## Manually setting format and breaks ##' age.groups <- acut(Diabetes$age,format="%l-%u",breaks=seq(0,100,by=10)) ##' table(age.groups) ##' ##' ## Other variations ##' age.groups <- acut(Diabetes$age, ##' format="%l-%u", ##' format.low="below %u", ##' format.high="above %l", ##' breaks=c(0, seq(20,80,by=10), Inf)) ##' table(age.groups) ##' ##' BMI.groups <- acut(Diabetes$BMI, ##' format="BMI between %l and %u", ##' format.low="BMI below %u", ##' format.high="BMI above %l") ##' table(BMI.groups) ##' org(as.data.frame(table(BMI=BMI.groups))) ##' ##' ## Instead of using the quantiles, we can specify equally spaced breaks, ##' ## but still get the same formatting ##' BMI.grouping <- ##' seq(min(Diabetes$BMI,na.rm=TRUE), max(Diabetes$BMI,na.rm=TRUE), length.out=6) ##' BMI.grouping[1] <- -Inf # To get all included ##' BMI.groups <- acut(Diabetes$BMI, ##' breaks=BMI.grouping, ##' format="BMI between %l and %u", ##' format.low="BMI below %u", ##' format.high="BMI above %l") ##' table(BMI.groups) ##' org(as.data.frame(table(BMI=BMI.groups))) ##' ##' ## Using type="age" ##' ## When using type="age", categories of 10 years are constructed by default. ##' ## The are formatted to be easier to read when the values are ages. ##' table(acut(Diabetes$age, type="age")) ##' ##' ## This can be changes with the breaks argument. ##' ## Note that this is diffent from cut when breaks is a single number. ##' table(acut(Diabetes$age, type="age", breaks=20)) ##' ##' ## Of course We can also supply the breaks manually. ##' ## The formatting depends on whether or not all the values fall within the breaks: ##' ## All values within the breaks ##' table(acut(Diabetes$age, type="age", breaks=c(0, 30, 50, 80, 100))) ##' ## Some values below and above the breaks ##' table(acut(Diabetes$age, type="age", breaks=c(30, 50, 80))) ##' ##' @author Anders Munch ##' @export acut <- function(x,n=5,type="default", format=NULL,format.low=NULL,format.high=NULL,dig.lab=3,right=TRUE,breaks,labels=TRUE,...){ stopifnot(n>1) update.label <- function(str,low=NULL,upper=NULL,low.str="%l",upper.str="%u"){ if(is.null(low)) low <- low.str if(is.null(upper)) upper <- upper.str new.label <- str new.label <- sub(low.str, low, new.label) new.label <- sub(upper.str, upper, new.label) return(new.label) } if(type=="age"){ min.x <- min(x, na.rm=TRUE) max.x <- max(x, na.rm=TRUE) if(missing(breaks)) breaks <- 10 if(length(breaks)==1){ if(as.integer(breaks)!=breaks) warning("When using type=\"age\", it makes most sense with intervals with integer length.") breaks <- seq(floor(min.x/breaks)*breaks, ceiling(max.x/breaks)*breaks, by=breaks) } if(any(!(as.integer(breaks) == breaks))) warning("When using type=\"age\", it makes most sense with integer-valued breaks points.") breaks <- sort(breaks) if(min.xbreaks[length(breaks)]) breaks <- c(breaks, Inf) ## Find way to handle right=FALSE -- maybe not relevant for the type? pre.cut <- acut(x=x, breaks=breaks, right=FALSE) age.labels <- paste0(breaks[-length(breaks)], "-", (breaks[-1]-1)) if(breaks[1] == -Inf) age.labels[1] <- paste("younger than", breaks[2]) if(breaks[length(breaks)] == Inf) age.labels[length(age.labels)] <- paste(breaks[length(breaks)-1], "or older") pre.cut <- factor(pre.cut, levels=levels(pre.cut), labels=age.labels) return(pre.cut) } if(missing(breaks)){ breaks <- as.numeric(quantile(x, seq(0,1,length.out=n+1), na.rm=TRUE)) breaks[1] <- -Inf breaks[length(breaks)] <- Inf if(is.null(format.low)){ if(right) format.low <- "<= %u" else format.low <- "< %u" } if(is.null(format.high)){ if(right) format.high <- "> %l" else format.high <- ">= %l" } } if(labels) labels <- NULL out <- cut(x,breaks=breaks,right=right,labels=labels,dig.lab=dig.lab) if(!is.null(c(format,format.low,format.high)) & is.null(labels)){ ## To keep consistency with labels from cut ## and because dig.lab in cut is quite clever, extract the breaks from here. default.labels <- levels(out) breaks <- unlist(strsplit(gsub(" ", "", paste(chartr("(]"," ",default.labels),collapse=",")), ",")) breaks <- breaks[c(seq(1,length(breaks)-1,by=2),length(breaks))] out.labels <- levels(out) if(!is.null(format)) out.labels <- mapply( function(a,b) update.label(format,low=a,upper=b), breaks[1:(length(breaks)-1)], breaks[2:(length(breaks))] ) if(!is.null(format.low)) out.labels[1] <- update.label(format.low,low=breaks[1],upper=breaks[2]) if(!is.null(format.high)) out.labels[length(out.labels)] <- update.label(format.high, low=breaks[length(breaks)-1], upper=breaks[length(breaks)]) levels(out) <- out.labels } return(out) } Publish/R/iqr.R0000744000176200001440000000026713571203035013004 0ustar liggesusersiqr <- function (x, na.rm = FALSE,digits,...){ paste("[",paste(format(quantile(as.numeric(x), c(0.25, 0.75), na.rm = na.rm),digits=digits,nsmall=digits),collapse=","),"]",sep="") } Publish/R/print.table2x2.R0000644000176200001440000001241013571203035014757 0ustar liggesusers##' print results of 2x2 contingency table analysis ##' ##' @title print results of 2x2 contingency table analysis ##' @param x object obtained with table2x2 ##' @param digits rounding digits ##' @param ... not used ##' @return invisible x ##' @seealso table2x2 ##' @examples ##' table2x2(table("marker"=rbinom(100,1,0.4),"response"=rbinom(100,1,0.1))) ##' table2x2(matrix(c(71,18,38,8),ncol=2),stats="table") ##' table2x2(matrix(c(71,18,38,8),ncol=2),stats=c("rr","fisher")) ##' @export ##' @author Thomas A. Gerds print.table2x2 <- function(x,digits=1,...){ stats <- x$stats table2x2 <- x$table2x2 a <- table2x2[1,1] b <- table2x2[1,2] c <- table2x2[2,1] d <- table2x2[2,2] p1 <- a/(a+b) p2 <- c/(c+d) if ("table" %in% stats){ suppressWarnings(X <- data.frame(rbind(table2x2,rep("--",2),table2x2[1,]+table2x2[2,]))) if (is.null(rownames(table2x2))) rownames(table2x2) <- paste("exposure:",c("no","yes")) if (is.null(colnames(table2x2))) colnames(table2x2) <- paste("response:",c("no","yes")) X$Sum <- c(a+b,c+d,"--",a+b+c+d) colnames(X) <- c(paste(names(attr(table2x2,"dimnames"))[2],attr(table2x2,"dimnames")[[2]],sep=""),"Sum") rownames(X) <- c(paste(names(attr(table2x2,"dimnames"))[1],attr(table2x2,"dimnames")[[1]],sep=""),"--","Sum") cat("_____________________________\n\n2x2 contingency table\n_____________________________\n\n") print(X,print.gap=5) cat("\n_____________________________\n\nStatistics\n_____________________________\n\n") cat(paste("\na=",a,"\nb=",b,"\nc=",c,"\nd=",d)) cat(paste("\n\np1=a/(a+b)=",round(a/(a+b),4),"\np2=c/(c+d)=", round(c/(c+d),4)),"\n") } if ("rd" %in% stats){ rd <- x$rd se.rd <- x$se.rd rd.lower <- x$rd.lower rd.upper <- x$rd.upper cat(paste("\n_____________________________\n\nRisk difference\n_____________________________\n\n", "Risk difference = RD = p1-p2 = ", format(rd,digits=digits+3,nsmall=digits+3), "\nStandard error = SE.RD = sqrt(p1*(1-p1)/(a+b)+p2*(1-p2)/(c+d)) = ", format(se.rd,digits=digits+3,nsmall=digits+3), "\nLower 95%-confidence limit: = RD - 1.96 * SE.RD = ", format(rd.lower,digits=digits+3,nsmall=digits+3), "\nUpper 95%-confidence limit: = RD + 1.96 * SE.RD = ", format(rd.upper,digits=digits+3,nsmall=digits+3), "\n\nThe estimated risk difference is ",format(100*rd,digits=digits,nsmall=digits),"% ", paste(" (CI_95%: [", format(100*rd.lower,digits=digits,nsmall=digits), ";", format(100*rd.upper,digits=digits,nsmall=digits), "]", sep = ""), ").\n",sep="")) } if ("rr" %in% stats){ rr <- x$rr se.rr <- x$se.rr rr.lower <- x$rr.lower rr.upper <- x$rr.upper cat(paste("\n_____________________________\n\nRisk ratio\n_____________________________\n\n", "Risk ratio = RR = p1/p2 = ", format(rr,digits=digits+3,nsmall=digits+3), "\nStandard error = SE.RR = sqrt((1-p1)/a+(1-p2)/c)= ", format(se.rr,digits=digits+3,nsmall=digits+3), "\nLower 95%-confidence limit: = RR * exp(- 1.96 * SE.RR) = ", format(rr.lower,digits=digits+3,nsmall=digits+3), "\nUpper 95%-confidence limit: = RR * exp(1.96 * SE.RR) = ", format(rr.upper,digits=digits+3,nsmall=digits+3), "\n\nThe estimated risk ratio is ",format(rr,digits=digits+2,nsmall=digits+2),"", paste(" (CI_95%: [", format(rr.lower,digits=digits+2,nsmall=digits+2), ";", format(rr.upper,digits=digits+2,nsmall=digits+2), "]", sep = ""), ").\n",sep="")) } if ("or" %in% stats){ or <- x$or se.or <- x$se.or or.lower <- x$or.lower or.upper <- x$or.upper cat(paste("\n_____________________________\n\nOdds ratio\n_____________________________\n\n", "Odds ratio = OR = (p1/(1-p1))/(p2/(1-p2)) = ", format(or,digits=digits+3,nsmall=digits+3), "\nStandard error = SE.OR = sqrt((1/a+1/b+1/c+1/d)) = ", format(se.or,digits=digits+3,nsmall=digits+3), "\nLower 95%-confidence limit: = OR * exp(- 1.96 * SE.OR) = ", format(or.lower,digits=digits+3,nsmall=digits+3), "\nUpper 95%-confidence limit: = OR * exp(1.96 * SE.OR) = ", format(or.upper,digits=digits+3,nsmall=digits+3), "\n\nThe estimated odds ratio is ",format(or,digits=digits+2,nsmall=digits+2),"", paste(" (CI_95%: [", format(or.lower,digits=digits+2,nsmall=digits+2), ";", format(or.upper,digits=digits+2,nsmall=digits+2), "]", sep = ""), ").\n",sep="")) } if ("chisq" %in% stats){ cat("\n_____________________________\n\nChi-square test\n_____________________________\n\n") print(chisq.test(table2x2)) } if ("fisher" %in% stats){ cat("\n_____________________________\n\nFisher's exact test\n_____________________________\n\n") print(fisher.test(table2x2)) } invisible(x) } Publish/R/publish.matrix.R0000755000176200001440000002446013734301176015173 0ustar liggesusers##' Publishing a matrix in raw, org, latex, or muse format ##' ##' This is the heart of the Publish package ##' @param object Matrix to be published ##' @param title Title for table, only in wiki and muse format ##' @param colnames If \code{TRUE} show column names ##' @param rownames If \code{TRUE} show row names ##' @param col1name Name for first column ##' @param digits Numbers are rounded according to digits ##' @param try.convert Logical. If \code{TRUE} try to convert also non-numeric ##' formats such as character to numeric before rounding. Default is \code{TRUE}. ##' @param sep Field separator when style is \code{"none"} ##' @param endhead String to be pasted at the end of the first row ##' (header) ##' @param endrow String to be pasted at the end of each row ##' @param style Table style for export to \code{"latex"}, ##' \code{"org"}, \code{"markdown"}, \code{"wiki"}, ##' \code{"none"}. Overwritten by argments below. ##' @param inter.lines A named list which contains strings to be ##' placed between the rows of the table. An element with name ##' \code{"0"} is used to place a line before the first column, ##' elements with name \code{"r"} are placed between line r and ##' r+1. ##' @param latex If \code{TRUE} use latex table format ##' @param wiki If \code{TRUE} use mediawiki table format ##' @param org If \code{TRUE} use emacs orgmode table format ##' @param markdown If \code{TRUE} use markdown table format ##' @param tabular For style \code{latex} only: if \code{TRUE} enclose ##' the table in begin/end tabular environement. ##' @param latex.table.format For style \code{latex} only: format of ##' the tabular environement. ##' @param latex.hline For style \code{latex} only: if \code{TRUE} add ##' hline statements add the end of each line. ##' @param latex.nodollar For style \code{latex} only: if \code{TRUE} ##' do not enclose numbers in dollars. ##' @param ... Used to transport arguments. Currently supports ##' \code{wiki.class}. ##' @examples ##' ##' x <- matrix(1:12,ncol=3) ##' publish(x) ##' ##' # rounding the numeric part of data mixtures ##' y <- cbind(matrix(letters[1:12],ncol=3),x,matrix(rnorm(12),ncol=3)) ##' publish(y,digits=1) ##' ##' publish(x,inter.lines=list("1"="text between line 1 and line 2", ##' "3"="text between line 3 and line 4")) ##' ##' @export publish.matrix <- function(object, title, colnames=TRUE, rownames=TRUE, col1name="", digits=4, try.convert=TRUE, sep=" ", endhead, endrow, style, inter.lines, latex=FALSE, wiki=FALSE, org=FALSE, markdown=FALSE, tabular=TRUE, latex.table.format=NA, latex.hline=1, latex.nodollar=FALSE, ...){ if (is.data.table(object)) object <- as.matrix(object) if (missing(inter.lines)) inter.lines <- NULL rrr <- rownames(object) # {{{ force vectors into matrix form if (is.null(dim(object))){ object <- matrix(object,ncol=length(object)) } # }}} # {{{ smartControl wiki.DefaultArgs <- list("class"="R-table") latex.DefaultArgs <- NULL org.DefaultArgs <- NULL markdown.DefaultArgs <- NULL control <- prodlim::SmartControl(call= list(...), keys=c("wiki","latex","markdown","org"), defaults=list("wiki"=wiki.DefaultArgs,"latex"=latex.DefaultArgs,"markdown"=markdown.DefaultArgs,"org"=org.DefaultArgs), ignore.case=TRUE, replaceDefaults=FALSE, verbose=FALSE) # }}} # {{{ style dependent syntax if (missing(style)) style <- "none" if (wiki==TRUE) style <- "wiki" if (latex==TRUE) style <- "latex" if (org==TRUE) style <- "org" if (markdown==TRUE) style <- "markdown" switch(style, "latex"={ latex <- TRUE wiki <- FALSE markdown <- FALSE org <- FALSE starthead <- "" collapse.head <- "&" if (missing(endhead)){ if (is.na(latex.hline)) endhead <- "\\\\\n" else endhead <- "\\\\\\hline\n" } startrow <- "" collapse.row <- "&" if (missing(endrow)) endrow <- "\\\\\n" endtable <- "\\end{tabular}\n" }, "wiki"={ wiki <- TRUE latex <- FALSE markdown <- FALSE org <- FALSE starthead <- "|-\n! " collapse.head <- " !! " if (missing(endhead)){ endhead <- "\n"} startrow <- "|-\n| " collapse.row <- " || " if (missing(endrow)) endrow <- "\n" endtable <- "|}\n" }, "markdown"={ wiki <- FALSE latex <- FALSE markdown <- TRUE org <- FALSE starthead <- "|" collapse.head <- "|" if (missing(endhead)){ endhead <- "|" } startrow <- "|" collapse.row <- "|" if (missing(endrow)) endrow <- "|\n" endtable <- "\n" }, "org"={ wiki <- FALSE latex <- FALSE markdown <- FALSE org <- TRUE starthead <- "| " collapse.head <- " | " if (missing(endhead)){ endhead <- "|" } startrow <- "| " collapse.row <- " | " if (missing(endrow)) endrow <- "|\n" endtable <- "\n" }, "none"={ wiki <- FALSE latex <- FALSE markdown <- FALSE org <- FALSE starthead <- "" collapse.head <- sep if (missing(endhead)){ endhead <- "\n" } startrow <- "" collapse.row <- sep endrow <- "\n" endtable <- "" }) # }}} # {{{ round object if (!missing(digits)){ tmpx <- apply(object,2,function(u){ if (is.numeric(u) | (try.convert==TRUE && canbe.numeric(u))){ format(as.numeric(u),digits=digits,nsmall=digits)} else{ u } }) if (NROW(object)==1) tmpx <- matrix(tmpx,nrow=1) rownames(tmpx) <- rownames(object) colnames(tmpx) <- colnames(object) object <- tmpx } if (!is.null(colnames(object))) ccc <- matrix(colnames(object),nrow=1) else ccc <- rep("",NCOL(object)) if (!latex){ object <- rbind(ccc,object) ## object <- format(object,justify="right") object <- do.call("cbind",lapply(1:NCOL(object),function(col){ format(unlist(object[,col]),justify="right") })) ccc <- object[1,,drop=TRUE] object <- object[-1,,drop=FALSE] } # }}} # {{{ colnames & rownames if (!is.null(rrr) & any(rrr!="") & rownames){ if (!is.null(ccc)) ccc <- c(col1name,ccc) object <- cbind(Variable=rrr,object) object[,1] <- as.character(object[,1]) } # }}} # {{{ header if (latex && tabular==TRUE) { if (is.na(latex.table.format)) cat("\\begin{tabular}{",c("l|",rep("c",NCOL(object)-1)),"}","\n") else cat("\\begin{tabular}{",latex.table.format,"}","\n") } if (wiki){ cat("{|","class=\"",control$wiki$class,"\"\n") if (!missing(title)) cat("|+",title,"\n") } # }}} # {{{ insert colunm names if (!is.null(inter.lines[[as.character(0)]])) cat(inter.lines[[as.character(0)]],"\n") if (!is.null(ccc) && colnames==TRUE){ cat(starthead,paste(ccc,collapse=collapse.head),endhead) if (org==TRUE){ cat("\n|") for (c in 1:length(ccc)){ if (c==1) cat(paste(rep("-",nchar(ccc[c])+1+nchar(startrow)),collapse=""),sep="") else cat("+",paste(rep("-",nchar(ccc[c]) -1 + nchar(collapse.row)),collapse=""),sep="") } cat("|\n") } if (markdown==TRUE){ cat("\n|") for (c in 1:length(ccc)){ if (c==1) cat(paste(rep("-",nchar(ccc[c]) -1 + nchar(startrow)),collapse=""),sep="") else cat(":|",paste(rep("-",nchar(ccc[c]) -1 + nchar(collapse.row)),collapse=""),sep="") } cat(":|\n") } } colnames(object) <- NULL rownames(object) <- NULL # }}} # {{{ Cat by row if (is.null(dim(object))){ if (latex && latex.nodollar==FALSE){ object[grep("<|>|[0-9.]+",object)] <- paste("$",object[grep("<|>|[0-9.]+",object)],"$") } cat(startrow,paste(object,collapse=collapse.row),endrow) } else{ for (r in 1:NROW(object)){ ## apply(object,1,function(object){ row.x <- object[r,,drop=TRUE] ## extra lines if (!is.null(inter.lines[[as.character(r)]])) cat(inter.lines[[as.character(r)]],"\n") ## protect numbers if (latex && latex.nodollar==FALSE){# if (latex) row.x[grep("<|>|[0-9.]+",row.x)]=paste("$",row.x[grep("<|>|[0-9.]+",row.x)],"$") } if (latex && latex.hline && object[[1]]!="") cat("\\hline\n") cat(startrow,paste(row.x,collapse=collapse.row),endrow) } } # }}} # {{{ footer if(latex && tabular==FALSE) NULL else cat(endtable) # }}} invisible(object) } Publish/R/coxphSeries.R0000744000176200001440000000441613571203035014505 0ustar liggesusers##' Run a series of Cox regression analyses for a list of predictor variables ##' and summarize the results in a table. ##' The Cox models can be adjusted for a fixed set of covariates ##' ##' This function runs on \code{coxph} from the survival package. ##' @title Run a series of Cox regression models ##' @param formula The fixed part of the regression formula. For ##' univariate analyses this is simply \code{Surv(time,status)~1} ##' where \code{Surv(time,status)} is the outcome variable. When the ##' aim is to control the effect of \code{vars} in each element of the ##' series by a fixed set of variables it is ##' \code{Surv(time,status)~x1+x2} where again Surv(time,status) is ##' the outcome and x1 and x2 are confounders. ##' @param data A \code{data.frame} in which the \code{formula} gets ##' evaluated. ##' @param vars A list of variable names, the changing part of the ##' regression formula. ##' @param ... passed to publish.coxph ##' @return matrix with results ##' @author Thomas Alexander Gerds ##' @examples ##' library(survival) ##' data(pbc) ##' ## collect hazard ratios from three univariate Cox regression analyses ##' pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) ##' uni.hr <- coxphSeries(Surv(time,status==2)~1,vars=c("edema","bili","protime"),data=pbc) ##' uni.hr ##' ##' ## control the logistic regression analyses for age and gender ##' ## but collect only information on the variables in `vars'. ##' controlled.hr <- coxphSeries(Surv(time,status==2)~age+sex,vars=c("edema","bili","protime"),data=pbc) ##' controlled.hr ##' ##' @export coxphSeries <- function(formula,data,vars,...){ ## ref <- glm(formula,data=data,...) Missing=NULL data.table::setDT(data) data <- data[,c(all.vars(formula),vars),with=FALSE] clist <- lapply(vars,function(v){ form.v <- update.formula(formula,paste(".~.+",v)) if (is.logical(data[[v]])) data[[v]] <- factor(data[[v]],levels=c("FALSE","TRUE")) cf <- survival::coxph(form.v,data=data,...) cf$call$data <- data cf$model <- data nv <- length(cf$xlevels[[v]]) rtab <- regressionTable(cf) rtab[[v]] }) out <- data.table::rbindlist(clist) if (all(out$Missing%in%c("","0"))) out[,Missing:=NULL] out[] } Publish/R/publish.univariateTable.R0000755000176200001440000000014413571203035016771 0ustar liggesusers##' @export publish.univariateTable <- function(object,...){ publish(summary(object,...),...) } Publish/R/publish-package.R0000644000176200001440000001526713571203035015255 0ustar liggesusers#' A study was made of all 26 astronauts on the first eight space shuttle flights (Bungo et.al., 1985). #' On a voluntary basis 17 astronauts consumed large quantities of salt and fluid prior to landing as #' a countermeasure to space deconditioning, while nine did not. #' @name SpaceT #' @docType data #' @format A data frame with 52 observations on the following 4 variables: #' \describe{ #' \item{Status}{Factor with levels Post (after flight) and Pre (before flight)} #' \item{HR}{Supine heart rate(beats per minute)} #' \item{Treatment}{Countermeasure salt/fluid (1= yes, 0=no)} #' \item{ID}{Person id} #' } #' @references #' Altman, Practical statistics for medical research, Page 223, Ex. 9.1. #' Bungo et.al., 1985 #' @examples ##' data(SpaceT) NULL #' Diabetes data of Dr John Schorling #' #' These data are courtesy of Dr John Schorling, Department of Medicine, University of Virginia School of Medicine. #' The data consist of 19 variables on 403 subjects from 1046 subjects who were interviewed in a study to understand #' the prevalence of obesity, diabetes, and other cardiovascular risk factors in central Virginia for African Americans. #' According to Dr John Hong, Diabetes Mellitus Type II (adult onset diabetes) is associated most strongly with obesity. #' The waist/hip ratio may be a predictor in diabetes and heart disease. DM II is also agssociated with hypertension - #' they may both be part of "Syndrome X". The 403 subjects were the ones who were actually screened for diabetes. #' Glycosolated hemoglobin > 7.0 is usually taken as a positive diagnosis of diabetes. #' #' @name Diabetes #' @docType data #' @format A data frame with 205 observations on the following 12 variables. #' \describe{ #' \item{id}{subject id} #' \item{chol}{Total Cholesterol} #' \item{stab.glu}{Stabilized Glucose} #' \item{hdl}{High Density Lipoprotein} #' \item{ratio}{Cholesterol/HDL Ratio} #' \item{glyhb}{Glycosolated Hemoglobin} #' \item{location}{a factor with levels (Buckingham,Louisa)} #' \item{age}{age (years)} #' \item{gender}{male or female} #' \item{height}{height (inches)} #' \item{height.europe}{height (cm)} #' \item{weight}{weight (pounds)} #' \item{weight.europe}{weight (kg)} #' \item{frame}{a factor with levels (small,medium,large)} #' \item{bp.1s}{First Systolic Blood Pressure} #' \item{bp.1d}{First Diastolic Blood Pressure} #' \item{bp.2s}{Second Diastolic Blood Pressure} #' \item{bp.2d}{Second Diastolic Blood Pressure} #' \item{waist}{waist in inches} #' \item{hip}{hip in inches} #' \item{time.ppn}{Postprandial Time when Labs were Drawn in minutes} #' \item{AgeGroups}{Categorized age} #' \item{BMI}{Categorized BMI} #' } #' @references #' Willems JP, Saunders JT, DE Hunt, JB Schorling: Prevalence of coronary heart disease risk factors among rural blacks: A community-based study. Southern Medical Journal 90:814-820; 1997 #' Schorling JB, Roach J, Siegel M, Baturka N, Hunt DE, Guterbock TM, Stewart HL: A trial of church-based smoking cessation interventions for rural African Americans. Preventive Medicine 26:92-101; 1997. #' @source #' \url{http://192.38.117.59/~tag/Teaching/share/data/Diabetes.html} #' @keywords datasets ##' @examples ##' ##' data(Diabetes) ##' NULL #' trace data #' #' These data are from screening to the TRACE study, a comparison between the angiotensin converting #' enzyme inhibitor trandolapril and placebo ford large myocardial infarctions. A total of 6676 #' patients were screened for the study. Survival has been followed for the screened population for #' 16 years. The current data has been prepared for a poisson regression to examine survival. The data #' has been "split" in 0.5 year intervals (plitLexis function from Epi package) and then collapsed #' on all variables (aggregate function). #' @name trace #' @docType data #' @format A data frame with 1832 observations on the following 6 variables. #' \describe{ #' \item{Time}{Time after myocardial infarction, in 6 months intervals} #' \item{smoking}{Smoking status. A factor with levels (Never, Current, Previous)} #' \item{sex}{A factor with levels (Female, Male)} #' \item{age}{Age in years at the time of myocardial infarction} #' \item{ObsTime}{Cumulative risk time in each split} #' \item{dead}{Count of deaths} #' } #' @references #' Kober et al 1995 Am. J. Cardiol 76,1-5 #' #' @keywords datasets ##' @examples ##' ##' data(trace) ##' Units(trace,list("age"="years")) ##' fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) ##' rtf <- regressionTable(fit,factor.reference = "inline") ##' summary(rtf) ##' publish(fit) ##' NULL #' CiTable data #' #' These data are used for testing Publish package functionality. #' @name CiTable #' @docType data #' @format A data frame with 27 observations on the following 9 variables. #' \describe{ #' \item{Drug}{} #' \item{Time}{} #' \item{Drug.Time}{} #' \item{Dose}{} #' \item{Mean}{} #' \item{SD}{} #' \item{n}{} #' \item{HazardRatio}{} #' \item{lower}{} #' \item{upper}{} #' \item{p}{} #' } #' #' @keywords datasets ##' @examples ##' ##' data(CiTable) ##' labellist <- split(CiTable[,c("Dose","Mean","SD","n")],CiTable[,"Drug"]) ##' labellist ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], labels=labellist) ##' ##' NULL #' Publish package #' #' This package processes results of descriptive statistcs and regression analysis into final tables and figures of a manuscript #' @docType package #' @name Publish-package #' @importFrom data.table as.data.table copy data.table is.data.table melt rbindlist setnames setorder setcolorder setkey ":=" ".N" ".SD" NULL #' traceR data #' #' These data are from the TRACE randomised trial, a comparison between the angiotensin converting #' enzyme inhibitor trandolapril and placebo ford large myocardial infarctions. In all, 1749 patients #' were randomised. The current data are from a 15 year follow-up. #' @name traceR #' @docType data #' @format A data frame with 1749 observations on the following variables. #' \describe{ #' \item{weight}{Weight in kilo} #' \item{height}{Height in meters} #' \item{abdominalCircumference}{in centimeters} #' \item{seCreatinine}{in mmol per liter} #' \item{wallMotionIndex}{left ventricular function 0-2, 0 worst, 2 normal} #' \item{observationTime}{time to death or censor} #' \item{age}{age in years} #' \item{sex}{0=female,1=male} #' \item{smoking}{0=never,1=prior,2=current} #' \item{dead}{0=censor,1=dead} #' \item{treatment}{placebo or trandolapril} #' #' } #' @references #' Kober et al 1995 NEJM 333,1670 #' #' @keywords datasets ##' @examples ##' ##' data(trace) ##' Units(trace,list("age"="years")) ##' fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) ##' rtf <- regressionTable(fit,factor.reference = "inline") ##' summary(rtf) ##' publish(fit) ##' NULL Publish/R/publish.MIresult.R0000644000176200001440000001577313761462745015451 0ustar liggesusers### publish.MIresult.R --- #---------------------------------------------------------------------- ## Author: Thomas Alexander Gerds ## Created: Aug 17 2017 (09:52) ## Version: ## Last-Updated: Dec 1 2020 (16:48) ## By: Thomas Alexander Gerds ## Update #: 52 #---------------------------------------------------------------------- ### Code: #' Regression tables after multiple imputations #' #' Show results of smcfcs based multiple imputations of missing covariates in publishable format #' @title Present logistic regression and Cox regression obtained with mitools::MIcombine based on smcfcs::smcfcs multiple imputation analysis #' @param object Object obtained with mitools::MIcombine based on smcfcs::smcfcs multiple imputation analysis #' @param confint.method No options here. Only Wald type confidence #' intervals. #' @param pvalue.method No options here. Only Wald type tests. #' @param digits Rounding digits for all numbers but the p-values. #' @param print If \code{FALSE} suppress printing of the results #' @param factor.reference Style for showing results for #' categorical. See \code{regressionTable}. #' @param intercept See \code{regressionTable}. #' @param units See \code{regressionTable}. #' @param fit One fitted model using the same formula as #' \code{object}. This can be the fit to the complete case data or #' the fit to one of the completed data. It is used to get #' xlevels, formula and terms. For usage see examples. is used to #' fit #' @param data Original data set which includes the missing values #' @param ... passed to summary.regressionTable, labelUnits and publish.default. #' @examples #' #' \dontrun{ #' if (requireNamespace("riskRegression",quietly=TRUE) #' & requireNamespace("mitools",quietly=TRUE) #' & requireNamespace("smcfcs",quietly=TRUE)){ #' library(riskRegression) #' library(mitools) #' library(smcfcs) #' ## continuous outcome: linear regression #' # lava some data with missing values #' set.seed(7) #' d=sampleData(78) #' ## generate missing values #' d[X1==1,X6:=NA] #' d[X2==1,X3:=NA] #' d=d[,.(X8,X4,X3,X6,X7)] #' sapply(d,function(x)sum(is.na(x))) #' #' # multiple imputation (should set m to a large value) #' #' set.seed(17) #' f= smcfcs(d,smtype="lm", #' smformula=X8~X4+X3+X6+X7, #' method=c("","","logreg","norm",""),m=3) #' ccfit=lm(X8~X4+X3+X6+X7,data=d) #' mifit=MIcombine(with(imputationList(f$impDatasets), #' lm(X8~X4+X3+X6+X7))) #' publish(mifit,fit=ccfit,data=d) #' publish(ccfit) #' #' ## binary outcome #' # lava some data with missing values #' set.seed(7) #' db=sampleData(78,outcome="binary") #' ## generate missing values #' db[X1==1,X6:=NA] #' db[X2==1,X3:=NA] #' db=db[,.(Y,X4,X3,X6,X7)] #' sapply(db,function(x)sum(is.na(x))) #' #' # multiple imputation (should set m to a large value) #' set.seed(17) #' fb= smcfcs(db,smtype="logistic", #' smformula=Y~X4+X3+X6+X7, #' method=c("","","logreg","norm",""),m=2) #' ccfit=glm(Y~X4+X3+X6+X7,family="binomial",data=db) #' mifit=MIcombine(with(imputationList(fb$impDatasets), #' glm(Y~X4+X3+X6+X7,family="binomial"))) #' publish(mifit,fit=ccfit) #' publish(ccfit) #' #' ## survival: Cox regression #' library(survival) #' # lava some data with missing values #' set.seed(7) #' ds=sampleData(78,outcome="survival") #' ## generate missing values #' ds[X5==1,X6:=NA] #' ds[X2==1,X3:=NA] #' ds=ds[,.(time,event,X4,X3,X6,X7)] #' sapply(ds,function(x)sum(is.na(x))) #' #' set.seed(17) #' fs= smcfcs(ds,smtype="coxph", #' smformula="Surv(time,event)~X4+X3+X6+X7", #' method=c("","","","logreg","norm",""),m=2) #' ccfit=coxph(Surv(time,event)~X4+X3+X6+X7,data=ds) #' mifit=MIcombine(with(imputationList(fs$impDatasets), #' coxph(Surv(time,event)~X4+X3+X6+X7))) #' publish(mifit,fit=ccfit,data=ds) #' publish(ccfit) #' #' ## competing risks: Cause-specific Cox regression #' library(survival) #' # lava some data with missing values #' set.seed(7) #' dcr=sampleData(78,outcome="competing.risks") #' ## generate missing values #' dcr[X5==1,X6:=NA] #' dcr[X2==1,X3:=NA] #' dcr=dcr[,.(time,event,X4,X3,X6,X7)] #' sapply(dcr,function(x)sum(is.na(x))) #' #' set.seed(17) #' fcr= smcfcs(dcr,smtype="compet", #' smformula=c("Surv(time,event==1)~X4+X3+X6+X7", #' "Surv(time,event==2)~X4+X3+X6+X7"), #' method=c("","","","logreg","norm",""),m=2) #' ## cause 2 #' ccfit2=coxph(Surv(time,event==2)~X4+X3+X6+X7,data=dcr) #' mifit2=MIcombine(with(imputationList(fcr$impDatasets), #' coxph(Surv(time,event==2)~X4+X3+X6+X7))) #' publish(mifit2,fit=ccfit2,data=dcr) #' publish(ccfit2) #' } #'} #' #' @author Thomas A. Gerds #' @export publish.MIresult <- function(object, confint.method, pvalue.method, digits=c(2,4), print=TRUE, factor.reference="extraline", intercept, units=NULL, fit, data, ...){ pvalMIresult <- function(object){ se <- sqrt(diag(stats::vcov(object))) p <- 2*stats::pnorm(-abs(object$coef/se)) p } if (missing(fit)) stop("Need the model fitted in the complete cases.") object$xlevels <- fit$xlevels object$formula <- fit$formula if (missing(data)){ if (is.null(fit$data)) stop("Need original data set via argument 'data' because argument 'fit' does not provide them.") else{ object$data <- fit$data } }else object$data <- data object$terms <- fit$terms ## make sure that a coxph object is treated as such class(object) <- c(class(object),class(fit)) ## make sure that a logistic regression is treated as such if ('glm' %in% class(fit)) object$family <- fit$family if (!missing(confint.method) && confint.method!="default") stop("Can only do simple Wald confidence intervals based on MIresults.") if (!missing(pvalue.method)) stop("Can only do simple Wald test p-values based on MIresults.") if (missing(intercept)){ intercept <- 1*(class(fit)[1] == "lm" || (class(fit)[1]=="glm" && stats::family(fit)!="binomial")) } rt <- regressionTable(object, confint.method="default", pvalue.method=pvalMIresult, factor.reference=factor.reference, intercept=intercept, units=units) srt <- summary.regressionTable(rt, digits=digits, print=FALSE,...) XXsrt <- do.call(labelUnits,c(list(x=srt),list(...),srt$Variable)) if (print==TRUE) publish(srt$regressionTable,...) invisible(srt) } ###################################################################### ### publish.MIresult.R ends here Publish/R/plotLabels.R0000644000176200001440000000506413664136424014323 0ustar liggesusers### plotLabels.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: May 11 2015 (09:05) ## Version: ## last-updated: May 8 2020 (07:41) ## By: Thomas Alexander Gerds ## Update #: 69 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: plotLabels <- function(labels, labels.args, titles, titles.args, width, ylim, ncolumns, columnwidths, ## xpos, stripes, ...){ ## available space (width) is divided according to relative widths labelrelwidth <- columnwidths/sum(columnwidths) colwidths <- labelrelwidth*width if (labels.args$pos==4) ## aligned on right hand xpos <- c(0,cumsum(colwidths)[-ncolumns]) else ## aligned on left hand xpos <- cumsum(colwidths) ## empty plot plot(0,0,type="n",axes=FALSE,xlim=c(0,width),ylim=ylim,xlab="",ylab="") if (!missing(stripes) && length(stripes)>0){ stripes$xlim <- c(0,width) do.call("stripes",stripes) } ## arrows(x0=0,x1=width,y0=12,y1=12,lwd=8,col="orange") ## abline(v=xpos,col=1:5) nix <- lapply(1:ncolumns,function(l){ labels.args$x <- xpos[[l]] labels.args$labels <- labels[[l]] labels.args$cex <- labels.args$cex[[l]] ## if (length(grep("\\;",labels[[1]]))>0) browser() ## if (!is.null(labels.args$adj)) labels.args$pos=NULL do.call("text",labels.args) }) ## to avoid that expression(bold(CI[95])) is ## changed to bold(CI[95]) we make titles a list if (length(titles)==1) titles <- list(titles) if (length(titles)>0){ ## title.columns <- lapply(1:ncolumns,function(cc){sprintf(fmt=fmt.columns[[cc]],titles[[cc]])}) nix <- lapply(1:ncolumns,function(l){ titles.args$x <- xpos[[l]] titles.args$labels <- titles[[l]] titles.args$cex <- titles.args$cex[[l]] do.call("text",titles.args) }) } } #---------------------------------------------------------------------- ### plotLabels.R ends here Publish/R/publish.coxph.R0000755000176200001440000000723613571203035015004 0ustar liggesusers##' Tabulize the part of the result of a Cox regression analysis which is commonly shown in publications. ##' ##' Transforms the log hazard ratios to hazard ratios and returns them ##' with confidence limits and p-values. If explanatory variables are ##' log transformed or log2 transformed, a scaling factor is ##' multiplied to both the log-hazard ratio and its standard-error. ##' @title Tabulize hazard ratios with confidence intervals and ##' p-values. ##' @param object A \code{coxph} object. ##' @param confint.method See \code{regressionTable} ##' @param pvalue.method See \code{regressionTable} ##' @param print If \code{FALSE} do not print results. ##' @param factor.reference See \code{regressionTable} ##' @param units See \code{regressionTable} ##' @param probindex Logical. If \code{TRUE} show coefficients on probabilistic index scale instead of hazard ratio scale. ##' @param ... passed to \code{summary.regressionTable} and also to ##' \code{labelUnits}. ##' @return Table with hazard ratios, confidence intervals and ##' p-values. ##' @author Thomas Alexander Gerds ##' @examples ##' library(survival) ##' data(pbc) ##' pbc$edema <- factor(pbc$edema, ##' levels=c("0","0.5","1"), labels=c("0","0.5","1")) ##' fit = coxph(Surv(time,status!=0)~age+sex+edema+log(bili)+log(albumin), ##' data=na.omit(pbc)) ##' publish(fit) ##' ## forest plot ##' plot(publish(fit),cex=1.3) ##' ##' publish(fit,ci.digits=2,pvalue.eps=0.01,pvalue.digits=2,pvalue.stars=TRUE) ##' publish(fit,ci.digits=2,ci.handler="prettyNum",pvalue.eps=0.01, ##' pvalue.digits=2,pvalue.stars=TRUE) ##' publish(fit, ci.digits=2, ci.handler="sprintf", pvalue.eps=0.01, ##' pvalue.digits=2,pvalue.stars=TRUE, ci.trim=FALSE) ##' ##' fit2 = coxph(Surv(time,status!=0)~age+sex+edema+log(bili,base=2)+log(albumin)+log(protime), ##' data=na.omit(pbc)) ##' publish(fit2) ##' ##' # with cluster variable ##' fit3 = coxph(Surv(time,status!=0)~age+cluster(sex)+edema+log(bili,base=2) ##' +log(albumin)+log(protime), ##' data=na.omit(pbc)) ##' publish(fit3) ##' ##' # with strata and cluster variable ##' fit4 = coxph(Surv(time,status!=0)~age+cluster(sex)+strata(edema)+log(bili,base=2) ##' +log(albumin)+log(protime), ##' data=pbc) ##' publish(fit4) ##' ##' @export publish.coxph <- function(object, confint.method, pvalue.method, print=TRUE, factor.reference="extraline", units=NULL, probindex=FALSE, ...){ if (missing(confint.method)) confint.method="default" if (missing(pvalue.method)) pvalue.method=switch(confint.method, "robust"={"robust"}, "simultaneous"={"simultaneous"}, "default") spec <- attr(terms(object),"specials") cluster <- spec$cluster-1 strata <- spec$strata-1 # if (!is.null(cluster)) cluster <- cluster-1 rt <- regressionTable(object, noterms=c(cluster,strata), confint.method=confint.method, pvalue.method=pvalue.method, factor.reference=factor.reference, units=units, probindex=probindex) srt <- summary.regressionTable(rt, ## digits=digits, print=FALSE,...) if (print==TRUE) publish(srt$regressionTable,...) invisible(srt) } #---------------------------------------------------------------------- ### publish.coxph.R ends here Publish/R/print.subgroupAnalysis.R0000644000176200001440000000101113571203035016701 0ustar liggesusers##' Print function for subgroupAnalysis ##' ##' This function is simply calling \code{summary.subgroupAnalysis} ##' @title Printing univariate tables ##' @param x - An object obtained with \code{subgroupAnalysis} ##' @param ... Passed to summary.subgroupAnalysis ##' @return The result of \code{summary.subgroupAnalysis(x)} ##' @seealso \code{subgroupAnalysis} ##' @export ##' @author Christian Torp-Pedersen (ctp@heart.dk) print.subgroupAnalysis <- function(x,...){ sx <- summary(x,...) print(sx) invisible(sx) } Publish/R/glmSeries.R0000755000176200001440000000435013571203035014142 0ustar liggesusers##' Run a series of generalized linear regression analyses for a list of predictor variables ##' and summarize the results in a table. ##' The regression models can be adjusted for a fixed set of covariates. ##' ##' @title Run a series of generalized linear regression analyses ##' @param formula The fixed part of the regression formula. For ##' univariate analyses this is simply \code{y~1} where \code{y} is ##' the outcome variable. When the aim is to control the effect of ##' \code{vars} in each element of the series by a fixed set of ##' variables it is \code{y~x1+x2} where again y is the outcome and x1 ##' and x2 are confounders. ##' @param data A \code{data.frame} in which we evaluate the formula. ##' @param vars A list of variable names, the changing part of the ##' regression formula. ##' @param ... passed to glm ##' @return Matrix with regression coefficients, one for each element of \code{vars}. ##' @author Thomas Alexander Gerds ##' @examples ##' ##' data(Diabetes) ##' Diabetes$hyper1 <- factor(1*(Diabetes$bp.1s>140)) ##' ## collect odds ratios from three univariate logistic regression analyses ##' uni.odds <- glmSeries(hyper1~1,vars=c("chol","hdl","location"),data=Diabetes,family=binomial) ##' uni.odds ##' ## control the logistic regression analyses for age and gender ##' ## but collect only information on the variables in `vars'. ##' controlled.odds <- glmSeries(hyper1~age+gender, ##' vars=c("chol","hdl","location"), ##' data=Diabetes, family=binomial) ##' controlled.odds ##' @export glmSeries <- function(formula,data,vars,...){ ## ref <- glm(formula,data=data,...) Missing=NULL data.table::setDT(data) data <- data[,c(all.vars(formula),vars),with=FALSE] glist <- lapply(vars,function(v){ form.v <- update.formula(formula,paste(".~.+",v)) if (is.logical(data[[v]])) data[[v]] <- factor(data[[v]],levels=c("FALSE","TRUE")) gf <- glm(form.v,data=data,...) ## gf$call$data <- data gf$model <- data nv <- length(gf$xlevels[[v]]) rtab <- regressionTable(gf) rtab[[v]] }) out <- data.table::rbindlist(glist) if (all(out$Missing%in%c("","0"))) out[,Missing:=NULL] out[] } Publish/R/pubformat.R0000644000176200001440000000336713571203035014213 0ustar liggesusers### pubformat.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Feb 21 2015 (10:34) ## Version: ## last-updated: Feb 21 2015 (10:46) ## By: Thomas Alexander Gerds ## Update #: 5 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Format numbers according to a specified handler function. ##' Currently supported are sprintf, format and prettyNum. ##' ##' @title Format numbers for publication ##' @param x numeric vector ##' @param digits number of digits ##' @param nsmall see handler ##' @param handler String specififying the name of the function which should ##' perform the formatting. See \code{sprintf}, \code{format} and \code{prettyNum}. ##' @param ... Passed to handler function if applicable, i.e., not to \code{sprintf}. ##' @return Formatted number ##' @seealso \code{sprintf}, \code{format}, \code{prettyNum} ##' @examples ##' ##' pubformat(c(0.000143,12.8,1)) ##' pubformat(c(0.000143,12.8,1),handler="format") ##' pubformat(c(0.000143,12.8,1),handler="format",trim=TRUE) ##' pubformat(c(0.000143,12.8,1),handler="prettyNum") ##' @export ##' @author Thomas A. Gerds pubformat <- function(x,digits=2, nsmall=digits, handler="sprintf",...){ if (handler=="sprintf"){ fmt <- paste0("%1.",digits[[1]],"f")} if (handler=="sprintf"){ sprintf(fmt=fmt,x) }else{ do.call(handler,list(x,digits=digits[[1]],nsmall=nsmall,...)) } } #---------------------------------------------------------------------- ### pubformat.R ends here Publish/R/table2x2.R0000644000176200001440000000461313573641713013645 0ustar liggesusers##' 2x2 table calculus for teaching ##' ##' 2x2 table calculus for teaching ##' @title 2x2 table calculus for teaching ##' @param x 2x2 table ##' @param digits rounding digits ##' @param stats subset or all of \code{c("table","rd","or","rr","chisq","fisher")} where rd= risk difference, rr = risk ratio, or = odds ratio, chisq = chi-square test, fisher= fisher's exact test and table = the 2x2 table ##' @return see example ##' @examples ##' table2x2(table("marker"=rbinom(100,1,0.4),"response"=rbinom(100,1,0.1))) ##' table2x2(matrix(c(71,18,38,8),ncol=2),stats="table") ##' table2x2(matrix(c(71,18,38,8),ncol=2),stats=c("rr","fisher")) ##' @export ##' @author Thomas A. Gerds table2x2 <- function(x,digits=1,stats=c("table","rd","rr","or","chisq","fisher")){ if (class(x)[1]=="data.frame"){ table2x2 <- as.matrix(x) } else{ if ("matrix"%in%class(x)||"table" %in% class(x)){ if ("table"%in%class(x)){table2x2 <- as.matrix(x)} else table2x2 <- x } else{ stop("first argument `x' must be a matrix or a data.frame") } } if (NROW(x)!=2) stop("Matrix must have exactly 2 rows") if (NCOL(x)!=2) stop("Matrix must have exactly 2 columns") a <- table2x2[1,1] b <- table2x2[1,2] c <- table2x2[2,1] d <- table2x2[2,2] p1 <- a/(a+b) p2 <- c/(c+d) ## ## test statistic ## n <- (a+b+c+d) ## chi2test <- (a*d-b*c)^2*n/((a+c)*(b+d)*(a+b)*(c+d)) ## 2x2 table out <- list(table2x2=table2x2,stats=stats) if ("rd" %in% stats){ rd <- (p1-p2) se.rd <- sqrt(p1*(1-p1)/(a+b)+p2*(1-p2)/(c+d)) rd.lower <- rd - qnorm(1-0.05/2)*se.rd rd.upper <- rd + qnorm(1-0.05/2)*se.rd out <- c(out,list(rd=rd,se.rd=se.rd,rd.lower=rd.lower,rd.upper=rd.upper)) } if ("rr" %in% stats){ rr <- p1/p2 se.rr <- sqrt((1-p1)/a+(1-p2)/c) rr.lower <- rr * exp(- qnorm(1-0.05/2) * se.rr) rr.upper <- rr * exp( qnorm(1-0.05/2) * se.rr) out <- c(out,list(rr=rr,se.rr=rr,rr.lower=rr.lower,rr.upper=rr.upper)) } if ("or" %in% stats){ or <- (a*d)/(b*c) se.or <- sqrt(1/a+1/b+1/c+1/d) or.lower <- exp(log(or) - qnorm(1-0.05/2)*se.or) or.upper <- exp(log(or) + qnorm(1-0.05/2)*se.or) out <- c(out,list(or=or,se.or=se.or,or.lower=or.lower,or.upper=or.upper)) } class(out) <- "table2x2" out } Publish/R/publish.Score.R0000644000176200001440000000474013761463037014743 0ustar liggesusers### publish.Score.R --- #---------------------------------------------------------------------- ## Author: Thomas Alexander Gerds ## Created: Jun 10 2017 (17:47) ## Version: ## Last-Updated: Dec 1 2020 (16:49) ## By: Thomas Alexander Gerds ## Update #: 17 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Write output of \code{riskRegression::Score} in tables ##' ##' Collect prediction accuracy results in tables ##' @title Publish predictive accuracy results ##' @param object Object obtained with \code{riskRegression::Score} ##' @param metrics Which metrics to put into tables. Defaults to ##' \code{object$metrics}. ##' @param score Logical. If \code{TRUE} print the score elements, i.e., metric applied to the risk prediction models. ##' @param contrasts Logical. If \code{TRUE} print the contrast elements (if any). These compare risk prediction models according to metrics. ##' @param level Level of subsection headers, i.e., ** for level 2 and ##' *** for level 3 (useful for emacs org-users). Default is plain ##' subsection headers no stars. A negative value will suppress ##' subjection headers. ##' @param ... Passed to publish ##' @return Results of Score in tabular form ##' @examples ##' if (requireNamespace("riskRegression",quietly=TRUE)){ ##' library(riskRegression) ##' library(survival) ##' learn = sampleData(100) ##' val= sampleData(100) ##' f1=CSC(Hist(time,event)~X1+X8,data=learn) ##' f2=CSC(Hist(time,event)~X1+X5+X6+X8,learn) ##' xs=Score(list(f1,f2),data=val,formula=Hist(time,event)~1) ##' publish(xs) ##' } ##' @export ##' @author Thomas A. Gerds publish.Score <- function(object,metrics,score=TRUE,contrasts=TRUE,level=3,...){ if (missing(metrics)) metrics <- object$metrics for (m in metrics){ if (level>0){ publish(paste0("Metric ",m,":\n"),level=level,...) publish("Assessment of predictive accuracy",level=level+1) } if (score){ publish(object[[m]]$score, ...) } if (contrasts && !is.null(object[[m]]$contrasts)){ if (level>0){ org("Comparison of predictive accuracy",level=level+1) } publish(object[[m]]$contrasts, ...) } } } ###################################################################### ### publish.Score.R ends here Publish/R/publish.CauseSpecificCox.R0000644000176200001440000001033613761362663017051 0ustar liggesusers##' Publish cause-specific Cox models ##' ##' The cause-specific hazard ratio's are combined into one table. ##' @title Tabulizing cause-specific hazard ratio from all causes with confidence limits and Wald test p-values. ##' @param object Cause-specific hazard model obtained with ##' \code{CSC}. ##' @param cause Show a table for this cause. If omitted, list all ##' causes. ##' @param confint.method See \code{regressionTable} ##' @param pvalue.method See \code{regressionTable} ##' @param factor.reference See \code{regressionTable} ##' @param units See \code{regressionTable} ##' @param print If \code{TRUE} print the table(s). ##' @param ... passed on to control formatting of parameters, ##' confidence intervals and p-values. See ##' \code{summary.regressionTable}. ##' @return Table with cause-specific hazard ratios, confidence limits and p-values. ##' @author Thomas Alexander Gerds ##' @examples ##' if (requireNamespace("riskRegression",quietly=TRUE)){ ##' library(riskRegression) ##' library(prodlim) ##' library(survival) ##' data(Melanoma,package="riskRegression") ##' fit1 <- CSC(list(Hist(time,status)~sex,Hist(time,status)~invasion+epicel+age), ##' data=Melanoma) ##' publish(fit1) ##' publish(fit1,pvalue.stars=TRUE) ##' publish(fit1,factor.reference="inline",units=list("age"="years")) ##' ##' # wide format (same variables in both Cox regression formula) ##' fit2 <- CSC(Hist(time,status)~invasion+epicel+age, data=Melanoma) ##' publish(fit2) ##' ##' # with p-values ##' x <- publish(fit2,print=FALSE) ##' table <- cbind(x[[1]]$regressionTable, ##' x[[2]]$regressionTable[,-c(1,2)]) ##' } ##' ##' @export publish.CauseSpecificCox <- function(object, cause, confint.method, pvalue.method, factor.reference="extraline", units=NULL, print=TRUE, ...){ if (missing(confint.method)) confint.method="default" if (missing(pvalue.method)) pvalue.method=switch(confint.method, "robust"={"robust"}, "simultaneous"={"simultaneous"}, "default") if (missing(cause)) { clist <- lapply(object$models,function(m){ ## m$call$data <- object$call$data pm <- regressionTable(m, pvalue.method=pvalue.method, confint.method=confint.method, print=FALSE, factor.reference=factor.reference, units=units,...) summary.regressionTable(pm,print=FALSE,...) }) cause1 <- clist[[1]]$regressionTable ## colnames(cause1) <- paste(names(object$models)[[1]],names(cause1),sep=".") cause2 <- clist[[2]]$regressionTable if (NROW(cause1)==NROW(cause2)){ table=cbind(cause1[,1:2],"A"=paste(cause1[,3],cause1[,4]),"B"=paste(cause2[,3],cause2[,4])) colnames(table)[3:4] <- object$causes }else{table <- NULL} ## colnames(cause2) <- paste(names(object$models)[[2]],names(cause2),sep=".") out <- clist } else{ m <- object$models[[cause]] ## m$call$data <- object$call$data pm <- regressionTable(m, pvalue.method=pvalue.method, confint.method=confint.method, print=FALSE, factor.reference=factor.reference, units=units,...) ## now pm is a regression table out <- summary.regressionTable(pm,print=FALSE,...)$regressionTable } if (print==TRUE) { if (is.null(table)) lapply(1:length(out),function(i){ publish(names(out)[[i]]) publish(out[[i]]$regressionTable) }) else{ publish(table,...) } } invisible(out) } #---------------------------------------------------------------------- ### publish.CauseSpecificCox.R ends here Publish/R/splinePlot.lrm.R0000644000176200001440000000641613761463247015152 0ustar liggesusers### splinePlot.lrm.R --- #---------------------------------------------------------------------- ## Author: Thomas Alexander Gerds ## Created: Dec 31 2017 (11:04) ## Version: 1 ## Last-Updated: Dec 1 2020 (16:52) ## By: Thomas Alexander Gerds ## Update #: 24 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Plotting the prediction of a logistic regression model ##' with confidence bands against one continuous variable. ##' ##' Function which extracts from a logistic regression model ##' fitted with \code{rms::lrm} the predicted risks or odds. ##' @title Plot predictions of logistic regression ##' @author Thomas A. Gerds ##' @param object Logistic regression model fitted with \code{rms::lrm} ##' @param xvar Name of the variable to show on x-axis ##' @param xvalues Sequence of \code{xvar} values ##' @param xlim x-axis limits ##' @param ylim y-axis limits ##' @param xlab x-axis labels ##' @param ylab y-axis labels ##' @param col color of the line ##' @param lty line style ##' @param lwd line width ##' @param confint Logical. If \code{TRUE} show confidence shadows ##' @param newdata How to adjust ##' @param scale Character string that determines the outcome scale (y-axis). Choose between \code{"risk"} and \code{"odds"}. ##' @param add Logical. If \code{TRUE} add lines to an existing graph ##' @param ... Further arguments passed to \code{plot}. Only if \code{add} is \code{FALSE}. ##' @examples ##' data(Diabetes) ##' Diabetes$hypertension= 1*(Diabetes$bp.1s>140) ##' library(rms) ##' uu <- datadist(Diabetes) ##' options(datadist="uu") ##' fit=lrm(hypertension~rcs(age)+gender+hdl,data=Diabetes) ##' splinePlot.lrm(fit,xvar="age",xvalues=seq(30,50,1)) ##' @export splinePlot.lrm <- function(object, xvar, xvalues, xlim=range(xvalues), ylim, xlab=xvar, ylab=scale[[1]], col=1, lty=1, lwd=3, confint=TRUE, newdata=NULL, scale=c("risk","odds"), add=FALSE,...){ lower=upper=yhat=NULL expit <- function (x){exp(x)/(1 + exp(x))} input <- list(object=object,xvalues) if (!is.null(newdata) && is.list(newdata)){ input <- c(input,newdata) } names(input)[[2]] <- xvar if (scale[[1]]=="risk") input$fun <- expit else{ ## set reference level for odds input$fun <- exp } pframe <- do.call(rms::Predict,input) data.table::setDT(pframe) if (missing(ylim)) ylim <- pframe[,c(min(lower),max(upper))] if(!add){ plot(0,0,type="n",ylim=ylim,xlim=xlim,xlab=xlab,ylab=ylab,...) } pframe[,graphics::lines(xvalues,yhat,lwd=lwd,lty=lty,col=col,type="l",ylim=ylim)] if (confint==TRUE){ pframe[,polygon(x=c(xvalues,rev(xvalues)),y=c(lower,rev(upper)),col=prodlim::dimColor(col),border=NA)] } pframe } ###################################################################### ### splinePlot.lrm.R ends here Publish/R/ci.geomean.formula.R0000744000176200001440000000150413571203035015655 0ustar liggesusersci.geomean.formula <- function(formula,data,alpha = 0.05,normal = T,na.rm=T,statistic="geometric"){ work <- model.frame(formula,data) nf <- ncol(work)-1 if (nf>1) f <- interaction(work[,-1,drop=FALSE],sep=" - ") else f <- factor(work[,2]) res <- lapply(split(model.response(work),f),ci.mean.default,alpha=alpha,normal=normal,na.rm=na.rm,statistic=statistic) statistic <- unique(unlist(lapply(res,function(x)x$statistic))) labels <- do.call("rbind",strsplit(names(res)," - ")) colnames(labels) <- names(work)[-1] ## we reverse the order of factors for nicer labeling ... labels <- labels[,rev(1:nf),drop=FALSE] res <- data.frame(do.call("rbind",res)) out <- lapply(res[,1:4],function(x)unlist(x)) out <- c(out,list(labels=labels,level=alpha,statistic=statistic)) class(out) <- c("ci",class(out)) out } Publish/R/publish.list.R0000644000176200001440000000110713571203035014622 0ustar liggesusers##' @export publish.list <- function(object, title, level=0, hrule=0, title.level=1, title.hrule=1, ...){ if (!missing(title)) publish(title,level=title.level,hrule=title.hrule) xnames <- names(object) nix <- lapply(1:length(object),function(i){ if (!is.null(xnames)){ publish(xnames[i],level=level,hrule=hrule) } else cat("\n\n") inX <- object[[i]] publish(inX,level=min(level+1,3),...) }) } Publish/R/ci.mean.formula.R0000755000176200001440000000200613571203035015162 0ustar liggesusers#' @export ci.mean.formula <- function(x, data, alpha = 0.05, normal = TRUE, na.rm=T, statistic=c("arithmetic","geometric"),...){ work <- model.frame(x,data) nf <- ncol(work)-1 if (nf>1) f <- interaction(work[,-1,drop=FALSE],sep=" - ") else f <- factor(work[,2]) res <- lapply(split(model.response(work),f),ci.mean.default,alpha=alpha,normal=normal,na.rm=na.rm,statistic=statistic) statistic <- unique(unlist(lapply(res,function(x)x$statistic))) labels <- do.call("rbind",strsplit(names(res)," - ")) colnames(labels) <- names(work)[-1] ## we reverse the order of factors for nicer labeling ... labels <- labels[,rev(1:nf),drop=FALSE] res <- data.frame(do.call("rbind",res)) out <- lapply(res[,1:4],function(x)unlist(x)) out <- c(out,list(labels=labels,level=alpha,statistic=statistic)) class(out) <- c("ci",class(out)) out } Publish/R/ci.mean.R0000744000176200001440000000052413571203035013517 0ustar liggesusers##' Compute mean values with confidence intervals ##' ##' Normal approximation ##' @title Compute mean values with confidence intervals ##' @param x object passed to methods ##' @param ... passed to methods ##' @return a list with mean values and confidence limits ##' @export ci.mean <- function(x,...){ UseMethod("ci.mean",object=x) } Publish/R/publish.prodlim.R0000755000176200001440000000540513571203035015325 0ustar liggesusers##' @export publish.prodlim <- function(object,times,intervals=TRUE,percent=TRUE,digits=ifelse(percent,1,3),cause=1,surv=TRUE,print=TRUE,...){ if (missing(times)) stop("Argument times is missing with no default.") so <- summary(object,times=times,intervals=intervals,percent=percent,cause=cause,surv=surv)$table if (!is.list(so)) so <- list(so) if (object$model=="competing.risks" && (length(cause)==1)){ so <- so[[1]] } if (!is.list(so) || (length(so)==1)) { if (is.list(so)) so <- so[[1]] if (!is.null(object$cluster)){ names <- sapply(c("n.risk","n.event","n.lost"),function(x)grep(x,colnames(so),value=TRUE)) out <- so[,names]} else{ out <- so[,c("n.risk","n.event","n.lost"),drop=FALSE] colnames(out) <- c("No. at risk","No. of events","No. lost to follow-up") } if (match("cuminc",colnames(so),nomatch=FALSE)==0){ out <- cbind(out,"Survival probability"=format(so[,"surv"],digits=digits,nsmall=digits)) } else{ out <- cbind(out,"Cumulative incidence"=format(so[,"cuminc"],digits=digits,nsmall=digits)) } out <- cbind("Interval"=apply(format(so[,c("time0","time1"),drop=FALSE],digits=digits,nsmall=digits),1,paste,collapse="--"), out, "CI.95"=apply(format(so[,c("lower","upper"),drop=FALSE],digits=digits,nsmall=digits),1,paste,collapse="--")) if (print==TRUE){ publish(out,rownames=FALSE,...) } invisible(out) } else{ names <- names(so) u <- lapply(1:length(so),function(i){ x <- so[[i]] out <- x[,c("n.risk","n.event","n.lost"),drop=FALSE] colnames(out) <- c("No. at risk","No. of events","No. lost to follow-up") if (match("cuminc",colnames(x),nomatch=FALSE)==0){ out <- cbind(out,"Survival probability"=format(x[,"surv"],digits=digits,nsmall=digits)) } else{ out <- cbind(out,"Cumulative incidence"=format(x[,"cuminc"],digits=digits,nsmall=digits)) } out <- cbind("Interval"=apply(format(x[,c("time0","time1"),drop=FALSE],digits=digits,nsmall=digits),1,paste,collapse="--"), out, "CI.95"=apply(format(x[,c("lower","upper"),drop=FALSE],digits=digits,nsmall=digits),1,paste,collapse="--")) if (print==TRUE){ publish(names[i],...) publish(out,rownames=FALSE,...)} out}) if (all(sapply(u,NROW)==1)){ u.out <- do.call("rbind",u) rownames(u.out) <- names(so) }else{ names(u) <- names(so) u.out <- u } invisible(u.out) } } Publish/R/parseSummaryFormat.R0000744000176200001440000000301613571203035016045 0ustar liggesusersparseSummaryFormat <- function(format,digits){ S <- function(x,format,digits,nsmall){x} F <- function(x,ref,digits,nsmall){x} iqr <- function(x)quantile(x,c(0.25,0.75)) minmax <- function(x)quantile(x,c(0,1)) CI.95 <- function(x,sep=",",...){ m <- ci.mean.default(x,...) paste(format(m$lower,digits=digits,nsmall=digits), sep," ", format(m$upper,digits=digits,nsmall=digits)) } ## format.numeric <- paste("%1.",digits,"f",sep="") tmp <- strsplit(format,"[ \t]+|\\(|\\{|\\[|\\)",perl=TRUE)[[1]] stats <- tmp[grep("^x$",tmp)-1] outclass <- sapply(stats,function(s)class(do.call(s,list(1:2)))) outlen <- sapply(stats,function(s)length(do.call(s,list(1:2)))) for(s in 1:length(stats)){ subs <- "%s" if(!(outlen[s]%in%c(1,2))) stop(paste("The function",stats[s],"returns",outlen[s],"values (can be 1 or 2)")) subs <- switch(as.character(outlen[s]), "1"={switch(outclass[s], "numeric"="%s", "integer"="%s", "%s")}, "2"={switch(outclass[s], "numeric"=paste("%s",", ","%s",sep=""), "integer"=paste("%s",", ","%s",sep=""), paste("%s",", ","%s",sep=""))}) format <- gsub(paste(stats[s],"(x)",sep=""),subs,format,fixed=TRUE) } list(format=format,stats=stats) } Publish/R/ci.geomean.R0000744000176200001440000000074613571203035014220 0ustar liggesusersci.geomean <- function(x,alpha = 0.05,normal = T,na.rm=T){ if (na.rm){x <- x[!is.na(x)]} logx <- log(x) n <- length(logx) m <- mean(logx) se <- sqrt(var(logx)/n) df <- n - 1 if(normal) { q <- qt(1 - alpha/2, df) } else { q <- qnorm(1 - alpha/2) } low <- m - se * q up <- m + se * q m <- exp(m) se <- exp(se) low <- exp(low) up <- exp(up) out <- data.frame(geomean = m,se = se,lower = low,upper = up) class(out) <- c("ci", class(out)) out } Publish/R/Units.R0000644000176200001440000000317113571203035013307 0ustar liggesusers### Units.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Apr 9 2015 (10:35) ## Version: ## last-updated: Apr 9 2015 (10:54) ## By: Thomas Alexander Gerds ## Update #: 8 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Add variable units to data.frame (or data.table). ##' ##' If the object has units existing units are replaced by given units. ##' @title Add units to data set ##' @param object A data.frame or data.table ##' @param units Named list of units. Names are variable names. If omitted, show existing units. ##' @return ##' The object augmented with attribute \code{"units"} ##' @examples ##' data(Diabetes) ##' Diabetes <- Units(Diabetes,list(BMI="kg/m^2")) ##' Units(Diabetes) ##' Diabetes <- Units(Diabetes,list(bp.1s="mm Hg",bp.2s="mm Hg")) ##' Units(Diabetes) ##' @export ##' @author Thomas A. Gerds Units <- function(object,units){ stopifnot("data.frame" %in% class(object)) if (missing(units)){ return(attr(object,"units")) } else{ old.units <- attr(object,"units") if (is.null(old.units)) attr(object,"units") <- units else{ new.units <- c(units,old.units) new.units <- new.units[!duplicated(names(new.units))] attr(object,"units") <- new.units } } object } #---------------------------------------------------------------------- ### Units.R ends here Publish/R/plot.subgroupAnalysis.R0000644000176200001440000000310613745461717016552 0ustar liggesusers#' @title plot.subgroupAnalysis #' @description #' This function operates on a "subgroupAnalysis" object to produce a formatted #' table and a forest plot #' @author Christian Torp-Pedersen #' @param x - a subgroupAnalysis object #' @param ... - passed on to plotConfidence #' @details #' This function produces a formatted table of a subgroupAnalysis object and #' adds a forest plot. If further details needs attention before plotting is #' is advisable use adjust the table produced by the summary function and then #' plotting with the plotConfidence function #' @return NULL #' @seealso subgroupAnalysis, plotConfidence #' @export #' @examples #' #load libraries #' library(Publish) #' library(survival) #' library(data.table) #' data(traceR) #get dataframe traceR #' setDT(traceR) #' traceR[,':='(wmi2=factor(wallMotionIndex<0.9,levels=c(TRUE,FALSE), #' labels=c("bad","good")), #' abd2=factor(abdominalCircumference<95, levels=c(TRUE,FALSE), #' labels=c("slim","fat")), #' sex=factor(sex))] #' fit_cox <- coxph(Surv(observationTime,dead)~treatment,data=traceR) #' # Selected subgroups - univariable analysis #' sub_cox <- subgroupAnalysis(fit_cox,traceR,treatment="treatment", #' subgroup=c("smoking","sex","wmi2","abd2")) # subgroups as character string #' plot(sub_cox) plot.subgroupAnalysis <- function(x,...) { if (class(x)[1]!="subgroupAnalysis") stop("Object not of class subgroupAnalysis") num <- length(names(x)) plotcols<-x[,(num-4):(num-2)] tabcols <-x[,1:2] Publish::plotConfidence(x=plotcols, labels=tabcols) }Publish/R/univariateTable.R0000755000176200001440000005112113672631701015334 0ustar liggesusers##' Categorical variables are summarized using counts and frequencies and compared . ##' ##' This function can generate the baseline demographic characteristics ##' that forms table 1 in many publications. It is also useful for generating ##' other tables of univariate statistics. ##' ##' The result of the function is an object (list) which containe the various data ##' generated. In most applications the \code{summary} function should be applied which generates ##' a data.frame with a (nearly) publication ready table. Standard manipulation can be ##' used to modify, add or remove columns/rows and for users not accustomed to R the table ##' generated can be exported to a text file which can be read by other software, e.g., via ##' write.csv(table,file="path/to/results/table.csv") ##' ##' By default, continuous variables are summarized by means and standard deviations ##' and compared with t-tests. When continuous variables are summarized by medians ##' and interquartile ranges the ##' Deviations from the above defaults are obtained when the ##' arguments summary.format and freq.format are combined with suitable ##' summary functions. ##' ##' @title Univariate table ##' @aliases utable univariateTable ##' @param formula Formula specifying the grouping variable (strata) ##' on the left hand side (can be omitted) and on the right hand side ##' the variables for which to obtain (descriptive) statistics. ##' @param data Data set in which formula is evaluated ##' @param summary.format Format for the numeric (non-factor) ##' variables. Default is mean (SD). If different formats are ##' desired, either special Q can be used or the function is called ##' multiple times and the results are rbinded. See examples. ##' @param Q.format Format for quantile summary of numerical ##' variables: Default is median (inter quartile range). ##' @param freq.format Format for categorical variables. Default is ##' count (percentage). ##' @param column.percent Logical, if \code{TRUE} and the default ##' freq.format is used then column percentages are given instead of ##' row percentages for categorical variables (factors). ##' @param digits Number of digits ##' @param big.mark For formatting large numbers (i.e., greater than 1,000). \code{""} turn this off. ##' @param short.groupnames If \code{TRUE} group names are abbreviated. ##' @param compare.groups Method used to compare groups. If ##' \code{"logistic"} and there are exactly two groups logistic ##' regression is used instead of t-tests and Wilcoxon rank tests to ##' compare numeric variables across groups. ##' @param show.totals If \code{TRUE} show a column with totals. ##' @param n If \code{TRUE} show the number of subjects as a separate ##' row. If equal to \code{"inNames"}, show the numbers in ##' parentheses in the column names. If \code{FALSE} do not show ##' number of subjects. ##' @param outcome Outcome data used to calculate p-values when ##' compare groups method is \code{'logistic'} or \code{'cox'}. ##' @param ... saved as part of the result to be passed on to ##' \code{labelUnits} ##' @return List with one summary table element for each variable on the right hand side of formula. ##' The summary tables can be combined with \code{rbind}. The function \code{summary.univariateTable} ##' combines the tables, and shows p-values in custom format. ##' @author Thomas A. Gerds ##' @seealso summary.univariateTable, publish.univariateTable ##' @examples ##' data(Diabetes) ##' library(data.table) ##' univariateTable(~age,data=Diabetes) ##' univariateTable(~gender,data=Diabetes) ##' univariateTable(~age+gender+ height+weight,data=Diabetes) ##' ## same thing but less typing ##' utable(~age+gender+ height+weight,data=Diabetes) ##' ##' ## summary by location: ##' univariateTable(location~Q(age)+gender+height+weight,data=Diabetes) ##' ## continuous variables marked with Q() are (by default) summarized ##' ## with median (IQR) and kruskal.test (with two groups equivalent to wilcox.test) ##' ## variables not marked with Q() are (by default) summarized ##' ## with mean (sd) and anova.glm(...,test="Chisq") ##' ## the p-value of anova(glm()) with only two groups is similar ##' ## but not exactly equal to that of a t.test ##' ## categorical variables are (by default) summarized by count ##' ## (percent) and chi-square tests (\code{chisq.test}). When \code{compare.groups ='logistic'} ##' ## anova(glm(...,family=binomial,test="Chisq")) is used to calculate p-values. ##' ##' ## export result to csv ##' table1 = summary(univariateTable(location~age+gender+height+weight,data=Diabetes), ##' show.pvalues=FALSE) ##' # write.csv(table1,file="~/table1.csv",rownames=FALSE) ##' ##' ## change labels and values ##' utable(location~age+gender+height+weight,data=Diabetes, ##' age="Age (years)",gender="Sex", ##' gender.female="Female", ##' gender.male="Male", ##' height="Body height (inches)", ##' weight="Body weight (pounds)") ##' ##' ## Use quantiles and rank tests for some variables and mean and standard deviation for others ##' univariateTable(gender~Q(age)+location+Q(BMI)+height+weight, ##' data=Diabetes) ##' ##' ## Factor with more than 2 levels ##' Diabetes$AgeGroups <- cut(Diabetes$age, ##' c(19,29,39,49,59,69,92), ##' include.lowest=TRUE) ##' univariateTable(location~AgeGroups+gender+height+weight, ##' data=Diabetes) ##' ##' ## Row percent ##' univariateTable(location~gender+age+AgeGroups, ##' data=Diabetes, ##' column.percent=FALSE) ##' ##' ## change of frequency format ##' univariateTable(location~gender+age+AgeGroups, ##' data=Diabetes, ##' column.percent=FALSE, ##' freq.format="percent(x) (n=count(x))") ##' ##' ## changing Labels ##' u <- univariateTable(location~gender+AgeGroups+ height + weight, ##' data=Diabetes, ##' column.percent=TRUE, ##' freq.format="count(x) (percent(x))") ##' summary(u,"AgeGroups"="Age (years)","height"="Height (inches)") ##' ##' ## more than two groups ##' Diabetes$frame=factor(Diabetes$frame,levels=c("small","medium","large")) ##' univariateTable(frame~gender+BMI+age,data=Diabetes) ##' ##' Diabetes$sex=as.numeric(Diabetes$gender) ##' univariateTable(frame~sex+gender+BMI+age, ##' data=Diabetes,freq.format="count(x) (percent(x))") ##' ##' ## multiple summary formats ##' ## suppose we want for some reason mean (range) for age ##' ## and median (range) for BMI. ##' ## method 1: ##' univariateTable(frame~Q(age)+BMI, ##' data=Diabetes, ##' Q.format="mean(x) (range(x))", ##' summary.format="median(x) (range(x))") ##' ## method 2: ##' u1 <- summary(univariateTable(frame~age, ##' data=na.omit(Diabetes), ##' summary.format="mean(x) (range(x))")) ##' u2 <- summary(univariateTable(frame~BMI, ##' data=na.omit(Diabetes), ##' summary.format="median(x) (range(x))")) ##' publish(rbind(u1,u2),digits=2) ##' ##' ## Large number format (big.mark) ##' Diabetes$AGE <- 1000*Diabetes$age ##' u3 <- summary(univariateTable(frame~AGE, ##' data=Diabetes,big.mark="'")) ##' ##' ##' ##' @export univariateTable <- function(formula, data=parent.frame(), summary.format="mean(x) (sd(x))", Q.format="median(x) [iqr(x)]", freq.format="count(x) (percent(x))", column.percent=TRUE, digits=c(1,1,3), big.mark=",", short.groupnames, compare.groups=TRUE, show.totals=TRUE, n="inNames", outcome=NULL, ...){ if (length(digits)<3) digits <- rep(digits,3) if (!is.numeric(digits.summary <- digits[[1]])) digits.summary <- 1 if (!is.numeric(digits.freq <- digits[[2]])) digits.freq <- 1 if (!is.numeric(pvalue.digits <- digits[[3]])) pvalue.digits <- 3 call <- match.call() # {{{ parse formula and find data oldnaaction <- options()$na.action options(na.action="na.pass") FRAME <- specialFrame(formula, data, specials.design=FALSE, unspecials.design=FALSE, specials=c("F","S","Q","strata","Strata","factor","Factor","Cont","nonpar"), specials.factor = FALSE, strip.specials=c("F","S","Q"), strip.arguments=list("S"="format"), strip.alias=list("F"=c("strata","factor","Strata","Factor"),"S"="Cont","Q"="nonpar"), na.action="na.pass") options(na.action=oldnaaction) # }}} # {{{ extract grouping variable if (is.null(FRAME$response)){ groupvar <- NULL groupname <- NULL grouplabels <- NULL groups <- NULL n.groups <- NROW(data) } else{ mr <- FRAME$response if(NCOL(mr)!=1) stop("Can only handle univariate outcome") groupname <- colnames(mr) groupvar <- as.character(FRAME$response[,1,drop=TRUE]) mr <- FRAME$response[,1,drop=TRUE] ## deal with missing values in group variable if (is.factor(mr)){ if (any(is.na(groupvar))){ groupvar[is.na(groupvar)] <- "Missing" groups <- c(levels(mr),"Missing") }else{ groups <- levels(mr) } } else { if (any(is.na(groupvar))){ groupvar[is.na(groupvar)] <- "Missing" } groups <- unique(groupvar) } groupvar <- factor(groupvar,levels=groups) n.groups <- table(groupvar) n.groups <- c(n.groups,sum(n.groups)) if (compare.groups=="logistic" & (length(groups)!=2)) stop("compare.groups can only be equal to 'logistic' when there are exactly two groups. You have ",length(groups)," groups") ## if (length(groups)>30) stop("More than 30 groups") if (missing(short.groupnames)){ if(all(nchar(groups)<2) || all(groups %in% c(TRUE,FALSE))) short.groupnames <- FALSE else short.groupnames <- TRUE } if (short.groupnames==TRUE) grouplabels <- groups else grouplabels <- paste(groupname,"=",groups) } # }}} # {{{ classify variables into continuous numerics and grouping factors automatrix <- FRAME$design continuous.matrix <- NULL factor.matrix <- NULL auto.type <- sapply(1:NCOL(automatrix),function(i){ x <- automatrix[,i] # type 0=other coerced to numeric # 1=factor # 2=numeric # 3=character ## set some useful default type.i <- is.factor(x)+2*is.numeric(x)+3*is.logical(x)+4*is.character(x) # treat character and logical as factors if (type.i %in% c(3,4)) type.i <- 1 # treat other variables as numeric (e.g. difftime) if (type.i==0) type.i <- 2 # force variables with less than 3 distinct values to be categorical (factors) if (length(unique(x))<3) type.i <- 1 type.i}) if (any(auto.type==2)){ if (is.null(FRAME$S)) continuous.matrix <- automatrix[,auto.type==2,drop=FALSE] else continuous.matrix <- cbind(FRAME$S,automatrix[,auto.type==2,drop=FALSE]) } if (any(auto.type==1)){ if (is.null(FRAME$F)) factor.matrix <- automatrix[,auto.type==1,drop=FALSE] else factor.matrix <- cbind(FRAME$F,automatrix[,auto.type==1,drop=FALSE]) } Q.matrix <- FRAME$Q NVARS <- NCOL(continuous.matrix)+ NCOL(continuous.matrix)+NCOL(factor.matrix)+ NCOL(Q.matrix) # }}} # {{{ summary numeric variables if (!is.null(continuous.matrix)){ # prepare format sumformat <- parseSummaryFormat(format=summary.format,digits=digits.summary) # get summary excluding missing in groups and in totals summaryNumeric <- getSummary(matrix=continuous.matrix, varnames=names(continuous.matrix), groupvar=groupvar, groups=groups, labels=grouplabels, stats=sumformat$stats, format=sumformat$format, digits=digits.summary,big.mark=big.mark) } else{ sumformat <- NULL summaryNumeric <- NULL } if (!is.null(Q.matrix)){ # prepare format Qformat <- parseSummaryFormat(format=Q.format,digits=digits.summary) # get summary excluding missing in groups and in totals qNumeric <- getSummary(matrix=Q.matrix, varnames=names(Q.matrix), groupvar=groupvar, groups=groups, labels=grouplabels, stats=Qformat$stats, format=Qformat$format,digits=digits.summary,big.mark=big.mark) } else{ Qformat <- NULL qNumeric <- NULL } # }}} # {{{ categorical variables (factors) if (!is.null(factor.matrix)){ if (column.percent==TRUE){ freq.format <- sub("percent","colpercent",freq.format) freq.format <- sub("colcolpercent","colpercent",freq.format) } # prepare format freqformat <- parseFrequencyFormat(format=freq.format,digits=digits.freq) # get frequencies excluding missing in groups and in totals freqFactor <- getFrequency(matrix=factor.matrix, varnames=names(factor.matrix), groupvar=groupvar, groups=groups, labels=grouplabels, stats=freqformat$stats, format=freqformat$format,big.mark=big.mark,digits=digits.freq) } else{ freqformat <- NULL freqFactor <- NULL } # }}} # {{{ missing values mlist <- list(continuous.matrix,Q.matrix,factor.matrix) allmatrix <- do.call("cbind",mlist[!sapply(mlist,is.null)]) totals.missing <- lapply(allmatrix,function(v){sum(is.na(v))}) if (!is.null(groups)){ group.missing <- lapply(allmatrix,function(v){ lapply(groups,function(g){ sum(is.na(v[groupvar==g])) }) })} else { group.missing <- NULL } # }}} # {{{ p-values p.cont <- NULL p.Q <- NULL p.freq <- NULL if (!is.null(groups) && (compare.groups!=FALSE)){ if (!is.null(continuous.matrix)){ p.cont <- sapply(names(continuous.matrix),function(v){ data.table::set(data,j=v,value=as.numeric(data[[v]])) switch(tolower(as.character(compare.groups[[1]])), "false"={NULL}, "logistic"={ ## logistic regression px <- anova(glm(update(formula,paste(".~",v)),data=data,family=binomial),test="Chisq")$"Pr(>Chi)"[2] px }, "cox"={ px <- anova(coxph(formula(paste("Surv(time,status)~",v)),data=cbind(outcome,data)))$"Pr(>|Chi|)"[2] px }, "true"={ ## glm fails when there are missing values ## in outcome, so we remove missing values fv <- formula(paste(v,"~",groupname)) vdata <- model.frame(fv,data,na.action=na.omit) px <- anova(glm(fv,data=vdata),test="Chisq")$"Pr(>Chi)"[2] px },NULL) }) } if (!is.null(Q.matrix)){ p.Q <- sapply(names(Q.matrix),function(v){ switch(tolower(as.character(compare.groups[[1]])), "false"={NULL}, "logistic"={ ## logistic regression ## glm fails when there are missing values ## in outcome, so we remove missing values fv <- formula(paste(v,"~",groupname)) vdata <- model.frame(fv,data,na.action=na.omit) px <- anova(glm(update(formula,paste(".~",v)),data=vdata,family=binomial),test="Chisq")$"Pr(>Chi)"[2] px }, "cox"={ px <- anova(coxph(formula(paste("Surv(time,status)~",v)),data=cbind(outcome,data)))$"Pr(>|Chi|)"[2] px }, "true"={ if (is.character(data[[groupname]])){ data[[paste0(groupname,"asfactor")]] <- factor(data[[groupname]]) px <- kruskal.test(formula(paste0(v,"~",groupname,"asfactor")),data=data)$p.value } else{ px <- kruskal.test(formula(paste(v,"~",groupname)),data=data)$p.value } px },NULL) }) } if (!is.null(factor.matrix)){ p.freq <- sapply(names(factor.matrix),function(v){ switch(tolower(as.character(compare.groups[[1]])), "false"={NULL}, "logistic"={ ## logistic regression fv <- formula(paste(v,"~",groupname)) vdata <- model.frame(fv,data,na.action=na.omit) px <- anova(glm(update(formula,paste(".~",v)),data=vdata,family=binomial),test="Chisq")$"Pr(>Chi)"[2] }, "cox"={ px <- anova(coxph(formula(paste("Surv(time,status)~",v)),data=cbind(outcome,data)))$"Pr(>|Chi|)"[2] px }, "true"={ fv <- factor.matrix[,v] tabx <- table(fv,groupvar) if (sum(tabx)==0) { px <- NA } else{ suppressWarnings(test <- chisq.test(tabx)) px <- test$p.value } ## FIXME: need to catch and pass the warnings ## test <- suppressWarnings(fisher.test(tabx)) ## if (any(test$expected < 5) && is.finite(test$parameter)) px },NULL) }) } } p.values <- c(p.cont,p.Q,p.freq) if (length(p.values)>0) if (is.null(p.values[[1]])) p.values <- NULL # }}} # {{{ output ## xlevels <- lapply(factor.matrix,function(x){ ## levels(as.factor(x,exclude=FALSE)) ## levels(as.factor(x)) ## }) vartypes <- rep(c("numeric","Q","factor"),c(length(names(continuous.matrix)),length(names(Q.matrix)),length(names(factor.matrix)))) names(vartypes) <- c(names(continuous.matrix),names(Q.matrix),names(factor.matrix)) out <- list(summary.groups=c(freqFactor$groupfreq,summaryNumeric$groupsummary,qNumeric$groupsummary), summary.totals=c(freqFactor$totals,summaryNumeric$totals,qNumeric$totals), missing=list(group=group.missing,totals=totals.missing), n.groups=n.groups, p.values=p.values, formula=formula, groups=grouplabels, vartype=vartypes, xlevels=freqFactor$xlevels, Q.format=Q.format, summary.format=summary.format, freq.format=freq.format, compare.groups=compare.groups, ## dots are passed to labelUnits without suitability checks show.totals=show.totals, n=n, labels=list(...)) class(out) <- "univariateTable" out # }}} } ## the name utable is more handy ##' @export utable utable <- univariateTable Publish/R/lhs.R0000744000176200001440000000006513571203035012773 0ustar liggesuserslhs <- function(formula){ update(formula,.~NULL) } Publish/R/publish.htest.R0000755000176200001440000001736613571203035015017 0ustar liggesusers##' Pretty printing of test results. ##' ##' @title Pretty printing of test results. ##' @export ##' @param object Result of \code{t.test} or \code{wilcox.test} ##' @param title Decoration also used to name output ##' @param ... Used to transport arguments \code{ci.arg} and \code{pvalue.arg} to subroutines \code{format.pval} and \code{formatCI}. See also \code{prodlim::SmartControl}. ##' @author Thomas A. Gerds ##' @examples ##' data(Diabetes) ##' publish(t.test(bp.2s~gender,data=Diabetes)) ##' publish(wilcox.test(bp.2s~gender,data=Diabetes)) ##' publish(with(Diabetes,t.test(bp.2s,bp.1s,paired=TRUE))) ##' publish(with(Diabetes,wilcox.test(bp.2s,bp.1s,paired=TRUE))) ##' publish.htest <- function(object, title, ...){ pynt <- getPyntDefaults(list(...),names=list("digits"=c(2,3),"handler"="sprintf",nsmall=NULL)) digits <- pynt$digits if (length(digits)==1) digits <- rep(digits,2) handler <- pynt$handler if (length(pynt$nsmall)>0) nsmall <- pynt$nsmall else nsmall <- pynt$digits Lower <- object$conf.int[[1]] Upper <- object$conf.int[[2]] ci.defaults <- list(format="[l;u]", digits=digits[[1]], nsmall=digits[[1]], degenerated="asis") pvalue.defaults <- list(digits=digits[[2]], eps=10^{-digits[[2]]}, stars=FALSE) smartF <- prodlim::SmartControl(call=list(...), keys=c("ci","pvalue"), ignore=c("x","print","handler","digits","nsmall"), defaults=list("ci"=ci.defaults,"pvalue"=pvalue.defaults), forced=list("ci"=list(lower=Lower,upper=Upper,handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]), "pvalue"=list(object$p.value)), verbose=FALSE) printmethod=object$method printmethod[grep("Wilcoxon rank sum test",printmethod)]="Wilcoxon rank sum test" printmethod[grep("Wilcoxon signed rank test",printmethod)]="Wilcoxon signed rank test" printmethod[grep("Two Sample t-test",printmethod)]="Two Sample t-test" if (!is.null(object$conf.int)){ if (printmethod=="Exact binomial test"){ cistring=paste(" (CI-", 100*attr(object$conf.int,"conf.level"), "% = ", do.call("formatCI",smartF$ci), ").",sep="") }else{ cistring=paste(" (CI-", 100*attr(object$conf.int,"conf.level"), "% = ", do.call("formatCI",smartF$ci), "; ", "p-value = ", do.call("format.pval",smartF$pvalue), ").",sep="") } } else{ cistring="" } switch(printmethod, "Exact binomial test"={ outstring <- paste("The ", object$method, " to estimate the ", names(object$null.value), " based on ", object$statistic, " events ", " in ", object$parameter, " trials yields a probability estimate of ", pubformat(object$estimate,handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), cistring, sep="") }, "Two Sample t-test"={ outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a mean difference of ", pubformat(diff(object$estimate),handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), cistring, sep="") }, "Wilcoxon rank sum test"={ if (is.null(object$conf.int)) outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a p-value of ", do.call("format.pval",smartF$pvalue), ".", sep="") else outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a ", names(object$estimate), " of ", pubformat(object$estimate,handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), cistring, sep="") }, "Paired t-test"={ outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a mean of the differences of ", pubformat(object$estimate,handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), cistring, sep="") }, "Wilcoxon signed rank test"={ if (is.null(object$conf.int)) outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a p-value of ", do.call("format.pval",smartF$pvalue), ".", sep="") else outstring <- paste("The ", object$method, " to compare the ", names(object$null.value), " for ", object$data.name, " yields a ", names(object$estimate), " of ", pubformat(object$estimate,handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), cistring, sep="") }) outstring=gsub('[[:space:]]+',' ',gsub('[[:space:]]$','',outstring)) if (missing(title)) cat("\n",outstring,"\n") else{ names(outstring) <- title print(outstring,quote=F) } } Publish/R/plotConfidence.R0000644000176200001440000011643413664136424015162 0ustar liggesusers### plotConfidence.R --- #------- ## author: Thomas Alexander Gerds ## created: May 10 2015 (11:03) ## Version: ## last-updated: May 8 2020 (07:04) ## By: Thomas Alexander Gerds ## Update #: 560 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Function to plot confidence intervals with their values and additional labels. ##' One anticipated use of this function involves first the generation of a regression object, ##' then arrangement of a result table with "regressionTable", further arrangment of table with ##' with e.g. "fixRegressionTable" and various user defined changes - and then finally table ##' along with forest plot using the current function. ##' ##' Function to plot means and other point estimates with confidence intervals, ##' their values and additional labels . ##' Horizonal margins as determined by par()$mar are ignored. ##' Instead layout is used to divide the plotting region horizontally ##' into two or three parts plus leftmargin and rightmargin. ##' ##' When values is FALSE there are only two parts. The default order is ##' labels on the left confidence intervals on the right. ##' When no labels are given or labels is FALSE there are only two parts. The default order is ##' confidence intervals on the left values on the right. ##' ##' The default order of three parts from left to right is ##' labels, confidence intervals, values. The order can be changed as shown ##' by the examples below. The relative widths of the two or three parts ##' need to be adapted to the actual size of the text of the labels. This ##' depends on the plotting device and the size of the font and figures and ##' thus has to be adjusted manually. ##' ##' Oma can be used to further control horizontal margins, e.g., par(oma=c(0,4,0,4)). ##' ##' If confidence limits extend beyond the range determined by xlim, then ##' arrows are drawn at the x-lim borders to indicate that the confidence ##' limits continue. ##' @title Plot confidence intervals ##' @param x Either a vector containing the point estimates or a list ##' whose first element contains the point estimates. Further list ##' elements can contain the confidence intervals and labels. In this ##' case the list needs to have names 'lower' and 'upper' to indicate ##' the values of the lower and the upper limits of the confidence ##' intervals, respectively, and may have an element 'labels' which is ##' a vector or matrix or list with labels. ##' @param y.at Optional vector of y-position for the confidence intervals and corresponding values and labels. ##' @param lower Lower confidence limits. Used if object \code{x} is a ##' vector and if \code{x} is a list \code{lower} overwrites element ##' \code{x$lower}. ##' @param upper Upper confidence limits. Used if object \code{x} is a ##' vector and if \code{x} is a list \code{upper} overwrites element ##' \code{x$upper}. ##' @param pch Symbol for points. ##' @param cex Defaults size of all figures and plotting symbol. ##' Single elements are controlled separately. See \code{...}. ##' @param lwd Default width of all lines Single elements are ##' controlled separately. See \code{...}. ##' @param col Default colour of confidence intervals. ##' @param xlim Plotting limits for the confidence intervals. See also ##' \code{xratio} on how to control the layout. ##' @param xlab Label for the x-axis. ##' @param labels Vector or matrix or list with \code{labels}. Used if ##' object \code{x} is a vector and if \code{x} is a list it ##' overwrites element \code{x$labels}. To avoid drawing of labels, set \code{labels=FALSE}. ##' @param title.labels Main title for the column which shows the \code{labels}. If \code{labels} ##' is a matrix or list \code{title.labels} should be a vector with as ##' many elements as labels has columns or elements. ##' @param values Either logical or vector, matrix or list with ##' values. If \code{values=TRUE} values are constructed according to ##' \code{format} from \code{lower} and \code{upper} overwrites ##' constructed values. If \code{values=FALSE} do not draw values. ##' @param title.values Main title for the column \code{values}. If \code{values} ##' is a matrix or list \code{title.labels} should be a vector with as ##' many elements as values has columns or elements. ##' @param section.sep Amount of space between paragraphs (applies only if \code{labels} is a named list) ##' @param section.title Intermediate section headings. ##' @param section.title.x x-position for section.titles ##' @param section.pos Vector with y-axis posititions for section.titles. ##' @param section.title.offset Y-offset for section.titles ##' @param order Order of the three columns: labels, confidence limits, ##' values. See examples. ##' @param leftmargin Percentage of plotting region used for ##' leftmargin. Default is 0.025. See also Details. ##' @param rightmargin Percentage of plotting region used for ##' rightmargin. Default is 0.025. See also Details. ##' @param stripes Vector of up to three Logicals. If \code{TRUE} draw ##' stripes into the background. The first applies to the labels, the ##' second to the graphical presentation of the confidence intervals ##' and the third to the values. Thus, stripes ##' @param factor.reference.pos Position at which factors attain ##' reference values. ##' @param factor.reference.label Label to use at ##' \code{factor.reference.pos} instead of values. ##' @param factor.reference.pch Plotting symbol to use at ##' \code{factor.reference.pos} ##' @param refline Position of a vertical line to indicate the null ##' hypothesis. Default is 1 which would work for odds ratios and ##' hazard ratios. ##' @param title.line Position of a horizontal line to separate the title line from the plot ##' @param xratio One or two values between 0 and 1 which determine ##' how to split the plot window in horizontal x-direction. If there ##' are two columns (labels, CI) or (CI, values) only one value is used ##' and the default is 0.618 (goldener schnitt) which gives the ##' graphical presentation of the confidence intervals 38.2 % of the ##' graph. The remaining 61.8 % are used for the labels (or values). ##' If there are three columns (labels, CI, values), xratio has two ##' values which default to fractions of 0.7 according to the relative ##' widths of labels and values, thus by default only 0.3 are used for ##' the graphical presentation of the confidence intervals. The ##' remaining 30 % are used for the graphical presentation of the ##' confidence intervals. See examles. ##' @param y.offset Either a single value or a vector determining the ##' vertical offset of all rows. If it is a single value all rows are ##' shifted up (or down if negative) by this value. This can be used ##' to add a second set of confidence intervals to an existing graph ##' or to achieve a visual grouping of rows that belong ##' together. See examples. ##' @param y.title.offset Numeric value by which to vertically shift ##' the titles of the labels and values. ##' @param digits Number of digits, passed to \code{pubformat} and ##' \code{formatCI}. ##' @param format Format for constructing values of confidence ##' intervals. Defaults to '(u;l)' if there are negative lower or ##' upper values and to '(u-l)' otherwise. ##' @param extremearrows.length Length of the arrows in case of ##' confidence intervals that stretch beyond xlim. ##' @param extremearrows.angle Angle of the arrows in case of ##' confidence intervals that stretch beyond xlim. ##' @param add Logical. If \code{TRUE} do not draw labels or values ##' and add confidence intervals to existing plot. ##' @param layout Logical. If \code{FALSE} do not call layout. This is useful when ##' several plotConfidence results should be combined in one graph and hence layout is called ##' externally. ##' @param xaxis Logical. If \code{FALSE} do not draw x-axis. ##' @param ... Used to control arguments of the following subroutines: ##' \code{plot}: Applies to plotting frame of the graphical ##' presentation of confidence intervals. Use arguments of ##' \code{plot}, e.g., \code{plot.main="Odds ratio"}. \code{points}, ##' \code{arrows}: Use arguments of \code{points} and \code{arrows}, ##' respectively. E.g., \code{points.pch=8} and \code{arrows.lwd=2}. ##' \code{refline}: Use arguments of \code{segments}, e.g., ##' \code{refline.lwd=2}. See \link{segments}. \code{labels}, ##' \code{values}, \code{title.labels}, \code{title.values}: Use ##' arguments of \code{text}, e.g., \code{labels.col="red"} or ##' \code{title.values.cex=1.8}. \code{xaxis}: Use arguments of ##' \code{axis}, e.g., \code{xaxis.at=c(-0.3,0,0.3)} \code{xlab}: Use ##' arguments of \code{mtext}, e.g., \code{xlab.line=2}. ##' \code{stripes}: Use arguments of \code{stripes}. See examples. ##' See examples for usage. ##' @return List of dimensions and coordinates ##' @examples ##' ##' library(Publish) ##' data(CiTable) ##' ##' ## A first draft version of the plot is obtained as follows ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper","p")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")]) ##' ##' ## if argument labels is a named list the table is subdivided: ##' labellist <- split(CiTable[,c("Dose","Time","Mean","SD","n")],CiTable[,"Drug"]) ##' labellist ##' ## the data need to be ordered accordingly ##' CC= data.table::rbindlist(split(CiTable[,c("HazardRatio","lower","upper")],CiTable[,"Drug"])) ##' plotConfidence(x=CC, labels=labellist) ##' ##' ##' ## The graph consist of at most three columns: ##' ## ##' ## column 1: labels ##' ## column 2: printed values of the confidence intervals ##' ## column 3: graphical presentation of the confidence intervals ##' ## ##' ## NOTE: column 3 appears always, the user decides if also ##' ## column 1, 2 should appear ##' ## ##' ## The columns are arranged with the function layout ##' ## and the default order is 1,3,2 such that the graphical ##' ## display of the confidence intervals appears in the middle ##' ## ##' ## the order of appearance of the three columns can be changed as follows ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' order=c(1,3,2)) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' order=c(2,3,1)) ##' ## if there are only two columns the order is 1, 2 ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' values=FALSE, ##' order=c(2,1)) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' values=FALSE, ##' order=c(1,2)) ##' ##' ##' ##' ## The relative size of the columns needs to be controlled manually ##' ## by using the argument xratio. If there are only two columns ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xratio=c(0.4,0.15)) ##' ##' ## The amount of space on the left and right margin can be controlled ##' ## as follows: ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xratio=c(0.4,0.15), ##' leftmargin=0.1,rightmargin=0.00) ##' ##' ## The actual size of the current graphics device determines ##' ## the size of the figures and the space between them. ##' ## The sizes and line widths are increased as follows: ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' xlab="Hazard ratio", ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' points.cex=3, ##' cex=2, ##' lwd=3, ##' xaxis.lwd=1.3, ##' xaxis.cex=1.3) ##' ## Note that 'cex' of axis ticks is controlled via 'par' but ##' ## cex of the label via argument 'cex' of 'mtext'. ##' ## The sizes and line widths are decreased as follows: ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' cex=0.8, ##' lwd=0.8, ##' xaxis.lwd=0.8, ##' xaxis.cex=0.8) ##' ##' ## Another good news is that all figures can be controlled separately ##' ##' ## The size of the graphic device can be controlled in the usual way, e.g.: ##' \dontrun{ ##' pdf("~/tmp/testCI.pdf",width=8,height=8) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")]) ##' dev.off() ##' } ##' ##' ## More control of the x-axis and confidence intervals that ##' ## stretch outside the x-range end in an arrow. ##' ## the argument xlab.line adjusts the distance of the x-axis ##' ## label from the graph ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' xlab="Hazard ratio", ##' xlab.line=1.8, ##' xaxis.at=c(0.8,1,1.3), ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlim=c(0.8,1.3)) ##' ##' ## log-scale ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' xlab="Hazard ratio", ##' xlab.line=1.8, ##' xaxis.at=c(0.8,1,1.3), ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlim=c(0.8,1.3),plot.log="x") ##' ## More pronounced arrows ##' ## Coloured xlab expression ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' xlab=expression(HR[1](s)), ##' xlab.line=1.8, ##' xlab.col="darkred", ##' extremearrows.angle=50, ##' extremearrows.length=0.1, ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlim=c(0.8,1.3)) ##' ##' ## Controlling the labels and their titles ##' ## and the values and their titles ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlab="Hazard ratio", ##' title.values=expression(bold(HR (CI[95]))), ##' title.labels=c("Drug/Time","Dose","Mean","St.dev.","N"), ##' factor.reference.pos=c(1,10,19), ##' factor.reference.pch=16, ##' cex=1.3, ##' xaxis.at=c(0.75,1,1.25,1.5,2)) ##' ##' ## For factor reference groups, one may want to replace the ##' ## confidence intervals by the word Reference, as in the previous example. ##' ## To change the word 'Reference' we use the argument factor.reference.label: ##' ## To change the plot symbol for the reference lines factor.reference.pch ##' ## To remove the plot symbol in the reference lines use 'NA' as follows: ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlab="Hazard ratio", ##' factor.reference.label="Ref", ##' title.values=expression(bold(HR (CI[95]))), ##' title.labels=c("Drug/Time","Dose","Mean","St.dev.","N"), ##' factor.reference.pos=c(1,10,19), ##' factor.reference.pch=NA, ##' cex=1.3, ##' xaxis.at=c(0.75,1,1.25,1.5,2)) ##' ##' ##' ## changing the style of the graphical confidence intervals ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' xlab="Hazard ratio", ##' factor.reference.pos=c(1,10,19), ##' points.pch=15, ##' points.col=rainbow(27), ##' points.cex=2, ##' arrows.col="darkblue", ##' cex=1.3, ##' order=c(1,3,2), ##' xaxis.at=c(0.75,1,1.25,1.5)) ##' ##' ## the values column of the graph can have multiple columns as well ##' ## to illustrate this we create the confidence intervals ##' ## before calling the function and then cbind them ##' ## to the pvalues ##' HR <- pubformat(CiTable[,6]) ##' CI95 <- formatCI(lower=CiTable[,7],upper=CiTable[,8],format="(l-u)") ##' pval <- format.pval(CiTable[,9],digits=3,eps=10^{-3}) ##' pval[pval=="NA"] <- "" ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' values=list("HR"=HR,"CI-95"=CI95,"P-value"=pval), ##' cex=1.2, ##' xratio=c(0.5,0.3)) ##' ##' ## Finally, vertical columns can be delimited with background color ##' ## NOTE: this may slow things down and potentially create ##' ## large figures (many bytes) ##' col1 <- rep(c(prodlim::dimColor("green",density=22), ##' prodlim::dimColor("green")),length.out=9) ##' col2 <- rep(c(prodlim::dimColor("orange",density=22), ##' prodlim::dimColor("orange")),length.out=9) ##' col3 <- rep(c(prodlim::dimColor("blue",density=22), ##' prodlim::dimColor("blue")),length.out=9) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' stripes=c(1,0,1), ##' stripes.col=c(col1,col2,col3)) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' stripes=c(1,1,1), ##' stripes.col=c(col1,col2,col3)) ##' ##' threegreens <- c(prodlim::dimColor("green",density=55), ##' prodlim::dimColor("green",density=33), ##' prodlim::dimColor("green",density=22)) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Drug.Time","Dose","Mean","SD","n")], ##' values=FALSE, ##' xlim=c(0.75,1.5), ##' stripes=c(1,1,1), ##' xratio=c(0.5,0.15), ##' stripes.horizontal=c(0,9,18,27)+0.5, ##' stripes.col=threegreens) ##' ##' # combining multiple plots into one ##' layout(t(matrix(1:5))) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' labels=CiTable[,c("Mean","n")], ##' layout=FALSE) ##' plotConfidence(x=CiTable[,c("HazardRatio","lower","upper")], ##' layout=FALSE) ##' ##' ##' @export ##' @author Thomas A. Gerds plotConfidence <- function(x, y.at, lower, upper, pch=16, cex=1, lwd=1, col=4, xlim, xlab, labels, title.labels, values, title.values, section.pos, section.sep, section.title=NULL, section.title.x, section.title.offset, order, leftmargin=0.025, rightmargin=0.025, stripes, factor.reference.pos, factor.reference.label="Reference", factor.reference.pch=16, refline=1, title.line=TRUE, xratio, y.offset=0, y.title.offset, digits=2, format, extremearrows.length=0.05, extremearrows.angle=30, add=FALSE, layout=TRUE, xaxis=TRUE, ...){ # {{{ extract confidence data if (!is.list(x)) x <- list(x=x) m <- x[[1]] names(x) <- tolower(names(x)) if (missing(lower)) { lower <- x$lower } if (missing(upper)) upper <- x$upper if (missing(xlim)) xlim <- c(min(lower)-0.1*min(lower),max(upper)+0.1*min(upper)) if (missing(xlab)) xlab <- "" # }}} # {{{ preprocessing of labels and title.labels NR <- length(x[[1]]) if (length(lower)!=NR) stop(paste0("lower has wrong dimension. There are ",NR," contrasts but ",length(upper)," upper limits")) if (length(upper)!=NR) stop(paste0("upper has wrong dimension. There are ",NR," contrasts but ",length(upper)," upper limits")) if (!missing(labels) && (is.logical(labels) && labels[[1]]==FALSE)) do.labels <- FALSE else do.labels <- TRUE if (!do.labels || (!missing(title.labels) && (is.logical(title.labels) && title.labels[[1]]==FALSE))) do.title.labels <- FALSE else do.title.labels <- TRUE if (do.labels && missing(labels)) { labels <- x$labels if (is.null(labels)) do.labels <- FALSE } if (missing(labels)) labels <- NULL if (!is.data.frame(labels) && is.list(labels)){ section.rows <- sapply(labels,NROW) nsections <- length(labels) if (sum(section.rows)!=NR) stop(paste0("Label list has wrong dimension. There are ",NR," confidence intervals but ",sum(section.rows)," labels")) }else{ nsections <- 0 section.rows <- NULL } # }}} # {{{ set y positions and ylim if (missing(y.at)) {at <- 1:NR } else{ if(length(y.at)!=NR) stop(paste0("Number of y positions must match number of confidence intervals which is ",NR)) at <- y.at } if (nsections>0){ if (!missing(section.title) && length(section.title)>0){ names(labels) <- section.title ## stop("Cannot have section.titles when labels is a named list") } do.sections <- TRUE section.title <- rev(names(labels)) ## check for second level if (!is.data.frame(labels[[1]]) && is.list(labels[[1]])){ sublevels <- names(labels) labels <- lapply(1:length(labels),function(l){ cbind(sublevels[[l]],data.table::data.table(labels[[l]])) }) } labels <- data.table::rbindlist(lapply(labels,data.table::data.table),use.names=TRUE) section.pos <- cumsum(rev(section.rows)) }else{ if (!missing(section.title) && length(section.title)>0){ if (missing(section.pos)) stop("Need y-positions for section.titles") do.sections <- TRUE }else{ do.sections <- FALSE } } ## oneM <- strheight("M",cex=cex) oneM <- .5 if (do.sections){ if (missing(section.title.offset)) section.title.offset <- 1.5*oneM if (missing(section.sep)) section.sep <- 2*oneM section.shift <- rep(cumsum(c(0,section.sep+rep(section.sep,nsections-1))), c(section.pos[1],diff(section.pos))) section.pos+section.shift[section.pos] if ((sub.diff <- (length(at)-length(section.shift)))>0) section.shift <- c(section.shift,rep(section.title.offset+section.shift[length(section.shift)],sub.diff)) }else{ section.shift <- 0 } at <- at+section.shift ## if (!(length(y.offset) %in% c(1,NR))){ ## warning(paste("The given",length(y.offset),"many y-offsets are pruned/extended to the length",NR,"lines of the plot.")) ## } if (length(y.offset)!=NR) y.offset <- rep(y.offset,length.out=NR) at <- at+y.offset if (do.sections){ section.y <- at[section.pos] section.title.y <- section.y+section.title.offset }else{ section.title.y <- 0 } if (missing(y.title.offset)) { if (do.sections){ y.title.offset <- 1.5*oneM + section.title.offset } else{ y.title.offset <- 1.5*oneM } } title.y <- max(at)+y.title.offset rat <- rev(at) ylim <- c(0,at[length(at)]+1) dimensions <- list("NumberRows"=NR,xlim=xlim,ylim=ylim,y.at=at) # }}} # {{{ preprocessing of values and confidence intervals if (!missing(values) && (is.logical(values) && values[[1]]==FALSE)) do.values <- FALSE else do.values <- TRUE if (do.values==TRUE){ if (!missing(title.values) && (is.logical(title.values) && title.values[[1]]==FALSE)) do.title.values <- FALSE else do.title.values <- TRUE }else{ do.title.values <- FALSE } if (do.values){ if (missing(values)){ if (missing(format)) if (all(!is.na(upper)) && any(upper<0)) format <- "(u;l)" else format <- "(u-l)" values.defaults <- paste(pubformat(x[[1]],digits=digits), apply(cbind(lower,upper), 1, function(x)formatCI(lower=x[1],upper=x[2],format=format,digits=digits))) if (!missing(factor.reference.pos) && is.numeric(factor.reference.pos) && all(factor.reference.posvwidth) ## xratio <- c((1-(vwidth/lwidth))*0.7,(vwidth/lwidth)*0.7) ## else ## xratio <- c((1-(lwidth/vwidth))*0.7,(lwidth/vwidth)*0.7) ## xratio <- c(0.5,0.2) } labelswidth <- plotwidth * xratio[1] valueswidth <- plotwidth * xratio[2] ciwidth <- plotwidth - labelswidth - valueswidth mat <- matrix(c(0,c(1,3,2)[order],0),ncol=5) if (!missing(order) && length(order)!=3) order <- rep(order,length.out=3) if (layout) layout(mat,width=c(leftmarginwidth,c(labelswidth,ciwidth,valueswidth)[order],rightmarginwidth)) ## layout.show(n=3) } else{ ## only labels do.stripes <- rep(do.stripes,length.out=2) names(do.stripes) <- c("labels","ci") if (missing(xratio)) xratio <- 0.618 labelswidth <- plotwidth * xratio[1] ciwidth <- plotwidth - labelswidth valueswidth <- 0 if (!missing(order) && length(order)!=2) order <- rep(order,length.out=2) mat <- matrix(c(0,c(1,2)[order],0),ncol=4) if (layout) layout(mat,width=c(leftmarginwidth,c(labelswidth,ciwidth)[order],rightmarginwidth)) } } else{ if (do.values){ ## only values do.stripes <- rep(do.stripes,length.out=2) names(do.stripes) <- c("ci","values") if (missing(xratio)) xratio <- 0.618 valueswidth <- plotwidth * (1-xratio[1]) ciwidth <- plotwidth - valueswidth labelswidth <- 0 mat <- matrix(c(0,c(2,1)[order],0),ncol=4) if (!missing(order) && length(order)!=2) order <- rep(order,length.out=2) if (layout) layout(mat,width=c(leftmarginwidth,c(ciwidth,valueswidth)[order],rightmarginwidth)) }else{ # none xratio <- 1 ciwidth <- plotwidth do.stripes <- do.stripes[1] names(do.stripes) <- "ci" labelswidth <- 0 valueswidth <- 0 mat <- matrix(c(0,1,0),ncol=3) if (layout) layout(mat,width=c(leftmarginwidth,ciwidth,rightmarginwidth)) } } dimensions <- c(dimensions,list(xratio=xratio, labelswidth=labelswidth, valueswidth=valueswidth, ciwidth=ciwidth,layout=mat)) } # }}} # {{{ labels if (add==FALSE) par(mar=oldmar*c(1,0,1,0)) if (do.labels){ if (do.stripes[["labels"]]) preplabels <- c(preplabels,list(width=labelswidth,ylim=ylim,stripes=smartA$stripes)) else preplabels <- c(preplabels,list(width=labelswidth,ylim=ylim)) do.call("plotLabels",preplabels) # }}} # {{{ title underline if ((missing(title.line) || !is.null(title.line)) && ((add==FALSE) & is.infinite(smartA$title.line$x0))){ smartA$title.line$x0 <- par()$usr[1] smartA$title.line$x1 <- par()$usr[2] do.call("segments",smartA$title.line) smartA$title.line$x0 <- -Inf ## box() } } # }}} # {{{ section.titles if (do.sections){ do.call("text",smartA$section.title) } # }}} # {{{ values if (do.values){ if (do.stripes[["values"]]) prepvalues <- c(prepvalues,list(width=valueswidth,ylim=ylim,stripes=smartA$stripes)) else prepvalues <- c(prepvalues,list(width=valueswidth,ylim=ylim)) do.call("plotLabels",prepvalues) if ((missing(title.line) || !is.null(title.line)) && ((add==FALSE) & is.infinite(smartA$title.line$x0))){ smartA$title.line$x0 <- par()$usr[1] smartA$title.line$x1 <- par()$usr[2] do.call("segments",smartA$title.line) smartA$title.line$x0 <- -Inf ## box() } } # }}} # {{{ plot which contains the confidence intervals if (add==FALSE){ do.call("plot",smartA$plot) if (do.stripes[["ci"]]) do.call("stripes",smartA$stripes) if (do.xaxis==TRUE){ oldcexaxis <- par()$cex.axis on.exit(par(cex.axis=oldcexaxis)) par(cex.axis=smartA$xaxis$cex) if (is.null(smartA$xaxis$labels)) do.call("axis",smartA$xaxis) } do.call("mtext",smartA$xlab) } # }}} # {{{ ref line if (add==FALSE){ if (missing(refline) || !is.null(refline)) do.call("segments",smartA$refline) } # }}} # {{{ title underline if (add==FALSE){ if (missing(title.line) || !is.null(title.line)){ if (is.infinite(smartA$title.line$x0)){ smartA$title.line$x0 <- par()$usr[1] smartA$title.line$x1 <- par()$usr[2] } do.call("segments",smartA$title.line) } } # }}} # {{{ point estimates and confidence do.call("points",smartA$points) ## treat arrows that go beyond the x-limits if (any(smartA$arrows$x0>xlim[2],na.rm=TRUE)||any(smartA$arrows$x1xlim[2] tooHigh[is.na(tooHigh)] <- FALSE tooLow <- smartA$arrows$x0F)")), verbose=FALSE) yy <- cbind(Df=y$Df, "F statistic"= pubformat(y$"F value",handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]), "p-value"=do.call("format.pval",smartF$pvalue)) rownames(yy) <- rownames(object[[1]]) ## remove residual line yy <- yy[-NROW(yy),,drop=FALSE] if (print) publish(yy,rownames=TRUE,colnames=TRUE,col1name="Factor",...) invisible(yy) } Publish/R/plot.ci.R0000644000176200001440000000543413571203035013561 0ustar liggesusers## ------------------------------------------------------------------ ## _____ _____ ## |_ _|_ _ __ |_ _|__ __ _ _ __ ___ ## | |/ _` |/ _` || |/ _ \/ _` | '_ ` _ \ ## | | (_| | (_| || | __/ (_| | | | | | | ## |_|\__,_|\__, ||_|\___|\__,_|_| |_| |_| ## |___/ ## ------------------------------------------------------------------ ##' Function to plot confidence intervals ##' ##' Function to plot means and other point estimates with confidence ##' intervals ##' @title Plot confidence intervals ##' @param x List, data.frame or other object of this form containing point estimates (first element) and the corresponding confidence intervals as elements lower and upper. ##' @param xlim Limit of the x-axis ##' @param xlab Label for the y-axis ##' @param labels labels ##' @param ... Used to transport arguments to \code{plotConfidence}. ##' @examples ##' ##' data(Diabetes) ##' x=ci.mean(bp.2s~AgeGroups,data=Diabetes) ##' plot(x,title.labels="Age groups",xratio=c(0.4,0.3)) ##' x=ci.mean(bp.2s/500~AgeGroups+gender,data=Diabetes) ##' plot(x,xratio=c(0.4,0.2)) ##' plot(x,xratio=c(0.4,0.2), ##' labels=split(x$labels[,"AgeGroups"],x$labels[,"gender"]), ##' title.labels="Age groups") ##' \dontrun{ ##' plot(x, leftmargin=0, rightmargin=0) ##' plotConfidence(x, leftmargin=0, rightmargin=0) ##' ##' data(CiTable) ##' with(CiTable,plotConfidence(x=list(HazardRatio), ##' lower=lower, ##' upper=upper, ##' labels=CiTable[,2:6], ##' factor.reference.pos=c(1,10,19), ##' format="(u-l)", ##' points.col="blue", ##' digits=2)) ##' ##' with(CiTable,Publish::plot.ci(x=list(HazardRatio), ##' lower=lower, ##' upper=upper, ##' labels=CiTable[,2:6], ##' factor.reference.pos=c(1,10,19), ##' format="(u-l)", ##' points.col="blue", ##' digits=2, ##' leftmargin=-2, ##' title.labels.cex=1.1, ##' labels.cex=0.8,values.cex=0.8)) ##' } ##' @author Thomas A. Gerds ##' @export plot.ci <- function(x,xlim,xlab="",labels,...){ M <- x[[1]] Lower <- x$lower Upper <- x$upper if (missing(xlim)) xlim <- c(min(Lower),max(Upper)) if (missing(labels)) labels <- x$labels plotConfidence(list(x=M,lower=Lower,upper=Upper), xlim=xlim, labels=labels, xlab=xlab, ...) } Publish/R/publish.table.R0000755000176200001440000000202513571203035014741 0ustar liggesusers##' @export publish.table <- function(object,title,level,...){ if ((NM=length(dim(object)))==3){ if (missing(title)) title <- "" stopifnot(NM<=4) invisibleOut=lapply(1:(dim(object)[NM]),function(m){ newtitle=paste(title,paste(names(dimnames(object))[NM],dimnames(object)[[NM]][m],sep=":")) xm <- object[,,m] colnames(xm) <- paste(names(dimnames(object))[2],dimnames(object)[[2]],sep=":") rownames(xm) <- paste(names(dimnames(object))[1],dimnames(object)[[1]],sep=":") publish(xm,title=newtitle,level=level) }) } else{ v <- as.matrix(object) nn <- names(dimnames(v)) if (is.null(nn)) if (is.matrix(object)) nn <- paste("Var",1:2,sep=".") else nn <- "Var.1" nn[nn==""] <- paste("Var",(1:length(nn))[nn==""],sep=".") rownames <- TRUE ## if (missing(title)) title <- paste("Frequency table:",nn[1],"versus",nn[2],sep=" ") if (missing(title)) title <- "" if (missing(level)) level <- 0 publish.matrix(v,title,level=level,rownames=rownames,...) } } Publish/R/summary.regressionTable.R0000644000176200001440000001347413571203035017040 0ustar liggesusers##' Preparing regression results for publication ##' ##' @title Formatting regression tables ##' @aliases summary.regressionTable print.summary.regressionTable ##' @param object object obtained with \code{regressionTable} or \code{summary.regressionTable}. ##' @param show.missing Decide if number of missing values are shown. ##' Either logical or character. If \code{'ifany'} then number missing values are ##' shown if there are some. ##' @param print If \code{TRUE} print results. ##' @param ... Used to control formatting of parameter estimates, ##' confidence intervals and p-values. See examples. ##' @return List with two elements: ##' \itemize{ ##' \item regressionTable: the formatted regression table (a data.frame) ##' \item rawTable: table with the unformatted values (a data.frame) ##' } ##' @seealso publish.glm publish.coxph ##' @examples ##' library(survival) ##' data(pbc) ##' pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) ##' fit = coxph(Surv(time,status!=0)~age+sex+edema+log(bili)+log(albumin)+log(protime), ##' data=pbc) ##' u=summary(regressionTable(fit)) ##' u$regressionTable ##' u$rawTable ##' summary(regressionTable(fit),handler="prettyNum") ##' summary(regressionTable(fit),handler="format") ##' summary(regressionTable(fit),handler="sprintf",digits=c(2,2),pValue.stars=TRUE) ##' summary(regressionTable(fit),handler="sprintf",digits=c(2,2),pValue.stars=TRUE,ci.format="(l,u)") #' @export ##' @author Thomas A. Gerds summary.regressionTable <- function(object, show.missing="ifany", print=TRUE, ...){ pynt <- getPyntDefaults(list(...),names=list("digits"=c(2,3),"handler"="sprintf",nsmall=NULL)) digits <- pynt$digits handler <- pynt$handler if (length(digits)==1) digits <- rep(digits,2) if (length(pynt$nsmall)>0) nsmall <- pynt$nsmall else nsmall <- pynt$digits rawtab <- do.call("rbind",object) Rtab <- rawtab[,-match(c("Lower","Upper","Pvalue"),colnames(rawtab)),drop=FALSE] pvalue.defaults <- list(digits=digits[[2]], eps=10^{-digits[[2]]}, stars=FALSE) ci.defaults <- list(format="[l;u]", digits=digits[[1]], nsmall=digits[[1]], degenerated="asis") smartF <- prodlim::SmartControl(call=list(...), keys=c("ci","pvalue"), ignore=c("object","print","handler","digits","nsmall"), defaults=list("ci"=ci.defaults,"pvalue"=pvalue.defaults), forced=list("ci"=list(lower=rawtab[,"Lower"], upper=rawtab[,"Upper"], handler=handler, digits=digits[[1]], nsmall=nsmall[[1]]), "pvalue"=list(rawtab[,"Pvalue"])), verbose=FALSE) if (attr(object,"model")%in%c("Cox regression","Poisson regression")){ model <- "Cox regression" if (match("ProbIndex",colnames(Rtab),nomatch=0)){ Rtab$ProbIndex <- pubformat(Rtab$ProbIndex,handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]) } else{ Rtab$HazardRatio <- pubformat(Rtab$HazardRatio,handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]) } }else{ if (attr(object,"model")=="Logistic regression"){ model <- "Logistic regression" Rtab$OddsRatio <- pubformat(Rtab$OddsRatio,handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]) } else{ ## assume "Linear regression" model <- "Linear regression" Rtab$Coefficient <- pubformat(Rtab$Coefficient,handler=handler,digits=digits[[1]],nsmall=nsmall[[1]]) } } Rtab$CI.95 <- do.call("formatCI",smartF$ci) pp <- do.call("format.pval",smartF$pvalue) if (length(gpp <- grepl("<",pp))) pp[!gpp] <- paste0(" ",pp[!gpp]) Rtab$"p-value" <- pp if (length(smartF$pvalue$stars)>0 && smartF$pvalue$stars==TRUE) Rtab$signif <- symnum(rawtab[,"Pvalue"],corr = FALSE,na = FALSE,cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),symbols = c("***", "**", "*", ".", " ")) rownames(Rtab) <- NULL rownames(rawtab) <- NULL ## e.g., MIresults do not have a column Missing but use Imputed if (match("Missing",colnames(Rtab),nomatch=0)>0){ if (show.missing=="ifany") { show.missing <- any(!(Rtab[,"Missing"][!is.na(Rtab[,"Missing"])] %in% c("","0"))) } if (!show.missing){ Rtab <- Rtab[,-match("Missing",colnames(Rtab))] rawtab <- rawtab[,-match("Missing",colnames(rawtab))] } } ## reference lines nv <- length(Rtab$Variable) if (nv>1){ if (attr(object,"factor.reference")=="extraline"){ ppos <- match("p-value",names(Rtab)) for (r in 1:(nv-1)){ if (Rtab$Variable[r]!="" && Rtab$Variable[r+1]=="") Rtab[r,((ppos-2):ppos)] <- c("Ref","","") } } } ## cat("\nSignif. codes: 0 '***'0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1\n") ## FIXME: should filter the relevant of list(...) Rtab <- do.call(labelUnits,c(list(x=Rtab),list(...))) res <- list(regressionTable=Rtab, rawTable=rawtab, model=model, blocks=sapply(object,NROW)) class(res) <- c("summary.regressionTable") if (print) print(res) res } #' @export print.summary.regressionTable <- function(x,...){ print(x$regressionTable) invisible(x$regressionTable) } Publish/R/lazyDateCoding.R0000644000176200001440000001007713571203035015111 0ustar liggesusers##' This function eases the process of generating date variables. ##' All variables in a data.frame which match a regular expression ##' are included ##' ##' The code needs to be copy-and-pasted from the R-output ##' buffer into the R-code buffer. This can be customized ##' for the really efficiently working people, e.g., in emacs. ##' @title Efficient coding of date variables ##' @param data Data frame in which to search for date variables. ##' @param format passed to as.Date ##' @param pattern match date variables ##' @param varnames variable names ##' @param testlength how many rows of data should be evaluated to guess the format. ##' @return R-code one line for each variable. ##' @author Thomas Alexander Gerds ##' @examples ##' d <- data.frame(x0="190101",x1=c("12/8/2019"),x2="12-8-2019",x3="20190812",stringsAsFactors=FALSE) ##' lazyDateCoding(d,pattern="x") ##' lazyDateCoding(d,pattern="3") ##' ##' @export lazyDateCoding <- function(data,format,pattern,varnames,testlength=10){ if (!is.character(data)) data <- as.character(substitute(data)) d <- get(data, envir=parent.frame()) isdt <- match("data.table",class(d),nomatch=FALSE) datevars <- grep(pattern,names(d),value=TRUE) out <- lapply(datevars,function(x){ dx <- d[[x]] if (is.character(dx)){ test.x <- dx[!is.na(dx)] test.x <- test.x[1:(min(length(test.x),testlength))] ## separator separators <- c("-","/","\\|"," ") sep <- sapply(separators,grep,test.x,value=TRUE) lsep <- sapply(sep,length) if (all(lsep==0)) sep <- "" else sep <- names(sep)[lsep==max(lsep)] ## day day <- "%d" ## month m or b if (any(grepl("[:alpha:]",test.x))) month <- "%b" else month <- "%m" ## year 07 or 2007 l.x <- nchar(test.x) if (any((l.x-2*nchar(sep))<=6)) year <- "%y" else year <- "%Y" ## order test.formats <- c(paste0(day,sep,month,sep,year), paste0(day,sep,year,sep,month), paste0(year,sep,month,sep,day), paste0(year,sep,day,sep,month), paste0(month,sep,year,sep,day), paste0(month,sep,day,sep,year)) if (sep!=""){ list.x <- strsplit(test.x,sep) Y <- match(4,nchar(list.x[[1]]),nomatch=0) if (Y>0) year <- "%Y" test.formats <- switch(as.character(Y), "3"={c(paste0(day,sep,month,sep,year), paste0(month,sep,day,sep,year))}, "1"={c(paste0(year,sep,month,sep,day), paste0(year,sep,day,sep,month))}, "2"={c(paste0(month,sep,year,sep,day), paste0(day,sep,year,sep,month))}, {test.formats}) } ## print(test.formats) nix <- try(this.x <- as.Date(test.x[[1]],format=test.formats)) if ((class(nix)[[1]]=="try-error") || all(is.na(this.x))){ format.x <- "dontknow" }else{ format.x <- test.formats[!is.na(this.x)] if (length(format.x)>1){ # multiple matches winner <- sapply(format.x,function(fx){sum(!is.na(as.Date(test.x,format=fx)))}) format.x <- format.x[winner==max(winner)][1] } } if (isdt){ paste0(data,"[",",",x,":=as.Date(",x,",format=\"",format.x,"\")]\n") }else{ obj.x <- paste(data,"$",x,sep="") paste(obj.x," <- as.Date(",obj.x,",format=c(\"",format.x,"\")\n",sep="") } }else{ NULL }}) out <- out[!sapply(out,is.null)] sapply(unlist(out),cat) invisible(out) } Publish/R/regressionTable.R0000644000176200001440000004577013761464754015372 0ustar liggesusers##' Tabulate the results of a regression analysis. ##' ##' The basic use of this function is to generate a near publication worthy table from a regression ##' object. As with summary(object) reference levels of factor variables are not included. Expansion ##' of the table with such values can be performed using the "fixRegressionTable" function. Forest ##' plot can be added to the output with "plotRegressionTable". ##' ##' regressionTable produces an object (list) with the parameters deriveds. The summary function creates ##' a data frame which can be used as a (near) publication ready table. ##' ##' The table shows changes in mean for linear regression, odds ratios ##' for logistic regression (family = binomial) and hazard ratios for ##' Cox regression. ##' @title Regression table ##' @param object Fitted regression model obtained with \code{lm}, ##' \code{glm} or \code{coxph}. ##' @param param.method Method to obtain model coefficients. ##' @param confint.method Method to obtain confidence ##' intervals. Default is 'default' which leads to Wald ##' type intervals using the model based estimate of standard ##' error. 'profile' yields profile likelihood confidence ##' intervals, available from library MASS for \code{lm} and ##' \code{glm} objects. 'robust' uses the sandwich form ##' standard error to construct Wald type intervals (see ##' \code{lava::estimate.default}). 'simultaneous' calls ##' \code{multcomp::glht} to obtain simultaneous confidence ##' intervals. ##' @param pvalue.method Method to obtain p-values. If ##' \code{'default'} show raw p-values. If \code{'robust'} use ##' p-value corresponding to robust standard error as provided by ##' \code{lava::estimate.default}. If \code{'simultaneous'} call ##' \code{multcomp::glht} to obtain p-values. ##' @param factor.reference Style for showing results for categorical ##' variables. If \code{'extraline'} show an additional line for ##' the reference category. If \code{'inline'} display as level ##' vs. reference. ##' @param intercept Logical. If \code{FALSE} suppress intercept. ##' @param units List of units for continuous variables. See examples. ##' @param noterms Position of terms that should be ignored. E.g., for ##' a Cox model with a cluster(id) term, there will be no hazard ##' ratio for variable id. ##' @param probindex Logical. If \code{TRUE} show coefficients on probabilistic index scale instead of hazard ratio scale. ##' @param ... Not yet used ##' @return List of regression blocks ##' @examples ##' # linear regression ##' data(Diabetes) ##' f1 <- glm(bp.1s~age+gender+frame+chol,data=Diabetes) ##' summary(regressionTable(f1)) ##' summary(regressionTable(f1,units=list("chol"="mmol/L","age"="years"))) ##' ## with interaction ##' f2 <- glm(bp.1s~age*gender+frame+chol,data=Diabetes) ##' summary(regressionTable(f2)) ##' #Add reference values ##' summary(regressionTable(f2)) ##' f3 <- glm(bp.1s~age+gender*frame+chol,data=Diabetes) ##' publish(f3) ##' regressionTable(f3) ##' ##' # logistic regression ##' Diabetes$hyp1 <- factor(1*(Diabetes$bp.1s>140)) ##' l1 <- glm(hyp1~age+gender+frame+chol,data=Diabetes,family="binomial") ##' regressionTable(l1) ##' publish(l1) ##' plot(regressionTable(l1)) ##' ##' ## with interaction ##' l2 <- glm(hyp1~age+gender+frame*chol,data=Diabetes,family="binomial") ##' regressionTable(l2) ##' l3 <- glm(hyp1~age*gender+frame*chol,data=Diabetes,family="binomial") ##' regressionTable(l3) ##' ##' # Cox regression ##' library(survival) ##' data(pbc) ##' pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) ##' c1 <- coxph(Surv(time,status!=0)~log(bili)+age+protime+sex+edema,data=pbc) ##' regressionTable(c1) ##' # with interaction ##' c2 <- coxph(Surv(time,status!=0)~log(bili)+age+protime*sex+edema,data=pbc) ##' regressionTable(c2) ##' c3 <- coxph(Surv(time,status!=0)~edema*log(bili)+age+protime+sex+edema+edema:sex,data=pbc) ##' regressionTable(c3) ##' ##' ##' if (requireNamespace("nlme",quietly=TRUE)){ ##' ## gls regression ##' library(lava) ##' library(nlme) ##' m <- lvm(Y ~ X1 + gender + group + Interaction) ##' distribution(m, ~gender) <- binomial.lvm() ##' distribution(m, ~group) <- binomial.lvm(size = 2) ##' constrain(m, Interaction ~ gender + group) <- function(x){x[,1]*x[,2]} ##' d <- sim(m, 1e2) ##' d$gender <- factor(d$gender, labels = letters[1:2]) ##' d$group <- factor(d$group) ##' ##' e.gls <- gls(Y ~ X1 + gender*group, data = d, ##' weights = varIdent(form = ~1|group)) ##' regressionTable(e.gls) ##' summary(regressionTable(e.gls)) ##' } ##' @export ##' @author Thomas A. Gerds regressionTable <- function(object, param.method="coef", confint.method=c("default","profile","robust","simultaneous"), pvalue.method=c("default","robust","simultaneous"), factor.reference="extraline", intercept=0L, units=NULL, noterms=NULL, probindex=0L, ...){ # {{{ model type if("lme" %in% class(object)){ param.method <- "fixef" if(confint.method[1] == "default"){ confint.method <- "profile" } } if (is.character(object$family)){ logisticRegression <- (object$family=="binomial") poissonRegression <- (object$family=="poisson") } else{ logisticRegression <- (!is.null(object$family$family) && object$family$family=="binomial") poissonRegression <- (!is.null(object$family$family) && object$family$family=="poisson") } coxRegression <- any(match(class(object),c("coxph","cph"),nomatch=0)) # }}} # {{{ intercept if (any(c("lm","gls") %in% class(object))) if (names(coef(object))[1]!="(Intercept)") stop("This function works only for models that have an Intercept.\nI.e., you should reformulate without the `~-1' term.") # }}} # {{{ parse terms formula <- try(formula(object), silent = TRUE) if("formula" %in% class(formula) == FALSE){ if (!is.null(object$formula)){ formula <- object$formula }else if (is.null(object$terms)){ if (class(object$call$formula)[[1]]=="name"){ stop("Cannot extract the formula from object") } else{ formula <- object$call$formula } } } if (is.null(data <- object$model)){ if (is.null(object$data)) data <- eval(object$call$data,envir=parent.frame()) else data <- object$data } if (is.null(units)) units <- attr(data,"units") else{ units <- c(units,attr(data,"units")) units <- units[unique(names(units))] } terms <- terms(formula) termlabels <- attr(terms,"term.labels") termorder <- attr(terms,"order") if (length(noterms)>0 & all(noterms>0)){ termlabels <- termlabels[-noterms] termorder <- termorder[-noterms] } terms1 <- termlabels[termorder==1] ## remove strata terms if (any(class(object) %in% c("coxph")) && length(strata.pos <- grep("^strata\\(",terms1))>0){ terms1 <- terms1[-strata.pos] } # }}} # {{{ types of variables/terms coef <- do.call(param.method, args = list(object)) termnames <- names(coef) if("xlevels" %in% names(object)){ factorlevels <- object$xlevels }else if("contrasts" %in% names(object)){ # for gls factorlevels <- lapply(object$contrasts, rownames) }else{ factorlevels <- NULL } ## for some reason logical value variables, ie with levels ## TRUE, FALSE do not get xlevels in the output of glm islogical <- grep("TRUE$",termnames,value=TRUE) if (length(islogical)>0){ logicalnames <- lapply(islogical,function(l){ substring(l,1,nchar(l)-4) }) names(logicalnames) <- logicalnames factorlevels <- c(factorlevels, lapply(logicalnames,function(l){c("FALSE","TRUE")})) } factornames <- names(factorlevels) ## for some reason ordinal variables get strange labels isordered <- sapply(factornames,function(x){length(grep(paste0(x,".L"),termnames,fixed=TRUE,value=FALSE))>0}) if (length(isordered)>0){ orderednames <- factornames[isordered] }else{ orderednames <- "" } # }}} # {{{ interactions terms2 <- parseInteractionTerms(terms,factorlevels) ## remove these variabeles from terms1 because main effects have no interpretation ## when there interactions terms1 <- setdiff(terms1,unlist(lapply(terms2,attr,"variables"))) vars2 <- unique(unlist(lapply(terms2,function(x)attr(x,"variables")))) if (length(isordered)>0 && length(terms2)>0 && any(hit <- match(vars2,sapply(isordered,function(x)substr(x,0,nchar(x)-2)),nomatch=0))) stop(paste0("Cannot (not yet) handle interaction terms which involve ordered factors.\nOffending term(s): ", sapply(isordered,function(x)substr(x,0,nchar(x)-2))[hit])) # }}} # {{{ confidence intervals confint.method <- match.arg(confint.method, choices=c("default","profile","robust","simultaneous"), several.ok=FALSE) if (confint.method=="robust") { lava.mat <- lava::estimate(object,robust=TRUE)$coefmat } if (is.function(confint.method)){ ci <- do.call(confint.method,list(object)) }else{ ci <- switch(confint.method, "default"={stats::confint.default(object)}, "profile"={ ## FIXME: what happens if profile method does not exist for this object? suppressMessages(confint(object))}, "robust"={ pvalue.method <- "robust" lava.mat[,c("2.5%","97.5%"),drop=FALSE]}, "simultaneous"={ pvalue.method <- "simultaneous" confint(multcomp::glht(object))$confint[,c("lwr","upr"),drop=FALSE] }, stop(paste("Sorry, don't know this confidence interval method:",confint.method))) } # }}} # {{{ p-values if (is.function(pvalue.method)){ pval <- do.call(pvalue.method,list(object)) }else{ pvalue.method <- match.arg(pvalue.method, choices=c("default","robust","simultaneous"), several.ok=FALSE) pval <- switch(pvalue.method, "default"={ sumcoef <- coef(summary(object)) sumcoef[,NCOL(sumcoef),drop=FALSE] }, ## "lrt"={ ## drop1(object,test="Chisq")[,"Pr(>Chi)",drop=TRUE] ## }, "robust"={ lava.mat[,c("P-value"),drop=FALSE] }, "simultaneous"={ summary(multcomp::glht(object))[,c("Pr(>|z|"),drop=TRUE] },stop(paste("Sorry, don't know this pvalue method:",pvalue.method))) } ## omnibus <- drop1(object,test="Chisq")[,"Pr(>Chi)",drop=TRUE] # }}} # {{{intercept if (intercept!=0){ terms1 <- c("(Intercept)",terms1) } # }}} # {{{ blocks level 1 ## reference.value <- ifelse((logisticRegression+coxRegression==0),0,1) reference.value <- 0 blocks1 <- lapply(terms1,function(vn){ isfactor <- match(vn,factornames,nomatch=0) isordered <- match(vn,orderednames,nomatch=0) ## catch the coefficients corresponding to term vn candidates <- grep(vn,termnames,fixed=TRUE,value=TRUE) # {{{ missing values ## number of missing values misscall <- paste0("sum(is.na(",vn,"))") if (vn=="Intercept"||vn=="(Intercept)") Missing <- "" else Missing <- try(eval(parse(text=misscall),data),silent=TRUE) if (class(Missing)[1]=="try-error") Missing <- NA # }}} if (isfactor){ vn.levels <- factorlevels[[isfactor]][-1] if (isordered){ suffix <- c(".L",".Q",".C",paste0("^",4:30))[1:length(vn.levels)] vn.regexp <- paste0(vn,suffix) parms <- termnames[match(vn.regexp,termnames,nomatch=0)] if(length(parms)!=length(vn.levels)) stop(paste0("Cannot identify terms corresponding to variable ",vn,".")) }else{ vn.regexp <- paste0(vn,vn.levels,sep="") parms <- termnames[match(vn.regexp,termnames,nomatch=0)] if (length(parms)!=length(vn.levels)){ vn.regexp <- paste0(vn,vn.levels,sep=":") parms <- termnames[match(vn.regexp,termnames,nomatch=0)] } if (length(parms)!=length(vn.levels)){ vn.regexp <- paste0(vn,vn.levels,sep=".") parms <- termnames[match(vn.regexp,termnames,nomatch=0)] } if (length(parms)!=length(vn.levels)) stop(paste0("Cannot identify terms corresponding to variable ",vn,".")) ## vn.regexp <- paste("^",vn,levs.regexp,"$","|","I\\(",vn,".*",levs.regexp,"|",vn,"\\)",".*",levs.regexp,sep="") } } else{ ## continuous variables may be enclosed by \log or \sqrt or similar ## protect special characters vn.protect <- sub("(","\\(",vn,fixed=TRUE) vn.protect <- sub(")","\\)",vn.protect,fixed=TRUE) vn.regexp <- paste("^",vn.protect,"$",sep="") parms <- grep(vn.regexp,termnames,fixed=FALSE) } coef.vn <- coef[parms] ci.vn <- ci[parms,,drop=FALSE] if (is.matrix(pval)) p.vn <- pval[parms,,drop=TRUE] else{ p.vn <- pval[parms] } # {{{ factor variables varname <- vn if (isfactor){ if (factor.reference=="inline"){ Variable <- c(vn,rep("",NROW(coef.vn)-1)) Units <- paste(factorlevels[[isfactor]][-1], "vs", factorlevels[[isfactor]][1]) Missing <- c(Missing,rep("",length(coef.vn)-1)) } else { Variable <- c(vn,rep("",length(coef.vn))) Units <- factorlevels[[isfactor]] Missing <- c(Missing,rep("",length(coef.vn))) coef.vn <- c(reference.value,coef.vn) ci.vn <- rbind(c(reference.value,reference.value),ci.vn) p.vn <- c(1,p.vn) } } else{ # }}} # {{{ numeric variables Variable <- vn if (!is.null(units[[varname]])) Units <- units[[varname]] else Units <- "" } block <- data.frame(Variable=Variable, Units=Units, Missing=as.character(Missing), Coefficient=coef.vn, Lower=ci.vn[,1], Upper=ci.vn[,2], Pvalue=as.vector(p.vn), stringsAsFactors=FALSE) if (any(class(object)%in%"MIresult")) colnames(block)[3] <- paste0("Imputed (",object$nimp,")") rownames(block) <- NULL block }) # }}} # }}} # {{{ blocks level 2 if (length(terms2)>0){ blocks2 <- lapply(terms2,function(t2){ vars <- attr(t2,"variables") # {{{ missing values ## number of missing values misscall <- paste0(paste0("sum(is.na(",vars,"))"),collapse="+") Missing <- try(eval(parse(text=misscall),data)) if (class(Missing)[1]=="try-error") Missing <- NA # }}} block <- try(data.frame(lava::estimate(object, f=function(p)lapply(t2,eval,envir=sys.parent(-1)), coef = coef, robust=confint.method=="robust")$coefmat), silent = TRUE) if(("try-error" %in% class(block)) == FALSE){ colnames(block) <- c("Coefficient","StandardError","Lower","Upper","Pvalue") block <- data.frame(Variable=attr(t2,"names"), Units="", Missing=Missing, block[,-2]) }else{ block <- data.frame(Variable=attr(t2,"names"), Units="", Missing=Missing, Coefficient=NA, Lower = NA, Upper = NA, Pvalue = NA) } rownames(block) <- NULL if (any("MIresult" %in% class(object))) colnames(block)[3] <- paste0("Imputed (",object$nimp,")") block }) names(blocks2) <- names(terms2) } # }}} # {{{ formatting names(blocks1) <- terms1 out <- blocks1 if (length(terms2)>0) out <- c(out,blocks2) if (logisticRegression) out <- lapply(out,function(x){ colnames(x) <- sub("Coefficient","OddsRatio",colnames(x)) x$OddsRatio <- exp(x$OddsRatio) x$Lower <- exp(x$Lower) x$Upper <- exp(x$Upper) x }) if (coxRegression | poissonRegression) out <- lapply(out,function(x){ if (probindex){ colnames(x) <- sub("Coefficient","ProbIndex",colnames(x)) x$ProbIndex <- 100/(1+exp(x$ProbIndex)) tmp <- 100/(1+exp(x$Upper)) x$Upper <- 100/(1+exp(x$Lower)) x$Lower <- tmp rm(tmp) x }else{ colnames(x) <- sub("Coefficient","HazardRatio",colnames(x)) x$HazardRatio <- exp(x$HazardRatio) x$Lower <- exp(x$Lower) x$Upper <- exp(x$Upper) x } }) attr(out,"terms1") <- terms1 attr(out,"terms2") <- terms2 attr(out,"factornames") <- factornames attr(out,"factor.reference") <- factor.reference attr(out,"orderednames") <- orderednames attr(out,"model") <- switch(as.character(logisticRegression+2*coxRegression+3*poissonRegression), "1"="Logistic regression", "2"="Cox regression", "3"="Poisson regression", "Linear regression") out <- out[] class(out) <- "regressionTable" out # }}} } confint.lme <- function(object, parm, level = 0.95, ...){ res <- nlme::intervals(object, level = level, ...) out <- cbind(res$fixed[,"lower"],res$fixed[,"upper"]) colnames(out) <- c("2.5 %","97.5 %") return(out) } Publish/R/parseFrequencyFormat.R0000744000176200001440000000160313571203035016351 0ustar liggesusersparseFrequencyFormat <- function(format,digits){ tmp <- strsplit(format,"[ \t]+|[^ \t]*=|[^ \t]*:|[^ \t]*-|[^ \t]*\\+|\\(|\\{|\\[|\\)",perl=TRUE)[[1]] stats <- tmp[grep("^x$",tmp)-1] for(s in 1:length(stats)){ subs <- switch(stats[s], "count"="%s", "total"="%s", "percent"="%s", #paste("%1.",digits,"f",sep=""), "colpercent"="%s", #paste("%1.",digits,"f",sep=""), stop(paste("Cannot parse function ", stats[s], ". ", "Can only parse count, total and compute percentages for categorical variables", sep=""))) format <- gsub(paste(stats[s],"(x)",sep=""),subs,format,fixed=TRUE) } list(format=format,stats=stats) } Publish/R/ci.mean.default.R0000755000176200001440000000275213571203035015151 0ustar liggesusers##' Compute mean values with confidence intervals ##' ##' Normal approximation ##' @title Compute mean values with confidence intervals #' @param x numeric vector #' @param alpha level of significance #' @param normal If \code{TRUE} use quantile of t-distribution else use normal approximation and quantile of normal approximation. Do you think this is confusing? #' @param na.rm If \code{TRUE} remove missing values from \code{x}. #' @param statistic Decide which mean to compute: either \code{"arithmetic"} or \code{"geometric"} #' @param ... not used ##' @return a list with mean values and confidence limits ##' @author Thomas Gerds #' @export ci.mean.default <- function(x, alpha = 0.05, normal = TRUE, na.rm=TRUE, statistic="arithmetic",...){ stat <- match.arg(statistic,c("arithmetic","geometric")) if (na.rm){x <- x[!is.na(x)]} if (stat=="geometric") x <- log(x) n <- length(x) m <- mean(x) se <- sqrt(var(x)/n) df <- n - 1 if(normal) { q <- qt(1 - alpha/2, df) } else { q <- qnorm(1 - alpha/2) } low <- m - se * q up <- m + se * q if (stat=="geometric") out <- list(geomean = exp(m), se = exp(se),lower = exp(low), upper = exp(up), level=alpha, statistic=stat) else out <- list(mean = m, se = se,lower = low, upper = up, level=alpha, statistic=stat) class(out) <- c("ci",class(out)) out } Publish/R/publish.riskReclassification.R0000644000176200001440000000405113571203035020023 0ustar liggesusers### publish.riskReclassification.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Dec 10 2015 (10:06) ## Version: ## last-updated: Oct 22 2017 (12:55) ## By: Thomas Alexander Gerds ## Update #: 8 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: publish.riskReclassification <- function(x,percent=TRUE,digits=ifelse(percent,1,2),...){ cat("Observed overall re-classification table:\n\n") dnames <- dimnames(x$reclassification) cat(names(dnames)[1]," versus ", names(dnames)[2],"\n") publish(x$reclassification,...) cat("\nExpected re-classification probabilities (%) among subjects with event until time ",x$time,"\n\n",sep="") fmt <- paste0("%1.", digits[[1]], "f") dim <- dim(x$reclassification) if (percent==TRUE){ rlist <- lapply(x$event.reclassification,function(x){ matrix(sprintf(fmt=fmt,100*c(x)),nrow=dim[1],ncol=dim[2],dimnames=dnames) }) }else{ rlist <- lapply(x$event.reclassification,function(x){ matrix(sprintf(fmt=fmt,c(x)),nrow=dim[1],ncol=dim[2],dimnames=dnames) }) } if (x$model=="competing.risks"){ for (x in 1:(length(rlist)-1)){ cat("\n",names(rlist)[x],":\n",sep="") publish(rlist[[x]],quote=FALSE,...) } } else{ cat("\n",names(rlist)[1],":\n",sep="") publish(rlist[[1]],quote=FALSE,...) } cat("\nExpected re-classification probabilities (%) among subjects event-free until time ",x$time,"\n\n",sep="") cat("\n",names(rlist)[length(rlist)],":\n",sep="") publish(rlist[[length(rlist)]],quote=FALSE,...) ## print.listof(rlist[length(rlist)],quote=FALSE) } #---------------------------------------------------------------------- ### publish.riskReclassification.R ends here Publish/R/print.univariateTable.R0000744000176200001440000000100013571203035016445 0ustar liggesusers##' Print function for univariate tables ##' ##' This function is simply calling \code{summary.univariateTable} ##' @title Printing univariate tables ##' @param x An object obtained with \code{univariateTable} ##' @param ... Passed to summary.univariateTable ##' @return The result of \code{summary.univariateTable(x)} ##' @seealso \code{univariateTable} ##' @export ##' @author Thomas A. Gerds print.univariateTable <- function(x,...){ sx <- summary(x,...) print(sx) invisible(sx) } Publish/R/publish.ci.R0000644000176200001440000000317113571203035014245 0ustar liggesusers### publish.ci.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Oct 29 2015 (06:41) ## Version: ## last-updated: Dec 17 2015 (09:23) ## By: Thomas Alexander Gerds ## Update #: 5 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Publish tables with confidence intervals ##' ##' This function calls summary.ci with print=FALSE and then publish ##' @title Publish tables with confidence intervals ##' @param object Object of class ci containing point estimates and the ##' corresponding confidence intervals ##' @param format A string which indicates the format used for ##' confidence intervals. The string is passed to ##' \code{\link{formatCI}} with two arguments: the lower and the upper ##' limit. For example \code{'(l;u)'} yields confidence intervals with ##' round parenthesis in which the upper and the lower limits are ##' separated by semicolon. ##' @param se If \code{TRUE} add standard error. ##' @param ... passed to \code{publish} ##' @return table with confidence intervals ##' @seealso summary.ci ##' @examples ##' ##' data(Diabetes) ##' publish(ci.mean(chol~location+gender,data=Diabetes),org=TRUE) ##' ##' @export ##' @author Thomas A. Gerds publish.ci <- function(object,format="[u;l]",se=FALSE,...){ publish(summary(object,se=se,format=format,print=FALSE),...) } #---------------------------------------------------------------------- ### publish.ci.R ends here Publish/R/print.ci.R0000755000176200001440000000157013571203035013737 0ustar liggesusers##' Print confidence intervals ##' ##' This format of the confidence intervals is user-manipulable. ##' @title Print confidence intervals ##' @param x Object containing point estimates and the corresponding ##' confidence intervals ##' @param se If \code{TRUE} add the standard error. ##' @param print Logical: if \code{FALSE} do not actually print ##' confidence intervals but just return them invisibly. ##' @param ... passed to summary.ci ##' @return A string: the formatted confidence intervals ##' @seealso ci plot.ci formatCI summary.ci ##' @examples ##' library(lava) ##' m <- lvm(Y~X) ##' m <- categorical(m,Y~X,K=4) ##' set.seed(4) ##' d <- sim(m,24) ##' ci.mean(Y~X,data=d) ##' x <- ci.mean(Y~X,data=d) ##' print(x,format="(l,u)") ##' @export ##' @author Thomas A. Gerds print.ci <- function(x,se=FALSE,print=TRUE,...){ summary(x,se=se,print=print,...) } Publish/R/getFrequency.R0000744000176200001440000001170113571203035014645 0ustar liggesusersgetFrequency <- function(matrix, varnames, groupvar, groups, labels, stats, format,digits,big.mark=","){ totals <- vector(NCOL(matrix),mode="list") xlevels <- vector(NCOL(matrix),mode="list") names(totals) <- varnames groupfreq <- vector(NCOL(matrix),mode="list") names(groupfreq) <- varnames for (v in varnames){ vv <- matrix[,v,drop=FALSE] missing.v <- is.na(vv) if (is.factor(vv[[1]])) vvv <- factor(vv[!missing.v],levels=levels(vv[[1]])) else vvv <- factor(vv[!missing.v],levels=unique(vv[[1]])) xlevels[[v]] <- levels(vvv) ggg <- factor(groupvar[!missing.v], levels=levels(groupvar)) ## totals tab.v <- table(vvv) total.v <- sum(tab.v) s.tab.v <- sum(tab.v) if ("colpercent" %in% stats) perc.v <- (100*tab.v/s.tab.v) else perc.v <- rep(100,length(names(tab.v))) ## avoid NA when 0/0 perc.v[s.tab.v==0] <- 0 # format percent perc.v <- lapply(perc.v,function(p){ sprintf(fmt=paste("%1.",digits,"f",sep=""),p) }) totals[[v]] <- sapply(1:length(perc.v),function(i){ values <- list(tab.v[i],total.v,perc.v[i]) if ("colpercent" %in% stats) names(values) <- c("count","total","colpercent") else names(values) <- c("count","total","percent") if (big.mark!="") values[["count"]] <- format(values[["count"]],big.mark=big.mark,scientific=FALSE) do.call("sprintf",c(format,values[stats])) }) ## ## groups ## if (!is.null(groupvar) && !missing(groupvar) && length(groupvar)==NROW(matrix)){ tables <- lapply(split(ggg,vvv),function(x){ xtab <- data.frame(table(factor(x,levels=groups))) if (match("percent",stats,nomatch=FALSE)){ xtab$Percent <- 100*xtab$Freq/sum(xtab$Freq) ## avoid NA when 0/0 xtab$Percent[xtab$Freq==0] <- 0 # format percent xtab$Percent <- sprintf(fmt=paste("%1.",digits,"f",sep=""),xtab$Percent) } tab.out <- lapply(1:NROW(xtab),function(row){ values <- xtab[row,-1] if (match("colpercent",stats,nomatch=FALSE)){ values } else{ vals <- as.list(unlist(values)) if (pos.count <- match("count",stats,nomatch=FALSE)){ if (big.mark!="") vals[[pos.count]] <- format(vals[[pos.count]],big.mark=big.mark,scientific=FALSE) if (pos.count==1) do.call("sprintf",c(format,vals)) else # pos.count==2 do.call("sprintf",c(format,rev(vals))) }else{ ## only percent do.call("sprintf",c(format,vals["Percent"])) } } }) names(tab.out) <- labels unlist(tab.out) }) groupfreq[[v]] <- do.call("rbind",tables) if (match("colpercent",stats,nomatch=FALSE)){ groupfreq[[v]] <- apply(groupfreq[[v]],2,function(x){ val <- as.numeric(x) colp <- 100*val/sum(val) ## avoid NA when 0/0 colp[sum(val)==0] <- 0 # format percent colp <- sprintf(fmt=paste("%1.",digits,"f",sep=""),colp) if (pos.count <- match("count",stats,nomatch=FALSE)){ if (big.mark!="") val[[pos.count]] <- format(val[[pos.count]],big.mark=big.mark,scientific=FALSE) sapply(1:length(val),function(i){ if (pos.count==1) do.call("sprintf",c(format,as.list(c(val[i],colp[i])))) else # pos.count==2 do.call("sprintf",c(format,as.list(c(colp[i],val[i])))) }) }else{ ## show colpercent without count sapply(1:length(val),function(i){ do.call("sprintf",c(format,as.list(colp[i]))) }) } }) ## for "variables" with only one level if (length(tables)==1){ groupfreq[[v]] <- matrix(groupfreq[[v]],ncol=length(tables[[1]])) colnames(groupfreq[[v]]) <- names(tables[[1]]) } } } } list(totals=totals,groupfreq=groupfreq,xlevels=xlevels) } Publish/R/sutable.R0000644000176200001440000000326113571203035013644 0ustar liggesusers### sutable.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Nov 28 2015 (08:40) ## Version: ## last-updated: Oct 22 2017 (12:57) ## By: Thomas Alexander Gerds ## Update #: 7 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ## the sutable first calls utable and then summary ##' First apply univariateTable then call summary. ##' ##' @title Fast summary of a univariate table ##' @param ... Unnamed arguments and are passed to \code{univariateTable} as well as named arguments ##' that match \code{univariateTable}'s arguments, other arguments ##' are passed to \code{summary.univariateTable} ##' @return Summary table ##' @seealso summary.univariateTable univariateTable ##' @examples ##' data(Diabetes) ##' sutable(gender~age+location+Q(BMI)+height+weight,data=Diabetes,BMI="Body mass index (kg/m^2)") ##' @export ##' @author Thomas A. Gerds sutable <- function(...){ args <- list(...) unames <- c("formula","data","summary.format","Q.format","freq.format","column.percent","digits","strataIsOutcome","short.groupnames","na.rm") ## no name arguments go into utable uargs <- args[names(args)==""] args <- args[names(args)!=""] test.args <- match(names(args),unames,nomatch=0) sargs <- args[test.args==0] uargs <- c(uargs,args[test.args!=0]) do.call(summary,c(list(object=do.call(univariateTable,uargs)),sargs)) } #---------------------------------------------------------------------- ### sutable.R ends here Publish/R/labelUnits.R0000744000176200001440000000466713571203035014323 0ustar liggesusers##' Label output tables ##' ##' Modify labels and values of variables in summary tables ##' @title labelUnits ##' @param x A matrix obtained with \code{univariateTable}. ##' @param ... not used ##' @return The re-labeled matrix ##' @seealso univariateTable ##' @examples ##' ##' data(Diabetes) ##' tab <- summary(univariateTable(gender~AgeGroups+chol+waist,data=Diabetes)) ##' publish(tab) ##' ltab <- labelUnits(tab,"chol"="Cholesterol (mg/dL)","<40"="younger than 40") ##' publish(ltab) ##' ##' ## pass labels immediately to utable ##' utable(gender~AgeGroups+chol+waist,data=Diabetes, ##' "chol"="Cholesterol (mg/dL)","<40"="younger than 40") ##' ##' ## sometimes useful to state explicitly which variables value ##' ## should be re-labelled ##' utable(gender~AgeGroups+chol+waist,data=Diabetes, ##' "chol"="Cholesterol (mg/dL)","AgeGroups.<40"="younger than 40") ##' @export ##' @author Thomas A. Gerds labelUnits <- function(x,...){ ## stopifnot(match("summary.univariateTable",class(x),nomatch=0)>0) x units <- prodlim::SmartControl(list(...), keys=c("units",unique(x$Variable[x$Variable!=""])), defaults=NULL, ignore.case=TRUE, replaceDefaults=TRUE, verbose=FALSE) lunits <- sapply(units,length) units <- units[lunits>0] ulvar <- grep("Level|Unit",names(x),value=TRUE) ## factor specific units if (length(units)>0){ for (i in 1:length(units)){ uat <- grep(names(units)[i],x$Variable) lat <- match(names(units[[i]]),x[[ulvar]][uat:length(x$Variable)],nomatch=FALSE) lat <- lat[lat!=0] vals <- unlist(units[[i]]) vals <- vals[lat!=0] x[[ulvar]][uat -1 + lat] <- vals } } ## labels for variables labels <- list(...) if (length(labels)>0){ keys <- names(labels) Flabels <- labels[match(keys,x$Variable,nomatch=0)!=0] x$Variable[match(keys,x$Variable,nomatch=0)] <- unlist(Flabels) Funits <- labels[match(keys,x[[ulvar]],nomatch=0)!=0] for (f in names(Funits)){ x[[ulvar]][x[[ulvar]]%in%f] <- Funits[[f]] } ## now flatten lists. otherwise ## write.csv will complain x$Variable <- unlist(x$Variable) x[[ulvar]] <- unlist(x[[ulvar]]) } x } Publish/R/Spaghettiogram.R0000644000176200001440000001565113774620003015174 0ustar liggesusers# {{{ header ##' A spaghettiogram is showing repeated measures (longitudinal data) ##' ##' ##' @title Spaghettiogram ##' @aliases spaghettiogram Spaghettiogram ##' @param formula A formula which specifies the variables for the ##' spaghettiograms. If Y ~ X + id(Z) then for each value of Z the ##' spaghettiogram is the graph (X,Y) in the subset defined by the ##' value of Z. Data are expected to be in the "long" format. Y is ##' a numeric vector and X is a factor whose levels define the X-axis. ##' Each level of the id-vector corresponds to ##' one line (spaghetti) in the plot. ##' ##' @param data data set in which variables X, Y and Z are defined. ##' @param xlim Limits for x-axis ##' @param ylim Limits for y-axis ##' @param xlab Label for x-axis ##' @param ylab Label for x-axis ##' @param axes Logical indicating if axes should be drawn. ##' @param col Colors for the spaghettiograms ##' @param lwd Widths for the spaghettiograms ##' @param lty Type for the spaghettiograms ##' @param pch Point-type for the spaghettiograms ##' @param legend If \code{TRUE} add a legend. Argument A of legend is ##' controlled as legend.A. E.g., when \code{legend.cex=2} legend will ##' be called with argument cex=2. ##' @param add If \code{TRUE} add to existing plot device. ##' @param background Control the background color of the graph. ##' @param ... used to transport arguments which are passed to the ##' following subroutines: \code{"plot"}, \code{"lines"}, ##' \code{"legend"}, \code{"background"}, \code{"axis1"}, ##' \code{"axis2"}. ##' @return List with data of each subject ##' @examples ##' ##' data(SpaceT) ##' Spaghettiogram(HR~Status+id(ID), ##' data=SpaceT) ##' @export spaghettiogram <- function(formula, data, xlim, ylim, xlab="", ylab="", axes=TRUE, col, lwd, lty, pch, legend=FALSE, add=FALSE, background=TRUE, ...){ # {{{ read formula and split data cl <- match.call(expand.dots=TRUE) sf <- specialFrame(formula, data, unspecials.design=FALSE, specials=c("id"), strip.specials=c("id"), specials.factor=TRUE, specials.design=FALSE, drop.intercept=TRUE) ## sf <- specialFrame(cl, ## special="id", ## specials.factor=TRUE, ## drop.intercept=TRUE) ## if (NCOL(X)!=1||NCOL(Y)!=1||NCOL(Y)!=1) stop("Can only handle one x-variable, one y-variable and one z-variable, formula must have the form: y~ x + id(z) where\ny is a measurement\nx tells when the measurement was taken\nand z identifies repeated measurements of the same subject. ") X <- sf$design[[1]] Y <- sf$response[[1]] if (missing(ylab)) ylab <- names(sf$response)[1] Z <- sf$id[[1]] if (!is.numeric(Y)) { if (is.factor(Y)){ ylevs <- levels(Y) Y <- as.numeric(Y) } else{ Y <- factor(Y) ylevs <- levels(Y) Y <- as.numeric(Y) } }else{ ylevs <- NULL } if (is.numeric(X)){ xat <- sort(unique(X)) xlevs <- as.character(xat) }else{ if (!is.factor(X)) X <- factor(X) xlevs <- levels(X) ## now values are 1= xlev[1], 2= xlev[2], etc. X <- as.numeric(X) xat <- sort(unique(X)) } XY <- data.frame(cbind(X=X,Y=Y)) ## names(XY) <- c("X","Y") object <- split(XY,Z) # }}} # {{{ resolve line type and color nlines <- length(object) if (missing(xlim)) xlim <- range(xat) if (missing(ylim)) ylim <- range(Y) if (missing(lwd)) lwd <- rep(3,nlines) if (missing(col)) col <- 1:nlines if (missing(lty)) lty <- rep(1, nlines) if (missing(pch)) pch <- rep(1, nlines) if (length(lwd) < nlines) lwd <- rep(lwd, nlines) if (length(lty) < nlines) lty <- rep(lty, nlines) if (length(col) < nlines) col <- rep(col, nlines) if (length(pch) < nlines) pch <- rep(pch, nlines) # }}} # {{{ processing graphical arguments axis1.DefaultArgs <- list(side=1,las=1,at=xat,lab=xlevs) axis2.DefaultArgs <- list(side=2,las=2) background.DefaultArgs <- list(bg="white") lines.DefaultArgs <- list(type="b",cex=1.3) ## text.DefaultArgs <- list(cex=1.4,x=xlim[1],y=ylim[2],pos=3,offset=2,xpd=NA) ## mtext.DefaultArgs <- list(cex=1.4,xpd=NA,text="",line=2,cex=2,las=1) plot.DefaultArgs <- list(x=0,y=0,type = "n",ylim = ylim,xlim = xlim,xlab = xlab,ylab = ylab) legend.DefaultArgs <- list(legend=names(object),title=names(sf$id),lwd=2,col=col,lty=lty,cex=1.5,bty="n",y.intersp=1.3,x="topright") smartA <- prodlim::SmartControl(call= list(...), keys=c("plot","lines","legend","background","axis1","axis2"), ignore=c("formula","data","add","col","lty","lwd","ylim","xlim","xlab","ylab","legend","axes","background"), defaults=list("plot"=plot.DefaultArgs,"lines"=lines.DefaultArgs,"legend"=legend.DefaultArgs,"background"=background.DefaultArgs,"axis1"=axis1.DefaultArgs,"axis2"=axis2.DefaultArgs), forced=list("plot"=list(axes=FALSE),"axis1"=list(side=1)), verbose=TRUE) # }}} # {{{ empty plot, background if (add==FALSE){ do.call("plot",smartA$plot) if (background) do.call(prodlim::backGround,smartA$background) } # }}} # {{{ axes if (!add) { if (axes){ do.call("axis",smartA$axis1) do.call("axis",smartA$axis2) } } # }}} # {{{ text ## if (text) do.call("text",smartA$text) # }}} # {{{ mtext ## do.call("mtext",smartA$mtext) # }}} # {{{ legend if (legend) do.call("legend",smartA$legend) # }}} # {{{ adding spaghetti's nix <- sapply(1:length(object),function(i){ a=object[[i]] data.table::setDT(a) setkey(a,X) a <- na.omit(a) do.call("lines",c(list(x=a[["X"]], y=a[["Y"]], pch=pch[i], col=col[i], lty=lty[i], lwd=lwd[i]),smartA$lines)) do.call("lines", c(list(x=a[["X"]], y=a[["Y"]], pch=pch[i], col=col[i], lty=lty[i], lwd=lwd[i]), replace(smartA$lines,"type","l"))) }) # }}} invisible(object) } ##' @export Spaghettiogram <- spaghettiogram Publish/R/ci.mean.data.frame.R0000744000176200001440000000063513571203035015523 0ustar liggesusersci.mean.data.frame <- function(x,alpha = 0.05,normal = T,na.rm=T,statistic=c("arithmetic","geometric")){ res <- lapply(x,ci.mean.default,alpha=alpha,normal=normal,na.rm=na.rm,statistic=statistic) tmp <- data.frame(t(sapply(t(res),function(x)unlist(x[1:4])))) tmp$labels <- names(x) out <- lapply(tmp,function(x)x) out <- c(out,level=alpha,statistic=statistic) class(out) <- c("ci",class(out)) out } Publish/R/publish.default.R0000755000176200001440000000105613571203035015301 0ustar liggesusers##' @export publish.default <- function(object,digits=4,title,bold=TRUE,level=0,hrule=FALSE,title.level,title.hrule,...){ if (missing(title.level)) title.level <- max(level-1,1) if (missing(title.hrule)) title.hrule <- 0 if (!missing(title)) publish(x=title,level=title.level,hrule=title.hrule) if (is.numeric(object) | canbe.numeric(object)){ x <- format(object,digits=digits,nsmall=digits) } cat(paste("\n",paste(rep("*",level),collapse=""),ifelse(level>0," ",""),object,"\n",sep="")) if (hrule==TRUE) cat("\n----\n") } Publish/R/rhs.R0000744000176200001440000000006513571203035013001 0ustar liggesusersrhs <- function(formula){ update(formula,NULL~.) } Publish/R/publish.glm.R0000755000176200001440000001100613761464751014447 0ustar liggesusers##' Tabulate the results of a generalized linear regression analysis. ##' ##' The table shows changes in mean for linear regression and ##' odds ratios for logistic regression (family = binomial). ##' @title Tabulize regression coefficients with confidence intervals and p-values. ##' @export ##' @param object A \code{glm} object. ##' @param confint.method See \code{regressionTable}. ##' @param pvalue.method See \code{regressionTable}. ##' @param digits A vector of two integer values. These determine how to round ##' numbers (first value) and p-values (second value). E.g., c(1,3) would ##' mean 1 digit for all numbers and 3 digits for p-values. ##' The actual rounding is done by \code{summary.regressionTable}. ##' @param print If \code{FALSE} do not print results. ##' @param factor.reference Style for showing results for categorical. See \code{regressionTable}. ##' @param intercept See \code{regressionTable}. ##' @param units See \code{regressionTable}. ##' @param ... passed to \code{summary.regressionTable} and also ##' to \code{labelUnits}. ##' @param reference Style for showing results for categorical ##' variables. If \code{"extraline"} show an additional line for the ##' reference category. ##' @return Table with regression coefficients, confidence intervals and p-values. ##' @author Thomas Alexander Gerds ##' @examples ##' data(Diabetes) ##' ## Linear regression ##' f = glm(bp.2s~frame+gender+age,data=Diabetes) ##' publish(f) ##' publish(f,factor.reference="inline") ##' publish(f,pvalue.stars=TRUE) ##' publish(f,ci.format="(l,u)") ##' ##' ### interaction ##' fit = glm(bp.2s~frame+gender*age,data=Diabetes) ##' summary(fit) ##' publish(fit) ##' ##' Fit = glm(bp.2s~frame*gender+age,data=Diabetes) ##' publish(Fit) ##' ##' ## Logistic regression ##' Diabetes$hyper1 <- factor(1*(Diabetes$bp.1s>140)) ##' lrfit <- glm(hyper1~frame+gender+age,data=Diabetes,family=binomial) ##' publish(lrfit) ##' ##' ### interaction ##' lrfit1 <- glm(hyper1~frame+gender*age,data=Diabetes,family=binomial) ##' publish(lrfit1) ##' ##' lrfit2 <- glm(hyper1~frame*gender+age,data=Diabetes,family=binomial) ##' publish(lrfit2) ##' ##' ## Poisson regression ##' data(trace) ##' trace <- Units(trace,list("age"="years")) ##' fit <- glm(dead ~ smoking+sex+age+Time+offset(log(ObsTime)), family="poisson",data=trace) ##' rtf <- regressionTable(fit,factor.reference = "inline") ##' summary(rtf) ##' publish(fit) ##' ##' ## gls regression ##' if (requireNamespace("nlme",quietly=TRUE)){ ##' requireNamespace("lava",quietly=TRUE) ##' library(lava) ##' library(nlme) ##' m <- lvm(Y ~ X1 + gender + group + Interaction) ##' distribution(m, ~gender) <- binomial.lvm() ##' distribution(m, ~group) <- binomial.lvm(size = 2) ##' constrain(m, Interaction ~ gender + group) <- function(x){x[,1]*x[,2]} ##' d <- sim(m, 1e2) ##' d$gender <- factor(d$gender, labels = letters[1:2]) ##' d$group <- factor(d$group) ##' ##' e.gls <- gls(Y ~ X1 + gender*group, data = d, ##' weights = varIdent(form = ~1|group)) ##' publish(e.gls) ##' ##' ## lme ##' fm1 <- lme(distance ~ age*Sex, ##' random = ~1|Subject, ##' data = Orthodont) ##' res <- publish(fm1) ##' } ##' @export publish.glm <- function(object, confint.method, pvalue.method, digits=c(2,4), print=TRUE, factor.reference="extraline", intercept=ifelse((is.null(object$family)||object$family$family=="gaussian"),1L,0L), units=NULL, ...){ if (missing(confint.method)) confint.method="default" if (missing(pvalue.method)) pvalue.method=switch(confint.method, "robust"={"robust"}, "simultaneous"={"simultaneous"}, "default") rt <- regressionTable(object, confint.method=confint.method, pvalue.method=pvalue.method, factor.reference=factor.reference, intercept=intercept, units=units) srt <- summary.regressionTable(rt, digits=digits, print=FALSE,...) if (print==TRUE) publish(srt$regressionTable,...) invisible(srt) } ##' @export publish.lm <- publish.glm ##' @export publish.gls <- publish.glm ##' @export publish.lme <- publish.glm ##' @export publish.geeglm <- publish.glm Publish/R/publish.riskRegression.R0000644000176200001440000000260613761463024016674 0ustar liggesusers##' Preparing a publishable table from riskRegression results ##' ##' ##' @title Publishing results of riskRegression ##' @param object object of class riskRegression as obtained with ##' functions ARR and LRR. ##' @param digits Number of digits for regression coefficients ##' @param print If \code{FALSE} do not print the results ##' @param ... passed to \code{\link{publish.matrix}} ##' @return Table with regression coefficients, confidence intervals and p-values ##' @seealso ARR LRR ##' @examples ##' if (requireNamespace("riskRegression",quietly=TRUE)){ ##' library(riskRegression) ##' library(prodlim) ##' library(lava) ##' library(survival) ##' set.seed(20) ##' d <- SimCompRisk(20) ##' f <- ARR(Hist(time,event)~X1+X2,data=d,cause=1) ##' publish(f) ##' publish(f,digits=c(1,3)) ##' } ##' @export ##' @author Thomas A. Gerds publish.riskRegression <- function(object, digits=c(2,4), print=TRUE, ...) { if (length(digits)==1) digits <- rep(digits,2) sv <- summary(object,verbose=FALSE,digits=digits[[1]],eps=10^{-digits[[2]]}) out <- sv[,c("Factor","exp(Coef)","CI_95","Pvalue")] modeltype <- if (as.name("LRR")==object$call[[1]]) "LRR" else "ARR" colnames(out) <- c("Factor",modeltype,"CI_95","p-value") if (print) publish(out,...) invisible(out) } Publish/R/publish.R0000755000176200001440000000176713571203035013667 0ustar liggesusers##' Publish provides summary functions for data ##' and results of statistical analysis in ready-for-publication ##' design ##' ##' Some warnings are currently suppressed. ##' @title Publishing tables and figures ##' @param object object to be published ##' @param ... Passed to method. #' @importFrom survival Surv coxph #' @importFrom prodlim Hist getEvent #' @importFrom data.table set #' @importFrom grDevices dev.size #' @importFrom graphics abline par plot polygon rect segments strwidth #' @importFrom stats anova binom.test binomial chisq.test coef confint delete.response fisher.test get_all_vars glm kruskal.test model.frame model.response na.omit na.pass naprint pchisq pt qnorm qt quantile symnum terms update update.formula var ##' @seealso publish.CauseSpecificCox publish.ci publish.coxph publish.glm publish.riskRegression publish.survdiff ##' @return Tables and figures ##' @author Thomas A. Gerds ##' @export publish <- function (object, ...) { UseMethod("publish") } Publish/R/lazyFactorCoding.R0000755000176200001440000000355113571203035015454 0ustar liggesusers##' This function eases the process of generating factor variables ##' with relevant labels. All variables in a data.frame with less than ##' a user set number of levels result in a line which suggests levels and ##' labels. The result can then be modified for use. ##' ##' The code needs to be copy-and-pasted from the R-output ##' buffer into the R-code buffer. This can be customized ##' for the really efficiently working people e.g. in emacs. ##' @title Efficient coding of factor levels ##' @param data Data frame in which to search for categorical variables. ##' @param max.levels Treat non-factor variables only if the number of unique values less than max.levels. Defaults to 10. ##' @return R-code one line for each variable. ##' @author Thomas Alexander Gerds ##' @examples ##' data(Diabetes) ##' lazyFactorCoding(Diabetes) ##' ##' @export lazyFactorCoding <- function(data,max.levels=10){ if (!is.character(data)) data <- as.character(substitute(data)) d <- get(data, envir=parent.frame()) isdt <- match("data.table",class(d),nomatch=FALSE) out <- lapply(names(d),function(x){ dx <- d[[x]] if ((is.factor(dx) && length(unique(dx)) #' @keywords survival #' @examples #' #' #' plot(0,0) #' backGround(bg="beige",fg="red",vertical=0,horizontal=0) #' #' plot(0,0) #' stripes(col=c("yellow","green"),gridcol="red",xlim=c(-1,1),horizontal=seq(0,1,.1)) #' stripes(col=c("yellow","green"),gridcol="red",horizontal=seq(0,1,.1)) #' #' @export stripes <- function(xlim, ylim, col="white", lwd=1, gridcol="gray77", fill="white", horizontal=NULL, vertical=NULL, border="black",xpd=FALSE){ U <- par("usr") if (!missing(xlim)){ U[1] <- xlim[1] U[2] <- xlim[2] } if (!missing(ylim)){ U[3] <- ylim[1] U[4] <- ylim[2] } print(U) # background if (!is.null(fill)) rect(U[1],U[3],U[2],U[4],col=fill, border=border,xpd=xpd) if (!is.null(col)){ if (length(col)==1){ rect(U[1],U[3],U[2],U[4],col=col[1], border=border,xpd=xpd) }else{ if (length(col)>1){ NR <- length(horizontal) bcol <- rep(col,length.out=NR) nix <- sapply(1:(NR-1),function(r){ polygon(x=c(U[1],U[1],U[2],U[2],U[1]), y=c(horizontal[r],horizontal[r+1],horizontal[r+1],horizontal[r],horizontal[r]), col=bcol[r], xpd=xpd, border=FALSE) ## do NOT specify: density=100 as this slows this down! }) } } } # grid if (length(gridcol)>0){ if (length(vertical)>0) abline(v=vertical,col=gridcol,xpd=xpd) if (length(horizontal)>0){ ## abline(h=horizontal,col=gridcol,xpd=xpd) for (h in horizontal){ segments(x0=U[1],x1=U[2],y0=h,y1=h,col=gridcol,xpd=xpd,lwd=lwd) } } } } #---------------------------------------------------------------------- ### stripes.R ends here Publish/R/followupTable.R0000644000176200001440000001202413573641713015034 0ustar liggesusers### followupTable.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: Nov 28 2015 (08:23) ## Version: ## last-updated: Dec 4 2019 (18:15) ## By: Thomas Alexander Gerds ## Update #: 51 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: ##' Summarize baseline variables in groups defined by outcome ##' at a given followup time point ##' ##' If \code{compare.groups!=FALSE}, p-values are obtained from stopped Cox regression, i.e., all events are censored at follow-up time. ##' A univariate Cox regression model is fitted to assess the effect of each variable on the right hand side of the formula on the event hazard and shown is the p-value of \code{anova(fit)}, see \code{\link{anova.coxph}}. ## With competing risks the same is done for the hazard of being event-free (combined end-point analysis). ##' @title Summary tables for a given followup time point. ##' @param formula Formula A formula whose left hand side is a ##' \code{Hist} object. In some special cases it can also be a ##' \code{Surv} response object. The right hand side is as in ##' \code{\link{utable}}. ##' @param data A data.frame in which all the variables of ##' \code{formula} can be interpreted. ##' @param followup.time Time point at which to evaluate outcome ##' status. ##' @param compare.groups Method for comparing groups. ##' @param ... Passed to \code{utable}. All arguments of \code{utable} ##' can be controlled in this way except for \code{compare.groups} ##' which is set to \code{"Cox"}. See details. ##' @return ##' Summary table. ##' @seealso univariateTable ##' @examples ##' library(survival) ##' data(pbc) ##' pbc$edema <- factor(pbc$edema,levels=c("0","0.5","1"),labels=c("0","0.5","1")) ##' pbc$sex <- factor(pbc$sex,levels=c("m","f"),labels=c("m","f")) ##' followupTable(Hist(time,status)~age+edema+sex,data=pbc,followup.time=1000) ##' ##' @export ##' @author Thomas A. Gerds followupTable <- function(formula,data,followup.time,compare.groups,...){ event.history <- prodlim::EventHistory.frame(update(formula,".~1"), data=data, check.formula=TRUE, specials=NULL)$event.history # {{{ Fix for those who use `Surv' instead of `Hist' if (match("Surv",class(event.history),nomatch=0)!=0){ attr(event.history,"model") <- "survival" attr(event.history,"cens.type") <- "rightCensored" attr(event.history,"entry.type") <- ifelse(ncol(event.history)==2,"","leftTruncated") if (attr(event.history,"entry.type")=="leftTruncated") colnames(event.history) <- c("entry","time","status") } # }}} if (length(attr(event.history,"entry.type"))>1) stop("Cannot handle delayed entry.") if (missing(followup.time)) followup.time <- NULL else{ time <- event.history[,"time",drop=TRUE] } model <- attr(event.history,"model") if (model=="survival"){ status <- event.history[,"status",drop=TRUE] status <- as.character(factor(status,levels=c(0,1),labels=c("Lost","Event"))) status[event.history[,"time"]>followup.time] <- "Event-free" ## ehs <- prodlim::stopTime(event.history) }else{ if (model!="competing.risks") stop("Can only handle survival and competing risks outcome.") ## status <- getEvent(event.history,mode="numeric") status <- getEvent(event.history,mode="factor") ## status <- getEvent(event.history,mode="character") slevs <- unique(c(levels(status),"Event-free")) levels(status) <- slevs ## status[event.history[,"time"]>followup.time] <- length(attr(event.history,"states"))+1 status[event.history[,"time"]>followup.time] <- "Event-free" } if (length(followup.time)==0) stop("Need a followup time.") ## FIXME: need a time otherwise all are unknown. uformula <- update(formula,"fstatus~.") ## groupname <- "status" data$fstatus <- status if (missing(compare.groups)){ dots <- match.call(expand.dots=TRUE) compare.groups <- dots$compare.groups if (length(compare.groups)==0) compare.groups <- "Cox" else compare.groups <- NULL } if (length(compare.groups)>0 && compare.groups!=FALSE){ outcome <- unclass(prodlim::stopTime(event.history,stop.time=followup.time)) ## for now: effect on event-free survival if (model=="competing.risks"){ outcome[,"status"] <- outcome[,"status"]!=0 } } else{ compare.groups <- FALSE outcome <- NULL } utable(formula=uformula, data=data, outcome=outcome, compare.groups=compare.groups, ...) } #---------------------------------------------------------------------- ### followupTable.R ends here Publish/R/publish.survdiff.R0000755000176200001440000000502513571203035015505 0ustar liggesusers## based on a copy from print.survdiff, tag, 07 Aug 2009 (11:19) #' Alternative summary of survdiff results #' #' @title Alternative summary of survdiff results ##' @param object Object obtained with \code{survival::survdiff}. ##' @param digits Vector with digits for rounding numbers: the second for pvalues, the first for all other numbers. ##' @param print If \code{FALSE} do not print results. ##' @param ... Not (yet) used. ##' @examples ##' library(survival) ##' data(pbc) ##' sd <- survdiff(Surv(time,status!=0)~sex,data=pbc) ##' publish(sd) ##' publish(sd,digits=c(3,2)) ##' ##' @author Thomas A. Gerds ##' @export publish.survdiff <- function (object, digits = c(2,4),print=TRUE,...) { if (length(digits)==1) digits <- rep(digits,2) saveopt <- options(digits = digits) on.exit(options(saveopt)) if (!inherits(object, "survdiff")) stop("Object is not the result of survdiff") ## if (!is.null(cl <- object$call)) { ## cat("Call:\n") ## dput(cl) ## cat("\n") ## } omit <- object$na.action if (length(omit)) cat("n=", sum(object$n), ", ", naprint(omit), ".\n\n", sep = "") if (length(object$n) == 1) { z <- sign(object$exp - object$obs) * sqrt(object$chisq) temp <- c(object$obs, object$exp, z, format.pval(1 - pchisq(object$chisq,1),digits=digits,eps=10^{-digits[[2]]})) names(temp) <- c("Observed", "Expected", "Z", "p") if (print==TRUE) print(temp) } else { if (is.matrix(object$obs)) { otmp <- apply(object$obs, 1, sum) etmp <- apply(object$exp, 1, sum) } else { otmp <- object$obs etmp <- object$exp } df <- (sum(1 * (etmp > 0))) - 1 temp <- cbind(object$n, otmp, etmp, ((otmp - etmp)^2)/etmp, ((otmp - etmp)^2)/diag(object$var)) dimnames(temp) <- list(names(object$n), c("N", "Observed", "Expected", "squared(O-E)/E", "squared(O-E)/V")) if (print==TRUE){ publish(temp,digits=digits[[1]],col1name="Log-rank test") cat("\n Chisq=", format(object$chisq, digits=digits[[1]]), " on", df, "degrees of freedom, p=", format.pval(1 - pchisq(object$chisq,df),digits=digits[[2]],eps=10^{-digits[[2]]}), "\n") } } attr(temp,"p-value") <- 1 - pchisq(object$chisq,df) invisible(temp) } Publish/R/formatCI.R0000644000176200001440000000657113745464043013733 0ustar liggesusers##' Format confidence intervals ##' ##' The default format for confidence intervals is [lower; upper]. ##' @title Formatting confidence intervals ##' @param x not used (for compatibility with format) ##' @param lower Numeric vector of lower limits ##' @param upper Numeric vector of upper limits ##' @param show.x Logical. If \code{TRUE} show value of x in front of confidence interval. ##' @param handler Function to format numeric values. Default is ##' \code{sprintf}, also supported are \code{format} and ##' \code{prettyNum} ##' @param format Character string in which \code{l} will be replaced ##' by the value of the lower limit (argument lower) and \code{u} ##' by the value of the upper upper limit. For example, ##' \code{(l,u)} yields confidence intervals in round parenthesis ##' in which the upper and lower limits are comma ##' separated. Default is \code{[l;u]}. ##' @param degenerated String to show when lower==upper. Default is ##' '--' ##' @param digits If handler \code{format} or \code{prettyNum} used ##' format numeric vectors. ##' @param nsmall If handler \code{format} or \code{prettyNum} used ##' format numeric vectors. ##' @param sep Field separator ##' @param reference.pos Position of factor reference ##' @param reference.label Label for factor reference ##' @param ... passed to handler ##' @return String vector with confidence intervals ##' @seealso plot.ci ci.mean ##' @examples ##' ##' x=ci.mean(rnorm(10)) ##' formatCI(lower=x[3],upper=x[4]) ##' formatCI(lower=c(0.001,-2.8413),upper=c(1,3.0008884)) ##' # change format ##' formatCI(lower=c(0.001,-2.8413),upper=c(1,3.0008884),format="(l, u)") ##' # show x ##' formatCI(x=x$mean,lower=x$lower,upper=x$upper,format="(l, u)",show.x=TRUE) ##' ##' # change of handler function ##' l <- c(-0.0890139,0.0084736,144.898333,0.000000001) ##' u <- c(0.03911392,0.3784706,3338944.8821221,0.00001) ##' cbind(format=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="format"), ##' prettyNum=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="prettyNum"), ##' sprintf=formatCI(lower=l,upper=u,format="[l;u)",digits=2,nsmall=2,handler="sprintf")) ##' ##' @export ##' @author Thomas A. Gerds formatCI <- function(x, lower, upper, show.x=FALSE, handler="sprintf", format="[l;u]", degenerated="asis", digits=2, nsmall=digits, sep="", reference.pos, reference.label="", ...){ stopifnot(length(upper)==length(lower)) format <- sub("l","%s",format) format <- sub("u","%s",format) lower <- pubformat(lower,digits=digits[[1]],nsmall=nsmall[[1]],handler=handler) upper <- pubformat(upper,digits=digits[[1]],nsmall=nsmall[[1]],handler=handler) N <- length(lower) out <- sapply(1:N,function(i){ if (is.character(degenerated) && degenerated!="asis" && lower[i]==upper[i]) ci <- degenerated else ci <- do.call("sprintf",list(fmt=format,lower[i],upper[i])) ci }) if (show.x) out <- paste(pubformat(x,digits=digits,handler=handler,nsmall=nsmall),out) if (!missing(reference.pos)) out[reference.pos] <- reference.label out } Publish/R/prepareLabels.R0000644000176200001440000000445513571203035014774 0ustar liggesusers### prepareLabels.R --- #---------------------------------------------------------------------- ## author: Thomas Alexander Gerds ## created: May 13 2015 (07:21) ## Version: ## last-updated: Mar 5 2018 (19:39) ## By: Thomas Alexander Gerds ## Update #: 18 #---------------------------------------------------------------------- ## ### Commentary: ## ### Change Log: #---------------------------------------------------------------------- ## ### Code: prepareLabels <- function(labels,titles,...){ labs <- labels tits <- titles labels <- labs$labels titles <- tits$labels labs$labels <- NULL tits$labels <- NULL if (is.matrix(labels)) { cnames <- colnames(labels) labels <- lapply(1:ncol(labels),function(j)labels[,j]) names(labels) <- cnames } if (is.factor(labels) || is.numeric(labels) || is.character(labels)) labels <- list(" "=labels) ncolumns <- length(labels) if (is.null(titles)){ titles <- names(labels) do.titles <- TRUE if (is.null(titles)){ do.titles <- FALSE } } else do.titles <- TRUE if (do.titles && length(titles)!=length(labels)){ message(paste("Wrong number of titles: there are",ncolumns,"columns but ",length(titles),"title labels:",paste(titles,collapse=", "))) } if (length(labs$cex)0) eval(pa) else names[[n]] }) names(pynt) <- names(names) pynt } #---------------------------------------------------------------------- ### getPyntDefaults.R ends here Publish/MD50000644000176200001440000001727413775125612012214 0ustar liggesusers553c9f459145fbfc91c66cdfd8f4c4af *DESCRIPTION c232507ead022abedd4dcf1c2d0fcc54 *NAMESPACE 5a729150ff2b9449cd7ad0278c7e5025 *R/Spaghettiogram.R 08b4c82000709969e260bc85df19221b *R/Units.R eac0fb9112077cb7bdcde7654825f8cd *R/acut.R e92f6f4332f5d5b5ab64c864c4fdfd7e *R/canbe.numeric.R 85f883ece7362b27557b83797d8702a1 *R/ci.geomean.R 2f4b1a1c71f087184245bcdebaba59d3 *R/ci.geomean.formula.R 7ab365301f8323fafb0b39e92e1244bb *R/ci.mean.R 4953acf170ccb92ca7402fd75f949670 *R/ci.mean.data.frame.R aaabc563ab85b6a93c64edf7ff58766b *R/ci.mean.default.R 148cf267253b2224e2cbbb8fe011d07c *R/ci.mean.formula.R 0e21cb8e131d030f429ecd63c7f9e330 *R/coxphSeries.R 2d8e9298d8f2cb4c867614c9851c736e *R/fixRegressionTable.R be6b153b8656424f0b54d2a336a92b6c *R/followupTable.R 65b59048180c7ed50b61703ea4819c54 *R/formatCI.R 74504d1b26ea22c866b338e8e695e945 *R/getFrequency.R ae9ce41fe159f5594946a826724a34e5 *R/getPyntDefaults.R 3248219b71e32865daaeda84fe01d36f *R/getSummary.R af9700a4ae2b576ec8982c7fff2a0351 *R/glmSeries.R 8ebbd8baa5999f391c3a525bfe733714 *R/iqr.R b7e9aa6ddda0a67041aeafbe28072d7c *R/labelUnits.R 7db173d33723b34e29fdf3ed07b03732 *R/lazyDateCoding.R 07c0d3cdcec0bbddb43bb84e4dd221e4 *R/lazyFactorCoding.R ef9962eaa6ccf40454528920c64449df *R/lhs.R 7a3a8af06f7c605e07cb619c0e29fa7c *R/org.R 2327466271b8dc0ac38d5106e5ae240f *R/parseFrequencyFormat.R c72ecae4428489d8a4f6b7bfad890445 *R/parseInteractionTerms.R 4da2f37c84a338b6168a4644a79eb7c2 *R/parseSummaryFormat.R 41360905a5dc88d3ab020fbd41289abf *R/plot.ci.R cc20db420e3646f562930f2cec045fde *R/plot.regressionTable.R ca5815922ea857258dd1c3e4aaeaadc1 *R/plot.subgroupAnalysis.R dcd1dbef28d80ab12e3ae53b46ec0f05 *R/plotConfidence.R 602c21f685f9c5c5f0054d4fb6f5fafc *R/plotLabels.R 0c5f0f1a47224e5b7839f331da727986 *R/prepareLabels.R 404d201944a3c3454d5136dd3db5e485 *R/print.ci.R d0290a8b115309d877a7705ad6f13a99 *R/print.regressionTable.R 60ff8edd8d410ad8a1f558404496481c *R/print.subgroupAnalysis.R bf1289d69a2ae8518357c8b26d0b298c *R/print.table2x2.R e1bf4285c05fddf79cf52306f4fec8b4 *R/print.univariateTable.R b577fe41c2bebf54e679228aaf82a70a *R/pubformat.R 279f836634be90abc234e51910d0de96 *R/publish-package.R 7d3429caf2374f6f53f0b0b62779116d *R/publish.CauseSpecificCox.R 908e233a42035c59c8aad0a1b9fad272 *R/publish.FGR.R cb042f795f38ed3241c5a5d152b8376f *R/publish.MIresult.R 5191f5f850a3b161930f7411408ca372 *R/publish.R bcbd113697334afaa541ff378fb448c3 *R/publish.Score.R 8c1c7dfda2134c7d79fd721ef930d826 *R/publish.ci.R 8e9123e3d5d0225d952cd193fabac85a *R/publish.coxph.R 610ae466e4f17fed6d82511c88490fd0 *R/publish.data.frame.R 377644b1332154e37ac73441a6d97c08 *R/publish.default.R c0b4e14dc565177a242da263dc8d4f92 *R/publish.glm.R f31b987831c60180682063dd7793e416 *R/publish.htest.R 1c91d21d772f74ceb26087d524a3487e *R/publish.list.R a54750a4021679e5acc272550b44131e *R/publish.matrix.R 71ed43a759d815a3f1fccb72b20e6ce4 *R/publish.prodlim.R 9ef94d4ba94b38b34c201cf69597012e *R/publish.riskReclassification.R a634a8435a1c26e870cce0a1ff26ecdd *R/publish.riskRegression.R 80488ad11f84fdc6dfb8891277f073f0 *R/publish.subgroupAnalysis.R 45bece7acf7f00558dae7ec55a022e76 *R/publish.summary.aov.R c5ccd754c6f356b0e7c2d6b47291d917 *R/publish.summary.prodlim.R 354b2bf084b95b6ed5e0ecdd02ad7659 *R/publish.survdiff.R 1e95f5eefac90d928e1d8c7dacbcc93f *R/publish.table.R 89bdcc8004bfc4692ae551d17b1a6089 *R/publish.univariateTable.R 4fbfea3fb6a4582770fc17bc136944ca *R/regressionTable.R 01a69c4849ff14e5e591a34af7594beb *R/rhs.R 62116c4ded38f14dbe8ba033d95fb9a1 *R/specialFrame.R 7dc868202db71c1a86d2e5ea3e75ce6c *R/splinePlot.lrm.R beffabc25523adf2db6eb8845d9f016a *R/stripes.R 780083dfd1e5a0a64ba87ddc33ba9263 *R/subgroupAnalysis.R 2bbbeb192e2bc3d56abfb7c4e6860ce3 *R/summary.ci.R cfbe83f62d55758d8f7a685b0aec64c7 *R/summary.regressionTable.R 4704ce7d32d0bf98ed0e2f2ae0bcd46b *R/summary.subgroupAnalysis.R 316566f0092801300a3285bef82e30e4 *R/summary.univariateTable.R 3e951a9e40a12293039656483d492a9e *R/sutable.R 8838b289980ba91e90b73bb130d6133b *R/table2x2.R dbbfbbbb42314e962c7688825b55aafd *R/univariateTable.R e7850a3e636e56080b99edbf5d8e677d *README.md a056465f80a60cf1da8dd86c4258ffba *data/CiTable.csv 615fa9de525f027cb85a4930f0b35e5d *data/Diabetes.csv 70f9101ce23026498c5b20c4a556ad5b *data/Diabetes.rda 32201723924050ac0906081edfa9df2c *data/SpaceT.csv 90b53e2a6a5110b3a08075cf68b9b261 *data/trace.rda 8fb74f79c54827f0d546724cc2f55675 *data/traceR.rda 511070ca513b957004bba4f73ff447fd *man/CiTable.Rd 6491f8e8494c5312e231c56a9e20b77d *man/Diabetes.Rd 0f8281f29c7ce46d9ab815caa499dd6d *man/Publish-package.Rd 11ca1b2aa1109d216bc57e99e8beb4a5 *man/SpaceT.Rd 278d52fa5781181e6de9ae7e44962352 *man/Units.Rd cb416cb8acb99d56d117342774f20b48 *man/acut.Rd ae6a153b9b6f341f1935e5da3a01b51d *man/ci.mean.Rd 8b7ae61e883914a38928ff09be871a9d *man/ci.mean.default.Rd 463f8aab4972651de0863062e199cc15 *man/coxphSeries.Rd 581ff1aabb51855ea7320ce2d01b0e0c *man/fixRegressionTable.Rd 4746ffd7af73b36e036188f7dd07c071 *man/followupTable.Rd d76d91aa5117f355819fee5c519654ea *man/formatCI.Rd 39f5c7d14c7c5ff2ac1dfdb18434aa8c *man/glmSeries.Rd 16a04abc48c828e2107b4e71631c89d5 *man/labelUnits.Rd 2c2b175b5774fcd425e8276b96725ff3 *man/lazyDateCoding.Rd b9cac71009612ca74925e32aa6692833 *man/lazyFactorCoding.Rd 1381f60f2b7fb4685d39935134d66dd3 *man/org.Rd 2d5b916eb758c31075050cc3eea37e82 *man/parseInteractionTerms.Rd 070372a74a72b8ac176f8b704ddb1dbb *man/plot.ci.Rd 4aed4af503f959cd2aff6d64a3f75399 *man/plot.regressionTable.Rd 56d89d76a112a20726438170e146bd08 *man/plot.subgroupAnalysis.Rd 507701eb9c438559c5304a9e007ea779 *man/plotConfidence.Rd 8a46d382df90dc71fe7a6e6f3b6a9f6f *man/print.ci.Rd 08b194c2cebc70512b76006078183bc8 *man/print.subgroupAnalysis.Rd e6648af731a5eec0d08555a5b3b63c1b *man/print.table2x2.Rd 4761dfa45f61e5e86a4ca9b2dd515ace *man/print.univariateTable.Rd aba78afc99421ae9b1068b653c2fba11 *man/pubformat.Rd 70357f0895df211ca882898a5f6279bf *man/publish.CauseSpecificCox.Rd 70681623ecee218d11a9b8a5cdde124f *man/publish.MIresult.Rd e663cb0f13e3106229a23321fab57412 *man/publish.Rd a7bfa62b382c6cc2f479edb2342a68a2 *man/publish.Score.Rd 7cfba3a19341aa2c3d3ee46086fdca50 *man/publish.ci.Rd 6468ddab712b3f48fed5afb85ad9df3d *man/publish.coxph.Rd 98487897cfb92046a348b628c92d2b51 *man/publish.glm.Rd 2994d066de2c163ffc914d2793b5c6ef *man/publish.htest.Rd ecd18f43fae68900fa9a62d7c2787f29 *man/publish.matrix.Rd 142b1dd6ea23101a3b69f99e1c605847 *man/publish.riskRegression.Rd 889d20f799197078b31a75bbec790473 *man/publish.summary.aov.Rd 99a6cbc5e0d46534fc37c9f6fee72587 *man/publish.survdiff.Rd 19adf8a1b06729b13773e975b5690685 *man/regressionTable.Rd 32c38c7fa817e06cfd92e6c89190ed79 *man/spaghettiogram.Rd 371cdf8788db8e7ace4dbf05a7c3d23f *man/specialFrame.Rd 25973ff649c6db01774bd0d209fceb3d *man/splinePlot.lrm.Rd 576d90951e49f6f85bb3a74018f813e6 *man/stripes.Rd 6eb90afe11dc04da9f578c1f448e3198 *man/subgroupAnalysis.Rd 556a1144153426ae497baf05f463a530 *man/summary.ci.Rd aaabe1c48e9c59f5472d40c68a211a58 *man/summary.regressionTable.Rd 69377afb7b880f2ad53d7157ddf08852 *man/summary.subgroupAnalysis.Rd 1a114d0c7c8b69cd2642d33a5314536a *man/summary.univariateTable.Rd 54ef61a13dde0da9c657f8d469da35c6 *man/sutable.Rd efb858e25960d0b08d80ac44113bc395 *man/table2x2.Rd 93c530f4c2cdcae12ba3773231422e39 *man/trace.Rd cca8325bea0c040f8b8ae93eab781ca7 *man/traceR.Rd 4892ac7b7ca3116898cf7fcd6c7aa483 *man/univariateTable.Rd 0aa72df1b9495296229f75034226a1c9 *tests/TestBaselineTable.pdf dd825eb02040332b1095be1830dab9fc *tests/TestBaselineTable.tex eefbcca9475da5e5899058a94dfc8a99 *tests/test-glmSeries.R 47cdf40577315811d1771a52aa4c50a9 *tests/test-publish-gls.R 4800ac0c12a9c5425cff0f48dd20281c *tests/test-publish-mi.R f6c64ad6e2980547a6cd8a42f1fcc2dc *tests/test-publish.R f5fd4a5afde5af04b418262190a5b41c *tests/test-regressionTable.R 0c6faef882d26297458ddd655fc7724d *tests/test-univariateTable.R