DRIMSeq/build/0000755000175100017510000000000014614334234014101 5ustar00biocbuildbiocbuildDRIMSeq/build/vignette.rds0000644000175100017510000000040014614334234016432 0ustar00biocbuildbiocbuilduQQn0 Mi i;LZu$*8Zad󋟕'rN8 !E}^h,QEASX3mfTu~[\roɂҐ.-VnnCЎ & By&{}d=0tޔGr7}5gȩ*R| _i+qø#hV0. ',kDRIMSeq/DESCRIPTION0000644000175100017510000000520614614334235014514 0ustar00biocbuildbiocbuildPackage: DRIMSeq Type: Package Title: Differential transcript usage and tuQTL analyses with Dirichlet-multinomial model in RNA-seq Version: 1.32.0 Date: 2017-05-24 Authors@R: c(person(given = "Malgorzata", family = "Nowicka", role = c("aut", "cre"), email = "gosia.nowicka.uzh@gmail.com")) Description: The package provides two frameworks. One for the differential transcript usage analysis between different conditions and one for the tuQTL analysis. Both are based on modeling the counts of genomic features (i.e., transcripts) with the Dirichlet-multinomial distribution. The package also makes available functions for visualization and exploration of the data and results. biocViews: ImmunoOncology, SNP, AlternativeSplicing, DifferentialSplicing, Genetics, RNASeq, Sequencing, WorkflowStep, MultipleComparison, GeneExpression, DifferentialExpression License: GPL (>= 3) Depends: R (>= 3.4.0) Imports: utils, stats, MASS, GenomicRanges, IRanges, S4Vectors, BiocGenerics, methods, BiocParallel, limma, edgeR, ggplot2, reshape2 Suggests: PasillaTranscriptExpr, GeuvadisTranscriptExpr, grid, BiocStyle, knitr, testthat ByteCompile: false VignetteBuilder: knitr Collate: 'DRIMSeq.R' 'class_show_utils.R' 'class_MatrixList.R' 'class_dmDSdata.R' 'class_dmDSprecision.R' 'class_dmDSfit.R' 'class_dmDStest.R' 'class_dmSQTLdata.R' 'class_dmSQTLprecision.R' 'class_dmSQTLfit.R' 'class_dmSQTLtest.R' 'dmDS_CRadjustment.R' 'dmDS_estimateCommonPrecision.R' 'dmDS_estimateTagwisePrecision.R' 'dmDS_filter.R' 'dmDS_fit.R' 'dmDS_profileLik.R' 'dmSQTL_CRadjustment.R' 'dmSQTL_estimateCommonPrecision.R' 'dmSQTL_estimateTagwisePrecision.R' 'dmSQTL_filter.R' 'dmSQTL_fit.R' 'dmSQTL_permutations.R' 'dmSQTL_profileLik.R' 'dm_CRadjustmentManyGroups.R' 'dm_CRadjustmentOneGroup.R' 'dm_CRadjustmentRegression.R' 'dm_LRT.R' 'dm_core_Hessian.R' 'dm_core_colorb.R' 'dm_core_deviance.R' 'dm_core_lik.R' 'dm_core_score.R' 'dm_estimateMeanExpression.R' 'dm_fitManyGroups.R' 'dm_fitOneGroup.R' 'dm_fitRegression.R' 'dm_plotData.R' 'dm_plotPrecision.R' 'dm_plotProportions.R' 'dm_plotPvalues.R' 'dm_profileLikModeration.R' RoxygenNote: 6.0.1 git_url: https://git.bioconductor.org/packages/DRIMSeq git_branch: RELEASE_3_19 git_last_commit: 6fa442a git_last_commit_date: 2024-04-30 Repository: Bioconductor 3.19 Date/Publication: 2024-04-30 NeedsCompilation: no Packaged: 2024-05-01 03:35:57 UTC; biocbuild Author: Malgorzata Nowicka [aut, cre] Maintainer: Malgorzata Nowicka DRIMSeq/inst/0000755000175100017510000000000014614334234013757 5ustar00biocbuildbiocbuildDRIMSeq/inst/CITATION0000755000175100017510000000153314614306666015131 0ustar00biocbuildbiocbuildcitHeader("To cite DRIMSeq in publications use:") citEntry(entry = "Article", title = "DRIMSeq: a Dirichlet-multinomial framework for multivariate count outcomes in genomics [version 2; referees: 2 approved]", author = personList(as.person("Malgorzata Nowicka"), as.person("Mark D. Robinson")), journal = "F1000Research", year = "2016", volume = "5", number = "1356", doi = "10.12688/f1000research.8900.2", url = "https://f1000research.com/articles/5-1356/v2", textVersion = paste("Malgorzata Nowicka, Mark D. Robinson (2016).", "DRIMSeq: a Dirichlet-multinomial framework for multivariate count outcomes in genomics [version 2; referees: 2 approved].", "F1000Research, 5(1356).", "URL https://f1000research.com/articles/5-1356/v2.") ) DRIMSeq/inst/doc/0000755000175100017510000000000014614334234014524 5ustar00biocbuildbiocbuildDRIMSeq/inst/doc/DRIMSeq.pdf0000644000175100017510000161462314614334234016440 0ustar00biocbuildbiocbuild%PDF-1.5 % 98 0 obj << /Length 596 /Filter /FlateDecode >> stream xڥTn0+x"ROH^ZʒMXI|}HxI=8˛ǙGQD}sKh0(T[֨?[=7R NR\y$%iʑJ5@ɬx|2xlGUUt& oκzcMBk\6fSDL])usyB2Xs–e,u{ڼ I(3nqFR;0wtڢu`q[<YoB,!"Q<,DrwSmbe g?wP?' Û$Adń"i$N{r|A|v]&fv 1;Yx> stream x\Mw8W 4,Iɜv>O7YP;:c#@&nNs3[aBҽWOOp0ppyz|%`< FqL Cxgar(*:ZLLBQTmΥmu~-9x۫mks~nq~}ɈSƿa# ',H`+{T+@I%W=HpDbtEnlݚQASdD,FBʦ6Ts}jKܦ|3--8eݵ%H$5ՍEM E)_hORBY| bD-P"jH=P#*": =5zrLTnat^,7,٢GHiU<݈yrUXr4wst^p``|coC8i8=/k$[ҾWB罪S,P Oֻ@:DC[Wxg?϶v.(ҟƘU GY ĥ(ކ,v]c虱)/As3$8`%9DBB= cf91k3EmOEޣ'0F yY:>RPKRJ"*@ώ2|[Sytgqw'y?RWHġF/L//$` ?6Ai .7̚Yi2#2̋|iX=4,LIt15y&LL( (>RwRJsy!9"D %Sg.;J#AJOiK~S*EG KPĹt"Q"Gn_G1__ݼX$V_Qa81d yB`āJ Q@P2P /)TEJ4f0 GBO%~Cy ʭ-cE}K>"$k`> stream xڵZKs6Wr1UaHrHVTRqvc+-'c>h 9*24 `zD^dJ*z%aӱ,;.E}WSo+s}rd +zt柮p` Rǯ6[{+wߺc^\d_ byaI_PkG| S:"QsI@&ơw;E]j#j]OM_.=E2b8\5=tԻ'ƃ$*Od6, D*Pe"Y\oDQ UťznlvL*zɵ?A%o^"Jf% sI$UEFidjNk" xvONG 0yAϬ V -e+}TNK)te @I}9>g 2Z8)pp4 6}٠/NSB2'5麑as?yߘ\mKE.(Ȇ zkc|.2-@༅Cabc$k>åUY2C,k/am#1'QeL3[ۖ[ӕ5h2|n:ٗksojZ93'I?/f{\݃ȿb܆[w$\t4+1w:1/[R"hB1sn`WV mgNnp# +y56ڙ, df ljz |r/a-Y[2wXv\Pe"~c%6>ܔus ;G:+EujS4籧;M rSjNJZ[< r6&;cTS=p)9ʞf:^D [@)my3@Y?UoxvЃ8;ӲCcf$$pU 28htu r8JS*HGTA0ҹ38"/3SAR@1 7%$bEL*fL_)?}D;$X<aee0|0K͸@hmB,ʈVLPSY9 Ti*UFԎK(E$NՉp}N1ۧdImdIR, d~&H v& w.T Db1]_%'S}ҟM,>s "?¯/ ߣGGǗƀHnz[0$ob<RXc0 Γ .LoZ;qB1!mhvC~S{a6u<8SU1Tk̭#[KFG7`8퇶FTO  n0h"qsWm@"A;Zc+.︹CoGhrw=`}ٙUpƚ, Ch&lC6Ss!a"M/hVgh"1uw$ CP H zKDĴ zWn R-ZA6LGӕ݃m9řBTlQqeD,NRamĦ wjC,]]w*Vq\y2E suכ|{%A?UX7k 'Z SY.tHnǠnI阥c֢hjfn͎@v;Fi|`ۼσݠC_f”*іj GD8!͢3Y̡6I̹ lPQMauAd/ UYsr#,9rM!_B2#&CRnw30GH%~ J k%Kt W?֦)4Ӏ#pԥh` }8w*hTI"HT, [ݞޕxHh&1Ej gNy ޯ= WeI\'..` !:n7Crw?v3F/3˜yv ,PǓ5%9x:;-Qx4Gi6m~s\rf@@ok[N֕$I'e?\ 2%3e3"-9T}f&D?f6#l"`f³ 0W"0,]E8u'|7d._$@)2Mg;wc -PڔZ@e \f4Aɰ+ض l%"1?i\-єb|i i|> 6º}":ELXhc"v^! uWX2]3AϏ Rg6ZSu([۬ 8Q 5x~1"v p{la0C]sQ(='J%|" xbt(Niz2p`ig+Ns>4618C=u5VChNuH =\inX*uD2D>)I;x- OH fizᘁp򽊥~kd4XR_UZrfh=v;-].##t%|dHT=O:(]8~S=|ug>)F~Eg7ftt/{Irqf۷Z~Ej̱̐{67eR1A&)yc-7p@:q e=^.k\v mEm[qT֘s?]5}JJ.oH 70sJʪcŢ(@*=q33kgiB w*f{#i$@#Wώ#cjlf54f`\;[ <*1N}GٛUwtr#P [q]APm'aɩsLGH&r CJ]kNrf|+ 6JL_w#2 endstream endobj 186 0 obj << /Length 3764 /Filter /FlateDecode >> stream xɒFWJVnZscfܴPj_?{Ʀ|MoϷdG*Z?5jY,DaUE3ڬ^Oʛ hkAw86Eۋ5.|⟮㿂3 >֭}Kwewœg_C^\(x39鷫?lN4+[4Z)8BR ύ*_V Tߗo.d}kf~mەUydz;–k9cgKv{m[65 :(O- h3cOǁ`,v{ۭӾ+kd'ᯠpC<*63uف$ɱ90A!"pz,~Z0Wۼ:N4ց~-}c IoËu 7=m02ir 뽽"$0%Į{h!?&h!'YM(F\Lʐq80IcAF%(+ 0؊GmH G5v}蔅&+ +ܰvЬGU!} Isp%Q2TWDS NP$H9d" c-pdf).S*$cr5foP/;;5Ass&am, n-#`+(sp|fGb] lalY[o% R9!x\0[uRw`9β澥Fe[{u<.mu ww=:T a>4 UQЁs6mK$b3lb8C i"ߧ #5?oH8x+1#@!tnMEK8! _!&$|: s:05wDvxՔ}¬ct(*p`"e)yY8'7\7(5I@1_('!DX>fk/?>~/>ד`7' n^ʝH'VaYOp3]:#۷6[ʬTGC0>\n1-%cPգnጃkfYu jL\55 Nf. 5觀Hbm.w3BE*RUCUA2> &HQ3l# z=P$Le7vGg]O #Tp㔵(=gE#/"@i0R%kLi 9+D ; aN lʣEst`ņ N|$sCT)אVe{B1xP*1ts[ǥ^y2Rp_$;kjJip3 ,fv.r[ۮCk280Ej8k(:@hN$+9q> Q6Kڝ\".qa z,I/3* 쏍6cexQ V+Asw9ڎZ v;Wc]Åŵ0ٕ RGt%у;) TS㚪8ԁH75>u~IPEr,BA=YWpLǙj_̕WfPsYȑ%a7U4o*9m*^28EкCMn]Ov2{ZRցM{;zxb/VJi*خ>|U<">hs[Fqo>bp2RBtWCӀOa3~dǂ~bFwFZ[0'[º-rM> 39/ n 81A R~n]muvw:#bM5y};s]D(n< X̯כ|!_U^ 򱩄CekiSiEJB!9m: ]4&y)hG{Dbi.H )sTDh4gK̔!m1|NFr.c8ȹ5PFi( cD ؆Cr ClN*ATTp <ŠdEM+|Oꆆ0;;rT)bp m{/{/>h~'eSJߦK~d|͡SЊ{D`@dTt33Rb4?/@MZ; SŦ8M^SƷzz0K{Og(TVldz$2f3xXD/,P1q(`9*ѹġ).~?K nN g>A1aLiVb\ʪ2zItn\ϕ궼v9<ɔQ`d SR,'ǣTm{%7_DN7xбe?`/i̥$ 3xlNr1s [[d?Z&x4lʞVK;kSFbg++PEj֞OWG|dM~ C񬣏|m7@%LnP5X͒as5zZc ,v[;[Ka];Voxb !=;6UL&0ZQTypV endstream endobj 192 0 obj << /Length 2986 /Filter /FlateDecode >> stream x[[oF~/4`M8^& Rt{ICR,hi,Hb{ EJIEϹ|6r`DOc y202Z |2 mk,әJo+ptKy_w~!MxَGʚ_~d߹s]+wb~jrӯߞD[Dq ,44haS/T(i4J. fF Iy3K͊*$& yiw"J'k7Q7()EO$c)ɔu0_5 0-l,@+#dUuDНL9E 2M夿(broT>2:QXqTfq؜t {*uSw`E1<6ͦ*E_654xo Y;vvB ܯ+ݙM;#|-\zNgF%1"#d[8lw~t<~T.u:=9Ui6p_ xâxH Mpee`FȰlCv%)[հt*r mq6]EσZnr[<7hbCޖ8SOۦk6XUQ7ˢm˃ WM,y}u^UY? i eXwUίHkقD]u 쐼l6f.̼`5n=0{Sۮ<,'D8)JnQ3l,Lk!R+[/Uc'<٥L/ l4hĤp7Z5ł 4kn nDسzupu]^lCԢ=@&߃Қχ[o׎Zg23Q&][(4'fd*f}STvj^pXSٱ݋D18d0b$w"p`ۺ,/f/( WqKJpʒ] _AzjZ[<:."#`\qa IZɩ㭭SKv.YXu 43>@@CK4 7񃴂=.bQ>R<@R\TςCK dR=,.axE pI69 %AxQ9*Tz`{7ðiNgIٴLдvgٱ=z>S6 5<0╶'sQ"&Nf*p87L "F/b5Y Lޝ8L[Q7%{gGC8yO\چiՖ0󜎌7=vY)Y/$\Cϗ6`|n@}r{zšMBl(aO_zrP4ՈdcN݊-#cCz᫵TD&ޫjsW*`Mm{CFkdQo-wnfwop#*qxZ%z&*VPAG'?0:h3Bv.>A^-ÊL櫢^ZwVE)և^JEi/QS=ԄLӁ3\D;gC.Xgl[*}nZ pmѶ-kE${\Uo4\!u(ǕCx.Rb&{bNofqdjjp!4I U&$ E=c@S$w0AÌ wF6ˣCvsA]p{}LZdXy\f+銷vz  _+sP&!A&=z Mhˁ<䭲H&ŧ}4TB .)ߥti9zjozDF0Ra% QX+d@)+v =;:pP'P:}*?^/`: Ɵ^˓Zy+C" pXNܟcRDsP Z] smPw{Am v1q*SDg $ŖӸi@ٍe~(y=.@H}0U4\D*n! ^˲G 18; }ߏ A}td}W@7#g#H"vNsh5dzbzMUΣ_Ã8&FG%]nc>P_K詤9 Mѯ.>vvt'∎|$Lq(382&{ _E'>X i}7)~_gH~FRD2F?U={!j?hdz? `3O7"6^HILWN9%"=>>_da endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 842 /Length 2509 /Filter /FlateDecode >> stream x[ms۸_ɇ#n<7&zs7meD]:'}!Ѣd|Ngb/K/]@R8a Qho329tVByA]!B)oA!6< 1^Q)a0PtA* V 4gX* `E$bgz+t^J =u@1kIFxVG<kca =AЀTj$l^@ ֋"DNBc 0Nt8F3P28K ,λ2vݮ:Q,szXd6/Nl՚NNmUVJ?]}־hY,}S[+_nAM~[&(.!^Ů>ʢ~ʢ5e-wmm ?4VpۥvKQ{Er{O E{ր-cZ&/oԕi7ʥԝA {,u[ᓺ)a9*Yn~0Iyd{ME5=YME5j*ꮩRSQwME6Ɠ-Qޯ#cQms%BR:gd헛B?AVŴpr1s).ãx'>AjV.nDl8 gtE'-G#pSPTBɆtZ;ޥf ?*gŬf/Ż̋9CUgxx7,͜ :[\T3=~jam,}'UU9iy;}iltt+!"fԼ |(}!uAmjͿt&ucc'w75/Ms?`$t#y 4+Gg 9~ Vy9O;s_+z ntC:Й4t3 ݿomsozۆ6ts [qXQ{l9 3Ͽ=a8ɘLY%IݡΑY8q#"{A"8[/DF d v$f?H<8#TĭBߎgx!W:2-hO:f1jȫ:Go12HZX@mgq,;vܨ2BrRe!1wQHmv3]cQ8A&U:%5'ӞEaL̂t=1'sPmJF$}i?H& 4g}FF{TXW^k nsVд']AjVʔLzj`/ኚne25Ѹ*tx]T aEV\.V\npzYLU;pX[3i*±C+7n vo-և/C]4ZJQsYtZ-iڹmL)Des'7h|T9eLJ=h-f17ZN|p u6f >2M]몺>/娜^.FU9U~37^󼸼*N4` Wc࠙% SpV]\􂠱3Q->Y~Q݄C b88};C^7t*[}WhMV8hEL&pO9CCCCu1%&C( 6ύYY~cfȿ)& endstream endobj 201 0 obj << /Length 2621 /Filter /FlateDecode >> stream x[mo_AUX{ˢk\\K\]Q0m(Eb3;KZTEP63ϼę4"[+}}yhH^}q eV21y/әN.r$xZ)h,Ou^Փuj}Sj4ƮTW;t4Ioꢦ7u^fg)}㻶}OFzu3~g>}Bf[LҒg ȫt9kmɺțyGg>}F:˴I쩇8xf9Xdq3fpu\tőıp\A6If3El.5{inu3@BM7y_/b+h SLs:TLQ%lפtLϋS)̀&HQfr9o[z$}OYUm\aXLM|\ .smlNJj&$(i*0$Wy | .Qp`Yjw'o9q6ɢ:؁_E(I (;R%s&+fOX9DYLOƀ2\!f؁(f2X jU'Ǚjg/@D PHQeELTAPҪ!y38J TXUS Hbr>kq9 U@v"cJL+V NWÈ(j-Wd #ȴ_qzE 6t0V dKD#r&@僑chmO2 -/E^SqjB4chʐsMR]Wl:/?Dc/TS_PrA=nָ+L)VA(i:KH:\oQ=PV M1mvyܩmw# /\) r=qVc4rS5y/$EZM[@Or3%@\LC]DͨI >::>H*vI:/iz98ԯ D =O.ʢ?X"QZf}\Id+WkD7DBm6b[o+Ǚe>11!c22,PdR "IM3JNOJ*$XjGWHQL[?foH ) aNIbM/u*g{2@W|#d @b#,=-Iy\JЄh^x4^6^m1F\ӈ%=kGb8?Tѵ\,"0   0` E f*zRD˗PeނSQ,%T, n6{JM !g8@Zm Jլ?-X?nk^T fE>}ry<aS!l\,-Sy=jm' Z }{qf%ya7kH`dVc#_Q[!fWcfWj]/8WpV4k8&l톿hS[,&ɭ:M5YK0.qRkP6]FTNm 6 28 ci\|G&.;l_85r+c4ڏ[e{0 ``6WoXiNoKy`x˩9@,ttC=Ve2<^n yge,^12VTn`{=/@dTp0βlI` b~{wLbrw߁Y6!3 yR{?Dsw\0h1 endstream endobj 205 0 obj << /Length 2816 /Filter /FlateDecode >> stream xkoFТu6&C.AM iq%fCHǒhٱ+hwg;eNMbɿo_ tL^+g&A|2=I6b>yYOLuQwe^Mg:͒n|]:no]Lg8ay_NgOm2|ȍ?2~x?|>2ӟNt8=2NVh3/O>+OiNiRM^6'_~Ȭ_z]zb3/tH٧$tfNΐ?2?ڲezSY)-ctrU^EϠ䏝U2bŭ>E hyU1ݜEǝ#3DpOtQE `,\,_uK>-TΛj: U!-LbsK#{aE]!G#j'p7syJmHevAwyamvDF/H3 ¥.DS8Ky-fYAӚJ;9n1|s :r4DU:yă$%(*pC,.gZ(/#-$ۦ"x-?Lf-2i u! T:_,(CYplo]X oаόg `vDP&ip_FoÍ=}=Ees{1by-W˗= 8qӁqJYrUp`=+ː.p_Ci[c>/ڶY?7kQ)P'!5Gb0B82t4h.X+t9Df./LCBB9'pUYu<``X-`{3SO{ͬ7.$˩"}L6\\WE&qRww\1gY<. UV޶D7zt;R\E%~x8H=ә?m{ׇDt],<`FشA4!0H>Sѓbwn1WT\P 4l[ ><6oDCĊc,? #| W< 4vT[<|SϻA+|zcAK`YƑJbs m%錮,Pf7cS%֤Z#tpGU\|\ủc_wN 9x})yQBpVޏːMetTu = 4A uNx[v@q)Em,f;om҄+1+xID9=-1؂AP+.irpޢ+|f oVdexeuĠG>8c%% +<j?o82GMbc2rts@Y3>\>Tac82a6w MfW` \]4yS/:#we=C07ʗbʗpnhقǚ;P\nTs8|w-sqkkLI7Wو3hNH6 4-ԏ<2%.hj +{oVG =u'RW1uG}Gh[v^X{v5=q! `PnmtQgPaxd9xA3X` 3M޴Ei5e\*^y/Uz[o% ^+&O] =Chi ޶* :\gf}NǮy{З@*e,Q3RpWX%RIV_`ep}MJO,VqX߇2c`ۭ|N-&F|1DAkay8CuzT^Z-Mۏy 4gm"D𮝃 k-16ˈ2ߘVe~VVe7d,M^Te9>K^kfMՕuO@3,؎@h> Bˊe"w>; CsΎ+K]m0cIJ\WE\6`B ,O4 =cNnd1PW`iDqOǺ 5t1셒 kȖ`|[q"9/GX[6mh+HuY!bdSwA k̑n' Ӈ:Cg<㪭 '^1#(g93{#T}h= S%$ף1`Ԩ4No?xk&OU>Xh%AuE1W鑒 IPR lrvɌJڌ( ȿJ3qG~ėɰG0*1oY&ѣN( M)m6ڽ~7@ bT웹@ endstream endobj 198 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/DSdmDSdata_plot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 208 0 R /BBox [0 0 494 494] /Resources << /XObject << /Im1 209 0 R >>/ProcSet [ /PDF ] >> /Length 33 /Filter /FlateDecode >> stream x+2T0BC]SJ5Tp T endstream endobj 209 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DSdmDSdata_plot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 210 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 211 0 R /F3 212 0 R >> /ExtGState << >> /ColorSpace << /sRGB 213 0 R >> >> /Length 1104 /Filter /FlateDecode >> stream xWKo7 ϯ>I==9uoԌF&F#)DuP=/yu֪O~ww{!'[y'Ԣ~y4?Iݬ(o2QDAF@=zORT;& ,W qD ΫdbKt=x Y  Y  YN h"z(@U ly4Nn쨄8fSWZm6Oeoi.K#ptrN4}tv󝞦NjDrH';c3}M]WuҼ+^*Px)̻:.kڧtN-3umh w}@K՛$Dg.$(u.]rS$(%D&LvG'^i 頢ĕ?^}x}V=k?/۽[qן5S4f_#b헗bGk~j*\hP:A{VI}kck endstream endobj 215 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 220 0 obj << /Length 3323 /Filter /FlateDecode >> stream xێ}BhZ@ D J2hIօ.Ї$(슰D*q=!Eq7NRXrmmD4bַMp/+IXiW7 q,N*_||Z\pjWE\(^uZ6Y]ZnwMn/W8ai?|7Wg,6aHQ?7گK<}?]]p`z>OAK#F h?ѳ$&B-µ4H`/j$lN#M(4r |Ƌ(H@Ûm\l(ZY- ?Ie[uev5W7nSdi]? ʼh7θCo{IaEr!戥o -iGAb!N%:rҶY; 㷢GI=L,Bʰwо() a C#Y!B3fǧV&g&ch܇AdC4x%Zb (idhbL$(v,RjvY`"Iu״^>|LF-@bj0gK7øRZUL6977ūQg[a%4ԗ;>3cko5K.5C ?kG*f=ٱ4&TySQrwRLIӸAj&I]iЏCkQ f^CӴi;&***| . hN_{;})фCo4Z ōjȁ{phnnC2#\Rޒ>kUYX!{,`mG5)5D ^F@8jںB%aXmBI Z^>H9rC! Q*?:ݪ.T Ԋl12\)$-f)f~{D+ ,F l,[8\Q%-H2Xܮ[d~}dƀśbgoFz{SH5n퍙b$r8e^.rTѾgy_,GѴl1k ;fj" =ۛ=lzG;}25bHp0˨7D5ᠾ`?[#H#sKT-[4dρ`;.f> aw&~scp"K'Y>+ &6-7]-H0b'm-cuǮ2|h ]@AA)RłUAd.% UϤ1b4)1O-DЬ|,L"3r'DgilO-ĖTYO`K0K<ݱ(Z5s$Rr!"rq?W74qH^Dw# @ pqtos"j|37-Y?CCMS 耐8!* $SB0J zXHb0Q搖E/ap<^+3v觊:8F R@~u?u/CO&q?냝={U_/*M~,iiF)c[N9r-R/cUvNJ l它k0ӧŏu}TQ(%)F${]MƭL ["8/ sX%HOY"7̂; d PC|qkamA)fB34@g(}J-LX$pbB $A~8* H@BEkIxE(BsZd֍ު9Hz<yC}8Y-?z>LbkdZ[meL{4vR}(A5ZW1ʦŨ=:Fs0>uQFvwYq"I%(Y ,}*];V?޹B} If:>U ޣ6@6CޗZ)Mw /"8zt.HӍR"78EdLYGu!t2--ϐK$Qf"  Fw3,y)Ϫq,TP76yѾO|/{Z[([EuIOjv۔Gp\YRa_Y0إbbKc e5a*1ލŏ ~k!׫!pc~@`4 M5B*N xâhݯ||U;_O& >jd<* $xJ]4HYk׸[/{6t:kG:ǁ#7*?a0}K-xDx٬ ˕sZk3;Bk8z0חW<,&絥8EgxVFjj0UzQenöQ1lNN8v\_To?GdT`I|#舑1IaJ^<9%^'%s-O#hJG c`6cw@P5H~<BֻhLLb֩y)V'E9JA(T|Do|gρJFa2`M&-'Msz>!D@Jz~1_l+ɂ?s>~5}|>MwY?GĒ5ٯI5Na@N>D>Qv-_ ?rli%=z9> stream x]4}~Enn-i<- Km-q4oc;.$d@JVwղC WlF>`?~uEg0뫏_*1Hdv};ShgdDfrv(noFUW<橎TmϷA[؇図+wضXVhKR10tCg I=v^?%aE(1brᨁɄ?TF߷E (q~\߆0?XʆR܅mۮ(we 3J:Y '&Wnx0R{wEUt)b%bEP۫ޙep߭ɻy)vO(D!|xڴawc졣_pē{Y.8HMYq~.!@V_gD|.Lbmۺi?sq[u-|sP2HZ1MP]G PKk&GS9%7`M;dTHFzRi';c8OnbIaPxrt4tC] \^ 2%:X?$gҥsv:Gwa9"Ȩ/{Ųx ZAX c2$Ĝ `q@U S,$=(\ɔiIaG7#|^;YE۾ 6T4')mg3p\xAע,E䚎h΢Wة-3Q;[0̤ >px^.7~0!N Nu9z qD@?ǂjvę)fGXLb8AѿptiB*W%<,t9@|vQ%M@tFpȷ}IxWre/8c(Ư>SS;c 8\m'HhX N7L endstream endobj 233 0 obj << /Length 1856 /Filter /FlateDecode >> stream xY[6~_ḧ%@"MvN]C[M{ؒ+;/ ƙqC+υΘ(x|w_%XHvqe'RbZ$Jr&LE^x6C]mgst:tU/z?i3U?-w/ҷ=n/?pM8~j9YfD?-0Ç'F]TQw!F!gT:z{S/opYBFڻL2$^93EOX:^]WoY.=;]f$EVL%8DN#0)S%SOtfsMrn[r@ҿ~K*J;UU:n݌N@Vi_7ywZifٷjINx&n߻{%~KQ0nT"q7tt6Y;O^ 8Su 2QphĀhPh&ql]սX߲" Ό!l|}A\Zqh}2W~RϏ]=B8v(_^ \"Cp.9)`.mKbwj|2m|G@^3V@@r~OGwk\v+ ⤷vL09*܍yصuRRzW ~&sYaB yE%iYΪ{?XvT(ˀAta5ظ1 WcUlwve7_z֢-5:>Уvc]نJMb_U`[qnk, W=UHN } MPqWQţnQ&?Zp(F1z̄H^7VNW-:V\R "ToیӶšlL/7MXI:+ﺚR_aiU=H]A_ c( SRd@n"bF}{|"hq? gj$zx_EQdwyW$" c@|`CwBE+Q[0 Q0D@My'>@"g$ "hb$붷$'0LDKoxְO쎟ޅ9C DK#V8%07.oFݴS->:$/+ >iAէl"o )gp%2 endstream endobj 222 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/DSdmPrecision_plot1-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 235 0 R /BBox [0 0 494 489] /Resources << /XObject << /Im1 236 0 R >>/ProcSet [ /PDF ] >> /Length 33 /Filter /FlateDecode >> stream x+2T0BC]SJ5Tp T endstream endobj 236 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DSdmPrecision_plot1-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 237 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text/ImageC] /Font << /F2 238 0 R /F3 239 0 R >> /ExtGState << /GS1 240 0 R /GS2 241 0 R /GS257 242 0 R /GS258 243 0 R >> /XObject << /Im0 244 0 R >> /ColorSpace << /sRGB 245 0 R >> >> /Length 2824 /Filter /FlateDecode >> stream xZɎ\Wp)-Lq|I© .)b$s'Uj[*s'^޸_g;~8DBp[U}oH}!!,8疁ɧJR6+Vauo? )>!'O1*ӡdÝo}1< R}@4ȵ4x|]PL[%j >O`ai04aP8Ll&'N߂etKZ.xx1؛ߗaS ҫFdݾm~_U٫ |UًTMy1.>hg۹/1'js.s>@ٗl0>}qlVIqѧ>c3km[yN[oA_ͥƁk2qDb(Đ` #ׄQ\KfX$yy"m,Aӷ، zK}׼/{n;2fn" Z|8ݟ$rc|?b3Z6ʡ׼w'%>jA ?7p Oh(q*rlV}% $X7_z# Mj3&Uqs5va Gi 8щlC7R#vqzK}׼mTe&3O~w7W3B -':ڻ*}evJds=__;mJ{Sw{nsn*Z$x}9&:mCYl{!|M/;MQ{]y5Uwǣԏ7ݳ'EoOg/ wDE5y}=6>-y};VSt3npt]S}1>=G#^P85m;s+.(]>^]_ol.#5~J%wOGwᇷ)=߿?|ӻOw/4( e"e?qWo-ԋ\"0-џOУ"ɟxtVj'cͯ>xq#("A,'-@9tۅ?OZJbAz7ԈU쯧<߀zMeaNYq{Z´xZt駅a.X <-PAYpXo(6G"-lax"-lax"ŗMi#r1EIoяX|4s|gOڦs™.CϜ'GbKv38/Rޫ@ endstream endobj 244 0 obj << /Type /XObject /Subtype /Image /Width 300 /Height 1 /ColorSpace 245 0 R /BitsPerComponent 8 /Length 832 /Interpolate true /Filter /FlateDecode >> stream x‡7qU-D!3׹ޣ=T*{DCY.t>7?:)x#;h ˕R'B[2 h}e|7w W[V@jj1u:Ly=]րڀ҈.mD@}nB}jB}lZ%-V0}[\Q[ܻ m;[ ٛ JJ녦F|GHx'(O?= }<h0|8`(0pw@ap08QO 9 {9068cMI(}ҟ6NSof3~p7a`缱ޘyo4ZB.xʼnvL}ZWW9rXsF[[{ endstream endobj 247 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 228 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/DSdmPrecision_plot2-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 248 0 R /BBox [0 0 494 489] /Resources << /XObject << /Im1 249 0 R >>/ProcSet [ /PDF ] >> /Length 33 /Filter /FlateDecode >> stream x+2T0BC]SJ5Tp T endstream endobj 249 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DSdmPrecision_plot2-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 250 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text/ImageC] /Font << /F2 251 0 R /F3 252 0 R >> /ExtGState << /GS1 253 0 R /GS2 254 0 R /GS257 255 0 R /GS258 256 0 R >> /XObject << /Im0 257 0 R >> /ColorSpace << /sRGB 258 0 R >> >> /Length 4491 /Filter /FlateDecode >> stream x\M%ݿ_QK{Tuf# dd=AyxHnn9ACH,}PX|O/OyM)-o~[OÒ??kSNR`'ϖwO˗nmkjKkZm훔[~|S&~|;!g)֭GHw`"r{jnߞx\10< ~iGk Z65Acm=p ~B[_JkFuǾ(m102쑏:}OknS:tScݧg_i؈ap:յUG(- cpPyܼc d6//}sC]~o7>bh;z"$2 HkdgER\"!9aNy@ϴmSOȝm?)䷋gĽ=Qebʸt=]H]U꣉`K~oIݏsn{6Jrpe2Q7Ͷ]vkO,Kוw߂g ɩ"kL]q'zFs5':B(풮ҹ3-Ѷ]Oȝ~5ٳ˫\锜j֞|"[2ώ%B^}=ngZ]vD5g=qeOYmIZmK{YeI(: yM֣.ҔU$ uYizZJl#Vz^4uY@=p%L=!X+N=Oxwn+MI^ܢk)lzElCVǹá=}%HLYDVEݛIZJp} \lOlېmmv;}=xעc' }T{%s'$<٥M^zBDDV+.Ҕ䵶MEwhzEly";\m~X8MKH\tiQqrT8FiW46G,pmLe~f Xb[^"U2rHK|5:-b^!+mmrl+ZjE[pg^9@" 3Bioze܋ݏ"utNNrwnO뵚\G)B=Jvb݆ICov{!!?>i|%EcV_-.73D֒({xqw%l2QnCVv="w!CB7Yh;b$hūz}Q-SF`!l-<jEMyY﷽V[A&ff[$ r6K*ny65ȗmz7Mo`KTK$ܹ 7_^w mSOȝ~I)ᶧ#3%R+1uN^¹D8=S,{hzEl#D=Xw䜔H :蚒ySGg!r =rku{N^guu=TJ=-5n;3rh,r%mV8n&eА|izmK8ǹ񏺁2Gp԰f%ҾxCEo<UG6N͎oꂂkҔ:Y-6dmRrg}T3Θus@4G}-R.eq'ZoJ .Q{fm"ξ1F.rg}TmԆgnKϓexߖ{Cye~I5 F~%T1k }䀀'>C.є_$3Eu e܋ݱOʧKIK~oMl%guI2dy9's%vyMlz2onQ>__5@{9 P/3=@S~4sE@_b.^f%d 8UKs z5R.ќ_dCL-9K@_]OK{[^(ٓ]֟n[ E&yݮGK4(2[EK5lzԸ{#vc/%׎˾=RcR a]Kt*"W=޾{~iyknq/v?bׄs/Q#БG?zG舼`-s:%d,qrۭm궶]Oȝ~˪v/Q2 5y6e/~ӌ7dPg@S~$lW% d]ovj}O|T>_*z7s/QmIg%٩Ϧ^?5F~!iގ\X!vn/!, ѳ^kxb:%\yHuڃk_dÁǸ#_IfۡƽK(_\Α_#qg;/QR{9Wֆޙz~ivV˧S6˟K4͌2}V痀wO1X3 2LІO#% &%<֦ .>f˖K&9Sb#}XTl_/dCG̍RF~ 虛zZJl}Oxדp%M;]75R׫2r@ݧf)I4/Wې_@Ee}_β:9 Cjh -є_C-X3-ڶiq/v?bN_(}oR&#NRy+ )dʝ;ImfBf/aK7n/q8ϡﺣh/Hq/6܋Yz)\.%-a=e q-L ^c4< P?nK5k7'-9Zu1F#Uˮh/ rnAu6܋ݏ8)ixnB.M[J̸Pܓ Wj%vu.'Xx:Xќ_jiŏy6;5_^3M߃k_d!},=-5nf"Q% E4I'gG Nc%%K$4As x9Bvb#NJ s~V-ϧ2KͭNO\Cs~ҁUpRݽmR^Q=-L%kwՑro\)DsN yӻ]ƽ}/xVM|_&V|+(>!g~3?d_~?6? @/$-wO* coe㞥_߶SaT2ڎD9ה?=_Sjg}G~ G}o>|7~!] =9ޮ__~px˷_>%?%\]AC"~e?=G)Wpήi[w|e'>\]Ŀgm*M9L9̠^,g/v˻}-X~=LdgK8Utihzg˟gųg݉Ya_gŶicGoeٻ??d$>#ZT?ѷ|Y+(~x>Sſ7 Q9~(x8N(8JsDQBTt< nkgģ,(x*1Jӳx+A> stream x‡7qU-D!3׹ޣ=T*{DCY.t>7?:)x#;h ˕R'B[2 h}e|7w W[V@jj1u:Ly=]րڀ҈.mD@}nB}jB}lZ%-V0}[\Q[ܻ m;[ ٛ JJ녦F|GHx'(O?= }<h0|8`(0pw@ap08QO 9 {9068cMI(}ҟ6NSof3~p7a`缱ޘyo4ZB.xʼnvL}ZWW9rXsF[[{ endstream endobj 260 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 263 0 obj << /Length 1636 /Filter /FlateDecode >> stream xZYoF~ׯ 7{Eñ#(h(hi%Dw(ɲ$˄"6@.˙ٙo%Qi\ #zH`5'Y:ܵi2>2OE?Og4:TOK'R?2~-l)ԟ/}I:8,P"OV9EF1HcW۵Ghm./) VO#a^sn8"i!"i0RPq7FJKP+6vS;|)dRDI4Y E#P V*2I6`c/1bCP嚚q@T""ʬC؁_KKH3ĥgϞ6>/~5.$2R#Eorozp endstream endobj 267 0 obj << /Length 2394 /Filter /FlateDecode >> stream xn_!4( 9^$&--yZqbQ}12dX,uΤ ]5wG<代ӣ7'F%9˭tΜIӹNeGϏO]U,'2si*v.;jΎ'J.~!Lz UM_6i'j\U"R_D?~o}e1;<=ߛ_roaz'zq[1eu28B+Go\@O92Gz@:Vf{>}{'jÿʕʭUy47#h7%@CePf`S2{PysbEB $R2Qy<,$s&LR*^XYQhvМoi]r}s"'W\ܻb k+%Bo6fOoe_-N@h[〰흀j?tkv>)CtUoG1_7CzHhjtq^cA)tf|I8_::U4Z$ߕHL lk7MZ'h*3We5+:#CǬY/͜ *}t&1_4}IX!Z"`b\ zkLuZUGƻ\ϤMf0k !@&gEpJL3 xXRώei"Ă(Ep b %n>41l+Z7FT! [ _6JZ" @4b :n*biNبth ȧB|xsbݎ)^mC/1oٻ 'UGָະg*Õ c_n&R78O~oor'V02 p0g'Hb4T״ 6O8v]jY&~ۮcn޾̬pDvr};r˗r+Qn= }A:0np1o vn9!@dre}LZC=D7?^R̺;ܯ/ʱuuly8nK G>u *pnz(0=/ y endstream endobj 273 0 obj << /Length 1487 /Filter /FlateDecode >> stream xZ[o6~XW`{Xѵmh44Kvَk߾CR-Id'J.11υ/Kѭr\{ 7=aCr{ZBdU\EQ$)1GZ0"YtF}F|ϋI:'\Xp9Y}JҸ8 KY{wշU +31b:{ ڨ(ْON!FegOt Uq;`{pkL =a;,^)pJP48 NE\6L ĵxU("moh3se1@\u%4E2.SeKA-,cRsY~ˀh`$̵D݂.t '<85`yJg a:?f=^LOyV5qdi 8VT4|56fiK*Ta&jKw5U(ã hSVІQB5$Cw};-J?}^|SA8%J|AdmP, \Y}.E$GLRD!F7).(N{-TIhSvU7D3WuÊS=vm?(<~]7F`ʸ M2˧D}mĨ|>@T-x"nºI}SZ]}1ŃBᅹ %Jm=x4T#Nn*]Xq拢 M{STqTJ$$(6JRZKgųbv=b2Ⱦe/ U9tf%7EL B)M0x*i/4;e/zZ<*x :v!J1i"Z|34!EB~W {^<~If)F$X 3 L"H^OM1-1 ǒ#_41h8S,jr7 0M) $H}yN8Y!zKuP˓N.e:M, s\2VpVakyܻ*UWˢǶ#hX ޏwPUG\܀YQ`0& v7:;Bn⢂WvlZ^8GK{.jPp~)c@,(R#E x+¥7> stream xnF$ '/jYh\@-$&T},HYM$ \>7o6o !^.F/$G[M$XXFGNdr˦,Üi5UUyu]x0V,'#؞TfjWGH˟k>|,y>O$_v85a@O_0Q]0,ʅШhhx\lu^Xd z q!3[s ;XUєDMįmYƼ"vPbfr Q5le`-Oʤ\ܞ>'~4x?`A(b%R` f_Dm֨rh:xsh?J%Qaey?IFzW&`,Cmu_:gq $b'8/s\2̙D)[4jSM&Uq N[ *:/ ˺uݔ07nxtX"?u2- +.%`YJ+x%ϯlEDWKӁuݸtjٿMW^*b<[ګjL I<ݡhP'Qܵ$>Wإ`B8RR`]n;gɤg& ->)$pjn#6.9Vd k+̈3Zef~v&uAS]ɨJ3XJAF~4uYK(!F&TF\&QMmokQ=3fVjVoeS(c<~0+xLM0b1w{r,`[KPLKU147|*LCU1yv"m-pN8ۅP<'zQtV~n FI|7 asݯoW[ ѧ"K~ށ SFӏ`Q0Tx\md h'$Mց!w401 0k9xq1[cR"`4VԂՒ7$Y,ĺ}˙}I,xg5Pqm1B$"ogٰ̿Ъp̰PJr "!@6]W( ]L<˸Y0̏&VxcVaD|?ѵ}g-v~ze쇠*Ew_~RTneĐp0}׽ݩ [xZ+7g -HLaB *>xW?p%?&vup5M#  * endstream endobj 276 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/DSdmTest_plot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 282 0 R /BBox [0 0 494 490] /Resources << /XObject << /Im1 283 0 R >>/ProcSet [ /PDF ] >> /Length 35 /Filter /FlateDecode >> stream x+2T0BC]S]K\.}\C|@.U endstream endobj 283 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DSdmTest_plot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 284 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 285 0 R /F3 286 0 R >> /ExtGState << >> /ColorSpace << /sRGB 287 0 R >> >> /Length 1192 /Filter /FlateDecode >> stream xXMo7 ϯ>H `E[!ȡpH6A_j>V/"54ң(]݇70޻yy\WW/i;Spivr\d4WBZl=~k_?NSevQSO(,/T{匿uK&>`hJX6 tGs0+z}p6P ۀl9EJÎ3 Sȃ{pZ}i=Wb?dۀq5l7 ]r$e9,'*]r!,4jO :GWvJ}})#L) TtH%l`%Sk%)ҶʑrJ(J v! Z|`F,pj2l-U)C:)CMr& bɣ R=1b!gD}jyV4Q ObT!Qx(HE HE.fЪTblU &J]΁rY+)<"!bri9 hB"R\PA\g*#UE d#\(a (Qxq=7K׹=>5 ΅|lJb 2jȾܙOOU{;36Mձ>c䎭e1ߺܳLOXζ1G6^39MxlnAJmvk1>m]c~صs7~vvێ]s ]<6+~yw.{5ϣ ~8ƭZ2`"j-Һq:iqz> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 277 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/DSdmTest_plot-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 290 0 R /BBox [0 0 494 490] /Resources << /XObject << /Im1 291 0 R >>/ProcSet [ /PDF ] >> /Length 35 /Filter /FlateDecode >> stream x+2T0BC]S]K\.}\C|@.U endstream endobj 291 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DSdmTest_plot-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 292 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 293 0 R /F3 294 0 R >> /ExtGState << >> /ColorSpace << /sRGB 295 0 R >> >> /Length 1208 /Filter /FlateDecode >> stream xXMo7 ϯ>) `E[/CCnF@ R467^Fk#%#Q֠y0ߖnqB֚~,d"ӏ% ޵&yr$0qNi?Mw"727En ph \sqpg@$*6G .V)0HtRXŦ0!tb]fKZfK,w9v982v։^e<\1b+ ʐJ@!JrUh`Rtej%mUIN^˓:R KJ@r`ʄ5. 7aui;aawNRR>LOvڝP-UH{wm`LFܐhЉ~bI7B ':k [ 6tp3VcЉ%:`)*`*`Y&q&o 3lv[gиa7dbK ٗ"RG.Qh\3|l}+}}4#޵\6DZvsB_f6Mio7w6G;xq 3l¬J4JvB-¿I^lɤkƧǟ:9O~6mo75}o_(ĥCݷ }?C{ݧwpJq\j˗3,u=KܛKZ;:/X̱|uiAIZeao __qmd#\xn{g.X[UF&Kmxmb\dPG endstream endobj 297 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 302 0 obj << /Length 1461 /Filter /FlateDecode >> stream xZmo6_! Wam CZ %B-ɕ#rު݊Hyxt(t\5 %Udf*!ibݷ]MHƃv䟜MOF&q c`VN:DQwTɃߜ2аtP& h4Dq땵$#FǮ[-AV 7WiSKo{v *h=ViН?,)vQ.\\)uWSjM]o+C1Iqj@<ǵiop)B PfVf=܇(!E,6#A 5pqq)bH?,8]u]Ag5uQg8]$U۴-jn#hG`.p΃& =.W`.ojA:|Kcquk`Iֆ=hcdi>N5MhC^{m1j]_7V JyqR0+Ҳ "u[IֵXD;҇B(j*0.Zú7?Ɯ*]GgϚbDxD~sOcFg͖eR+3Ξ=g a7h 4oI5՗]1r`GGJAVys+I8 H& >mSW>/ProcSet [ /PDF ] >> /Length 35 /Filter /FlateDecode >> stream x+2T0BC]S] \.}\C|@.U  endstream endobj 305 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DSdmLRT_plotProportions-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 306 0 R /BBox [ 0 0 1008 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 307 0 R /F3 308 0 R >> /ExtGState << /GS1 309 0 R /GS2 310 0 R /GS257 311 0 R /GS258 312 0 R >> /ColorSpace << /sRGB 313 0 R >> >> /Length 2572 /Filter /FlateDecode >> stream xZIo760}9bĀg$GY IHf~~^-[؏kX^mz{|qޕRy'зqǟ6r+9hׇ|hѯmasif:1m)=:爎6 ۯjl'BS<{HQ![;ׇ `s;Xehzn"CͻLoٺ r{ز2JÖk{С-۸쮭 P4 vgt}>ZAxp5lJ55 qTIc%k!>I̳bH%|wDjUH%Q8Rۤ L|4GU-rudL+\]h_1mנEru4%0 PBkz N MMB#Ci!6tz!= {Ns+ PW|@;1rbM˱$Jw*ol+B˱Tc{ ~ZմvYO"+>5 弬}$69rJ 14騍% O'J^9sp Dc(Op8lʒدoٔȠ4G%ARF 9N*Q~-3NsX GW kñ1E"#8 EfY Vk1U5"8YbueWsFhQQ2#( @:h B~Nf] 5u(m[b@i ߃7^ rwvفPye\xWhpժ6 %­$=0ʸ4Wk^/Gxe\x |yK s6^SNF\BFȜ\tk%HNb^qhD+++Tw^#^^&^A .Toxe\xť$#^AW(~w^^_yLt^ ͖^5| r !VܹkxV -B]7n#ѷLk@U#]Lp%T}ᙆPS"/$Yd3$:״ ڑw-,*O H6`f?d;oׂl*S5apI> cGLiUG/~XYGp/ ޖ m`N^^&m ZN [7ҹ=+XTd'%@-ȶbױ(N s˸pn- [/nnP<>lɷvnnffp;I[u6qtйu; qҹE< viq.3E;p onn#K0r没-m[!<\qmmS^ָ*H۬TW~ Ns ;p'8sIGc2.ܲ=M§0Y ,ӳ g1?Lc~&L0= p`z3(O2AW *M)V%;b?0̺Lc2t46ݜLN&1M)<&_n$aOƬSZcvyB,]ݯ%u S}c|{n{[|?m#{;v]#Q#Di5qv>-U_޽ݑ8C5TEb|8f 4ay=) #&l!2<=D0";J(1't0k/wze0tlOUjlΒ ?l)PAHdK4ȶl?DEK9ʋ=W^G3SR^b2><>Yݾvz ߴ=;{xKĘl];>.\ endstream endobj 315 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 299 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/DSdmLRT_plotProportions-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 316 0 R /BBox [0 0 992 491] /Resources << /XObject << /Im1 317 0 R >>/ProcSet [ /PDF ] >> /Length 35 /Filter /FlateDecode >> stream x+2T0BC]S] \.}\C|@.U  endstream endobj 317 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DSdmLRT_plotProportions-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 318 0 R /BBox [ 0 0 1008 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 319 0 R /F3 320 0 R >> /ExtGState << >> /ColorSpace << /sRGB 321 0 R >> >> /Length 1573 /Filter /FlateDecode >> stream xYIo\7 _ Ԫ$j= 6ERCC:Mz%RqHCLD0tJ3 tqHTI0K+$ 22K+$0Ŝ3*3P0Fuҩ/ npށ 7TfHKĂJf7xi}i9&@AE-0iD4pu X3m CIjӈf=׈L#Zc5\o/E`@*|DvU7WRLjO^YHn c&f^s;~bm)+hyn)j0^SGe?keHЈ}$4bF>ӂiԴ&N,}NU˅Og{/#Ai%xfL>d)|C\ޝO{t->'+aiyaƘ霬O{C0‎N#[d;BO$w +|뎸5*;K8f3D~vC7#}O@ŕ5 Ɵ%q(1눇rÈ={l>l7߽gl6xޟ>2;]>ǫ1T3O*RIǎei 0Q.|a7juvYw]mGJuu5`a)ڶ 8Gx}8.q<2~4Ni8}8m=)}驴/f,J̳iY%4ˬlseVy92<ۜfUbmP,#Xj璤Ϗn 96{ۘD; dj`nP;l1Ch6qk6Zv&ъG&kz?پOJ@mhve:`f盳u#vPv?bJB[XʨCl] ;>]]m"ȋT+ŃO Xfds݁40|}/[7v^n#kۍmyMtɶtXJq'(C :xX :nQ.hx6ݧ#Q9x:R=[o q+-i]ZSWN/~kq~[Z݅^j˳wkT} ;`7OlH@j endstream endobj 196 0 obj << /Type /ObjStm /N 100 /First 890 /Length 2067 /Filter /FlateDecode >> stream xZYSH~Eu_Dp4 3agzAm$,/e9X@U/,!bɠ4 ȴF?jfe` ' ˴dD @`A9<^wdĘ =Ie SFl:/!m F,]fYXvA6sKῦ4/aޚ$9_M̪^Qٌ^`dY{w={[[4Ϭ51u>(7aq=]d#f,(=kT5y??(a2i6jru68W)_Y@R4`W`a1 Κ^~k3bח,Gt*wwKx:zhȃU+_E'umusN飚M>e\ؔH' D1rt:[xȔLDK/ۇzÖUfT3@ťPjZf,P@Etb>&=oO{MCz;)/_MC^%񅮮zI8_|aԦE/sNoZuKht%y_%>]⛉.浛7qkfq-/:z~;%ǝBo endstream endobj 323 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 330 0 obj << /Length 2348 /Filter /FlateDecode >> stream xZ[o~ 6}%řhnl&]@,ErysR-€89g=W&fۯ< &ZJ$uύciEpķV֏|^֍.<-bkҲ͚߷)mXZ'~w-!{G򒟷];Ǽۚշf7o0_Bzﾽד=(p}CKie+e$B0HF[w ^2b*_!<Ϸ"7 <(ׇVn{SUU>ۄR[ '%9%zʉx ߍr&RyAI2Nn.y'%%C}/1e0x`v꒡rA:RB"3ݬlp],ox\l:Ɣd|gTU˴omwNF=wF<\(R?r#;k =Z60pɜh%B2@Y]+`} FRʾ[kڏ4+ҍnL/#v$[L}3]8$ B+nOQ7RAܬu˄&@p"q;m͝fpd3+(s̳LNq[hBeL03. G]]3>$^[O*11Qz"T$`eJitO6, 8\NV Ȯ~Yk> R4RMo:0wmK^ͪ6}˳vybk H5\ʍs({*im+hZ֟sT"]Ϗ-$n <YJTp*\ϑpt QMMTW)W(srOԎIe2ъtwtKߒa,aoUqk:CEUJGN8'nr#Jg,]S ~hF´,Kp\w"!_{\Ȇ. S KfIR>VfvVd,_cWEɳ8R87z)i@H+ݡl4͝ HǶzH%  6ߔ9*  TGYg_ߗ< ZcBB9䰬xQ$j&&]( pdXaa,Bz7Sb6)i+,4M#bouFkc`[h#SۣAFob [_WDFOPٮHK8`WaEnvTwS@ǃx}sמ`u6<,($ '7pō!8XY> $PBV^4  0T@$ ;$n:@bؾ.X3h~Pb>PG ǧpzz %41CtIґ WÌVh^fpb8k&:BkXRC~mb9KunrL3o., 8`uf9CL$0q^lۗ M9AwHK8_OwYbhO>4rRV$𫬭 .} 8U Z( Fh8 'K(߂`?\RRv˩;}qHW~z<7DP"Eve &ePELL endstream endobj 325 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/DSdmLRT_plotProportions-3.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 332 0 R /BBox [0 0 992 494] /Resources << /XObject << /Im1 333 0 R >>/ProcSet [ /PDF ] >> /Length 33 /Filter /FlateDecode >> stream x+2T0BC]SJ5Tp T endstream endobj 333 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DSdmLRT_plotProportions-3.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 334 0 R /BBox [ 0 0 1008 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 335 0 R /F3 336 0 R >> /ExtGState << /GS1 337 0 R /GS257 338 0 R /GS258 339 0 R >> /ColorSpace << /sRGB 340 0 R >> >> /Length 1236 /Filter /FlateDecode >> stream xXKo7j!)J@A6+)h~$ܥ7 J73̐3E7w Jqߒ^?Ssm aQ2nE7TOA_nN߇fFw.`ɐTXRd"9|tt|@FzT)j4_u ?JN[;+$D!%?p Ȱ{ SHHZk?ML9J] !G[1i ]@I"Jcac"J ( 1*CA( "v9JbAsaԛ(Adb"XGXہ&? )Q<=R1q&܌ĆFX̬#Jab vu@i4RL1EaΫs0F2YfήY 1k3p`O_/ l=%=kx }F:JrL;:|2ucډ<.Q'S1Df2~ Ou5Ǵy6':å>1Df7Q9OD{:X.uxbS5ΐX#0cׁ\A5D˯Psc;B%֕eN)Z>4]1ZԢnЁiv҃?BKu]ǎ k!~װLh>8zh>J{>kERcʡ$zgIP\j}@]$/䇓yD>>%(%[ ]F~:^QNlN?Mj^mgpJWc9W~oo/% Ԡ hʌF@W)ؠZ~ٜύ.YwwԯNt'jJsw:^4ȟs6E*b,@ DKAǂ@}l9rr.{ o(,&ٝ)ڝ`J {^GE ]٠XCC1fuy+,x#Lr'XHᨭ>XCWbgW`!4!X!-JB00KaNz`\oWC3DF|vT-bK-J7 m6#?ޭ`po'&]/EYV'_@[! ^'XT?Z endstream endobj 342 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 345 0 obj << /Length 2315 /Filter /FlateDecode >> stream xr_$37iػv&>l2Zdn(R!){݇~{.͗Rڅ$x<Gc_,'kMyÓo8"$c( 'F,b0>,e^q2ΫQjӞW y)}%+ӓz٠]ZطW_Us6үÿ"O ٹhnH|=~F8‘Q@Rz㓟LrxrҲJzEX% aoΪ*LnlA {UT_FE>Ni\}KUǓ,CU;_ΖsДVwx8z5hpٹ[ }蕲guz ɩ4) ;O;rٹX}rF{9g|T!ׄ8Rj$Fr|l^m؁t=ٜRc[D!<= el=;=jxBQKp'28}YO)ןՋzWǭ>^i֊SԖN w1cX_d ~2YCs:#qQN{ppV*d:~;k3Q)enN49ş/umc:\a Qֳ㼪eśWhZhG7|Gֳ픊i=2JpU/0zFX2-\|)SI=Q=jfgG>nB-1m=ܨ6}@$oHR]Т 8ToJ9)eUb7JXo\} a]? {o22F`zqPȶ,RMQLuWY<5ņit,D 'a*\ !pKrBiHx^^̳RT]zA/Kbyo;u<_6u2GyحFr~iwΓ :g5e1 E-+M.3m5"1Qƻ,&8ջ-8 }^qy>W(~ϱA-c>(nEΌ(6Xа[s&z_xj.Jw^d4Mj^<̻IR FT꛸6ߴpڻ7m3lͤMr-5?ddʙfd @u& VwԻfU*mQ9"J&->g- ADQYnV2i !! PUغdz~@ ub@>@,wByjU}O$2;&kc!"/0'3ԖX|j bxI:._$Bе> stream xXݏ6 _]`{X^a[/qr%vj9(-I圴%"#Eˆ gluG0^] d$t qã<8~-iU&1Uz\Inge|kh9kR?4\ MrKlϾ%wa77w3If-Ipuwt(NGGЇ?i #T4[qN"FE\* e-FNҦ>x`&DJxbKLI])c R1yL,$\).r;\)d?.RgaTU/Ubm̯sT{9_2+rزyeYl74*ӤZCzsXeeR>8^4RFDiVMpVn2&!9FjS;(@Zꃝ]c=&L ߮Կ|`L`3{e)vݮNOZirfIAs+um 4.Ȩt 6x{yA>l`Q!CkmWIhSfE>cfNOs=VgO`a$G+P&KR~tED)5Պeֈ1( (Hvow55^nPĔr8mވ,O}dVJB eƅz\ I0x&-7 hn^^~TH7F I]i)f4_Qfa(\?qIfT݅@\ n=Cfi.#$GDj˶d C )/0mVEkw;w\H$ P>Qx endstream endobj 354 0 obj << /Length 900 /Filter /FlateDecode >> stream xYo6~_A/P- 9 ҵŒ)O0(2QDGW+IxdKxx f"v]w>= t')ΐ$8"(/I1)ZWmE񨭳bѺ:|vP'˪']M')*w=.l|-ڋ#&ǟ~[/|rC釀\G^ ٲ,;/]FĤgc#pP@=FSH%9M0qG<2bhbljhf߮1WfK.!`bo))$5-MI,l!4\FTƋtp3Lɇ8/NZ;ELB>ºѳbm feg@^ʛkyc|T}kvmdo'V̆hť. c}cvy3x>c:$dO[&/ޅ|n{A>t]O4}9Ov?ܱBhLjuEkx^g#40:V~UR|UevcO' Vn7)S^)#܍fhVh~'gYTXq\dG67& endstream endobj 347 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/DRIMSeq_batch-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 357 0 R /BBox [0 0 494 489] /Resources << /XObject << /Im1 358 0 R >>/ProcSet [ /PDF ] >> /Length 33 /Filter /FlateDecode >> stream x+2T0BC]SJ5Tp T endstream endobj 358 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DRIMSeq_batch-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 359 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text/ImageC] /Font << /F2 360 0 R /F3 361 0 R >> /ExtGState << /GS1 362 0 R /GS2 363 0 R /GS257 364 0 R /GS258 365 0 R >> /XObject << /Im0 366 0 R >> /ColorSpace << /sRGB 367 0 R >> >> /Length 2809 /Filter /FlateDecode >> stream xZˎ\Wp)-Lyy R|~NHvmi1W>b,dGE|x_> w|.M(&m%jO߄K8Rj>M@ߦS`|X gq$]w+Aϙ.x}kˠ ^zyiA2+4˨=ڛ9FưX˨˨_K)sˋ]Εkgk!./ͅR|M>WJ'cJJ6tdk>umVJM]K|KuWgcN[÷>6\L 1崙+оmڥ r6CGضI3%[c6m3:'ܶ/]u2߆x>\ i]l|܁0h?{KelĶM)T6f[ؖ7s+bt.P;D u=>TCGP~]t m6J&T7ul :'Զ/]E|g4W[Jhk"u jD퓟)F"mL)LM7ڧmFGVߗ#6syTrH\ru$&$IL oJK"a2Җ8PnX}UĶEZ)؅i[HKWTw+=SU 4!2ȕC:94Њ[5L~>tmVJ2].mF"m+_R\:-B|{A'74قebJ v5$9.1ۂĶm|TuW/GEhk.F⒫# $qRݖ`g"U"\c"-J .6$Ҷ/]쟰#@0E2( DM(vRUtdNnCfi4ЍFf[ؖ~-r^DjݻsL UtCuާjq# =ٶ~#$ aC DTTxzZ܍oD.W )SlqJZ'ӘmqM>&L]Ei.nБt.v=V7Is SR\ġ2h7JE0teor}x%@sj6K~o8*2ۂĶm|KuWoUXoRaQ8 *f.cözBm_R3d;OM{P"ŨnS f ۓ!ߢl|> ]E(' _s-[_}Q<h8(y踖+SQ$T(~4t%K^va;q|KuWmV#36_3|׌ e&lp||0UĶ5).L7N[Vd[|KuWmVeff^\ᜇ|ԧ0l0?9wNlu~{xy~ߋ{ ܝ@O =~?KncLO,6ZS' ݿ=[e:Z!HSGH6T,go.=~ 3|/_̩v}7K掷۳Og/ ^nr'<ܞS&CaœOo'Xg/ b埽qՅ:W1q")^6xh秴M9k?킓\]lse6~._m|oƝct?;wjuV[.뒲/h#Qz !3i;H~Q^ }T\ZD׿ !gįfg$rQla{㉻'|!m1_Oyd> stream x‡7qU-D!3׹ޣ=T*{DCY.t>7?:)x#;h ˕R'B[2 h}e|7w W[V@jj1u:Ly=]րڀ҈.mD@}nB}jB}lZ%-V0}[\Q[ܻ m;[ ٛ JJ녦F|GHx'(O?= }<h0|8`(0pw@ap08QO 9 {9068cMI(}ҟ6NSof3~p7a`缱ޘyo4ZB.xʼnvL}ZWW9rXsF[[{ endstream endobj 369 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 374 0 obj << /Length 1091 /Filter /FlateDecode >> stream x]o6]Bh oR"Iѡ+KV %;\ɑyo߉lGK3((x}xGcD N[/tm{6! o7L0A2C4T pI1O:/"]NbtibI;$P-,-,ADt䍅}_|x7|+k[oU:P}'m 4 -@ݒp% Da|/f h %8|I-^ӈKRP&G'0 bM–{a{9˲1,Pa1@4̂&^i-X,{0Q7e!В%!ұkY qYGs2npJxKBI%:$`req4p0y /2pntK4Qe Vbw1aľ,J ?*Ĥ"\K~%f\ts҉`EwIQpV&Ia=)n1`;D1=qI !Rlb©7,rO9尮Jkk-Dm gR `eگUxUѴuqng0+K56wl;哌@ABGM(y1KKa^8@@"D%mԍg{L GMQ9,WNoz37,}<'6fJ= twc%Pj.=n~ZzX=Tbu|1\wwI;FT{ \Wk+ RD1|}M"Zwۮ꿘[ #g{TQ1wKwܚ5~&(\VCwdY\i}kXQ2ܦ+*ĉqN54<8e endstream endobj 370 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/DRIMSeq_batch-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 376 0 R /BBox [0 0 494 490] /Resources << /XObject << /Im1 377 0 R >>/ProcSet [ /PDF ] >> /Length 35 /Filter /FlateDecode >> stream x+2T0BC]S]K\.}\C|@.U endstream endobj 377 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DRIMSeq_batch-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 378 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 379 0 R /F3 380 0 R >> /ExtGState << >> /ColorSpace << /sRGB 381 0 R >> >> /Length 1177 /Filter /FlateDecode >> stream xXMo6Wh’A@6CCnFl E}%%^Vѐ̛'rzsm7O\sΌ~y/n6Log~5_n2WL(:ŵX3ySpRp6;IayoK6b:@&X>E%V ^kGsO6〃A PVf-r6b|.@-gdSj &;d9@͡Cd9X_:d9@M @2C5xٺ`#QN+W~ ^wx_+ < L̩QL,fO&2_mxWCˈ,X񿐉yXE uV[[{R6T9E2 $>8[( >7(>T+ 6P4ȈosF4䬧-s93iD`n)z ( oyc [Xaĥk'a0ȫ{#A #`oe0H3 *EM.PĩRz (neYNu+ o*M*`n pzBq!UGM a X%S%[a(WYYiD n(8) T(.`n(*o$^93$) `.m%K{P7v nB\M([I31T\M(K si7`n(;i&6N4 0 ^Bc⽄&wKl n[--Ho;`g)~fNmAG49CVϙZ5tMmn8w@IeksӹsN.Yb/fi|%퇞a#ig7{v#i(a7 v#hW],ofEhQ#d%(Q!`!an.d7ϧsk.&5C*kB[A9`kCֵ"ܽ×򝹽9caWۺ5*?>~=]l~? endstream endobj 383 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 390 0 obj << /Length 2176 /Filter /FlateDecode >> stream xڵko6{~>*@-־dK CDZd%iٞ;H} (^x["`x5^'˃y5 'dA^|a&qҒg ۍޛws&a &a27K,c/pmr yK bgA$]t̄u}\~?yǓg| ~-2yĸ( Dyw`q\y8 "iUw ~AfeH!84h[Uc7-V%򉱕nt_e]{ S>IȧCQMT]6i!Cb\NfCaBJ=e/$OX N~@Ujg)\_ #EJweA.rAYVeF6f2lvKF`MHڠi촙61Ln̨w{bco ]#*(4'G`e4Cq)|Q5用[{"s|L T3>]Hњ~ME=DD*%u1 cPն֎Urgd.RwlD?@f[܂"'=O#~Y$4nJ |ccxtN!֪8ʤ*S[T[!:|Ij@s_59>VQxiMtR[WNZP?Q7w8cBP(6EQΕjsM놦l8\ݒPj)C'Baѽ LHStY&hh8F;;i\eWleB'` +"7U6|{=$Į1Ϋ)MĘS[.b `˭z@ ]Aށ @Xm@Ո$0(K6]J7}ot+'%S>m^}_ V븝XԘvؑoӈYQ]| (|8zk~H/+82JF?'~\6?%NHfМ,Z4C/V$ZCgW]2gQUI[|^Y0a?P&f7fɲ怖%Ӝ/+g+03XBQPE_ig0dz,K$ʸoc? }⥨BO}w4H%$Сv*«?1 endstream endobj 371 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/DRIMSeq_batch_plotProportions-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 392 0 R /BBox [0 0 992 491] /Resources << /XObject << /Im1 393 0 R >>/ProcSet [ /PDF ] >> /Length 35 /Filter /FlateDecode >> stream x+2T0BC]S] \.}\C|@.U  endstream endobj 393 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/DRIMSeq_batch_plotProportions-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 394 0 R /BBox [ 0 0 1008 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 395 0 R /F3 396 0 R >> /ExtGState << /GS1 397 0 R /GS2 398 0 R /GS257 399 0 R /GS258 400 0 R >> /ColorSpace << /sRGB 401 0 R >> >> /Length 3075 /Filter /FlateDecode >> stream xZI\7ׯxGh_s;Od !!p:Q^ϟUuubJ&%#)Rzzyݿ7?xU)7V#g忻ZN//zowZD^9-Oe K7iiq_jƭ1qE[~Z5ZZUzX0`l^Pǝzx`y#Cl"kW?)qEe<0Da:V`qEe_UPԡsmڅUPQ8xqMq(Ú&9xHyv(y9x`ajuSAcV .xڤů6WtƮdz]>#xP|3C\d NRȈ`yC7`[W6dBGX euJ PUΉʫό"2gvW_]fZ_}>7ҕ9goxT>rR44u!G0iu e;gŦR+Yw|ܢ;RkϒV73k> -"IcixL/߱k8x);&"IE2!7:j;d@VHƬ%Y+2 %F@TnM7%C^$æ'_}S:g5,w@2μ7~!ز dXs젉&ڭ91.tWh,ͨI'҂ݿy6l^б4?NgܱhtuNxݞt+'Ng{A.b]K+8m05&di.U'3)pqu5jҹ774F2Dg2dGhykVdE6: foTxr^F0k;/a[לc+]f s[菧, <\|Gyw DnX h!ohڂR%ҡh!y=+|`FB`C%Q]x Z6J-+;H{mŴc Gk* TJZY"UI z!Mp MB]t K(MCP\P\{dXM#bá Z8x䈼ot28G$44,u=fSBd6nk$Fktȶ6$afn}JС*{*ٶn 6@9/ uҁ4崍a;hmgD6ʣLȟ JYB#Ics5$UɈMtent01 F'^qhsux̋ g}[>΍T%h~B͵ʹi0s/"2yU d0QS.tIcʒFg]9 G@\}]39-N'JR5N}g}cw TeF8}θ0l-tl.3QEwnV-o7B. [,JoʗP(G ]h-`\,[fdQݰΎ[BJlC`MJo<'ljr]C \bi&%0F+auYn$-Mb݉l,ttr,g\;Cf"tzLFǙBg{i|iR nᎨsi">c ҺtՃkYzcl9-@y܈T;?X.1݁tIsvԠB=}!rT{te5l}*Jm7llE5`3dǶی-. xsVzظ8`+tIA N,(- WcglCбԵ vBlRs6=[ 멧WBi 'qUb;|30Uj/H K ~TG oKuvԘlmp %:稸ßW7[,>ja'+1љB ǻ7c!{vxLHhi5~68m(G9e⌖;Ɂ&##~CvN "q[gJhƳX_w{!rw">Fn| cbsTCoYQ/gNZbOϳ@sl{L'OmtPm } h/2ʳo5h~yn1iͲnƤ.ų&uI)!iw"= wbmߖﯯ^Q!l=!ej endstream endobj 403 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 408 0 obj << /Length 3515 /Filter /FlateDecode >> stream x]s6ݿB׾P7J|=&^zm憖(D*$v %Ҳ#٦L3~`.G?NO~x(fft:Y+FLjt:1L:K㉈lPI^MlUJxU +|c:Ҋ YN~z1O9/|}SJc;>$Z[+Me6D묬g"<*c\$.wZIa b[s. g@,}NGLtV-~Om'.XuLu^W*Y 'o4bJXx,֚0 $\&uVÕ$@%MpEW+.0bI}pqEu>rzwA,-rF |8OUqy 2<(j+GHأ,@I_>), @EV+ZR7R))T*C <_n *" J .f|EiUg I3t 1mԫ\v] j(hzjx͗eXhk)0 ^E~dZt 譕{q23g:Ei0,cNȈJ8̶݋QS/F0Pv#ilDERxΘ[ZLy]}[5ЊzPUMU&x=n $c.M1Ij(P XF TXWYEyJ/Y~kHd`]m̊=2(uyXqI,Yd(P|C; &Da&ѯ@$c̲7˷ Tug=f0namf-@܃j̔ Y CTJh2KQs2s3û"(t} LNVo+o! P?LUJhc mw5j:=tKYLlG •Ќ̢I]:|Pg'p6{ĔC¸T|8jx x%310$EvV&0}*}kBg%0$)$y=pFԈ$?W,FNݡtʇL EɀLvv3<>܍cpj .unPUM#׈;J遟ZSȋMV䍙;C Pq,_&I>An_=ќkiyQĔ1w-w+!k@Yt|[7Hٲ~[y[B1e }( SB.VN[dҔ\-Rv{Ž0c~_9`% .J\(Q$rx'[$#FP0J)uon"707> m~Cx5?#g`$;ŃF 7!v@'(_-ř evFJGt#7vgjF%j#g ~?cLL7ۢB ;kS Kȗ¯n_&!I?Vr=R{@jgC\ v)'T^ QknwMX,wOKy ֟Vx4)3ao]uޗ81'/lLٜwC7fjH?=wn1z! Ҡcb#P8ޣLW_Ϝ,XOtr/hjQ, Tj$ѿ Tqi6PU/#&7n8yYWCv.VwwzsS R$%k~EEhZJXc`1LˢlR_Tg(]Y9kW?bQ.TV/sT[wpˬp:_冀MTH/_eҪ M젣/l" 5f"0[v\-D9T͢5>  z\E.:8I]KdQ;M]_&γԳk?ܲܟMf]1nIW6]QjQIeohbTqD(-zwJ㑩G#be_>%%l.ZO]F_/S8y,l#?J %z$;n6G悂._ SEnkuS6ȪSNɹnNc \zj|ID[>8å@M 3-3 -3м endstream endobj 415 0 obj << /Length 521 /Filter /FlateDecode >> stream xj@Cd&{>\mHi vuהR"ȲP]b`c kͯ_ݝ^LR mq$lG݀ c,Z H0Ђ9i("Ϊ4Z_QVΊ4j(e͓kAPeY=!(UM7+o?y41>+ u8ŃBo}h?J[$VΫu$RZZBCMiqֵֹ-N'@rJZv/_,qTEn_qE$0CkFR\aP7)F`CxnasZ\'8K⨺/lkn)njKU52V4TƱq;`t< uH$nfȼ1=NC_`d;'DS+O>|WfzzL0ԂzDWFvR1F#ޟrv6ם\Kd.;(ޝd?ǎ{Ak endstream endobj 410 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/SQTLdmSQTLdata_plot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 417 0 R /BBox [0 0 494 494] /Resources << /XObject << /Im1 418 0 R >>/ProcSet [ /PDF ] >> /Length 33 /Filter /FlateDecode >> stream x+2T0BC]SJ5Tp T endstream endobj 418 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/SQTLdmSQTLdata_plot-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 419 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 420 0 R /F3 421 0 R >> /ExtGState << >> /ColorSpace << /sRGB 422 0 R >> >> /Length 770 /Filter /FlateDecode >> stream xVMOA 0c\ARDqhiR 5iIƳ)uvlm.:}z 7P)l*|6]=鮮A"^U.;82ӣ`,*BhBaR;XI 36j)A=(8XXw&x5{FZVݦeFemZ[tJZVݦeG%2|nklPFR!m|iTea$#iaV)/1ǠlǕXO{dfd5}-5 zDFPMN:>דH<}JZ*L 9~w*˛اy}t!O%A<IX 1p6E=5,nwqf({3&46`>MZ"=y9b<{+Ӱ`V*(^+JRqNDXhZ̶ZʶZȶZƶ-xxGMأCǛK 0.{q!q4d~t4^'{Ắr:_]n V3hv_gmҬܤoM jK2rsS2hܶ*>Umwvp> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 411 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/SQTLdmSQTLdata_plot-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 425 0 R /BBox [0 0 494 494] /Resources << /XObject << /Im1 426 0 R >>/ProcSet [ /PDF ] >> /Length 33 /Filter /FlateDecode >> stream x+2T0BC]SJ5Tp T endstream endobj 426 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/SQTLdmSQTLdata_plot-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 427 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 428 0 R /F3 429 0 R >> /ExtGState << >> /ColorSpace << /sRGB 430 0 R >> >> /Length 892 /Filter /FlateDecode >> stream xVKo1 ϯ=ckEDJ*.-R !=N&;ɔta㵿#v S mU\=^k> d ,޸n3>8Y|~떂 S0mKKa8q`;^:4*75*g∖jY䂃Gkf a4fܦ)0tMb G]ʓe^je4+ZR9*uᦀHǖ^*2cHAm7ȞdΗV"T qꁬS'c4ԫ;2b {Ip\NgmBGVbmU[XNu8#6 ee.(wWUC6jXxvĴKJU^SZձ||/p"#vyt^O`Ut`ˣ͏۫c^g^%Totz۫ endstream endobj 432 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 437 0 obj << /Length 3212 /Filter /FlateDecode >> stream x]6}^1#~p}!MCK--MBdkcIᐶݤdCE8pf8%cB$,E}Y@C?.Ξ>2)X<':c֊(TYky[wUYOi)tS]vT;-'ؕ?_\[RMNZ U /^Ml,"K 0~ϳp>wgP?pY!80]1!SύZxbU9n,+Vg 1DM@[0MvyYɁh Ş(- K{!)2}^՝*ja%7Q( JL*m. rue2[GЋ1sWv&V"T72 KЭ&-;("E hۭ9MDQ½pNV-~tֺԺi!q }cA&@J~*Vs+StaҪM y}8[ٰ,5WtQuV `G#L^m|K/)_/a%ttIP3,݊V{\hX<˻ AM H-\vzBMLM` /."z"e^! F +)aVU`L@o?_ϒ4ɵﺂ4:y3+;B 8h ,7lqF`AzB\1 5A+flkW;<&2C^o~F @ֳꪚeݢ*wDDQd+vM·+vDq$'|R xlP{`zn~174)+}"4财Ai%́꿎mKJbHHh,z27}=b]k$PLox=Å1;m ɩVhD\t7PA ޢOiٷv\y_؟ٍϷdq;ak;sa<>̑EM .<.mҹ Ҕ ]VeaUYpJ Y$ /!0mu<+#xA?`Y*>#Je#6~QҠ{L&t/uQbL:Kc/pT "x/>`xbBk0K so0ك#PӥϢ97܏8"1'A߅&@IpAF%ؾTfEb"acs?~Pzrk߼|(n ,Y^!Nm)U`2\1eRrʦ(5>Pk0лtSXe\Jp$|*.kJ(]D =$j<g(;fSfrQOgm#e!Jǀ(9d_Q u|eF$ʒ!}KՆkuz͂ۄὓ::↳ (g##DjIRL1+^Y{D);:Bu}$`MUf#, ʧɨ[?7A͝>x*Gmr<ߔ+wsQ5z$!JEZqM!z!>ZsE.\_8L+߿`7oce~> }:-:4IJ`"?UX;q7i7}CeĄjZʷ> j-wទp *n0g+ݾþYߐO,ص i:6S/i~ CVn3pWCwD)-g:yL8`|jpe//'U)`<{om>bH@M[nyZ1l\Vqqp.)?ROg{\8ЙrcQqjXt{R?BA+hPV/ֱѸ37/:R*rv0 `C5-@dFٯNMi!C XBޛY<G Zc*bDX5)bD]4czRTx7C^{` e촮?}I力C\|/3~J-陋Gq֗"~" Rd}FP" k:/}1(\db8EX, endstream endobj 412 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/SQTLdmSQTLdata_plot-3.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 439 0 R /BBox [0 0 494 494] /Resources << /XObject << /Im1 440 0 R >>/ProcSet [ /PDF ] >> /Length 33 /Filter /FlateDecode >> stream x+2T0BC]SJ5Tp T endstream endobj 440 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/SQTLdmSQTLdata_plot-3.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 441 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 442 0 R /F3 443 0 R >> /ExtGState << >> /ColorSpace << /sRGB 444 0 R >> >> /Length 756 /Filter /FlateDecode >> stream xUMo0 W: l CKt@פkbؿ%˖5m,~I>Qpݗ|}}t ]BJ [m3|x^]Ʒ~wW {p]sni1RWuC`HmԠd@+`Vwp[Z"A0 Z?bN/ }DN]]cqvq܀Rd;: f4h6Y0AsL0šdi{tN S4OBU-g"-*C#aXor9WlV9#,e=ʲYQ|,f,A e 9ϫ&M+)-dp*O+iaJxs;!pFw8}K>@5Y48qƃ(c-F)e}Y^(Se"\UI-yay hGKKo/|f ay}\oɶ)g~j4Xadv%w#I2ˬe6QOy)('|TF\"~ŬQ\, 7UU*zjFj =CF^Xg)Cq2,8!CYsJW$"󷇵'\~/0k:]>onOp 7sc;XYKas1~]ϯayQ:4~$Ϡ :Z?>?˚}> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 324 0 obj << /Type /ObjStm /N 100 /First 893 /Length 2178 /Filter /FlateDecode >> stream xZYoH~ׯ跉Mg` ı'@f8z@SmԊ}D|qMlVw_UifiWɴOhbh3/V@*&ӓQ1Ds( ek/&3Pd;L׿YҜ/8az:]n5uיrӋA[Tg/n\7W' O[[)Zo7gZ o</ $ 6 (7glhB=i㞛wXcRP/pĺ|ZygyQt*w>F } 1L^ a2Oؓp7SkݗUSo]fO6iDFj@OE_@{3Ҍyzz=߂&^vwybif%ydI}ތw~A!g}R'^xA %;? KoK /~ċ=X'0\5@M*:!e# nEUE=<9ʈHa:bDArO9 RvJ^0/!6Ju+?9qL;9-< '6) T@X 5=5]x!9tI.n(pcLAaź caeF.9 %e)|ڟ3R m7pzHs~::^::Vw*$?TmB}?Uw>Wߒܝ{&3>L 3`~1z&<"G0{{YԫOJ4? hPʃ%-f1Qf<\8*ž_/>q%eFM}h7}T*TפRVǺ}BAL]UӻklbTTuTae!=޳᤟432ԿnK<)s3!>~ȱyQ4Vi1ڧâk]ׄ\ѫ0gx O.|G0[Lgm;}GhW%RTM.T*\+/4܇rRgg|!..@-jZ qɳDzzӪ7+7ȉ!N7tB7Fz7Γ{WKNqi+^\leB^EXWswh~&>jӼ)?S v{]]bVn}f]bOVONL#0/y"zXfB5[jC͑^-f)RCexHϝ4DMKk endstream endobj 450 0 obj << /Length 2024 /Filter /FlateDecode >> stream xZYo8~b^kl,6 4X[km ﷊E[w`EE`RًWRF2/,Iktu,7L3Y dC5}ޕ>C*@R˚f驧ly77vn[囷M,_I_8k3JGkB:a $6+WC`Rn~?= >%=4Ko1D9m*hب~p]eǺll*׻)  d[>0+Bz@?m}vs&@^Eqbyy}f91hDZos3F>!h(`%RR\8@%e%Ai\?(B2D, ,C`53##rF8yY)Z,w2i8F\??Ut}*Lą)<lgs!X~s ,5_ˋ{abBU%pE$]88O$ TjaT?v2o;f?yO| V!hȯ+1YCC`ׇ`k$ETawƑ" QmxHC&/B\!q bD_dCF-t}ٳJS޼s d(gw7 s9= bAw 7x2Rx‡n?A2NO6LDH҇: .''DG9؜ENL|ʌ-9fy}~NyVgD\mD"o? j4S*giCT3r nӟb endstream endobj 447 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/SQTLdmPrecision-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 454 0 R /BBox [0 0 494 489] /Resources << /XObject << /Im1 455 0 R >>/ProcSet [ /PDF ] >> /Length 33 /Filter /FlateDecode >> stream x+2T0BC]SJ5Tp T endstream endobj 455 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/SQTLdmPrecision-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 456 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text/ImageC] /Font << /F2 457 0 R /F3 458 0 R >> /ExtGState << /GS1 459 0 R /GS2 460 0 R /GS257 461 0 R /GS258 462 0 R >> /XObject << /Im0 463 0 R >> /ColorSpace << /sRGB 464 0 R >> >> /Length 5244 /Filter /FlateDecode >> stream x][$ŕ~_ hm o|U@MGh-Ηٝ7ȿ㛇W[/?=çC8>x~{Q|>}p HG.s2keu|R>w#c ޕtR78xGw% ᥨcS/4H@0 JpKkl+, , r˻gWτo杬acĘIi`ɥ3ϔg`eG/ciǟ̻7`ӔZ-\GS?H32$8Q@9e"7@#Y'7独(6[$N_8cbki[y?>0.Ÿb\q1.r.aFQQAvNXy ?dZj+بʦ,.F`SnSmZo[?"}$Bqŭccpϸq/xDѵɦD葬3DK_Z86[cE}ss9،ؚVd*{|#q1.Ÿb\˿}gQ툾B}1pe :ynt꧀ qJ&k%ʕooc*#Z䧀J2cL3ZJPDODZ$rNnMmK^m\?ibQFe܎je $7Sd̿n+Bh eQO|=Wfk̗m=}MmK^-wոb\q1.τ8f{juh~GqU0@~~UǂCע '+(}AW[K۬׼*oA1.Ÿb\qyj\\mEzjg7w\revJ,InlBlNUD՚$ܖotЊMQ2E/yU|Wq1.Ÿ˽gh.z=6^;atζ'o޻T}#]bH f/m[^ =R&Ҷ%/[Ab\q1.?n ظH!RU%A/檧U Wfk̗v_uWlFlm^=ob\q1.Ÿ1ԲH^6IRw1WK=i yQ_3w.YɏˈcH:بok`5zT|eȸb\q1.τ˽, 5fj_pI:)ub: SA۾DOZ5aU髪}%)F}31y] m^-wոb\q1.q5pDEow@helI$kTB=T20 [RPB)֥o.Wfkb]z[s۪w[F)q1.IsٟV_z9vmVgQnI DS2fW5أ>(6[z/glBl-m^=o}Ob\q1.Ÿ<5.wש/+Il*KJVP%tw.j ۪U@WԏhTlm-W-5c[o?NեnXQIhDWO\ AX̹|Ql4.Hfıms^-SŸb\qy&\fAt$ $4I Y36h(#]D F}QlI"pJÊMh S/yU:c\q1.Ÿ\`>+*w\vIC9ӪN' ~Vt*l-n7p;Imk^{q1.Ÿb\HLB^6Iz_ q|)*glU|qlVI[،86zT|n\q1.Ÿ\C8K$ aQq ʶ&\i+b5I 0"O؄%j[WIμb\q1.p |>J;>.$>CyГk~~TׂG\cDZ$?ط 5zK|q1.ŸKV%be$ԣ e`!LAS?Q_EE2]glBdm^b߫q1.BA ;gĵ$(/;suz8}ۚ/ |}3(6[$O_<+v\ڶ%/\h\q1.Ÿ;Rve4Lcb"E(Z:-S"+r*)7劝WLm[y>Pb\q1.Ÿ<.83|:fT$OA=M]d㮮tE^KOKt3*R;}MmK^m\q1..n@ /l.?r\"\葬&s^(6[୰|3aXó%{Ÿb\qyn\3.1dמHa/]LF}vAgO'7>:I|QlIv#|&Dڶ%/۸b\~ \=>EШQdS%UKL89 y[(ܺUWQӵKRE|&D65/[F q1.Ÿ=\]#qt[5wZ$WDՕBkQҬ5 'wNT?hl]}QlI"gn[Kۢw[b\q1.{;@8(ˡ#(W SJ}unIhUFXH-z͋}6.Ÿroh,peDBB cONm@"Z(6[_/b[s۪w[kb\q1.yp{אnя:Q de*D2"(6[a@}}Ŏm͈mk^{6.Ÿb\˳2}ZKR vMXLŠ1Y葬B~NI$Nb$6!-m^=ob\q1.ŸZ*Aѱ*l܎3jeqF,&Fq4~Dm%*Pt|ߪ`I~n36!E/yb\q1.p"ubku";N Wl`_}QlfItN3$6#UyUZiɸ+N-L<$ΝMXƂsg|Ed1o<(6[$ Mbbki[yb\qq़Xiaeتa~ТʈSp"zᔜz7- -TJ,56#U/yq1.ŸqFj ǁ\vIr3*hMa]{)ѫ~p+bH"z 7bbki[yb\q1.qAiOu9M%r8򬦉"pv >S(t"A-,٧ifܶ%/۸|\L2'95f7VV䌒H#,UL ?JzF1}o+h=),I ӆ[s۪w[Db\qepJ~6\vI2B H5 )TGꩯ $ԄHX =J&Զ%/>q1.Ÿb\WWJi i5RJub($ i.}F~Wfk4ܢ_5zK|b\q1.?9M[[Qn7V޴`K]2/xu.h Qa8Nu-4*x bfܶ%/j\q1.Ÿ] t:Hld,u?b!xʖEQ}$⫈b5I"fŖoYk۬׼*oYug\q1.Ÿ丠7ǽ5q0{.6?=ī`KCŬˑGbZ<[HQϟ{lV\0qd8/+v$?|xDFc=zp|^'0uplOǫxÿFwvqkWՋ9~C8xRua^|x)zZaBW'I68/eAH),¥3Mp_0;us5m?W_wMc\_7p I"&t|:<>}?_ߟ{?߾~/_gǫ4T*[ҚqNoEYB]7o\s߿;www8c/[sǭ"<ػyOc/a1}\TC)ezP|, zZ(^8?.X,|Z xZ(^9{*  -ӅLOellGZœ-[,Nl!ؒdO-Y(,Nl!q7hໟouPw? ^~w՛s־;ww9U.X}>~.Xt# endstream endobj 463 0 obj << /Type /XObject /Subtype /Image /Width 300 /Height 1 /ColorSpace 464 0 R /BitsPerComponent 8 /Length 832 /Interpolate true /Filter /FlateDecode >> stream x‡7qU-D!3׹ޣ=T*{DCY.t>7?:)x#;h ˕R'B[2 h}e|7w W[V@jj1u:Ly=]րڀ҈.mD@}nB}jB}lZ%-V0}[\Q[ܻ m;[ ٛ JJ녦F|GHx'(O?= }<h0|8`(0pw@ap08QO 9 {9068cMI(}ҟ6NSof3~p7a`缱ޘyo4ZB.xʼnvL}ZWW9rXsF[[{ endstream endobj 466 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 470 0 obj << /Length 2203 /Filter /FlateDecode >> stream xio6 `1M-rl b y${hFIl=C>2XQ|>*.4zqɓGXTtvɔ"-(VDgy.~Z^\LhMʬ$LkE;meWmHQ=,[#>4?E!?߼1iS07?m߿̦w(qϓ4H9[ F$aIl2lل&LǟR{4_uYW mbd >feW$"ob!LDgsh\gg'N(ȝF4%Hٔhv:?q@%QSD'ȝX"ʔv@eWhFƉ,)H1(@0+|uQ8'T(eGI31EZdV,h MD-BDhd >[KcVYLʠSn3T$8FV,Te(nU!^n\XB)$jc Nj-/Y l<_yh j=袩)~~L> \kX 5 u/HŠ+#r r{E Rdr _.('(mHr W. QÇʑl 5\[Е"VmGgT1L–# PdCN:~_i1m cG]+$c\c!C^GȄSb lR_g+s 9EwʙA|-êv~ Gqu+G(̩p2+!R.cA 8;вϖKXMg2w~ga|m/c. , B:iˢ&[..}){E#K$u{>Jdn8I\ɋlUu^lےޱnlKpIXn#ۃT1y8gWɁ56#* IJo21 B -,y{PD(ٻV31quYM6#Y*TvF:}oᇴh&mWNSHaG^6+3(G(zy g*.wmh7Nv$lT,?\h57!p5=Vus5ףx HwOAQ z}a~͒E}q)gVdv3[c+Od#4ȼ~hÔ?:aca#󽎁%/ #w82AcbP )qx9p"5gQ.cTXGPxpR%88j]j|: jmy(tʄR%`[FZ% ~]|>F]|a]| tTKr/,}j5 rjP]\c肚T1~>,l(qcr\A06XvzY^qr#C!:q+P$z5I4[U^ ШۢX/k!+?Voҭ"_9\46=q:_ HרxS@Kㅓ]my^O*1Vo7ru=|wuYo\]\2% deU\'ŤOqxVS>LcwSLX5yj_%vje!&Z)I|$EHM];TL*0!,xqM_uYKMr wBujy: 4nYõ@xYL x_5 \T786&>={=b#Sm_6ylCO}fǷp˰Nv>NSDDؐl0u FM endstream endobj 467 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/SQTLdmTest-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 472 0 R /BBox [0 0 494 490] /Resources << /XObject << /Im1 473 0 R >>/ProcSet [ /PDF ] >> /Length 35 /Filter /FlateDecode >> stream x+2T0BC]S]K\.}\C|@.U endstream endobj 473 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/SQTLdmTest-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 474 0 R /BBox [ 0 0 504 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 475 0 R /F3 476 0 R >> /ExtGState << >> /ColorSpace << /sRGB 477 0 R >> >> /Length 1264 /Filter /FlateDecode >> stream xXo6 19HbP`öaCh_a([$C9IO"ḳ8V?~ܟ&Z?Oϕ /m4Ooky-Y0?O-w>=Lf.`0E /'3o\<ҟhg ݅,\9Ǖ0VD @!&P&Rtpd!F.rEk+3xV 0&M`% "r!A.i %-:]ȕwI[.i1BZ"㖒Ju$ 崒]Nc崒]N v9dӘ t9dRhIr^\]IqR*a-$QEͥj;nVnJ[9^]YA N-׵4&IæRе]t`[F<+!fݶz I^?{6;/g]9HEUYD= Ϥ$"xp=[.յtP( RQ @z(P :\Rӂ7ض)-L#oSu ؃|`gQg*'xfa-'YzҢt`{9kTv"H> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 484 0 obj << /Length 989 /Filter /FlateDecode >> stream xnH_1><`ET*6NHvع5vE9sdB W эg>u@la/%PD"5NZdDF <UxIoq#aR9ۭ>AXS>ǝ-e!ya'=ʹv6Җ.8,e@<<.KT/ j'Ф(Ү'~I͡0)qKrck^O 8\y[-fY>Y^&YZGi!bj)Ua 5ލč T0qWXf=No0731D! ~L:QRUQl,\xv $//rWNNTb<.Ѱbf~6*'Y>Ã7VWFE/,I7x.+*loR4Mҩ8k.ik M=vxV;LRiEX9ARMXe1 endstream endobj 480 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/SQTLplotProportions-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 486 0 R /BBox [0 0 992 491] /Resources << /XObject << /Im1 487 0 R >>/ProcSet [ /PDF ] >> /Length 35 /Filter /FlateDecode >> stream x+2T0BC]S] \.}\C|@.U  endstream endobj 487 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/SQTLplotProportions-1.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 488 0 R /BBox [ 0 0 1008 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 489 0 R /F3 490 0 R >> /ExtGState << /GS1 491 0 R /GS2 492 0 R /GS3 493 0 R /GS257 494 0 R /GS258 495 0 R /GS259 496 0 R >> /ColorSpace << /sRGB 497 0 R >> >> /Length 48239 /Filter /FlateDecode >> stream xˮ%˲%?__@۠hmR s)cf1m͜3ݞw_w);;ˈ_˯U_?W_~__>U~ջ}^jUu__Q~?:(\OUL7?px~+rn 笿i}h4H{+>u P_DCcߣ'DOe?!x"6~B kWO>V|BĽO>wګޯ[/?[/K}5~jjNZ/?F{?z5Mg斿XSXO3m[kޛrEGw6KrV|}>sn}_>د-J)ͧyFmcOkޛrEGo-J}\{RZL~O)eSAM د[F|[̙X2\2}O'&ŧTSo-~',}k~<]ۖXQ|kKM"7u3of0k}_]Q;AR76gnkc_s2ڠ\z {ͿeϿ-΅ukri*w-z`+yUsaz-k_V{u25=l^R+`Q bW6犓>k;KSoY`.XhE+P⟳D?Ѷ|:6Ɩ.ŧKSoYך[09N=y ޯu_PXQL->^{['M"S4{!9#3G?=~J ևĊ|Z6m6(>%^žz:ϝo_s-}׼buQ Id-⤞XQXO3ⴗ&+ŧKSoY1p{&B?'iX<_ )XlO'̉U(NA~_(>S{-4ˎKrz|q{M vU{IN\߃&ŧKSoY#|_9q5<5$|{~1LyHf0,KNIb+E^;{K.=o|}ʾŒܸ[6SKHީ6[{cŧ7֋؏޲/ ;[O^{n)XQXOC6[ Okoɥ޲/ }16}xWɻ~{ɳlm_̡0ko%^žz˾g;Gzwm@-)ͧ+pWڠz7~{S}e8lξ[Ϭs1(؀ZS'OcMam> Neoaoeɩm_|Ko?ܸQ`{v^>lq5IEbE]y1g#ۍ&ŧ֋؏޲/}F>OΌOc,4f}q|Sd~rZ~[㷝kWsoɥ޶/p>e_Ĺq94`c^[~i(ͧYHM Okoɥ~{~1=093O.xfe޶׏/8b5\~WrUz:ˢKKrTm{o ܹLVy,%9x'\oɽ)^~oΑs)2ycHΌ-{^~OS O9^N[N)ͧq7Kl \ 9M"MxJ+4 .߯C593؉*ϵAqm-[i/ #+-mrxΫR *R'OvbE-3˞\{Sn}sn ə{o?kT-XQ7'Ư9׮1ޒK/aOu;mH%yãp_h ~{~%԰G*9'\;/ҋ؏޶/QD w[A7[Ra,Kkiq.x߄Uk[rkJGoٗ ;ɢ}VSqSXSXCڠ\z {m»Q|19O)I=9Zh߱tbE]/&gū؈\mWm"NN1)S~[,_"2ʵAvյKSoۗ'm87\k{{uE 6ོ#b#?"6"k-7֋؏'sq;VHoYHFolaMamaX~56(~~ҋ؏ގtsL L1>2g,cEL=Dv TMqreU˝s{ X)(gko-XQ &-\6(ڽÿ=`O;3IY=ZMڢ /p$VTsZ[g[r%쩷}s+#?'K5s lWS͹R57293Ďuo[Y[i^ IΊe D%`ARpTf$8EN<7֋؏)ng72?G0n[Kf,NkG^»mp SoY{ &oZKk~zĚ~'Wa#zk|Y.=v޽p."\y/785mY<4BMy ҋ؏޶/w ;9"D3Y|Hh2ġu1[rEGoۗvdo x'rXQGGoUlGk3+X93˔c?㶼4T}PxxmRyR.-:+hIk$Ÿh%[E>䴸_$"ŧKS[pw?'Ǘ9Ӑ_VQ-Xϖ?qOoMri~OϵI9[.=}AVڐ}_֙iBf2K95TG('xg.2Mʶ][.c?6:$炣;"vf(43LDsZ']5}Iˉ9y7+-[G4=ضM{C~˳4{DkkĵGKSoٗx3/*zc~"p֦Ev+*sʓ3/3vGZ_Je_ܹ-s .8En΢`ޫsEv.1elakr%쩷<ꎜ+N7ވ0Բz +j${$5,v9쩷<+?'/dXj*_֋lE '՘ M)ͧYq6Q˖"y>)^~j]q^1k򍤴-g6؊& z-ཱN|c1ɼuXcI8#932/Y |) { U1ArIũ8n[G7\ Rpodrf=I½%^~ӻV#qû5ߜ蔌4LA-O u\o[r%쩷S _ g81 o]R $ʒxc k:"!=3*^[)'[co0]Ln"{y}~3طSco0v{K.=u=z 3ng.% Rk?67'\ޖKSaOez:ri~NΊ._+2S i-_/VTf$JXڙ{K.=u@÷985Ư {7 ) 6&֔؏޲NQ<A"lrφ'Q QNѶ| Hg #Hȵ~1 쩷=H3oƌM7+ubb<@=:ƵyI_Iv$LnjC$=H+@XSə4v vޒK/b?z -F_%sHҍ~R0 __j+jٝĎ"g*\z {dbp$֙,SL/X^H97՝*6&O&׮.˽%^žz McoI=ƃ9b@ï6&NymRxZ{K.dEL&~!ŗ`4^+}'ds:.@6&hn!_#7\^wȟչR+]ix_P`5q5Oi)^~v2Ds \: \(qqW:7)ӿ[`MM3XtIȵcҋ؏NFqw~s8pBTVGzAdq6<.)ǡ&3U3Q\;)\z {dG%w92J"~2>-)5+"9 Q*a ^mW-" х {1 iga'c/KN Sb5kWsoɥNv{lt`OGA؈ }1G Aс"NvtU%93>[ٚ`Ÿʔ]XQc[ۮ( 20k7ޒw=}yxqNHa:e/F^Dbt~_v)5"9H-Jl\iCM" HX/8-FBZe3ь`ܦ`w=Ċjy1/!cLMOso˥;mwLv[l:žE:DzRY4#sLT&[ [ēk[soɥ޲/LqΕ4' u {F0 ƒ|Zt[1ʵIim4o5:xP\ltH[֛+Mx*rl̈́dao~Z,7e`an-{7:(\ʗia;#`.m7:6`O +d8y*Dkr-^ƞz;XQuX'sԬ`ˍ VP?xI#Gnlt FZht%^$ad{1߂F f{ GחĊZ~ &J&jo[r%NFhȵvW^ beQNFeaoN/PUo\{K{'#LLFtAGT# lx8d>XU2qu E9Am6ۍT~6 bg}bW+j]r mݲ \z {`Wbre#S4ŀ=S~XQMJ(-(%/KSCwHVRzr=aRd9MƊNJO@pgo[r%쩷 t\yu <Q1G|k*3ـNXY{K.m`+I8L~nVN7d9uܝIl[r%쩷}sN{ Qjp~MSQH u6\E%Yd4mh[TĵQ(Ľ%^~i .a?'y$FYQyAe٪LM.xŕ.&%^žzMxywL&HXQ~'HlC7 OGBnTxv+A'>HP &6\ OVԕeE_qڤ4\z {rCZoƍtymS6fc$XΙ3qe:2S{!ͤUK>Ji 8 6SD*ٳƊCۜ*ѫ+.,^mN72?']*3T{[y @<ދE )xoj849&\:4z[&)ws"n[`k϶51’|Zmڤ4\ {m\8gu9kwm<_}%q7PMOmTSo|Guu1; mݿ{VgG/©:Wֵ'҆O]J|]#rn9]u8d-7ђшʒv^XS==p4~얢kzwu7%쩷C*CRylG:Hg)HC| zeѫfklC>MOsoɭjTߗQR}/ 6R~3j#i`rI,<9vzzroɥ.&qm$sКu 66=Kxj Fcp +;'3׮ޒK/aO ٟo9M\{r>W8sE36=p[r%쩷Clњ=,TF|zg)TXS`茱G2Mk/_.AVa*˃&"6^鳛cѫ'ŌPaE]$^NNs೭2=2r g[ղ(-ڤ4\z {f^0?G-`*^_-Nlt/cE /xr&lKSoۗݖʾdkΌ4q*sVl nql9CkwgޒK/aOw3ǢG6Cp=hqfΐ~B[~qAtbqϵ-cz;T3sa9nmHing,'6vxmR|z_[/aO}mn'|z';rz3m\:2 nAx^Xd.-OwfH.=j\6eo}R=9f{۾%Soٗɦ%KdNLe?}ǿvSaO+*Y78yNν%/n쩷!\X}L~ͬMv/Cv2Ěʒ4|yE!p%ǹҋ؏'£?I99Rn$W//cʛ|gSӑ jsoʭni $ˬ^j:A{mE#,)ͧPa;:hnm4Ūb99uwf–x㡤2S1͍k-cFڢλԼ펛lc390|ҘƎ]f]fQJ0X"ε#KSoYFW`6~N^4h0kl9 kr#95[`6)<%^~;8f9PRt=ͮչyqʧ&ŵ=Oޗ&B^[)jwF712k5dt\ )Xhc6uds7s.&Ei$o[}!+~`|%8vK܃b2F3f w'WͬI!pP̜99h 3ߗ);خĚrւ9Gk;{[.A^R/ȥ꼁Jiw̼S-zj7}^iMʙh=F&h2,7˳#u`wjg+ mv˾[rEGoۗD&jUԱ, |fg! 勶[XQ&:aTm^[ntJ.=ehoOGxsl/}owVTS՜qc+^TڗS8ţG[Ot!Qz.9+*;f&ѐ0vu/[r%쩷 Bsmr éƔmR(?CcEy)_pJR8$mþ6bsqޒK/aO}Iysrͤ6q/ۀQbW'M,ҥr'1ho/'tFдꟓY ͉s{R'F1S3 v̽pgcOwoҢ߻7i&t+ &l@0wN""ԕݬAcua-ncEGo_8` sr%v`2tIs$Ssp6\ޒ[/b?z;Ӑj6C0Z0ݨK1Ő¹F`/ <&j횳AKSRn~oMg6 T6YS} F78’|Zm5Lk {o˥޻ly>}Lv㍐ZX风HKFe9[r%.7+y=E|VMݺQ:)Xbltz&T6rZ6sڻ ]i{V=ON=rq1aIWgR W%QVXQϚAcb^ޒ[/b?z:]iOk>.$V}jy=ڀ5}jH@)ZgJ[؏.7.-Qprv9EAILĄg%SAbQ2kũ[r%n'?ĩ^D;.D(}CoA\O.scʼn/Sx' m,g3cMݾg&gMkso˥-7BsPñM6C/پ|wbj=k{` B)bc*eϵIqmm{c?{؏:W~ ElGOYϖ3AXR\۱~%{&؏nmnM=޾V=O{eGmh{o㛻؜ h{i^yzt픬`Zhp@ędfS #yw'sҜ9`,'hxmR;qoɭw_don&_M~#o {uOO,Nv?#Ez &4OΓH6ZД4V3$$zwx35g{lH0M$@353ZĒ|ZFu˵Iim4w'q]IU G [gC)g+scM-'U%!e/b̽%^~oʾ&;lb|G)GRbEec䨻yZ;CGSo0.NE[T7h+ImQ*f6K[ iݭz3[{K.=v)~W1[᷼W7mٯy6-w7k)r$ qZ+K*Uw+sOAh$Ӕg8K!L꙾fNc~Z;dsoɥގL`/哃3fc4)_ k*ɁK,9/ |:쩷S99H e} 9XE:y͙߯lu=Ԝ)Ƣhۚzoʭm_:l%gvF(LZ'e\|o-W3DaE͜dZYZHnyWޒw{R#+RFbR켎f91ɇ}Тˍ55m˒=XtεޒK/b?z;{~3a &MΙ 2$q +s] l(37;#&GQgz4|,Šڷs`!}tFGsKSoY' ]!fxcv\)XKC]~c#εIim۩؃YɁ;b1&DbErsD|(q{nl 24\{K>2Sob7߽tK΅ՎbZRlu0-,FH.mEzE=!roɛz:z+?'AΚ8F5y};5U=3Ҝ>Tڤ\z ћ˃dv4uEJߑ211{=[:88\L*R0* <=%zĝѶ)?'ӟ>nScˡXbEeer VڤLOXz {RdKץ ;ɱ̕cTc!R&j,)ͧŹeG`D8&ŧTSA;#ܼ=t=r3B/2hT$ip5}H@0؎YY^X{K.=ui!q>L\bn&=LFlCbMam'>3Nڤx]̀\zLeg1SzhpViSRɽ%^žz:2wʹ+ gfu2+KJĮ\ۘ NޒK/b?z4nMѽ3{=lpUSrUOF5u$nBbr_ޒK/aOw\8Lg1E/L6q8\,aEe߆t$Ex%K-y˿_Iet`M S98lTxUS Co]-’|ZU [%֔؏Gl>ɩh8>.wύr.sC>+k:q:zۑYIim9LFr)h$G#'beH..%W:ku)zs6=qtLz97tL{eu|$_tg k*4ތ}oIqmm92}#oIJMdzҥ59HPsN]sTכXS59p=wymQLexH92S*kv"9Lf/v8Aa+jQ2JG"z{-.*a894L4k|I1݀Srr9 6LF-''zo˩9#3z54::_a $ÑXQÿ0XzDvud-20ȡ?'f .U I_Vm+rrgrYi^;gnޒKZN/7zrV4|Gb#y{d"g@rVN,عvsoʭ}w [og9JGXvo ކ "o S5y(9ۘz#A{K.=eFM''ˌ>WQTU?ƚ^4'%vm>\zۡ,g9+$qG.ͬ۔ }6T5O`rhDk7?soʭ}wRLrd\LSo+.t4|5kjUsZ(]ɽ%^~S&o㎲ؕ.f7d9g&+vp\{[.=]':$98G׸r*(XSppkb{[.WBMSK]j- iяjbi^aTT:-t$i7T]2jrm쩷:\t]$0C6poCD챌Mj.'GPum8v 8\z]nml̡ N{h#H?L&q.6CIh)^~vN<+V;t23 |+.$)c 6)>ͽ-^žz 7^srH΋2 'ՑMk*QNɵ&roɥޞDᄮy`AeKdĊ$55~v}9z]*i&@wpdPQ qN*VT$9$r_W-ۿ}67{е5bxqtr}IC+ND癁84٫{R*m;u\Z` TAjEU)'IUW0&k!*" HEѤpo˥WaS=*pF$5񢏪 =bxOӒIlə)BlRe64&e78_ Nu8Ms4{Ǘ`:p:TW\q-'lud/#dNPxp9qU ї;ՌFA[>Y/,A\e7 Iim4&epأaz( ׾+HS 5 q=&5{z%^žzˤ=rTIFz{mb͖eafbѴ#׮yޔ[/b?z;{zsrPY7kŬ>-oUĥ~5Ob#ʵI1{AY[/b?zr< 08sak",]+@C;jVxSRG׿0'*oŇϿ_Xml%1:,GƯʎ&5r]MTKktK{[N-/#LdUsb7{5k8`NEyv~r%GoڟTʛAxցRgr Ws M*[$ĢaGAroɥ_dp'@s! sLJFBCTƇR%\z {-VxpsT8_*JUEb͔ffc3g`rn}j{mOU ae6n1@3VTwT-8x[r%쩷K7~NoYo|5?ӷ&TۗxsFM,-[r%쩷s ~#:3c3$94S(7K>V؅tf0\X-7IDc0!+05]cqJ`lF]}ɽ%^žzuч><:9rT9'DžRի (lCy 等55|JN Œ쵛w|6{hZ[s4sQ?@^ղ9blVM"Cp?x?&:JFQq9`lX!.x{K.W|sٞo͟4j|s__) k*}^ Vkלh-^ƞz;wq}5f ڳl|wY>X)đ!.>ޔ[/b?z7Mۏ9~^cVpl-->[/ϵgGޒ|?on-:tlz81LnI6AYb̵]roɥ훻 ǜ;=#}snwbM(,%\{{Sns=!ieCOfL:PMDQL6= `EX)llA&ŧSo4lerP41>0d*s?3Z'Xv(<'{6tמj[(2e9|vprĊ3WaXəZ{r%9t't=cVSwr=5ղV^6[Mkso˥޾;qjj\)\=ca !"|,{ꖣXS+%fr_T){Sn[xo#sgѯ._[x# 5~-n۾V-<MS 5%0δ7n-r\-ޒK/aO\99 ~o.m雃<}s:=q7G ޔ[/b?z77X\݆}2L6tJrM0VJO9Xݤ.'{K.=ݩAuwѨttV?t H#Ir0W,$ksoɥ-ކp8997BPi#z2 z+kjB&98&VyZ ~?EG&hwMvڜ{޹h髋V>o9+7٥ɩe,[sL-ۉv90贈kS8'QqѸ%Ɗ>m%{L͞[r%쩷73smq=YN}49ԶN(ZXfk#w[{K.=vve%wέND+ǐx!]$.c˗ʹpKjmyu{e`OhVR&(l/{ɠŶA% ^\qkCCn񚕞=sP*9V+ܳcW?#XS+={X1r*nȗd{R""vS ѴlFV*7csoɥ vڪ"h?g"ot&sf ܄ժ$($\̨:t;!,CLqgj'FYg^Ɗ2䨒UEqZroɥ;zuPr 1d)a|g;`E՜$NC=6)'>!5S/cOwk?ɜ,uݍϼ>YxeO3)u-{**eڟRݨ!Rra:o zܜjjݔCMZsXs`KSo.O_U:԰\x)9[2 kjŗ$~\{SnRg;NVs8J9%H P[ ׸ Vre_zxby^?9ݍ=v*cYVL ?$ SrUkkjdVsJl Sk%^~ץO^*;g5;#&ץR]FbIim_AŽvwʥ)ݵF?CDbhFY*`8'n%W{ڢ7\ {StZ= CFpDcqF/[n^82} }ymQ|L^žzW;qlj#w\9n}/<t3/q|ǯ#Ue%F姗:َ.gdĚهY&viޛrEG=/6)L8QO}'5HΌ#aIim>-ӚeݸSnMmwܢva%H0:䃹~akEg>{T6yI&v +|\0?ީ Sn4q&6\)2ŐEKƚʒ XYr{K.wqb'ptƠ,C"kjcڠSb5Q] 5sg;zEl*i0Eڵi VVɒSf[kre쩷qDM9AOwrs P#;f3,->\_1z{¿y_[ćK,rUTχ,2c'XQن49{lC-^žzkf^n*LX>C +lT|LŠ\{{SnWBDTV۫v=M݋) t&ŵ9blA|k쩷^6U-BZxEQT>Ք]fj ybUǡ],%-OU)^~V J'<\`g/QIoՄ1z5e+ơjūfTwwXں>3\7=$2xQF䋾2a=g -ikO7ŧ[v[^>IKA9*y2oS`0=h԰#29$ňvȽ)^~u`Er@J1/fEC:9Z/-Ib vs"zץè>($fRtcFvj+y6VTk99%Z]}KSo_/]̹XYԙ[xr(lWSL!;ω3Y$lg瞕E[r%쩷3/&5697~ۣMcwd;S)YĚ|M5;GfFxoɥS++虃Q>T̞-׷X=Do1!kU~g4`Os]G9vX.ʼn9 <`ks=/9H3ncOwA.M=ޕEO99Ys`ˣt<&qȥ&lf\9>=|KSoۗL}͙|/gR%v)af C]559 kYX}=}vs6qP0NRdco|e@5fپ,w{"ękg05z+޻(󟓃xG'z} W52;<ks@-2w^zǙfS^ػ1EۤOＰXڻf޶/BC<9xhè 1-| 3XQݟtr*ƢSY]̽)^~;ǹtV7{2~S:G,^J}ŵ8 'Q˵IږKSb?z;;nQՃ1ߞ]f.5ŵtur;RΉl}Ijo˥)O|vg8UІR3DoN [:Y7N9iO49D-)9|2wm9'VT49H7rE&ŧKSogeC]ZsIA8И&J6$WAP.9dI,rWr.{K.=;??'Am[TuVŮH_ve8VCZ,ޖ*飷Schjms8j1z)Qke;m9Z-\ޖK/aO{phJ~F{h5Z$*#ER`NDA2. -* <=ɐ6}t;8<#=;(gr(4VTONe a[ a|[r%vaN+jNKli ajk<4m`aE'wnf7t'k;n)^~vv\92 ~NTXҙ7>s瘢bsLQb8-y93>z{1!CWڡ,Rapo PTMQ1 2c)ë5(>}-+^zn쩷ӭgwGr&7"|?`4K|7 =TIJޝ7֋؏޻IjeZ%Am#g)h)X.͖?2VTugr lc&ŧKSoY95<(SaX9=|*Ef\{Sn-t֖ \[7ۧqۺU>[ k*%vk˽%^žz&yɁ+6ZjEln4 r6-SA<ߓyvq`M" QSyy<.ri(j{S,H_l?P=u̅e &ŧKSPMrpB=ͅz@[pp+ޘGŭ}>sMOso˩έ7Ii-y1?K3%I w`3e[Ċjٖ|҉-qɵGޒK/aO<F~>;44c Ku$n:CM_.3z|?kWmfyOJ qǙZ#)9i.ﵳ;zo`{$SP3alx;k~fʥ3^ޑɜ =0F@ylkOXQ# 9hXxr#LM"sp990>og0^μIwl  trzv]Lt/ۙ'N,b;RtU@\LtS:-7y%ޒK/a?zۙיG<%91\3iߔIi3 \M0^;g]v>&х68ӅǤPjè97Nް^ޖS/cO]$c=1fNvý6.SOǖw4x1VI3S'#K`?zۙC]G3ABH͎^?qcMڕrZ>cMg몰,=yoɥ[u-P_E˩m @#~$VTf}$-EeKQ KSo̳\O+@ 6 .krprɔX9g8\z {꽃EcNڈ{_x"Z\hYއ} þyB c6]^x&@7;'{]IܜTY8MuxkXc-a:֋؏έGZpn88?FM1/俩tvW|W09ٖX?se{K.=S!nβON(>)؀V/6TI'ً+CK7$_~ޝԛr8h4\b/Ry/VTϑ{؊ ׮yޒK/aOJa-JjU^Fl)'L[vXA]bbkt[r%쩷 |qTk8=X=q``(؀j{tM];Ab}Z{8C&/ m6xi9l-ۇP)sq䠟mbٖk[/\z {j8drK # ϊ`E"'ZT"%쩷s3v\p(OXk4`Fg1٫XQgc,o;^eݑm( FCoۗiӭ{ENI[-ڔM9 Xtɵs:S-yw?`Om_T.D'9Cazjh1aTŠʲLpEQe7֋؏޶/)FKE9=[>|:+cɌ٤V6yڢl_™]žz۾tãybǔ匏{{qvn5bLἷKSݪ'w#əlx1ص8Ra7C߯6qr ]s~@/b?z۾p(ɩ 8Gnذ qUnĊJ79WHa;EvlRm92qU~NNA̶xrkv=^q-C_Vph|޻6hrpG6hYL YjG|'gR5uNrfI,^p3[r%]J(TkxGuA^bז0 ]MjNCkcސkg"E-y{mXgx8Z>[s9L}Xr1VTV$gaN3Ar(`Om_0r9 >:uٙH(pólǜAĢg]wc[/b?z?69qsRqDj)R!2k6w+iR^ VUGx^}6`"EXQe6 g=m@lܹ6)_bo˩޶/L997 W >g+.. $/sX4n`ޒK/b?z>\_&_Ñ?jpS 8nqJk7.tʕkr|[/8޽sU@;GIee ^(u᭮m]-_ ;$KXȵSsoʭ%\:s{idRܹ~γ|:{ I>؅HXS}k[r%쩷 ۄ9WUo}1_ +je=9f\{[x`Ow|Yn~y12;]MFR-y#KX\;~-ש?Sr&ҡKSoCs`FY9 !'a\#$)a +jnsK,F{ޮ[r%쩷ӡ"4#9+ꑤ,}򉼏,HW5ɇg;|i NoܛrEGoC.'fڱZ, O=Vz6" 7~ޒK/aO=lwJ`Za "AyL a;a_HX5[r;!hoʭ]9|zl+q GGӒRND'gjj'yOJLn~1dHk|0_1Q4c#>6njgqdk{D[r%쩷=u}sn$MGZXq" R,s#$UiOh KkiqpF06ݹ6)>ͽ-žzםVAAn\p4/^.0F8w:yMngj^[/WoyS۠pz UCd@ӔlOr Kݬ) ;&ŧs|ȭw:PזC5 lަ?R-1#Ό3AbGsax-y0gviӠJis⦜RclڣOř6{m=<1\z {'3!Н-΢+/O j\m9ʧR5s{KalCo_P$nthq&<6ѵ>)dll_cE栯nb1;CKSo*{Xyɩ 4v`HB~LԵx}&VT~#7kre쩷=;d 9֭1NoLB5PrpM,(zι.M"-i/[*vVJ_]6V729-~(E*׮FޒK/aO9LտKr4+NAѿm)ڀO3V_wI Yqգv{Snqh} 4Ŕq}1A˃=6"LeBwt^žz۾(5)s&g]h1Tw&$/6(TLNG7cQk7^ro/.Q } 瞜ܓ'poQc9kjf+ksH,T w>ޔ[/b?zpO*,HN ɬn*=e$VT&&%Ʋkr'\z {Wz `a@ہpGlpp)X`)_< +;;9Ol]-;Uyo˥\LɜOmoc˒\_я$`U2D 3o@H#Xr7`|Y}Js?DgnDʌڽweedĊu,!:! -;鄥,fu.F!j-;[Y!;e[zIUn&qDHyl<7͝3F9s S.vZAbYm~۶Q&(,k66RO cK୉8'.ܴ/bO:5RME rn$*cۂXR '(Rb' Enbi_Ğ~s/S5qa-`lXm {XJf j񅍎j۽<7 ؇Z_@h} T;D>. kT;엊FK54 mF^Ǯڏ{nS;rH#;YtsGZ^_hұт8GsNp[Ddir$ ٌ% FBdaq-djrCPBcgRhn,'MŬ\)=f,7jw/cqDz~M;֗[ +q%} LX.liMԚ8|6Ɔ17 ؇\_^GٻoT%tNJ^zKF`p0D..ܴ/bOOk}4#Vܺ /ܐ=;ߖ06fK%=)5v7斝{PLYLuF' j&I[eXIS'_3zjlHq5]~{j;Syǚw+n+6 WmSXݚx*Ol'禝~[g?#;+ݬӘ@@൦tbStjb]ʓiJK५5 sVr\Po,u7䱝i_E9RKrԀT* LWXJC`lC\cܴgsߟT4lNpS|h[]#: +i`K >Xm}~: ~: &C$f{b'U~-lcLM ؇:i.ԇEHY4$4mM&4]m`M;"[g?m殳Lggܬg9IR6szfNsl3wqZþҌe\,==[ yJ7Rܚ["Zcbkn-($ken5_Yh<ں$vWK)_負v&%YS X&K(mGc8a)c5I:QtklJ-=Et*󊱐0N*H֗fy}]86$\eĞ~ ÝBk;b7~rk8)&~O6$\͹i_Ğ~k}ɠ^lófU;EwFvA)oM8a ֮FkWӷ_Ğ~RRxx6b|}kKҊaw}`Tˌvs.}K$ͳDD*a2$a (ӣ XI. 5Ng4v]~[%*^{QUeb Nso,%ml]~[Kv/RHsG^$1iEI >o53dž+]N=R#46k"M#YuhlN!䲷VREh fܲ/bO$nQPPw,|Ua,F~iA!41M{y`OIV{ Gzw&CI-^eB.,v4Ac݂sWƞ~k}<Zٱ R՝[_cucgݹ禝~{XGS]Xge>G>hn8TkKFAvTMZujDy4i%KI3f!;Wޢ퍰L%M 3;-;[,@0&+ ?Z?nO͙D쳀XI]-F[ز:sN}RR 5Uf͖ANp%;Wo{.liƚ^o%n ֗K5TҠgNEY$+vJz2YHc#CcW inrj+/ ^E9,Y_S2WI4nM ;"\cgkn)VkkX Fxߒ|ҷa)ښ~ cs~u`nwڙ|]{ 1.S:!D{ VmȎƎQ%SX,9>i_Ğ~s}Y9T4=z.]T>k ր&5= lS^#P֔&l>o;+a_>-g޿dty\=h*w A'"a۫Oۖ"Dꢱܰ/`~XB܇}k2vy;FLvK)iOks˂fosPmhߛs(7VYgD&s$ĦKxĚvuIvm֗w.XSZIk:},րj{C^0х8ؐ06}&;>EGS:k!8(3Z7yE{|'SK[Rcxn߿ USQOl T[:,)V3?h7 kɵd$FoYR|[v՘q͕ƙ_]Fߒ0j `sn}doȜ#kɬ 6Ǯ%د>UۏmyydCj(ݹmGq,=:(xnwnᷨ }ŊMiQ\DlʣHd%.^Qu[ظHvUcU )ܴ/`~suR⾢DŢ=KR $}XJ}EWcec;SsN='4Ԕ125~#;[\sΎXIY.iJ̅-!՜[vEoN%oU,khݷD4 I.+uXJZyzlZ7M;"[Xgw!|BgWp (-*F,ā؜B!wp#1i0&MeiūyI*E"m8jquQUuTli_Ğ~%B6(Az`7Y%ᱏ\*,-& H՟5{4M {ͯU-bKӒ" DڱKJSRK4XŒi_Ğ~kIA߹v15:]*Yo`=tE+b!j-;"[KD2^c5 {if82-$3[y.&ܴO5$_؇bAGS%:T=Xס 9g a@(AR14q"lC>m9o-)E=$N&-m-JcIO-MA'b:pg施쨴O~kSGWYQ0:#`NDQf4HF\Ih>"!TLxD&:+q>NM$&DQ#g\p@FM{K)Ju4ی]]dž1Iӳ}{Q%vhrgE㖄So;xQufʴc06$\NK{,afZ+.v1:$ŒCCTk ?STM{V5i`OImn,YYf\}VA+;sL%Ks,2Й%jM;"[JsSYi+fvyCNa^mmd?k4H57C5 {워:4AYd(MH`iSlP&X'LlMlǮwjMe_Ğ~ W證WjL5bbf"pkauXIYqTkGؕ=6$eML@) ^B)M&.b%]z[8a[46s.}OxV);VI4?n)Ig6R뱛2<7 ؇;C-r4/5ҲS4\0rX~cm`!ҥs:kXNLsؐp5=O~k}6:2aPfgct):i ,bA0КV"=kհIeIjE}=We|Bmzc!al&JQĤ!j-;=%{Wtd5,3pFCk@9Ԝ&Mg뱳47~S6ME 7+VҮ" 0'`#VRrN34)ilJZZJ%rm7@DfK3#n,O{n$)րGO;a)al\MMP&{][K,̥+^)@]3ocHJ:K&ƶcij7 o~8rYq5X&jQ 6eF}k2RETܴ/bO: ",kLSt}5HvrnR{ZjwrkLX.h۠i_Ğ~su2bM&F ›xBc#c;/sN= q6qj|ebtH*Ƙwqpsi"bl@QcC,iR|AW86$\e_Ğ~694Y d;QSڐ Z^/C[;$dz(<$}.nܶ/`~ktc ƏS3KXXye.)VU^,nZkc+ryX_b'hlkzu~>h֫$솦bwa;Śz;ZsN= uMH.pQ4'v3SwFVFRjgƲ5ΛgsN=>{[wuv6:/TIxho%ɭ55рب:خJܰ/`~+:}{'i"i5 MM.fІ6-ٟʂcEXJImaS4vDsN=Vl.Z7VvBg-PjPhǘҢ!bbY1-vRJFJzD5UvEoz1 ȚZ %a=5d {[@ɱˮܰ/`~s}RIgQLsʼn%)~V˶)|I$ )ܴ/`~+678bs067`lBd`'HZ^pI:bsQSlsN;ޱ91mMÊӽ4]b\}ۇbbb)uc3V,fM;"T`hvc}7j$ƽf ,oPw5wbsqXbA'~*.WR`%MU\ZzPbwf榝~{\ESw~4A">6}_n,6i ;+M{GQ`O t&&NVtGrk.Oca%5m}#6禝~{ߴSscGŚJ$aŸ@JqJffĦd5[vE[J,v5jRI%Io;ZłˀvNʓܴ/bO7`I|\~37`7Kiz&[fkWA^%Nێ7[a)5=)&l^7[WسZ_.%Jњ8m]&-VgSVFnyKMPk**Scfs.} k8`tգ3~M)PAWNYJFKcS Bv&MMYl QvJv[ >ЍJk`zlw ܴ/bO}ևjfX P ]V(=ʇ4o͈؂dž;57 ؇ߛcM 5UzL3)z[ K;igi'L֠| I{ٶ~{QDFrp|u#I7Ia] [T+[5%lı^8Ak"z!9=IRnk;r.c%ߚ76==7o!]oMT/u+HQN\1\}~k?~M;"{҃5d+-^#Uoңū5d)G`~_f~k ՏS L?ـk-5IZ1xvtRh IX;iJX-;[vqjZ֎c:A|uvvVRדšAcz'熽>ޝu^;z%FXoA5P-(v CW)K)_d & [v%c>?NMR8ÊJ-[T 0^cC՘[v%[UKTG\x& kTw6n,d>jr΅Aw!溶~ {_z?cpޟL@>Bxȱ.K.roHO46gXk^_Խm=񱚟jy}O</ 5޿dzܿ/_N7zv5v$Z 7$I4gUM]< 6ƦՈ.}s+v$U/DѕW=ƕ>\kGG.qKY[®!a}cj/`~+7YP_9_ =vW4s3EXWTbH;cc౳A57YTޅ5Er Rm",;f`"D̞vE>0gTLg]JF/UwFP\ )MO168=ɹi_Ğ~Xa}_y><ߟΒUċC> 7W=Ƒm}/q7N%%*aCGqxuri79%T̠AIuMơppH֨J8'ߦ&9b=) +XC{G?-c)%sQoԀ}sؐ]Zs=q6\#r>NMtX0mtЬpsuG~G26<4c9vN=vi@DPjmb8ҿQ9|?f;e+O66Ϋ=v6}`a~ktANMD.&Z^M蒜 P=BRjJ>f(*_{bOM;"[Uk|YsGXpIdY Rfɡ;R06$*m_Ğ~+ǒKEka%) !2%)d6t뷂w:t:]ơؔ0vE*X4A->NM3SVq@-ssEW{KuSWW/zFapdj oBUЛ} %~)V~`,kμhiXslHsN=괾3o NXsG 7r? It^>h4̴f%j{56$e_Ğ~ =jH7P桋 z$U-vqtPu"IU,z~lmӚkJ)oi=Kd%]>AFTsH5®W!j9^Դ!\VҌhIpy=Z3"\!8ڹ!Rw+Qiزx(i_Ğ~su .n&t%ΧǜHqqۘR_J6kZ;MsN=4ڭ}iXoFd Ť|Id"b)al\MMp N@ )ܲS`~ VCAn}Һz,QtJ4zba)%Zb%!/cC՘[vEoK1"qUUnyulFa)'I?Mw{[M;"[ z~8֎%N@})VB۶B[ b!al\MԙWؐpuܞ{`^WڭaJ(RvIV El@htƺUByhnߛFZyoMmb^% Bubk}ׇHO;}Es=V0/z \hƈTD_T,#+i2Htaw*]~[<4BSѲ~w<5Vm_XInnM<ĦxklH I/ ؇߻U@NҔZoVKBxp%I,콓4'6N&ܲ/bOƤ,AIq`uڝÕ;+CqY]Iz"vtECbsBok)Zf9rVR^$^e#XH[LF|06$ܲSbO0ԑA56%>LT>᷂yUSU@B >GpFT%-ueZPw4iq9ynګ{\0}x[eq$ȟfVSv+*Ӛ<06^NMt"lI[ r{lyTv)5AclySM;"[<)Ұu“2;kcv&9s.}h:&|!H " {29TAa͡i_Ğ~+GS?:;a9:-+W ~ՈXH5Qr.$]wՋڞ{`ׯ#7t9v)mĕ4 &e2XDZ`禝~1w`^P_r}HE_zG-wI ϭSsѽWXJH A06kyrM;"[)A,'MOͻ (vϋ3ߒbY+cݱ!-yCbM$ 禝~{-f.>Xk"?&^+mMsMa},%M 6Lc ccin ei:k>b/37@{x?&W4)(}}k-ؐpuS1Koy^Rxur$碠xKuրQبخܴ/bOv,hqj;Hn=ѵfby<&ح ,c!i_斝~{No{ToQ܊K=b%+)N>7.a#phlJ;|K؇';uI`zT#T}uTء_y ,Mo卻yGB/E%kuk +ӚhoR /Cƞt^ʟީuԏ@$JI!Y:X2[Œ4\K{'M{;~oS5}`Lz<Ʊ>)<6bM]z; e={4Q$Mj֛mKOVxΕӅ.,%WK"Hcgs3knٻ{.X_ю%M s0QwN:a?xn?XNT5"5ARRH+^'Vj$8iXJLo8.~ynګX{w$ jy%H$Q(ڧԔeM35MMj47o/&6k |JwDӘ斺rޭml1EXM{3O|N[kNڵSsVQr`Yke5GX'd#V+nlCnYinߛ'3ĚH [)$;CN/}vk_)z h^[vE;Z+}ڬA_񭠄5 hZ#$#qOlh[vE/c66hȑ{>/Icv8k:!I3qD(ؐp5斝~{ym?'?" ׈¹{׽Y}5H/^T {%?GS$+W"#r{H禽(Z_&g?' ^|IiNFzE,rqC8&'ؐ\ø؇\_zVjx᤹vh=ջjɧԻ+o>,y lp!.Y~ qm;:;c~:w:)Oa ~ᱏupw/_q~uo5C?zliRr5UƢ|]๋ڿYҫn ^ŭ<(1v I{Rr 516Ո|J;C^1:<統%iMB{}ǐfP=Mz&9%yѶ=͌vljz[UcWjn߻oB$kMv,eTdIc.,$ma#{lH[XsNO=޹k-|=YcMFO}2OKiHQ3RR4{M !)`M;"k51ۧ@mwc;@d2kVMI1vjuEߍ 5Vq,&7HX@$;w4^b+88vݜsv3֞Ұ/OI1tuq]v(f(-m3;@sN=ޅqIHSqPM)iGX6R 汳vo/ sV͌䏕gjw׭8}tO ᐾs5*ʬNq^1*2a]ܴ/`~_Wl'&5IFza%U=H:ܴ/bO,7S` '9{eIZQ xj2F)՘v޿0+76U/9m{uuvKa/,,{s8綝{)dk"tG؅dYܠ2OKi*nMd2:Iz47}Awؒ̚6p)a 5JjYLf];{ܴ/bODw Nq%yZ >($V~aG&K !ܲ/aOKyRHǦ7?V<c8'+{mzHv 1jCVe-I'* 6R4f_fzlHg4M*~etx}7'ր%i}b%?F 򗅭]֗ym;"Z&;D|/t[EHҽ'V' DۊrI߹{C( ؇5~t7˷!)րz*nJڵ6DQw榝~{.o(ך+FTd*BG84wDQ{n;>UbDmv$z N+Jz[&q R8vҹ禝~[/*CLd$7ƉsH҉}mōd.[kېq̱jnګ:7a~Q7:'H<ח:sG|,"}MG|X_8I};V| LD}Z%MpGVJ#A9 VJ*gFX_6<=7o/C|T}"gToEFX}dE9ؒǬZ8ccghnteDψSSxFw$i HU+*q_Ğ·dž;Z~[˭fR[{ӱO rèbT`ao#iKؼna_>Dd- f<6.\p8q_*oIJXS"/lxs1 oCcEǩjV憉keޱ=KšخEOߢZhKVڍ\GRS7È85$S7u% ;0;@*'툔]~{M`-Hk.\e"qxYlmom6,PgbD4oNAǩ^*5^Tj` +HeSÔخ>ETkiܴ/bO7V5pP1)=% R*pio #֚;1665PvoM<,7!,OpNn8 Rы-Bw9_0ߊj6sA?l҈SwnFRz@؏6s1{cOC}.[Ƒ~tҶEةDn.1D=7NPѨND;ipIp^XIUEd=v2]~{CO\;ׂthԁ% sn,,P)¦ uؐp5斝~{9yssuԚ)&y1vQΩg}cn;9[jը HRF ؽ "ODT)4'lRv I9~{㞌K/=ԬH@+ Vx$I8m}`C@yk"FBlt.({tݚM!8cNH!&;mR;Ah klFTsbܴ7Nǭlk5WqhV/dr8ݣpJͣ .> 1x\i_>2}{*Tbh4s?9ߍ4w"Nllxl7>ܴ/`~k})H9qETZJ 8ҝ;HUtڧB O8֏p>qvTN' j ͩkt1_ۖ(iؠa&|ܰ/`~k}C5 Z]9J7On陏9Y- REКm[l~obSo\tVem懁tPm>kmTno&8iǵaȀUq".bMEHZ1 ~JpfC3/vKDhl.rp\dXIEO&kr1qi_>m)o]U`7~ r5~o]?LoQĘ- 'oe=}`]?+8ZzokM*s%[qɺ|#I&[8_?ȼӈJ}ӈ'?GOk>n#xSRzEoS3H9lC+=ݒC;q55%Ms$D~"XF{2 MT>q}K1vcsد>%?`Χ\?au\_(ګQd޿?ʸ@PG+ʋ{~Y/IswDKHHz\׫ )rDm'2#kZثc_;s.O}`5=YZqeK^n{XIY?K Ryt/^`>%_e͇m!U}I{H{3׿U !r_o \j M =rGXo XJ[Qg§dlؐj-{;ݪqcwkTМq/Wa%XڄM96^lo'/*[D2C!_^*.do&m2+{9B7hz&Ǜ*G/sigNKX?̏QrD#?4~ou5* ,,ZW֕4%qfmWS6¦z WcncbNY,m5n+hq/0B )b{z`cǽ?].w!>~\4w?]Blz;"i,Wݪ(u?.[ز>倭mP0)_tE<_h@$YSЍ )8m+)Lcl\=q'fslJN]/a~+ UeM$^J|et/_N݋ǽz/lz؜v_gWYrcoBoO_ ei˸۵r\ W9ˑ爟$?q,]X+<*Oj7ʬ²3iRcl\ :.ܴ/b~ %ec<hV@s "|`1y/:Pϱ!B<ǯ:[I9bMW~>T_yzN$ot5MzFcC:E~b~]HsEO6(w!bs.5#B{??KP=~/(xZpKi/k>~=1^xؐ}{hVXB`gGN_4N[L])"{??^nMtl5?cЎ;%Ą<ϱ!}K9ٽVd/܀tᔌw`2`V0s22+V h?9İ{#MjK 7@d,mG׿u"ǛF+9Aj4y'q^ *+(UGM t]pC!J<|o^▭Ǝr=">M3rW7Z"|{z`c^ 9C!ccn.Sy[ "^罴 4v{lM</Yj>f>{I8ϡ*TY;vd޿AI_hD4Dy!%k#_j 5 Q>N]el8jZ "l7=6[Hp\[U[7~ýǽǽ]ǽeWEǞ?Nq"ZPK>[i5@$|m׿v/G4B9/*b6f&~|IE9G"ҁ%l'qcCRs؇H:DR5ޢ9My/Wb!q^в $q/ӽt5Ϋ꾗8$^`?^*H!x/^h'^Y[^y_SCƝYj*lα5>%v gGt$TͳeE ay6sDMs G:[QDL$*~HCrO>ϫ\cl2}; ?ɼ ^q zdzm>k Rl[sƇXq`]C{/'VT0n9vmA9>fz-u)fIȘxe|{+i7f~: 96^l'_D+@+rFVuaFtX#YTG׿yr+VOV Dly/ ܧuُ8`Cdou\Y_yEm8*Y+#2*OH^9:4#Y[CE׿5#eN#@>"u*"wIJ}F2UDKd*Jq;q55dlz؜v_|{6芊xUi`K9awI,qV oj`$O/M h?y%43a1ܩ ZnN@$ɺ ?ʅO;w^WW|{ҿ/rME=.~RB:;DJ!ƞcS1>]gܥu/{w{]$wV\WнclJ{؇߿żmR'PA/srzا)O;w]љ|.zH5qB4ʽ2QiJ}m)XKUǫu8G:)a?9?U<佫ZEğ2wQwF? <_#~}zU|^TVjs{ϟ5׺7_7k?ǷU@.߼l_!k~.?_/F5n=~.@_Bc1ٿ:$>{{WG#ѣGhW#y_,]H:p(h2~oM-HA3qO /_g~Aicg+gםo|Y`hݟTޟz˘B '>˯`aa,Wij?>Kȿ\,]GYl*[Yt|v> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 481 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/RtmpVy4Obg/Rbuild2d824050f954db/DRIMSeq/vignettes/figure/SQTLplotProportions-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 500 0 R /BBox [0 0 992 494] /Resources << /XObject << /Im1 501 0 R >>/ProcSet [ /PDF ] >> /Length 33 /Filter /FlateDecode >> stream x+2T0BC]SJ5Tp T endstream endobj 501 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./figure/SQTLplotProportions-2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 502 0 R /BBox [ 0 0 1008 504] /Resources << /ProcSet [/PDF/Text] /Font << /F2 503 0 R /F3 504 0 R >> /ExtGState << >> /ColorSpace << /sRGB 505 0 R >> >> /Length 48401 /Filter /FlateDecode >> stream xˮ&6'H+@6` 6F-~*VV3ERk-I?ʏQ~c?~??ʏ|_(}?8w=?~&?Z]k}}ݏ7?3?Z3?G{>gsg-?|ε]@y=~.hgsYE>ݗ󼿕k<揯?mKsqIk}QB(/WH7lRëy=>t֝c=_Eo_wH7y6&샳=ǵb=vOq 9#4׏H}&=vv{꽣t1r.`?,Ӻ{z=;b4X7lRн~kzt? 9O?|S&V> 󠵛+) Orޝ?}N eX&^Vn(i5o4oĺxvHgM|?\78^F WotWLawYM%%ݼZy' [ؖRb?֚ؖwԟgXSн}z?z{|>RǦvUvݿ]۹M/xcum~;w>~pϚx^bvTu/zgXߦIPzt8eL;CGc%W܋k=dUO= _0F~AK* 7> pe":]n^-NYjb]~ڭ ygu,c }kOYR>kӽ}H}mImEO FX YsŽBoy|w 悧LMR_}b7nKxj+V<^ 9Mav|;tjszclnRͱ-/a㴂%2W'j,VcEQYpA{t>K|+]\nXFwj]$N+wp#{|>[-x Lk<"k\2+ѿ{%{MH]/N^,T@9i8yxsMd|FAgx)xЯSW۱͉!tc?'yjė ߻諤S{u$s{b=uu5v+sk9¥4Us}k^#u_uE,^c&$ebF?Ur*I]‹x8%7̃5ݼZIjmy߱vL^=[?K,\Abku4XN[5gUǽOH[c?,qz7n=wGj]$.(-~_actL.x1(ppn!-_1pW}t|Rn~a#/E=}`;{ R0NmV)8ʙ]!2>)X~<2#>֊a5&\'YO>.8kNxvt-GEfϽ>Sv NiIGp"}^?ZIRiip|Ċ{~_i*z4г@HPf~Dt}.>}O) N8gV/ipd/`H O"w7qpEH͹:IźMR=ɋvKߙUYXn#^S{֫%e$NR2jDwZԪ1)5j>{Xc3_ͯ{̯?u7j~n?¨mak2^_/ݕ~ߨt'9;w;va? oܕ^0]f`1yDSabD10RzK(AXVcJ*km]X+3K=o̷qu7.lZIlKnwMy\ly]*fNr:_I\' ]f8grI N:&^'P"&{׼cÉ 0nB]Z5&Vd1m㌸w;XcMA)<~Y {jǐFa?˩o0>8`? G ` fN? $.۹|v9c39W/ƽX1iQ32㭝{ny8==ꮛؒ.b?*Zk( ]ƽ`$aG!~kJbv[?| BPm>Κl~KzѺ?boۦn>2lN= =7ۧ^fۧ6 a_Rpħ6ϷE17խ;IF Oosvm]սɚXc-Ĩ1?ѱ0} ,I`%q4]ͱi%AҺjcjs}+NR㚈"ɮCK_cj) ;猣y?8kp8 @)cr k y8cG(MîrE>x}?$N0'2$辿e! V:iĚn^-fĖxbwnM"n~݇?pV{6FC>9oUB H:O#ND˧P WjISRZCn߄_L#B8G΅Jn _mdrG7ujqK~r&ū9ӔMl0l?+R_ܯL҉)Z8&~HiLIipOۇ/ɧO[r~+RǁL(8EK9Vlj59&_ؒ.aw w%W@<1۝g_^ZWq$NŘ<֤gZIRͰ6[3^9k~.ίq!"4k!KUSXy]N;cEA7g`bs Wkle~3)b[7Cxsf|maqT (9N֌5KONlĶXfg-vmSr$w+7~&g='%] %EոX B?b硘b\Kipo܈k{S7^,d݅578hn)~/H ûZM1%5mMp^{UMDnEdCN)"H8ЊKŨH+ OcJJkl}{qF`L8DlS@;EL@1 nIscakmN~Lg<ˆ~ējNr<2,bF02Ԝ8o)gR7)^ͱ%]~>14GBא*6:1%B͉K%'g/j6))nunQP9+JH+ afyXS-Ü)$8=ǖ\vawjɸuc*l1%aLXk<7&VbL0l pNti<2¶Djf""cF"8{]GQhheX"V))nuo" Xœq$F0ѱZ rLIips[CJC[>Kwp:7 #1+j.934;XIsrleos,(R]q:8FdZ%1BI #'T\x ] [r%nc_݈ -Sq>jb7rQ~)VQƊ*L {TYREѯ^ɨ{3 sKGkzC~u()#pS%&oH))n+9ˊZڵ%܂;g0B.f(W8Mi093F>ɱ%]v{%ۆ "?DKbW#Ix[kt1%5m{%kXدS-P ٭ՔgzbEA7&', ؖ.cw߽Wӂ̸pXv:N$p3aW#z(f^03VIwZ+ ^1-5mz%OD.=jr &{N؎ A9rzل5u<~Fr"ؒ.a?~Q5vNӬr) dML{y7952!55[Lq~B˄LbIQ7(fݤx5Ƕݯs='mV@w%^+v 魑~DO2*ZIP+ƴE[=31Bni#n2zRS!ٔ &TD$/]cK.5b N~ss@5M1Cw-xI'Lf]t!:>.*[NK#0'jtd q SEi%,)5~@FU"?0z|V"ΧlKL/,DƐ 6swi=޽Q]1btTH U )=c1DZb0W8$Xk:SRZ#fDD<`THNEAb J)53/c dna#0zuP(^]lNrY*nr",9_bwpbAHu*D09E06J'INag5ū5~Xn419h!q2oieZd+,KxGbzc#C⤵fZǔ_>vS1x H$: Ju@+xzHڑ¢sr9Kj#HYLA:{QbdՐ)u61%5mOgpͱqX.֣8ya"6_WʣJ>e),',J[rEݯY+r)ӌ*kث5y [0G""͘W @w6[ߧ3-<3X0D̰>ȸLqQM;ɱNJ|=$!r>vʱ%]v>VlKi4K|PR\)<`8ɹV2VTiR"ƢZṉ%]v7MIxb8CIb3͍|%ia2-̺GN[r%n)[^lN1Y v4œmnC ؉5 Cb:Rx[rEl=^alP1P[b(р^%[z8^"3}cJJkl}?Xc,BF}\O8Ȕo)E()#;b} kB[ǔ,p]A(b4uy])R H`haE 37)Cݤx5Ƕ\v ]fvxffvᶙE?.k̡>|Xʴ!LV҅RDdM311ڄZ1%5mynZ-jD$ԁ0K $mZ [Zǔfwj"N5LBBΘtqt8[H2T28nӤiLIip (۬Bs /Mg.~qxXkwǤTݾu451N:* M\tƵg))q$쀌I`WZudzƔ?poYL."1jNƽm!nX݆qM=?Afޡm R6\ YC܇ߥGjUgedh3dUS΅dlUcjOǖ\v UzO//)j6qѥRTMcE=o:sSPl"աw9KŃvߙəv5*S{:*TgOͫi9jxrleݯ#KVVs#HB((_4+&)*XS+Gej.rEݯ# 3X2qauMcm\.Ŗbl Hǔ>c1 8{  2S q$՗\fFȭ5mFt/Cbu-؝ՆZw]$Ɖ>7Aw5WMnF׈U`FC.l\͎\ʼtm$3̀޸#bpǔT 50Q(+3 %O@H0Ĵ dhk{LIbl}pzRQk00;BV(N>PcEeLsR~KlaH&ū9Kߧ3"Pcs΀",1bbo&+xbr&"a:nRcKnK,έND휋a&Ƚt6)Ogqffy7+O{utƱ%]~>5g8R F5@f ^8&YSL㖢E )c>ѐSRZ#fwٽ;O'(4'/V9@sTD{RfHNP6l;7a昖6[ߧ6}~vlthզo;>rmcdz9cJJkl}fѻPA{yV^ g*J}btG)Xq"|1,b$ ٟ[ؒ.awDsNIxb%SPEl|+jd9(ŜXtI1968iWg7v:VNos{ :DxZ+dnoP?4 ,3O͹ Zk4-ӖcXQgכ^(zeS^Kc[.~FG'j S: OȮ*Xđxݞ}!)֚SRZ#f{Vάd:qN&f"< .Os,$ƺ@1ƁVʀm))n=x8Ќ,zeK(7&*Kp,YbLޣ3~i%K1ƸYT5^A_;k*3:G7tK9b)+6JyѺ7=6嶋_=bHjH<^(1Lٷr2aZQZؒ.aw_=TqWFz"*=TLuսJLNX;KGؒ.aw_=s'Uv'nLdS\ĽRZ8p$b4tZ}WxLIipCu y"ɘL8>q>.(C}݊q$FgaIe-hLIipHVnG2a@ h){Ƒȍ7ʹ܅zLJe qH$8m=hrQs.d^kț#&A")ugrEȦR.Zc5nBa\)eHTB(lEZ[k*cJJkl}D/GqƧh[WQ[|ݺ Ts*]mײdDGAQ{D;hjj)fGzjl@JG?ҘۓΞ]}ٜ =YgQgX"JB+DFc1%'wc/E 9^¦.2mJr.+:>9nEal-v;7dU]8A:}tEʮ29+jۆ:XpZQ-" Pafg uT">r0,Evq$G2UdEF)il䧷, iN$2Yjp-)N9'Y~xSrq-8--tZJwɢ[r%ntWE@Rqizݫi_|-܅mq!f}n))n=]m)(ȴIHC|6\ '$3j8Ff{|覧W9'] *^d5 {[~O8'T V6G%]vW›:bTQ>zm(bkq$dܸ8{A븞oyDͅ+2@ft.3nWvƁX+)(I<0o)01)5{}Nb0݋,FTOZbE)N'B'tgؒ.awߧ3aZp[~[<1Ę8pʱhJ`}؂7.%]vG8"mQ}S9T2#DQS1YWcM5gSag,ϩdvǦvaw$ٗjiVA`B<i!ND4!RZ ))n}n6243{cnʱnsmn%g/i63߱rnl}Pie0GhENRףq$2ɌCl1D1%5mlj@ǩ~UE90 6qY7QS:T_Ida3cSYk?cJJkl}!A'`×*VdH^*%@NSaŒ%xl#-ͮ6]scSn='Mr+"azq4ѐ"`@{ IDOOl0΋;p!gchLKapbѲpp(bYÀ%,5kJO w(ʙdBЧZ SҮҏm\cb,̔Ps.DhC_+ kQGѨXQٍ!9hsaDuLؖ.awKfǻ:Yz":*K\]{ɸ~xu+,2/Ř6[Y'3lbV( ݬ-I+`ՙR6DwΓfkJku))n$le2[89(.qn+A‰i?!n!@SZI)xApoظtJ:UZ#1ʈ^8YŃ\/vV{&9M,S_cK.~ߓDֳbEs`R( yol(9ju%V#st0@urenE"3&DU8b#>pSI(J+@ p OXR׾n;c/{m}Վ/`hOF\Xo_:>C:UTnٜ :xo^Ał= S'GƊ:smΊ6㋰nRc[.~7e#ί Nr&"Dl{Sq"~bLvK#nXZGkLIip'qrRNά'&6OF>Ǩg9 kj9:9(XTKiV)]~]+fSp*WiV0a^a2G7 ؖ.cwۭM5kF{q~-~ k*#ӑIgl 8S7)n8K%œNaj8!Iŏ&@bQ(uɱ%_Qn @ .B1ą-3 Xp5#1V6I ƱK>M5F?[19U,Ue|MʕRD7R܇mȥ98ĠYks))n8T $ 'ua<׳"8> &NԺQsLKaqE/ї'?8 GD=NˊBMQ&đU-LF@i%K1Ƹm*:Yo1ߓOzA'sbg'T s7II嘒v[CCz'0ҶiWӶ )a#'DH/֑l)vl}/Xp:ќpd(|p1r;R A%3.9nRc[.K E>vAWƦ__;=.L!cH9jf'VԙQ,+.bMWslercw PMNW}' VĢ<Ě:|n΁o8@+usliE=N uIOΉ{w5ԦHlPw5]Zj)zlkl}_Kx\'hp,z/y9X^E1Ya8LN֚'SҥJցm}1|m ֤"SųFHd3!Z6[ߣK½_cNG'(q"0|E@8u7yf`ntQ1--Fft),Z+jH 2Znę(~!qpbh%ۏcak<s Cxl`g7A8wZTI!nوzk0!~D艃ʤ2HD "8zHsG-v;gcAbY4܂ag㽊 H\qpZkEƔ]>Sqދ|Q ezv ă8df ̸A& =&`EvOǜ ~:QRf1g_G(lciŠY !vܷu,,-mbiln7rC Ѹ9.rVp:D?KqFid`R 4֑=5r 'ʗ|=B\< 0%mQlƁV^JJw҃M$x)ƴ RD3֘{ 9\r. W8۱Ӌq$h3f))nU V'l(?f-{A3|(?-8ʰ2G5i]1-ym|JN~Sq̆Z`BcSn;vAƚ;A$nbUAW]9KSah6Tsb?lkOr`)\ObO*Ǔzfk6m5#|Qxw TC=+BXSYÜ{G²*unmt u֟.b#*XGbea(@V9ј6[7d ,1*9X&z*s$)7M‰(w_± cZJkm.yjE#2q.f 8MX4R>1`Ig1c ɨؒ.b?6c0N6!QLiSq>r855ͤ9;&Ƿ{vؔ.b?~?.hY-9> -*] ޺LHK;K k*밙S*;3unm92v Q @ih(RZJ95Uc:3<ǖ\vaq|z}m {mѮ|]p'>7>>:"NbZ2۶FWxv>n&[0a ⏀ǵ1S\ ONG٦0W5F2Fٜ^;9N954S Kﯶ6D^5U:D)5zl*`:7n?.)nk9}Ɗzٛsī\ anR}=92JЉ1ClBk<:]m༫đV5K+^1%5meN=/ǐ,78=-FCBVxLIips|"F6^RX7qJ:ƉXO2f|4Jplǔ>}a'Z'8WYNSP!6XQ,DF nRclevO_X1*H](ciE3M_$ u!Na}Ook2J_Rx6i;vTh4jGJkqK cD`ƔT>}UTN2q$QYbBN"2.H)`ƑN2%Ck^@yLIipy4A) IZѯF8h`5?p&h1%]z1n}* P:%өr N/=)K#ќnjHZ1%5mit^g `r"^7{uz-bGbJt&/.}<$[rUଢL@'+*j -i'b'Z6Z~ݒXQg&BnRʒr%n)V_1s{=}5qϦتv- 'br@ ><SRZCnY:23k:h!j*Ҙ˙R/D&J>I+ ^1-5mZNGp6U![rZOu-81%=nl~EMUЙWh< C j]CR 'ȳ22أU8hV>VGJaqgehChl*- GUS-tpta ^28dYk.yLIipgeҬ3f˩cs4K'KWJnT.|:Z3R4u<'d( 5mUB]Sc w\(~;datl\Ik (9+*=WA՝VKwzrle(]988(u)sF1)$VTτ,s1hkdyle59\ rfg)")d<c]N>XEk&$Caw=aދ ZǛ`xAv&9CS)aj sLIip 8X3VAhRiw=̨c)S t3,5nZw6RYCnlxE2NHLtu=pՆd!YM lF`l1%5m~}MNEǩS'\I 1":V8%ͨ+ jI!n=^2 hDr*;U!@X,*++lu,9H76R3uu=r%n{1ƅz@z8ψ.#UG#:M1\7B"'Q 4Z,z0b\Ki#ql_Y.uc"k=2W~CҮ|ѓhw1pi(5#X=b~>sZ|åiXE{9R L|Vtjp.NBdi&K1ɸ2'>~ wz:H0z:~]Ɖdfp,.I!n=1p9:ᗘx.wb)Wߔ6d?p3A[ iR!`xzaj#c޲pH-:PhW^4kvP+^1%5mx\3S3G؟2 91YR6VDP10u2&z91)5~7UtKUsR:DxCdwsv V#GĊ93alGuؒ.aw<BrsC "-C",o%T#9QX=䲋cB@;^(=&oAK8 '?qheNc))n"s8Ͳ (ˮH8Hjfmq8֖+5Fw/"6ԯ1FMXgʱeJa BGɀ[ؖ.b?~R\.3CцUEQzLݳG%_/2F~m{:0]:DpkK^8yLjt͖’ZcJJkl}u6Nl^efc\rȰ6-RR:-io u'cE1%5mgAȽS`GYy#D|:YOI9nĊjxe.ncK.~V'?_^8Q/PxќUS%ݼZh-<[nQc\ yRtoF@v$LJJq?G!+ᢻȰVʀNkhq,N'7H[?PTcMt'btaY"L4c q Һ2ScZJkl6?E)hčQu\廓+`xZq$G~4ZG)`Y1%5m{Yo8堿b)5ỊLXR9b- rYzcw6n_#NAgMW0I,g!cMerq. z!HIP16!lљ=b1R 𮩝)Eq$Hbxk̈́y))nX f,F_4lNO jJ:%b@iOpeKcJZn9jBF9M9#7$7kY>2c#BIQ7Ƕ|zmn{(ږ_m{5WJ;뮦/c`D8q>%$x)+HJl.F9fKB.a uPs!҆JH q豱76 yLJe qE%=8b H!Jb=~),&NDI,ƅ_{Z+ ޯjZ*jߒq;5 _#呣`bE弗0SXwyc[..OEVO{]5-9a#}{g+85DfI *:IkcJ꒯m'ᘍ뜯H;P7+.&oRKHt}q8I=ǔMDIݛH]7qr'jrh2+xRM䘒6[S4Ŏ_'keHI r3=J+ĉ8GC[ 7"$cZm~pf a9Ҕ'^Z}g:ץ$V:8am)6[OK1|휂Hv92z+f{Ed峰\ ޳s'v'OJ}K2u^6[GUdYɃ.&j[z٥3mmXcJJkl}P:/U+-9<,}-*Ag'{u9̂1i0Mʳcm92vbCgrs ƒ Ž4[XRͫ9NX Ijm,v=Dq^ft>T %h'' W~Iy1%51HGc\O"/ 1PӮIlP<"qx| ֘6[s-Fb1c߶q?lb/'Y6 Ɗz 䙃ae/~jyleAKF; 7=Y^otDd&1+p~i}5K}QTh=~I934hq(,R"Ȱ=G"SĐ8&Ir1-5mMgvq U1!֔Mr95#INe<9S%]~grqQp `+$!R^[E'ԩ8>ǖ\v 1"L?b+SS1/S3U}&ݢͱ%]vW `zj(*|B* l]_`T{2;GĊ:2]m=7#C{= v;L9J|VǗ񤜹9c;!񤪍ϔ322ul>)ge<)gF:ė_;N_F}8EqCc7<>ƊZ}1g{L1ǖ\v CYSRHago؋gZ^9XaM5ћyL4R51%5m~l \3܈ĆCtO{[Vq[wq$'"Ƃ[C8Kzr9Ƹw$2p*[*~oGĶ¤9y[}cbEt#Hb=FcK.~oi:?9ͱ?7Fa/Rz*@8gd$"uX+ ^1-5mRa,9X/X86(:gBScMlz"uW?`9䲋H HȨ(}QpU\Dw[JK2L#Q`ǐi%K1FwGX9/*wk0q$K#j8*irjX MY4ǖ\v Qr $9'zjFb9@EDZOfyR~qujqБ؅.MWsleEyn!gQk9 "P])n(g׾|2&MV*gƸs_MtT`6[itVnnSҭڿ/B"+,(^XW6:kZQ83̀[gIZIpØv[ߧ3JV1V1C::/"=G=8j#JlB\s3Ferg6[>ڌǥZk+NVt&t\qH+/%zt6WIPcXCnwQamRQg)a,Yjr!VT>/AMWsleM2/Ռ1 $2:Tg-5Ki6L8weYcJ\}cUiqC} *AESD 9cM7>? a)U|w!dh&". _8fɺm~r!/[Ÿ7qĞqG"@ܜqx5{vw`A4gkӵ4}Ɍ]ZOeA)&ۋHgZũ m$,!٣Ԝv_W t8"}m ǡ8}sl!+zˣ֤95b(R΋ac%wCր%/Hjɱ{zn嗰ߟnȎM\tD|0X%)7d̲ALXȏ^X `lG9mj@k6hPv,B5։^IOYRT.Z!GߣLל.EVycv>b"[beEȣ_K4S8 3S`wGf6un>p+2#sx m}#ocBFwU+)sR~/<[vEߟNg]82Ve'[,~4򝗚vVklJʉVvy9'B)RSУ9u}a!PJ^"鈚NjaS:L e͸HOlV96%.lvEϧ3dkS N#C=H&^ib'$@g*9i7~⼚8&aySBWcYb4Mlo:6 fΫ,qly5ˍTy6qR8ݗH=cv rQ P;QHs*o}tCVXI75|{wdQF.P7fAXIm|kv5KgƐf^N1Hco-v1-5d*R>[DgqVj'慵Ti5hXt;˱i]~s?}]YoɌci%㝛n6+27tѣ_kO_sŠ JBmt'VtT 5SVz#sncm'l:$NV 'a9OŊ/ugsJo}ңX7cr"_HL]B[0y)N4dRG o|}G;vW_셑YT jd +IG: BzsJo|CTgZlx/jo樲"8 Vjָp8dS)+n9&m5TQa%pL;:&VRMFkȪa,r#dH.+.4!TI b눅kԞiSVz#'ɹ  [,[79ת>p-qnr.)H%4MΥ9i7>\X_r`#"QʭD&-2n Q|_p7~cdZ5⋪o%9ߣێCnb%L3CveZrqv՝rcԀ2FFB;,}ǧ^da%f! .l1?͹m_~?X.XIp,8~! ^SB8%VRޫ %Xvys.DeUdcOc3s.~\ Nkװ1FIм$xQPz\XKLީ_mb/g2 9צqe&E/gXkL+ bx%lUqƅnIƴ%7k< #kBiAT1֛kSZBVud]YeFY#ba2wΆq#[电n !+NJuT^C6/\@ !;/\ ܛG甕llb#r4qx2Uynw%kO+ˌcٕ~)]KJetO`4z6Jw&&Ex/wFioVґ6j,u::%|בVdUSb!\l$ͮ)AAh,䌰ơ\Σ&a甕ˆp| Z^тZ=z2#Ûw(__´#XKE5`^ؒim"|PpZX&*;*Zʄt45!clLi_ľq%hJO)\UzW9r%ZWAPBQGQjN( po~ȿηRK ,rf C:٩蚖@ >ǖXI_ c ȱ{yn嗰K!)|ɻy=v%r8 뮈e‘LfU甕?N-gTHM#_^t^ $c D(,i!mأ'#yNY3~+ (*T^ѫJ/[8 N`EũY8miԻKsJo|o<\we;5G,<(@7 ǸF4FO—8`&0p)D} .6;rGhušDbdqn:m_ľ0T443KθTY;~iG MjC؊׀ǮܶSaw?凼/X:< ;B=Ί),EiR0$CRXiNYͿ A]gO0ki9`Nbckn嗰V\&JPkp;,ّEsK:wbvKAij*$9FRkZ[phPT{".;NPʙVPSn!rQWU4F 7Μ}i,R/y4+"/XimZ[+h@c7̹i_ľB]E$vA 3DKWJ"KGk㉕sD]aK,<9m_~?2tz׽[z}HSK;3酵tW[2vcYxM"O GhVcKrk #| Jq?$9Z ,ȖhohԳ@9),! ޛ@}δG?ƞXKY$wcQcg|-v4(ŅVn}:/ x=3UetkV+pzsT (UHRQBݷkK ~1v ŅH5ү-/NXrܲ/awrH9`(Gf%sO!.PKG+ZM)K$BFDR {w#Zn)8 3ɉ^-9a4EչֱgNszcZf̭Hx~qf.j'ey(lE*ŁLNvFgל6_ %"aΐ$;% /Z{[h @=#Zrs.~H"#-6y[qY}h$]8#~9/XJ1Ɠ-?͹m~(.6)9˽P %w[8 I!ř'zٗZNy}+1nSld7'KGח"drÊzZ,$b2hf:|P|}^h31d^Ueyf[4Vvݥr)n!3;U_9A\GDY3Q]TNԅrť$7`l4okM등(̱[y=7հy `7kR4_u,_-?ʂĸ/ 7pl ~Fky0}mvѸlTܜwy*_U RtʸF=j')Pv?p@bN fxI,9ۥĒ/]Z*ܚ9KMYmvy94zdj&blD)篏aWf%Gb%ql_M6Abr{ʘvyJ!y̬@9Gs,P\]Ɛw|DcllfE)+nWHP,5hA]Kp/vO^j:ؒrݼιe_~?WP 7bHJ␁NN~7!T8Qpԍ8dgɒ7m>MXq)ajМl crwsҵeWbeh=gK Mܶ/cwYD[_b1sk5F\uZ8 ô.=`.M?L)+nE u'X@X @*c]eVG!{$!p%zzNY @|}f9L] -SATTLӶ=XyWGzǦOsn嗰ߟH"; =\urd8IΝiǙ48? r= gR=TKbi,[Eyg7VRiyoŚ[v%t}er? u4q2ڼ. Gqk"skSqE *w*c?k;NۉTMuvn59D[v% \R؅t v )v 4*#OQYW ։։n /܀wMBͩ(NNB͜y)PHanI!n#MgKp:%$`^r¢wn]e_ľxnxŊaBwk.=xjب_x#$5VҙP, 3ǦS^]~ D"<[SqdQUp{eŒo'Vvr1#P6)}WD4]~ )&QfPqZdZr\5pk8#lJ\(.X<Ԥ_v?q׷@bWd)[5~VQ!D2Q֜3^ P~\;M2TL# uG#Z(4WµzԖwX/".Ѩp 7P $pSǁ r.8vG6Z!>hQگ]"ȷSBJ\isfKHjKlǔǮAe_~?/_HBIvР h˷<•xrpNYpHkS4!uTN .l-q5#5zNYRm|}\!B@`bMtdJ\4=c?ຒڶb0Βd ʄ7m>灘ә][PP?Pa PVGae&Io pԑg)kM}}!צUAЛf# 8Qȯ pshxNYc"B W_".q:+~b8њN(|Ah19^]-V'* SCfvDps,ɫQؾX&{e HKV9KO8ۀ9kTXM2@I^p8qJ*IplVe]~0zE^(;5"ArpDF~*#5Rw1Pj؊֖fKM"OYCϐq/g 5*ݣ+WtW֚/gH_qh+opQ[^thNYpQ^jfNU.5p[Y jY߼K<5wR3pO XB ?+"-qa9xfZ$b}i&i,#{$K疽 ~^@==z $2tRVZ3dVY%+b8:nQnH\e&$G(9eb;ƻ!DD xS[^ZEicy`ӷ#&g0`-vy9"D)5=4MmXa*◶&KhFjJlgڽw ~؅&l<6EgJ? ^x3IJ.>K!YiN( po>/gC'uz\ GGIuc9 cԨ,)tī|:+";[1K硅CU86SQ8ڊcqzjhXBMxδ6_?%v:B,?W3k0,l뮋0NuB|k٭m>`).&w,z(S1F8 睘Oyˈ[Qi+n`YfÚ ,j ;Ig&2yi*o/8Ev,h OH"1iJNgi+C[9vaܲ˯骳E Sa_to1Q׊8A&!z[^Vy9K _qWjj93r @\ggv|.θ|_3[#cWsܲ/aw?E*wq"hXy-#s1R( sZj8hvBSVz#'~%~cVv}*RAmGqVJ1`>SVz#uYU_2*.ĐNTEBA:%bkA"̺[&4.bGbN[iIw_?GN^"8Xvf?RNeʏR\2|L+#n9]2m 4v6TBx(^KW*аu8iVqdԨ9eu'6_?3{ͷI֐rOd¥XvT%&V}dM%]0Kg^+R}җ8AOe^DBhَkJBԀ2',3Y(sn}׊48S6iUH|1t!3x@zh[GzbEq PSr)+nʇ#ZFH db`lu'amcEG&pswgVyC#XjIk&vd Šv"%su 3UgQq#5$k;@[O C$p,WT )w@ 4h3®eQ fI90̞vR&V25bƎXrጠ[v%sgH7w4&zS)#ْ= ąı}$ ]#Ss.O}-s^RVdsr;xODbh'Vҽf ؁}SsN='pD֊IȕΠեV0,rnv5q2DTצ BA,"Bu33)lE<8 7-dV $G=oNi+n9<^|m\Et=(1k 3@[p)Q{jNYp0[ەHȫl= ^۲V'f\_ ܫ+72VyC-/3^R D#I sׯQY(EuO⺨9ݹSVz#-n}VAIV52DJ"J:2 Bz!%lj96%ߢܶ/cw@jWuk}4S`zi͊4[Qud̎!cţfj甕ґsnRs##"QڒBGCV{&531h=s.~KteŊ\GYAD zGzhNY q@>M2NF$'<3&)tQ(-XZOXQ)CK6_)@ Ǥ'/ё\We-zͽYÊqΊGtSVz#3jj+ț{"yQ/m+9PC`Q59|F0|Zظϻqbϟ >=g2g7_Ǡ,.MNlDVb2[Y" DM?WQ)|W*o}};[] -d/%p[h/9{τ7]i#)CR+2j^{.-,);|VdG% {25 E=F#ZFcE]ЁV-qLeOZpfNBXQN@ 5ꑏJsʺR7_Q?pkS!v[ă )kH@3[8)G̊IĝШѡwXpHh A$ulN%jyqXI#A6d7z9K<M|m $b759\L踬XiD)(;W GmY٠9e7m>O QHF>n+ڏL$*1pʽS!ʣfUϻLIV_W&їEVdaޝ@p*JŜ=6_S? Nň\gíZ[R:KZϸS]NU>XXQ[kNYOU8kSueLb/}zs5 'ad}"eHyvקqNZ qiekאY:{!MR7 +iܭZ+z1fm F`z)bwgT( D7CGͲJ)+n9*{t{?5lWs[ Xrn;R,+)KSsBklwy"nl嗰ߟBǐbCe)Cm)=X~ )=b1XbC_W$5, ) ׊sp|Ɍ!a%|j*3cqkc|-vbhkP R_9eq^y|մNqDG!ԭUq(!Y9e7m>S%d)0"W 8Fx. ֪F$TwñkG=\9i7>Yp`dmC8DUڵR` [Q1aܥS4T'-3iԕPV|}fFx"kF@C>/K !_=cJZPc=|˹e_~:^tT{r _%Ȃvf4Kњmͱ#9K{SBXl6'ېNl:!+Qpɨ!Q!VZZݟҦ:˦H '-gȍ^ )I~%.©0neӜS֥f"i,gёq~fTqs!'f8 w)6GZHsJo|}>]ΧҚ q߆cl$X}ېlݣ,Ԝ\|b`R,~7 5 3]UpYJ84}Ӝ6_٪د|3n*>rg\5<|kXK9&nВV)slIs~%vyB{ԍyst7_?.Z9UK?84K^#;[C+首c fܲ/awW0ܭţwGN*&z0WyAGỢuQMw䤂A8>>S"v,6_?U]hyRɞ楼?`._ =5j.s5مZ]T#?!E28%0*doLVR&5OA&} ~f*7##aM9= S߼pj]I[h嚞SVzC @yMm55(I,nrL[v%`.S)#׮oweJkU[$K7<GKI!n@V㭦]f84oeKbiG6;eCdu{`cSa]~ \6F_0m Tǣ/:/.1zDS8V,,Y1qu#4S\d{nORo#OY(93EV|IY)OY;Qk9i7:mbϲ9r/gܐ#i +JyضE1b]]s._cLfFuXzEkێmjb%Jv29KO ]܎gT+طs䠎M ^zO+HMS`-rqq✶6_dKjS|F /v0OS#JwDRx'I9v[v%چ YQo` ruC(8W~GCLF,LE;vǹˁ!7m~ 6F%rr'x*]HA4𒐁ƕV<@(,R֣tkNYpϧfb=aY;cßf&F #bT$\fbԜv_?:V.8H]㋑\DkaI6Vquxl#9e7>p ֯]k+z3_OQ\M~b%ݑqk fnwe_-=Q 'Zf358Ԉ xX»S/ +)7S:ĢF,[v%Fe7_.5^ߥ튔J g)OZJflaNƦĻ3m"O<'oݵ cxifD*eيqC)&ʓSPQsJoIOr&E&n*LhxiY(l T(8UIL˙攕dv nEaSh,VlaxwX.;i bg+F o40~J#rM#tzd尗ikbq095199e7>Gl5[tJ4=D~ oU^ȀUB WkѨ%4SVz# *ɧvdC3\zO\ޑ5i/֠RbcCs.}ӚXOiMd TUd\wp*=1ʍⱫvrn嗰GGs4cM۸kI\NP~&Jj 4]~ d}Zd f)?9I;"%3Hd ¨E4ǮyAe_~Zw\ssiE 8 GE.p%n hw_t^[*`pE6:މts~k*baρW3NBTXyun@i+!nymk`.-̍0bO6Y((J+xÍ0"Eq(Ym9emnv`{T+,UH\ؙSVjZ뽼Fv 1-\8j4MٽqqO}:w[,ɡ,3jR$ t48 =ɭɧqqDZXsJo|rr'3*<Ҹm9'r3!) Gu,# a\G]gZpN͊u@&0)*3o; 43sH=v]u-vmvY(޹ yt \r߮pܦq\?=*Ci7m> # b}uqd ov+r-lAΒ5NaD9&s '֥@EOP-^YU5p쐵"P8 %.p<*9m7m~jXI3߲aY'%~aё86xVZ\VIgt V<7Bcf!PaawC >bk\S%Q@B㰍f眲6_xׁ2ͅN ~f+X4jͥPsJoT9:2ZhhPqhbuqNըVv4cIFHݓ]ȹe_~ɏu#Fɇ[A)Gcz~؉tާ*i{lJጹm_~+Fd&m4bAdדkgP;u3-rՑG9e7m>'1HQ4ErnI&uɏkO7 %#4E%1rNYp.(]+ɨ:PeKiT/Ҡ KcӗJוM #.O~^@Y;p)&#Hkzd^\֕N7=):ң&E电'4ō9 7m7LrSoJmNBۙ:ŝp %5'O) f0ھwF߬iD9884s?Ÿy:P>ksN[q2) HCgCGllUOLDXKՕΩ0v}Ri_ľ?;HF ?D !;>{KCjeXtbȱQC-vˌJP2Y`jU<C.D) ^D TM2cE<ԓ[v%v/H#۽u^9pS>$Ѷ%VfD8 ˅KV`m7kGNzv_ɹDAa [E@C&mtXdoGgڣq&t*5hXؙs.~]$Bů[qi% jJVt xLlAXv n}FbN[pAQ"%N- (*YY΍7ө?$dɱ&]~ ET%dƖqukf&z3%Ȩ'*Eˁ ]p6E\,߄lU*?4gKMGCwc٠cg!WMnւAW;NAy'g-KσZ:|jN?{" cS-涝~)ױSiZD"߰R(% %piG6fb%Mdf3DN]s.~> &Bn$VR#@og,ȅ'Jyi.P zF".e]~GbmZ3R -s[m($l1FY+ 0-4iԞIBSVzCǜG( B6d_p*"?eUO}mOMT~uޔ})O29ꖿ+R{#' }Xo%A6'D %0L+)y #4Md!m>_M]*ĝ\,6- ІEQ86RrGŜN=6_2`h T \  "<|ޤ}׶"g8 =Rqx-zԚjSVz#+Q'^_@uojįo;w_4X|OH?,Vs\q^Μk_O_ŷ򣽾5/kY-j5kNG\w_eoo?a_F.t(ZymvD_zOh?[>e*O:H~wOOo+Yf=zrvA[}(@1va_GP.,tMn1svi~7o_pEb|)mcߤ_07p[/oO?~+fkg??~ݿ]܃Ǭ?x'<₼7<:>; oq]A ??I]ǀAw~gnc{[b?3i:->=?8_O_pn)?_T:S~7DDyscܠyIkVsV'xʸ߯S5y?X L>>H2R5&/Rb y{^!y~^U'oLU~ =ItOz#о~^u\l>|,ymo'?{|;pȟ}^eϋ^q'vz)stNThȟ}^) +W~}4>g{^QD1D8X ϋCg%ʖO3:~_ 9Odٯ׻~9'+Bݜ0+ٜ )n?;ڈvsߡ>jt#9k;^wF>V;(q5Gc񣯊(> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 512 0 obj << /Length 2034 /Filter /FlateDecode >> stream xZ[s8~WP5/’ey:nHglMWԖ016ctҿ~.6 gkkI~urqEyn"FXw. C (F4٢w.%eg ž(y^ezWqhuȥԻ@{UR;i'J?R6WxZq{/$9{ǵܿ7[:uXo:6%>Q[&eVڧO|G #:"9B0\-.'}H|vLa5]믋MҟE<ߥ٢?Wps2xcow5TB6a"7(ϨY~!Q(@A8LM( 5*1eE̳ө%iZ FٷIBDB+~ /J0y̳{?NF^ΐE>hl4!l 1klcCٸ`ֶ\B<|rAgɷZ; F۩ꆵ` $p_H6S >蘻p(U-NYa&{D1z o9gUj:xx;#q_g6#q l]ї`6z{wڵH7/MR1&? DZdȷ|0ʘ-g\,ؕq-zDџp}w|ˆû .B_yeI㫤_@ڠs|NJXr:r'Ҭ^z&bQZT9oΑF-s"f >mKfh$Adc` j ڜG^O(^iMۉET4b*2QpwH@ov5B K=bS@5sA(s< S1&c[7I LM4B.Yu;喗<˒ iPML5&I[dِἏ4JݡƑK Gd ciqM)aǪIy *e*Z7)߉$+#/e#p}F9{[=Ƣ<Ȗ&PK:`K6<]WAN4uLشV !}C[+|~f\>uoQ}iͪT@bw%bLZf4Ѡ@ LkJ5L-is<؊a2]o7r9}y\g^d5Z >7|Ю]OTlZ44@铃^bnȕ暘>-wy&cFnMora0Kk4W 302F+15NW|FE )kF壙aZgZlN>yz B>PU^>,y~ \? zDWAɏ=G@RFb !ڪPc g endstream endobj 521 0 obj << /Length 2693 /Filter /FlateDecode >> stream xڵYێ8}WX` eQwe,/ɺ3H@˴Ř]̿oQ,ʲ[=ٗvbթSh{؃W'W V8`E `|CVT0VˤJK&Fj'kvcނ=?|,YGx?wQɾ/Jq87749rzoϳwl@_^ck&})O2~,r@K SjQf\U\Bkhl9XY~s) 4]rE/ *PӬ;Q&|VDM>ٍ@9(}vإ `e 0^`Lvwz%uzCU>2*2{Z'\SCIP΢`҈p֦T'u sVCUfv,aq|+pe͊mQxPwh.ҀmU Z n6/ YʍC.ZFWLz-.U amE=QPtҏ]Dvv8$8tjtàw/Z;"`x2M[F_22_䵱-EڔB<`OTkWĩ.@[pҲkT} _IO ښXU)7$sDIY*XPs7Ip `ea-̷en b.# s, 9[~hɇZ<*LY0|ތ񶮟ek:7u_2Nƨ9%#8`}B͵UV\2Zޔip [UJ o%.p,dwn̨1E;|ʏѺOI!OYGc{ſLJc GWTp k c}ba{x uvvYsM6(YoV@V L2gk^q;(`&]+IMjAVE;LbajC a÷c%I'lf:M [PJ{m*LKXk(ܭ;|H3kq<m 'nWwrh >vá~!]|=e6[.aW{b:5:7CՓr窦MW9J>-IbI;VC_k'!ǭtǙwpS3H+rZ+^AOXɊ/tfWd Hł=(-TB)^ey7r Z(߾x٫<^ endstream endobj 542 0 obj << /Length1 1687 /Length2 9571 /Length3 0 /Length 10664 /Filter /FlateDecode >> stream xڍT.Lq+]wwwb! hqwwhqE C" ҙ93suZl{<]_i8d`E[ ddԇc2]a,\@L4Ԁ:T<|AQ!Qnn/7 y; P:arPg/W-<A,!?2`Wm'=({Wfq[8YÃㄺH< p[.vu[~ :*o ЃZ=`;]ܜz*-gӟjpyqAN^'5 RT{@'߆@8- HP+> q k NVrPGG;?y+w/kp8YY.͙ VQ p .'Ȗ^?<ŏ58C֏e L |oK bqO+G~2}d?F̥PݐVB=>|^n70@h!/_'k(w>6?9E64a 7w+7#E7?@G_u?qj nUA<!0E'JI?ֆ G/n=n=rOr?PpA~o |#<v8Gc~k+A dD.Ko$,2<"H7zSߒߵqY |.oowM.hA^?<H8?>Fsw8~O0N班y  aBAb!v!2[(G/x9Ƌ Sz9 joy5e].sW~l64zs(X>?I򹠤}֊P`*K-Z:Mۃ!ee3y}$&rE!ͮlubJtm[9oDDifҩw]a&z /SFVuSG1\*Ĺ+sT"޷xʒzYybyoJ˜#dkl yP65h;j17eH2fؗQR^5/%˴RְY\p}Q-~[n>-p8XËhr+#CbH9#7ߜQW"[!k濻>}Miځ^:zn1VHpFpp QrX=M+PQ{Nypا}_o=5%֏`9ipnb\ti[^tvGktN|6俲%ph^u@͉~R^5!n6d}XB_*´XBxO<5WM+KD_I0N8h{YlScՖkeSfa|zmץ &A-^Kh!J=Ԟx3k9@mkIZ7y X75!"2;% 㛈g7L=چ 7E#@_9b\~QS=34[&]Rr+S}^LH.M=@f:DӼeZËVʹ́bVE%D7 AjqKblDh/kHuW=$.[<1*mjLR_.$Y5Sfou8_a4?ud0"/]Oh|~M@N%WqRs5A~O>ӛ̑9"#kMR 6Cu=2E1émG\';T^78~!tB'.5kd0ad=)^$ٰF^-v\85əʚ 9G8c_"w[b~HH43ҟ`S+~= xlMI 'FYZvM |sC=tz4IW6fwZ5cUV59jAD_.D6Nш6GS >47%8U&?}b/fP#qŞ7eAdOwNME,,KBZ&o{y]KXή]qk=֦&94*Uj҃ kTۺz bkuЄ9[|C2)b, *'qE@z|WePAZy@#Z_ri+l08p A^ʎьjL36)^/kV3'+}1n ATy7PhK aZe- ï.HYz2>ָ ٮ0ͳ^3īʼnD=p'H f{i:.?mZu5>14 cqE5nf-fndԹ},:MT:E~\?H/$t< nS̱kK%4 hUoi}y 78qf {똏uΎި/G~Ox'd$E1rud,|wA=I<J'UU=x+)E+DY\$w Hy=X+(Qx⤂ѱ~ z90m?iϧA:2?CQz&^P$~Q Hˆc!u7Y6)PĻ.4u!OO/`C)/#5__i?}hvV| =ۯ껚Yܹ;;`k:N`H߭rR)'ir_xo׎OJ$ˁӞN.C4Pd8{?{I*Ib_N\z*=p&?'պ|uhWH);(\wfXT1dc@^EU ˨v?N1.VHiO<5[sm(cR,h-7̈\|+s48nXY,s`҄I.Ĵ 7!ϴ>Ks8Z5Q|r.la`^963#ql9;%B;!F*=ziTje[&e:D![Y/X"߼G.8-qybrs %X$-pmN&C B> "m(Vbċp?آq,:rtO!@61;%ۂt(mj<4v@I/2U^„RW;shb1Ij"X}v*lbү>R>a8C;'ebmL8u}vFA 2,PVH_@(^l.FuNky\;ݦX󉇗I^*kZٙ~nXOއ2£5.~5^[7%*A7YdOK‘3^aԦa~Iy辶_C|#ixuwXo |]=G>M8kq&A>n<\ n?‘OXV֌X~uA}|POIF+: Ѻyy\~Q %9Kȿ6r㔏VMnr:󾼸X]mH/yF&L)铦P$hw}3lyC\lzN-IJkE aK3rw&"Gm'Tٔ3O1YL !նEVSۯ"W^ Ws\|]ߌ *]QX-]2XUIƒCxVg6Ss2Ki'_cb N^a5!~wvӿ&_MqVɝ$Vc%UIFYEh%q7C`s]^l/o{FZzDxpKm^QL!sɻU& d3h{E!d siPֶtIX $ ۏPC wP-Rڞ`n䑾ax-+VaIz4= C* !H=&Բu6\=\x;m^5˪-\8FVbg}IJӯIwli5SZ"[a2~c&X^f%<ͣ{Y-B] %>!U쩗||7Q9}e!׃ObYU:98Use;Mq"BXX)ƈY'/uOIyaZmOY]*[9 mxNQ{bIrdAU 5n;e̜Lp@ gW+3S7l*ܻKp=fQS0=+X-cdh)2+Nưh-aÐ R+¼PV%dc)nR9_j^Cu#i9x=9+ݗrڨw?@~M&4SRg4O6n5{Oi쵾;axn4D47-v1[h vT7CQm'aBTE +M"YIGyb^7T xd]U%B@SaW6N)e/ zrAB.`b2q,ggx}T-\H"r'?'gwd6jJ gޥF?F!CFl'ij ݷ+`.]A {'ILFƑ MVjhYOoi ?A-]E7ZaٜѵdYFHF >gIJ|W1C躯}F93tE]VZYo.%yRd n>d 5Ta^7;G*n:EA,i::Cͻ̷hI) fe+!A57TJRt5ʟوs^XEtBGyfUYܖpֿJӫQO9ٛ]Z5kA#K^qä'ʩΐCm)jb߲h\]HtZyr(h|IƂM*뫽 S^$OjA-uE{@=6IVW[BCt= єOe_~t AzJ./ŝT K>21z/$[1(, eI (Z;,^B3 vzggv"rRG~pUͨ\-L!}>Kb4KK*D݁9"`$}{b,=&Nɼd#=B<3Ãm7]wLuBEպWE۫2X3R95HEeոJ(sl0zDam1&,t: ӑ}²!Kl.%Yw, w9~D>egs8,o^e[-y$[PK_TfٹmJQ|'W< 8H?OVu`U0<=ء$?[֐O[cJ=bS3.κ?D}YJl85.s$t'ҳsgb[K;##/Wl^uThʋ6^ߕAϹ/D,٦cc(wl#)"&~eǍ~}CUӵ<DFQs&*Q"\'}~&RHEч xWw<9Y}C^'<.,QA\G*ХxL ,{D8-bf[Q A5܇O$Iejmm_=7hTP71_?Z'pK7>B4;`F .($=Mr>ZQsCwG>fDZz;ƙ]1sfg1x߈\/OhV,ޝgsuiR|cw,3Zbd[PSa=#LRY~V?975QNzƨ%}K]|ںaɡ-͵p4VFHclE=kR4:z^bXa,һZWK*<=跱TUkE a{ݒX#9[ߴx[@1V٨[qu&~r&\fg2tp MNW0p]uءaiH/H6no}/G._V4_}GFsY`o1|p:jOVjCYX UT&5F,>B7WeW >&zޅ'Z{W<j^$v Ǻk|f/=./|Ž9Tz"Max}L=v*TT]n$ZzyO| b1^uFppbx+wvX;0*:A̯ 40%@kO+ (Nicau}Ѽ9+&rlaz+v7;{ x|@ڒ$*M B5{;jNR `AZ5&L49NaXjiF},&ML&Լ.V!x! wՊ>Qi [}C=쇯$j b4mCyY_3ȏb -1bbd@iktҍጇ?. 4ȊO*ܺȈw] $U(yÆŇzQF"IO>aea#|5 X= ShS;ކA"b?cݙ`t ٭hvuJcm}^PC鑮XЕPZq$g7)Շms 3mS ,w7]b^1SL,.pB O*z]CCޏAWu8A-7!,$QԼ'J̣ܺl(r}Rw;M:'f'f/ϙ[GI-읪)OS򲼥$s ( 8qx~Y;ӊe-R>"za5Y#N4Ǩ!)7|  6W^|ld*jH:aYlk r,9z)v^QtdoyUxz'ܸ;qQ\]i GWyPF'+*-%v횟|ċa\{o;Q$љm.VEi_%V?PFxV-hxV A@,-9"W6.w?LWҠЏZAk9bDs}2$/j#܋scAzeCZy0E$*B-8]"oN)ZJ!zMuu/콛/ZBuiG$"i~bFBE5H{>i'"Z .Tv8lңT7Cz3L>W ʓio=}"/ɫBW>jX.䚒B S"_b6}ㅭIKɴ5ׂ,IEؽ9R#Ԙx:uZw^WJIDՑ`狵 |c t$%BmDĨ endstream endobj 544 0 obj << /Length1 1400 /Length2 6240 /Length3 0 /Length 7204 /Filter /FlateDecode >> stream xڍtT6)H 1CwtR03 t7HHHI "Hc{oZ9{g9sL:_ir%I?'{^\ylХ%ẕZc)W;FS̩d$-yiK1tbﾹ-ccׯ$gMb%/UQ o|S[AI/fj4X:f]uN,:]9d9AWE>`5ϐ(R%AzEA|ϝɫp5[Z+x.[ h{خ/ (nOi| ŋ;QwHp-ԐӱPNIܯ=G}6a+gGK!$El}HR)5 0zL9MόPib,W?,NJl ,7 mZSlq`}&eۡ^R0"}am~XfP$.+ ZVqOK>d~,Ae{##HyzD{]7f+bqW~z=Xpu6lmDJ+}bН^ ˘ztC#^f^Iy%&04 CL/!{.C+%ڟe]fޞEߣI #OUy#3=<06W@xUGX`crKl!g %Mi;ȳ}"}6AơEzI˲)yLXYerazM8燏Lnt=l\7E f06gηNdC.cT<^/a&nhb9}ޖx4'Fv. Nbe‹A7*=D%3V/%"#yL~ﺤ`%87q:%O{f5~X]cF~;-Δ7PS~w.ojlK~OԔ Y K<8!%Vp`רےg1g)Ŭ&."GJuq+;X%m19"d!T*P2{>6WDGj)A9ghGddv.Pybϳr h#;khrD\/'TY:pv/=74mM_hCPc !@L&x$q 'wY1d#WekT! =R{}ΌZsUx-ƸS1$ȋ$-јi͌?l:Qb?X-7_:rX[K`%Q}%+z}!$fB3.Vh Mnz6!TxL^ݏwgZ}6kɅ(,K`=||s6D۸jV31N~"^pұ+#ԕ }1#Q5YR :w*:SF?tH1}nwQ K[i5/ǒOK@cv@vgY^[g^Թ 9JL.%f3ڗLg¤u84c@Hc~Ʒ\<:w~XS޸{SNCGZ\xv<8#s#su+Iĉ:MZLIp)RlL=l`x).5NI3v F7(҅U䱘.ReQN&9/͎Xut_g;ǷV~Bgy6;2Y{W$q9x2lxv]Nɑg/XZʽRPL3u~nqgW)/Yt[4-9 w^zPm}ԥQHh6vB[]j@G< 9&S{`rHUor/ӉM0NlYr,R\ȬHVy-|&Tf?=nm=χ`[ b*(t [CNձ5NbzIϖיG5D5\뚷;A\R.Pg)eUu6[!e)WK 刱PV P={/0,K4L(ˑ;tPLѝդ ɫ9I׭I^98h*({'7_xbLag2aJM)Mwwa&8mQf]f9M}>sBs8 PH1xY0~jK=`CDmɸv L^1 d_yxվUBSdaudug4&zF!XgNȫgMD.G̅7JTXi&alnYi|fc6zkdiUDm|˴\xb ;FCM&n2zBߕ+BYXcy_2NCv\yNenx! }v1("g⺚Totxo;%[SF(Q@&z3'8N~=oT9#ETn\m >QQ+L}9؇7%KfN\Nnp+-/4~P-0xG1Ś6">`~:6uwTa> e\Iޮ k[}W3藨v|0>{#^翟DlpfZ9_/t}a((n7*S|#eo5 91>WCs- p:8@՝B7zgBJpL-筍u$II7P@c='u=va{ iKƣ䒶7L5jD0:x+`H$D\ۍIO-EOO,u)*+@ubwG*lߤ'ѫhc*z =Y _+2?0U9An̓R=)PZ:XV^?l3>wjM{y-G}?۱:+CPQW} zL'| *ܺi$%!Kkb6f\ LaTFkXjU(u#T)sL(] +vlR˧ER]]^X=+ّgHn Q(!P3qv#7&-Z]+&ƈ~JB  UpoƖ%!mOá￵ܡָ7J_,`|g.vYLM.HWD;A7ͽyF)?|wb~ dW}P/3+dV) ÎWʄdyU k0ɴH&AN1Ew: Ѕ$^_ۛMK0vA{ Q0䊝ⷁזF"ɕ0m:.U<*ɖOF;ECY̎V D/JoVr=j!2CC ~JZ.FAW"S_s0LIHP% \:5n}T} =waO&JuqL5H-\aՅ6'e}0X89uLodVHW=8{\v$O8Qԍ]ϴM:|μޢd)aP§%i2[Jbh*g&GGE.25Z}٭r4!!:0<(U4}"+=aPsufI!EcxzS2ÁdM —T;NAC]GZ'vyw ;[ G6]}㻮hHZigd_`PMk_aXOV ~Fމ?H4#*(j>'Hӕ |F_sk \1NAc*O ǝY(4:Ln LV h vK7"}O_U1ʫuG ~mݰ1MT?Æ|`' )N>%yh+[ޭ2Esntft %=Mg} Cjz,]&ZY^hp Izͯ*ZdF]O!֢-Uj. .w_pqQ׺.dŦ3>ّ,E]KOS=ÊxDs?[4/;:~iZTn~+gSiNS;͖9 cZoMTQÓ.ibzn-ͫݸ4M)FinӪK'%tu4||VF nE]98 Ým,}˨#фc`qRy 9~R5g/3Uq>j)tC VwVߓX&r?tfڛsCkY)-6oVa NwwmWt0/8p- IE{,)?5^]XJE(rOg$Mmd75}_WvnBPD. 5$Yo3ψ&̤G˷_ga>~ D[b5xPbB_B<,:L"D%PVڹ+g 07B>ͥNIDTl4X/6[+PD4U.ܜ^$:7Zqk` lw?K1͏ -^y8Vls~h)ȽX6|~oKs)e7ŧ'ћ=jRsr&6ZXCO#h #SV.BbNד endstream endobj 546 0 obj << /Length1 1445 /Length2 6402 /Length3 0 /Length 7377 /Filter /FlateDecode >> stream xڍtT6HCH303t /)( C %] 79y}kz׎{ǵonv3!UW3X C EwQQqaQQ1nns p[H&04@(!PZNT &**/C8B zpI­ @@=Pku҂`P`O̍. ( Oy"w%~AF`WςF OʄIo ! aH`. z @/g  n(`e G @0ן ( P3W ))OyH FB?KeM: C!I~A]0m=0,,Kj1@$c`@RTTTZV]+!hKY-/9RwbbR #I]t"1@DGa\BnpωJ"`oL1/DB yE"^7F7,>_?uA`Q_ N]UG5V'iHq3~YD 'YǪO)4T.!iH3m|rgS#}pW7],ķU6/-#~ǝ#s$ԯSMz~'ӍJ)} PE}ī ܨD_g*19)J'uŷ{r(o d9TD `QKeA?xnyN_*9`d ua_ ohؐ0et5|^V/ưbu<LĤ?0#ع20Do)CjX&䓚3!uy]䥣ײ; ӻ3~>hUΣ\4_sFWz}fМ԰J?ۖ7XMuHBJv6:Kˀ Ke]>[yjߴj7f]JzN-Xȋ `f~<%B__Wh~aTM]lҽ0: Z7x5uÇԾl0٩Rg5s[ts_ ;ҖD܎:&byrfj" ho4hՂl|EЇVR>Άk|A*Q<3(;3TNsuG=gի0`!#S+[)[R᥹U' T1kH6>k.#]ve ZaPY)GRoR-JVȦ%#y`nҫ;E͍Z=flfpSvC֖T =Ms+M|#sH^Ws̑04GQ N f#G7)qfeh ݶ@DdCgArSq-KK9+&)펇/WT8VN}cU%ь~:-|[8?T &7V.>C>ejz pLI 8Ay6Ô㙮ba_\tzruy' yR,5r(f"^5v|A뗉4h9LaKlEWe?vS)/o7)t{EEEUN&WtMg6U7i\ B?jo:1ݶMD`:o#m"ǏzױEe9X-FIQ@I7&Ĭvie >q|A?hq[Ktiqlc{'7n [FcWC‡fo+dLm!2/zmhvl!MU3ȊOflbLο ia[ho^%GNR$V*aۚ Qή ֯ӳZ;yZ.r=`dULmx'Ao;ya"0G\=gmi=~@|Dsd_"\':. E6- wËӏ:vISY^a-R[[w%t7PJv2iȮ9;\whyb=*!Lq}[tQs`1w&[ZU%Ʒy8Brڛa?DFt汇,9=UVx/z}MnayqXͭ}])"6l!b j/d@KD=NZCߝ,zdX_-fiO m2DWCqևojD ͘xɭ|/}'/?@7oꍓT9﻽JG7a3>(:0ͺ 9;e{(By=~$n&z 1$/K7z"bm~2ԗƶw,tWlߍWJ$Z^L@kend .фͧL[.E۬?2ft 7#84@}zj I MlK&GYeo+eV O]\c&9JQ"йOC=_H'nWb)ϓ^ɩ9V`S]Or O5~S7!q ql e\;}~u`9v *"sb9W6̢er=B@T泵)-q302':S֞;bw|$ṕqZbwj[qE +MzBQ',iGnÑ< 4[kh\1JM)\RGQ;vJ$aj%q`udE*`9,R]փ弸 ʮӌ;mcyRBx]bq76T1jgc9WV;E4UW!#AZcuXn5&~*SU~ ȚkϽ/q*MȂ<]{к.!\)4m/lv7; ja֛=N>*8xeltS [5ϻn~ ˣ~KgW9G42S܆ bI90E1P٧ SHW?Ʈ[|ŒOd3QA7*ʶ%O7evؼ Fyz ~;)j۝-C|?4v;_u;nҴc[|SRT8qqSAz# zt&^k ek$ugNRצ]#xM{9vQz)"Jy߲XKLw_#hR_}V{7}+ oђ4)楁WL ~akU6Qe4&%4n[R(oX"hp{Q6}xOi̞ j棤S2Vc[b$ENpɗuECk9fv-|ֵpf L5P<(:s@=!z]]wiQVN.N%DW[:y[06AM˥GH]dF-,)XY{07"p̽REcԸf&)4 v":c3u."y\?-~hZ#vDyM`BCSyUW]N"!$BRqY̷#􅘦>Vy#;;ތ h͌H1Tج[ Uk ;4ƨ5IxvPiПmkKF5lW%,2 Wu܌4}OUCu0=DI lyǺQ3Ť/-`%<: 4$.Qudܸ:Y޺PaJqslI475NRDit=lO䴑= =WœH‡o<];v9 Ub"R 5V A|"=2 4/׻Y͛V+Dɚ[+>شK*V1bϽ¡3zYe s@-wBdU-]JT5-vu2Ucf7> 5/K`FQ?x}A/!\3hUýUӓO)U5'k@FKϲ4yCu@CM@F=hC%q@Y endstream endobj 548 0 obj << /Length1 1374 /Length2 6090 /Length3 0 /Length 7034 /Filter /FlateDecode >> stream xڍVTڲI IHQz:(.EZ H!T*]EA:iRHT HGkVr93g>+-m<1p} / u̬` , E+p\VoœlP< !r@*DI ʂ*rT 'LhA:l('%P &(Ij8$ ApDh!cUA`(*@R#@kxjhE7&z#m0|0 ~H@ D{q@@#SlA !2+W"$w0àPt(D @ }S|^ E{r`H (Ar]8e ~utzhO GE0ҭ~ FH'W X7˃dm `0XI !0oЯ䶡XoL?`R $NAp  w;D@ ;; Gٓ&CIă>^A{ s;cS Ƅ ҲJ@iY0*b EUX#4TS,Up_K2ǐ MpgFi;c,@?ߨ/P//@]O[#]_F xٔB 9{1#`qm4Q} >Z]FƇ˻:BXtLul ww4SF!3dV@t$R"Z V73_QT^xAuFe(R|GZT fxAbAHb;+&~aWCV=+Vf6`+X&~|٬Ĵ:{+3Cb\(ᢥO\(qXQ0sއ5~e#I Эkw9.irOE b 4_e2v )VPy.-9ߋzd$ұ3nS~~^ Ҽ[ńg{*/5peLM%ܩ;iKFS`+Sr7ڂYs_;fv,&F;Wm5&;)ֳuTѷjM]OVQ1b2ZY\ ͻǩ5RC9&QyݼvM mEʊƧ5tV+BNn}AxBn̘u\wvY,=l%ojyY,8]x1K{{чl0 'P/mv[*WuWdn⇌Xq 7m'\ \R5V9ti#$MZ.哾v U]ȚUuk-Iҟv^y}kKLy:j+J<n`f3J rYsR%#A|ΈKưsYML&yKo(6V$p{/[.9+o)Fn.]U4ЉV\_RȜ08v'K i3;TnHmo98'-"j,nTZ}CVL h]+܈ڦQQؽ0fsV#jw,{t>0ev9/2ĻfnΒ}^,U=W':+8 })g](ksRu(n &Ю=Zv?FHK Xplb+ փ^9~|~dx%\[i^b,Yu\SWė2, &y2V(d2 #vo)kRD$٫ ˆYd/SFW% oz"{> ,lQW;j7t)$5Pgzf%9fPzZf6!xj@[TdOp n VR!|Oxn %7KHڅ4SOq߳YeKl6I Ԝ՝rҨٸt=d eEH~}q3^F4_9ty4,N&)a;/vf>̿氡Vh~4.zRTUkd ZMML]?zϛشdot^'qkfaB0 Bυ=)M 08h'dd>$[%_}DGnlTeWϱosϦԟ=?EЋGdrB2^dl0Nq:13y~ⳮҫGU߅Lb,`l9-=kUJo~҆Zw&0p#u1ws"W:lrXon?p]BIV8Iǀ%6zg2,rުj`3԰;3$HQe9Kyӛ|oZ*-f=rzG~mX^0g Vͺl u,Ũ;;nS] d-`JF7ڗ*L, h7G܍{|Qe][ )2~8]d,"1O7De^\}2ŵJ:EF{yvq/w_f.\ؾr+:]4ҟ-^*x/ZY\Ȃ&FQHu9K{.JuY-Lj, ksO0fFs$sF/  %iMht8nVpc =5ҵ}"!By@_ˮ˔]~ !Ls+oL)Zm3㕠} !Нe9 2ѿ{;3o\^ks&e3|-cj >jTJXIPlqF4Ϭ(돇[7ZF]77O8HMb(J1Lĕ|D{eB8mt(> +C&n.I='9 x82җOKY݌S{1׷GLU>ǵ6a|ٔ!%>x8vkV,b/{khvѱk,UM,#({PK6b|)Yt>Fnȇؐ<94jvjy uzp-mQݢVU5}zň%'Fw 2Zob֩5j\R%.@]!*9 *i)gL@V58Y-C)H+ws{Q|a'bYt+ZWxST`dlF}OEEG'%)]i~@E^qSca)(`EKᒽRֻ~-FkTK#ۄdk%IάJ6* Jhgm߲| };'|3͠8dzԼuB"Rj+8NB~ T ~Ql)BSV&N/)A6?wv]nɎvt#3<-(n1vR"L{|#ϳIJFIWg4G7V^tiaJhD׋Dy1{ kcٸXyp #g[\(zLz 留Uo溺ӣʱ2W?m=f9R*|Ll([ P{pZ?[R:1EEws>Fi4eq&0+{sjw/ݜ^{+DzYs )R2?)Z^:40ћ鼍uٝIӜ '+c3eXlۉ??59ؗ[-RyĊ*aؐEz84 RRrͺ_`8J6Nj̮,}l'yRگ=K j /AW^ڦϗ2vס̰CFTKxn{Q5]!<VC [{NlIݨg_ɏOq;&2Ec]F<tZ|] "cH&~}H> \ ~gTRIR.5ШTfi/ endstream endobj 550 0 obj << /Length1 1405 /Length2 6107 /Length3 0 /Length 7069 /Filter /FlateDecode >> stream xڍxTT6]%̀tt7H "1  3 R% Ht4" ~9=Yk~ykϬ4TqD8@4p,@MJT "".$""Fi E ۉ8!H(.5OPh>D%eEdEDb""2u7/CDj?O ][ *##%;Ap>qGW` A# !+,#rG !<y>P xzCF!&D 0u"8LN('6`;B<= ksBJWDP`ppgj |QC" or@~h@  zBH(׌¿ҠYpwQH_C=!` unp<k G/a38DG/ Do3@ `_L< <' EyC(O/HP:"8B( 'wvg>O/ZM?QȯϿl sDa~>bar"|b2AI$@JJ<@>#ViOx/ hB<& 0"e_iz`<@3 V>C- qzWBAf]!P&.XnKo0(D 0(EvC?EhjvAg] 8Klb'ȏ} @JGo2:1$uatq}bwH(zk@m D 79 v&ZG"\":/T}V׺c%P\ \𳵦;Ѝ>.VDN2]>x]P=,v`pzA9وǚ;bTO72w@99[#*^%{jyu h…jg7 넬<?)ǖ?2DO{%KU\"==k^jL`GWZ-Go[ +'Lv9߄IZSb\rr:bd~в /޵? 4Iwi,*f\Ucuxw-b`y|Zeɚ ?i}9u8bMK~#q>KaΧ!]@&';+,N'R,mcdZ>V !'r;`~Z3VtG˓ǘFz&9x tw/3྇mOQ=_)PalGUASg͟ ,Ubz7잿e?j򠯋;}WaDKv=VՒ(Ѯa&zyJ֩P۝f+(ɸˈopG|$M6Å0\Z6aJh9R4^iy1}jg7. Ӕ QP CF06heEVso,z7bvbmj*D}驇{:;$Wi'Ym3Xg߹62a?iQ``wRZ3#Q,D0y;!&rY.`JL`h`O6вJ6[q 3 ߷SCXe9sjٳ܀_@[0Si_jFiTJyoͺ\#;$j#Ƨ)Jiri "7ʪW}kIϾ=e|mXkBDO:l'?D;KFIVѹbU6f,eS: k/}'ut+Ɛ Ƭj; _'NX}_di4,TL_r'{><'0bVtָ7!Mp[a( "KU.6H=O1jvj0FF4TH|$}LE\|bi7 jҖBfQ@Vֺj|ի|کzЋ6`z8CpOw nR7 |"45G*Eŝ0\q['6Ұ͗6I붼l[! S꣥5.Bĝk/[ ",IU"orAMVbD'㩋 *a1ࠀa備 'LPR̛ 0h>4q.Ġ" '[q>ma͠6lsPx"lGiNUKt!LikWgQ&` 5Cīxiz :6GOd]iK>oW `+􁱎L"*;q7ʍ"x7g(b2G48Tòj#ɧɟ_gcvlF 'dF! zN<)D֚S  ];7|!Ɂ}6-z#:O'V —qRq|w:F})F$dبU*r$wf{hǘu4z8V2V8N1r'jKE&47޻_OgKwjhĆ@>K(S0æǫ||d ex"6 /L 1JEu ܪƺ~*"`߮z0e>h?b^Cۢe1CQ8JO̝;w4fR< H){DE!Ac€=wps㰹_Ks vj-%PñP>=.wԃfT,SV Z9)f3&ԇݚS8v?T(RzTF?uzBO6Ro'hs棽yhb ?A3Ź(UN8]٨|PH^iĒ+,…\m;sV⯞|Yc5jꝳ.Ss+ja J{`^rJ ҽ99 N> m>ݒ|95kÞ]uԮ7 =HfTźڃv^svEsJO6o#A -IjQųr9P~}b`I/k?%Ba{i:}w:"ҋ}QIzFwWGJ=;S4%̈́DDгTM)~A"٬-T4 $??,Aq\d>Z_MQ5Tl2,|ŠH*iAĵ^?[Ĩq\u=?hUn.J?#)Zq* X|(9̱0zkAp1!ڝT(yB1uLO?ö;EkI_?~]$+?ܠuE79 b`bJ9.״: 0 :g 7 XfK=2754+_ZFfcہ[ïD<,Q9l*Nu4ezQiIx&fARW15w뒏URnWn%E]X G̥d4fe zGe8y"qF/S(ntG~ cM<,88<([_;hJXaEYe`AxPfei4t@2ΩyqK39U[DÊTo=|ý/WuI~A~frZ 1/o+-ޛkd!?pĶ-u8!ث!?@1VYOG+Qa\̩K*m^ {&1woI3""sMgKBF)#%|LRе2/Q︯X1yVx;~0EoPڕx}aZ˴]PB8ʅT`jxSgFQy͡? /Qaȼ"4ĥm7e9]}iF&Nk%*(8т{faXw]8*i6jDWwicƘUZJT,aeL{//&MWify(@JJC`8VSTCBܽOxQV5y;Hwy?KJP@g][!Y%זhO9_a`} $_+U))Q[泵ELaʇCiҰ|aY[X$'g; %/BTUSxϋk1)ˎ2VQ5SqY&-Xhgi\c>\pij }rTН@H7V~6> stream xڍe\] ipaAA).|z^:ֹ + y$P Ԃp70 eeU@@^Np" *0t#AHTBPB&ky{9@d@@ 9AP'.U5=7nk>P'R ?ký Pp䝼<`>+@O'@ E@6 YOӅ+vu\CNN~P;]'/# 7l"\`P]ӟxBfqA==".@ݹ6v/y(#o~]MeyǰITAvN0HXF "I8! ~^G^{8ErB_D $W%q_+rK - n qKHu[BkR]:I {KHu[BRbtKH/ƷbrKH/bđ!ˀ=!N7."<]n[T%l` j'Koߣwi 򗄑 pWׂПoம`ĝ ] _8~YyUGv| LqHCrwwd cNw"ru'ܱSzl- RZ0Rftc yyoM#k<"7~p#9VAw(I'w6DFh)HRPZ~}"Ff?׏>tTf7%+G[l4@ſW^fg{Zەi ^[Ѩu>CnO֋][ftfƭ ~I}{N|Hԓ!Bԗa_?b Fd,!läM YѨÐmkO^%?\Q}@䬌m|pRXQ)$wesA)zNO=͚&=>[pq}4rfڕ&=z+*c(?ir)ңwʭG2(~@8)6BP,cTz񺟼4gR)H'# ̳!uNweL¨`\d &d8RWܸ4GaRteųe]LPbjy`gTDUӁ & l%o]j.#I=dzۋW֎حӰ.@.>oKA w3/t*-7+_o|E Bw=m#ƞi;[15! I8_Y}̇;qmfRsXaج]s#K"K I=󝅝5FRƤ,* Q(ǎ1D6b]6Oa/+Wiaθ γ_ PD[ƻy [%JL%g&nIO#6#Q~> 0;mVŵAF|*L!{Kai0ҳ"n+3^o2E H`ޓFZ#jMrrVu#J:~ʑ1u$atxU{ϧ0hVDcIڜߗ$N-HI_ʗTRʼnNу^2SNo=1>SH " YbZE_EZ|X{꽀Z?J-{Wb2a䉖7;(NAhyJӸs+Kҟ+h6 u#vY{S:ʵϮ_4&-ͬ_g^Տo;,1']%hcPEmÈ|}?5=a5 OK$Eע_6PiNA>?uq-T|\>4d4ZQtȺ/NR+2ƒV0Z~ߺUrdyvɯP:ךBE_jyDmϻ@F_*@̪fPF; d>&B%ޓ$}{aʱ1485<4#Y[;CLs>pOeкY;cy_؀~鈏F}L j=o3lesrObO8p?n_f9.g%r:0彾oa~R щj?[cj>- :ܬvauқD;3э;ݵf{XigBݡ L? S|gݨ:+v}%GE?q^SNc= JYđN=N7+st+Lk2|($rs([;Ču37ؖ΅ZE9L"o|6QO)VH(s[UDSn;IAs.bf,"漏%{r陏u2ޥ=#̨&0Qzh*L|R}Zlj7=aK`U2$zTIn鵦yaRmVW6سE@,gS/7F ᬮ;ZcwY>'ə7bjn-ZAt%D7 #;. H]`)"@c KHLUssaLE<Z@$ժV'Oh eW@d-I S}mGf(9;tie͟6Gi-GOIs ,K\hpD8&oTm=Q96>B@o8^>!=XM )5!˞T7l\ ƀ5p RЭz5Dd:Xǹ}npK)h#3TtE%TorӁw|\bZ%EfYBޥ]N6Z/U@;ٯtZuf͵2􋻤{s zyֆzxt"&jsh1z3k+O]ݧNO-YsiOƣ0Trێ~XoQw⠍d1f%Y̼Oh:&AkE"}Zp̏:(Bүh]^4*Ȩ~D*%i1LL :i?{M_XO|iù1fBFTLaʦ/aBH%u)NOw^tܰ zTjŒR?(Yy2P^R(HtF(>f2}cZr%F)0FÝ *<֢s%I?~-80`wTzC ?=.H<2O]_@/JK6j8s^~닊іO_ a*đTЌ37#S1G|_*g)Oanp_6Bގ%[#˲^~W$pv!Z ampGڝlVM})Z"ܛX/ug ՝t $[u$&7-.#t'lCoZVryv;fH_u񾃇d+)Q <@d4Lyu!Tuv/K*]܉ׄ7ե#ЅHjG7 b*Dt.wFzň$G6X!5R> շWLOLML+x/ ryKzPӨpSjX w9r^) zi^/|{Sݳ1 qeԱ4ΘTޒYcAZQRKR\xvP> s[K;VOr %{>]]Q7 KaA%-ӌc2KLihU7Mɽ""B %y?M }WA`F}OA>/e\Q'YP Kx&#ofgjgWD34'u[;| )4ߚ.4K)&Qkdk&pL*ɈQOs9|Rqͽ90ݟ1<h QfD#cK<$d`: tJפK0rE<)dURDr!U+-GXL{Soj ;2R)YxV)Ƥtimฏ5>"$"A7Ig6:ޢ hgz&ݭߵjsI? Pd$2e; ᕩ 1Lr3\P脪eLOş,94Z޲ݖ2[,jxMmjSX1b@kƤZm,{SCX;x5@xoy5"Ս.8[˚7mKO=XEs[+פ;*k\IUlA {avEt})fP:_½O8JPs3 Hl9o)~cyk e5 +Z0y ޜx*A.K<%3K'-&Io"^JqTz㉥6ᳺ v)L@J1IOE֫kgl{[SL,6K0`/by#q 4M;%Ś41z\~bUxxcܗzVVP1K;*C'+iH-aO<ߤzyZvUǍa "Kj* C4 iaJ:Ӄ {#obxDZ{oQ阱V+w}L`Ip(LqDYmbekϖsW"av-cMܢJl*ثCoҷN{b_@5 5EvQa|RQ1Cޮ>5<E;yK TOl}X*6∤5'ȇ$Sc`{zϞMKS؄¨O`G毚w?;Gς٣,?ߛxQD&0U C9 w$эR5پfvbGS7:%z݈ oniZO9RMXpHsR!\='e pÖe}'/=Ueg8l&\|PVtO # Yvr:5Z!tw6ʡE0&̙Ғ1|3zC冱!\Ulf{|=I&:)CTdWLKrWkN _-;j=GG܇KަOw'5 ~UB8e4͞ax%X_ CmXVxvn_x[?[ ΃ԴAS1{)@ |ׁ}ZY$HC"F$ +'/(?> [=ޡ#83w ?JZSn'k<L r6w_vί_Jo6*q]]6>[7/:ڠp!@s%r$ J1f=#}ܥAVkhL/M݇ Ċ ,TcQi<*_Σ/).pN I 1R#w+&=eGfOftrEr;4蚔C Ŏ5hD [&r2XrAk5~"`| endstream endobj 554 0 obj << /Length1 1632 /Length2 6616 /Length3 0 /Length 7555 /Filter /FlateDecode >> stream xmTu\֥A APA%NarCiPD[ZA$CϹǰk}6 iG"89"i F8!H s3 p@b dDȂ`"]+g2p x@>L#Í n??5 `Fs髄@C}C9b:1DPWl4Q Trí!RK8 G񟠵 i80C@a(5t _gV[ sMK oRΥ,'^_rj (؝><Inf.N Swvz @/ K dA@p)\! °0uW}x\:W{0:AN?vtmR0rͯ0 rU (1, b1Ϲ3O#3lw#aar1uby btZ]X`noC\ĬAPkc5~ b<&3?tB8ۙy` J#y31=CaWfq+0c.y^0{_QW 51n 0W1PkW䊼V3tp!H)1κ\\ LWk&o4']w{~a+vBa61;WߵAcHK#W+YZa qFa鯵X֘ _Ǒ@Ĕ$2^Y/1^^}a%jϯCZqg; 6ޝ]'5$OaiV.5ѝС-|sFvrF}n=rLԵ"EL%2g:q"Ե%?qhmȊ܊͗JgZx}oӊ ygF},N@\Q)լ{h9J'hb7%( U#Ni>.C貍~6Ow[qʹhvkgܕ6M_B.aw=etC6QCς[&3.޽8"frݘ.o@YR҇~n2/0|tQo!]v ]Lo\g\|u˝*x[`Ls&7(?0R*Gg=Jï.?+dF|LKB ~hm2,w: 7*@[LW&PL#wSJlC_deSdoB HV$cz8͜D\@I1T;K-\۟˽4[pm7O<A ōT{X+⊿au BƄCey ƻn (ے+>L3FE8H>!|P֠>o8lahpAHAD, Evdc%=0\g%#O.ym2ɏ*"VB gTqλZN'e(6eҪt{e=n9IoHl,{KзJhW}$玮q&w-%z/AP Rra.Ui<; _Gé b;f|,]i/,6'M7}Csb1UuG2^褑%;@: Zjd[aa'&Ufg67{x41IS2-xu2.,vM{+I1.|7Qo:NmG E|8KHVz h=U_bSe\eQ gNKjWeb4X0=*evꞍf>%jV<~'~}4ZoϪSYs oD 1*-%zG|m!Y%+NUoWࢺއ[ [^SZaiNu<p:~0ז<0f1A?殚J\!9|"jI䶚lWYa5q Ϻ'xcujNMvyJoF$;${˵%|4=4+$<~Fp`׀(b_~7e ~ #62`azOˊryTV.{"m-*$r:OUk|R,8ΞmqtlfGl(;CBY4Uxɽ.)"8_N8.dXv#QUyv66V~A;3']1ߪ1 [TM\fm=٧8Og/bZ^dC4ur|WKˎWgKtKK(ԧv_hKօv60+U^Bx挩۽°uX/o]!aV]8ߏN2l5> ЀH;B6Gbdopڹ]D^AL A}@UXW ^~&N5(MV{m{ISP$G@RyC )#"UZE`)'ot\=|a~?-ezq2/ն[ؤT!iwmef|,b!]J|y?.zz`pA;_\&oK2-#5K2*љɄ&ǐ !WjL$p6 ]rZiVMB#x샗lbfHEl |QfP&h.ȤPr%{ke?)i =HZgĩ瓏g`ҝQq+B=ԡ;&a9n=lxDhu*V`v_Uwr6<%ecs<_J? ='Kv/9KY9=͟L;|$_ ,V-ro:T70z2K8${HS*gi̅iv&ǘ /މ-h$w kr|1+K+eQVa+[-T#GkdpLgs}y^R4ךY. !kӥ)qc[߾qy!C3fN@6mSDd'j{QUށienο ƧG$o\ZEdV.η tj 7pJڟ7XY9 }EJ^mvv% TPpʃ7"XցRC ;쵓WșY4%saeciЖ&Z0=\Tj)X0Ak?w6- 17=}E+" ]˃ ,%CxpKomQڅ H5?HS}b#ҝw# 1ydNOCw0][/[]e,U^!>;N'=[f[0>'BՄNEǷdTT@6~2e{yJi`^k€I^g*m }6)"X.=RJd[X]X!`KqrfMEsAܯC*`2t#]G{w٬ҤG5~yss[zV}-w XhCSsAg ! \ÊDəFs G(d݌iDaBtBDA$p i}Qj(v^eicpDZMeJ5JAx@<ۥ![MM_N*!FtQ4&&{8V2OvVa89FC\@v&~y)nPZSzE ^\-sB 'axJ/wOA5ѥsdY5vHu:sh.M>s>$4MvZTAޓaN^TSok(F#9YA/l祥E8=8|9XTl,NsHUnM%h?Hl!cv& -e(*c.Ukh̖vЋ 0C,SMQ"v(ul0+bR[[:KQHF7a&v{)\,biv D0?Pwj CWah<ӆe$@qb+ =n1y!7F_* nB";ӊsf`Ul"?-%޻n֓? H*s־mZcLq)꼥PQv*y@CLV͊dJ(hZWyd%)E(0JN@ɥY6_GDW^%+@3M?dXEO&N|89Sp FPh\FFlSrq`#g??OS'ێS_ZC10ligj qjyR-T7`Oz{%ˇ纤6$ *,'sjI(©S ֿ{{B:CE|aݙ^i󶋇4LBcwӋ0'Zlmq%;[]?Ɨ k.8U=BSzOwy Z/}Cxܫ(!w[u ' y 9CRYClA%ɽQe6Ԟ$]L"5b\S/ yr\4GbI[ 7:ƔLo@hCkm Yܹ@eRH/?)!&IFS~'phR Y +8 e[ ,!65?3>桉L s{9m!`@1SE Kr%Fm KaG=@e~o WyтqLt;R@ ޹rH=xd]7Ƕ^WGƖqOA v*P=c+ ;~UVa ߂C3:Sʛ܁<%PL3q$GC򫹇ŠkY%[ff՗7;)cǵcsGs.%[w|[c[x^E^\<@($QMhdЄgOly} 8/PͅG˓(og>S+ӍxSGsjȹ!^8bWb"hDil ٽ!Ɲ&`!ϥNJ~FȞ+ZN* 7$vMG&=T?hiW}-/g &vC_L# Y~ӏVr|IՖy6߫"A[(u> Mi uϩ*+14|o}x`垡0˔h*T.KñJ.~=_)+}a1v_+ %V׌m`Nøgؓ~hq&VU?l-MO0o|`l!:P^0Up%0{.q4ڹT'=u,“o;lIK V8> ȯ>l;,#uW::;ҰHkh%Ր{̜(rCH-#gÙ1 ؒR endstream endobj 556 0 obj << /Length1 3063 /Length2 24921 /Length3 0 /Length 26633 /Filter /FlateDecode >> stream xڴuX=,)tצ;6NiImϹskαgQ( %lmxr6L*@3g+C  dk#fp:`&&n $^4Njv@f_@щ 1!v 3s_9Xe-14uu mL2 [W L5@]U\E JNlgg.jt1a5qP ߌ^U+\^\MXM[I#W 8*s'';FFWWW3gG'[3;_8ۘd;@@G ۿN7WN@ʘ:+$68m mNNΎl@ʿ jw2.b ޙN{ƶ6 G'ǿ3 +/f&/ -!F/ -;6 NnNy',&b0s"1vD>1ONGז66n 11yg;Fu3PZ?`o n挿_f_fp=lV@o)prpz{o 0;>,e1pm3$@AR[+w Q ,ԒpR0RoKd/J``mh?k G D dlwcK;/lcf/d-l w܆! /Fm -Qu-mmM@6fv;X,OfMn)`c9;yLm~M(70FF߈ (qALF߈(~#Vo`\d#0E7sQ\A\`.JoF`.johF`.Z?E7XX& |'a04su\kcim>qN?V3 x7Fk36[3kZ_ / 23wo'ZCG2clhG M)wZ_1gnGBp3w3XS;'{0]ߐLwfvp v=xp%gk_w m-6l lm( ne0;C_`cߊ`k?@̝D!g_7?>mGa1*fp?~oG5Bdtc`$ $33 ;;P+1Ns8SvQporL@KEǞ'?Oſ%Pd~&"o>n_jfG""nl=гkl5+|=@ay֘7")G< K@K&z9mG,g(XVNG'ߦH"y5rDYhGhz@_Y)Lvv1Lz[l@}H>e2Tm-Ƶp m i#a2ͬA^֨ ]O7.ħBv0XQݙ<'qա!ǺjjqXe TD#?r7F01ܯaxUՀ0tq"85Jrsb۾IüuDM:6Ngᘙ.H-̶JF/=jR~GOkRc`UHۍYCk2V, }Ƈ v{j~-z|CmK^e4xbQuudE'Tߝ~ͤ"bѺ7.0CٷM)#mlF! $ݡ䍆֗F ߔQ<'d_B`1 HGc'aP#U"Vg rYS_4ɼm̖Dzĩ*,̰u *Q/p+s0f%Y4v[hl.p.d!:ML:jl)#I1pi;8Նv,܁fuAS5e,rvA]% ?o]"e}ohƎeqX=y=`IQrR~/aa@W3'/dh:Nz%ž-mw`\z?=ia/ЮC( }^dPb+6ٲ5kk>E+Z!tsP𝥑+]Qл\:nªl=^umo&֢}Ikt/%mqSH\|9^NͩD9i͚XbG)kN0+\Qs+zj_Cenj๯ DM?%Z03R2׼[䏭.p^eiu+܏=m.O=S>-m}Zљ#E*%&b7'[rJ BR3۵O2~K30efuH7J5$ FZӝ汛9Bث`IHÏ"dxf׬.z TiY GOD҇猎 /j&s[ .;k\[1w Bj\\<'c EKWC1IH$tfy$^ݭiZW:B"Y~[x8!5&q@9ߍ lE'sUC#eUc\z&YK.Iu8uQg9) fM߁$C%MKl+^`1;b@p( \X8H;YX7Ůq#_t5؈*|vHY1tTJBDJ YeE]S wQ\T?c{^J2~0KZ[XrNśIșUhDc G9[.ŸVeQwwNO_/2˘%(I1VεE,%Ppok<**]/bMHb&dd}ϗTˉע1)uUSlzXuݥm} F&a3fߑkls JU{c9UJ~5p IHߎs-TW PʼnO>,/cr,Ht&UB&Q/)KYţQVHܸ/4^^Y ;lmD0dj7IU,9낙WV+gTJȈ-- IM[J!­j.K$ABw%FcmYf2-2&՞2x@/iߺ tt{zD9.ᾞ{td'Lp5saNs \SteC5}uCՑ׀Mv&TiI1%d79^ 8Ѓ&ӮGU@oe)Tfķ-'Q?Y@d>j<4rb(DOuИ%L7?e3:>D>)DCYzD!sXp)f @X&;V?,,Z/lW)&}YY0\ _Ȣ{gvp$![UyG[j[Ȏ'H+,5~q{X 2hq,Q5P?#XeLm 2fu91 #8!1f*D; +vJYCTtOdQO/ܛ>i oOwEg:4׃ESRQ>)Htև}FY8ZDSӱ1'u遶EQU @x V5h4 "b/Mxmem^vs9vŊ>8V-+)w{hV^;*tܴg.m;`OPyAeJl#d+' _£ ecu'Efuc#0 $Fnm~]ь`S*1guFl*" y3> fk}y oxz9Y2>(mg{֗fa6b>NDȽf'nLk֟¦t=yo+Em}mLZfH޵<5@qG%mP慢8\^5R0 2]wO]H{ :,Rd7̚KޒmW\u>38hv-wE<>Yi!TI|A c ]و<2M:ωO53 =\u@b?hO:XyLFaɟ($D!cjaSR_$j2]r@VSh \QŦ:hۑ1@!C<ߙ.XZw j$~*ş(Lܳ!\|u>x e8πNR`Loй,8AIi-e?~IR2!Pjb3:5nvYD0;4?#yUQYn`1, /6_@ֱkFj>8)63oZKLf.etx81 *>$x>e,i.VHʔOR˱lN9CNr$[-w`wGrTB,렿xyřjZb/yl\Mi'˕u9/@L8} ]N Cxft_HԹODGLM_~N}F%9UEz#4IRc A}d015UXl^ml [ l* q_u1]nSLU28dS#qN}҃n~xWu,6_|UCQe#Tmg>> |½5Is8KL{JuH1BݿŢvg=׭s2Ø f.h6T ɸ)4Nx:שq8[# kI}l (Uߥg ƫ@vf_.baSF)ͰqGB֋;o-)]p&'\/|*X$$HN%#ޒQdx1P}3iC51~5`C%5χܨ ~96ͼUZ4ՖψE&V8(8^,˄FP$bغm :kG !n?8H"n Zp!J>]bHr=Mo> 6aT˔18~ FvnlCĬ: d)\l\9[ AO?F%#jQ\"N^ItEc(ryG퍶 C]Y s0Qme[n(y[=&Bb3d ,DI8&S a B$J fWKED4)FmcsAОT^Jv<6e1SȰII{44ՏBAHL~99xpS̯2~6c* !S=nYL$c]tݮv~Ksz&G0^sM'/: e~p|!G$@W7ē[@f̟rv_龏\$3Y[PG龧`yhWYܽ Zxw eRo(c mL+>a+py6 H)utv j^r@IΌII:?θDm#"IEKwqX:eM7=R'`].*1>9o |sLLGj&îirҪ"|Է?F8d!jn]<G;mkr]f *WV{e3< ϒDK^S6YŁj_8OkLUYC!̱kG9mJ0(.Cm lqst:3Z l`R>t8bBk`ڐ)~g4dlaǤF-)w3-b2Ae1~jLYZ5\h;2|0!!Z:{ul1m>onJ.h@sLMc_[~J<XأA)GyJ,lvv_55xl@#> L 'X聫' $TB/j}8?/ x|Kw_ =ABof0eoVi`-ȵi_#C}ߝ ;_] -KՔ /ܟS7}] 2#4bЖPEcĤzPo0yF?)Oi[N_%tn.8l̜ifq~{@Y}ťD:bGPMX,B8L$3B?o32Fs0657ٶU|WUd8~М-7y3}9M۵kP:uu,/Ooܜ*VXz H3b&|#Ԩpx&BAG^ zkO`Z6Y!Y鹺$%LsM{lcVOޟLX:dMzi12W!d ^b%{ %2dFUٹaJB& ϝQYd>1u?f@m<'el4J"|TTݗk- o]%{|//$o yFv?:ۈ$k6Œsݦ]}<Zf:rpMi\lt}M1ՏTЇ]L] -KoCіmYJ ftpjPx m} E(„;%R yr5_㮤%S认0` "؊%&p#o/p QfA+#eNɛ/;ʕ)Qɿ3/9Zk3Ѭ=}. inݽ+;#!cόfQtxK5:89~B .Y_םCb{1ʟ32kRt& -(hC<nRqfVW^n2 *mΞ#Oi9g8~bT iU.7.ni" ꌪQx?oSI:t 9U`-k&h2?Z~uZ8!"R0*gSjP4z Vu8 K ; /o3z+J_b+~dߏ@!"n7hiskIϕM ĉxdxt+2z7nڎ<?#`Es)C l|."zΪm: xRvK#>W`tk-*sX*&T̳Aw>OɚV -3^@ .]@aH%q !kmM:_> %E~'苨5B uO^Ԝ-Ns }>!.hWuBG̕t[;Thu) FFmu;ofe)r,&mMBA"@؏/jd`SuW 9. YԙiL;W9(WN$ ^8Z,Z\IDX\,M^8{Pd.~ٺ`<ʀ6<2Y"/No?]}.~_1kuDpIS5ǤKuT,>O? P38r'!ҝ%Q^:$ gzmՆ8F&&t8ဋDпr[oJCj(!&1W-x[Dhɏo_uD+2*9Ukȋ$ q ^v˛<Xߜej2|Q(#ԾO?$U+E^ `YnZs?b5#2;y"V%D)oʠiQ7yxn܊79S0qD?ʹ:Du gP )?H`&]ʹ{navê{J※8kƒ6_gN{scJfL>Ŭ`,p"8 )8 ?Z 9J!j9bK(`xʼbxʾEY6nL-ۈe/DOrv]6m4[F(\U霧tm|IN/.x,~aG+yRraM%`= /VfFZDd%# #^1ލs8yiZ"#IP.#J=KVFe k)UI9D\RPD42< 8vaĎjp]Gɢ7);tJ+LŦi7ra?f+)Uia(lṉ)# Pf6;/N" Uj3mS7]7 M_#B9ͅSF ?<v7F uMuy G?'uE3@*bS_9Qw;9b5`y-!Po4'r]> x)sq*@;3 m57MW/D(19I0ziaΣBs,Iݺ߹aG[s@";:0G‘4 X̌wGغ ҚҐtnP<]8#?~:ސ }{.?y=@ {Cv㣡pۨizI ZcOnL,H%]Z-9t>%yz؈#X5mC,܃qNZ˾+i72O}>q >aSJ=aX8u@ 8c.ĖZ[ nO[?!b DgMd?S3'$hk܌ TOz]7]:TprA6MS[,{r}cwGI[ քvlg fi #r`0NFDCqV KjŇ}άB[x-~h5IܦCRi" {.BDZ(0]8µ[K$Ԡ.MͳNE j(m38tݟkI}#-?zuE)h(Yx Jf)_&`)w]KH7aNhiR"\Ӫ֘%OwΈko]U-XN_ݲ";(Oi_&YЃ)SUEԽ* ~{syR1qtbM-ݺɫ:ix%V%Xj''RE "rJf"RXIe:A!gJ:oh.vuv}:9=Va*,)v k{d( #_ҼBsf(U0T]gOWOfd:?,n9sϔ9vZYT3^1ucPL>OVXM5#z_|&?|bq1z_^ҹ1TFŪwSIA~{v]sRTFuӽ;3P1UpvК`k*OCqz嫰OSe4ظOm ϳϠB)\3ĉWE|#^IE:b8ȫUF}=p"W i&,~I{f?f:7tor4vv4&26?9O"U~a\ ֬BȞa),҅<@(rMҥ9Ԧzo(5I J{ڪ Yo\LV*<: |rXZ( Y\hz\l, 5@I#޳5rQ=۝o-aq"FXnȥ?aNغ'q _ M<[BsJř!Ͳ{`Dx:;CQӑϖ`Zi6€9G3Hݿ, Il;ٻWgv#-hW~n|G`¶z#q}H>#kL_27{=7DaMnMEH9F͝ 7"Ŵ6yx-?qbPIH7]5x|"J|5kxӋ?QAOKNx)5^m\Vi:@^5հs&֋v=o,k8<6(ej$(qC8\rdK iPl2DEJ6626OHkg?Gp*n_P9Oy6I 5iA6wEzBuCcþ3 X[Xۨ )qO2ÖsOqHw>GF<êT1mϞWCJygHxlUUGI6ݧb{7CM 惘 hŷɖy[܊?YD8] ) ,5ص'O*}hQ:g'n'KP$LDP:Sw saT˰}w9CJxjL09}L@9}|s7jˏa*45%+ "V޽:3E> 6k /E]a؞p2æQ~ˑ);!\2y//SHgKS܉z) ^, B`Evn'jwVjF 1<ߚ Sj9֝OY-/kX-dCzzr'ȓi5z{=}x`wRqtLBĭ: z®::SfX3#6`]^ߛt@W?Bj[6'SP]Bi5wJL1VJד×EN2-ZjV+]ɣQCD: |Psx"Dxhm|M36zk&sBM!f?#|.#t_8rFR/ך K/y h1-w ݕ }uoMXKQ]v+1|M<0Da`;zK}IⳲV$&̢;~G]4̓419yHׇA [(ME!-Ikf @P+傳[Òx4g"5ZFdR&ɶg!{U!<k.T~0qU1*\r@% > &64 Mo$ 7C%NoRfD8hxt*gܒVd*Ȥ6 ˯u݂Z""yg7_i[1? ED;]~+!Q'U5 tbu~WH#|2Kѷmc7e^D%SeX80 .lw8;?v cËH.ݘFa"T(',$<_eb&Km?6;SgB=,gď H0oGz^\L8rHnE`VfhEhK נd2 lB`o``9edŒ^ǦUI5kJ*b69 БDjwҪ$mB anяb)N"x^u$RI{)᩸xTL 4?M0{N4JJNպZ`6.#*h_ݜwXiN8dK-v=;2-J Y _]<~٪Bn^ia/]5ܞt`b/2dKv^H}wZjm!א Ѽ~„( =FXn]zXdQ>f"=xƘs} k"`|^TA"oWȢ@&'mbpEKMd^m{N򘞹W9Pt5"WAQ*qmBy`4UJ \-;]\]z ^2魯̲ܩY=OPu /!E'o|4j8<,,1J⊽1[H-NIlL0v١j&tK6G.᱒m0xs y˝(8Vs&O3 6dgB-݀b9U:^eTgkx9iǮ.o Z8vo( xdV)w x ?2$RHZ# sj\|h/ؗ63{&5Rd!kV,CG%/[L櫉OiN|>D[ 0kmfpl_GsZ$PUSo]L- a>&6 OE u5;rVr笸Oj5!xE23;[1Z>39yN%F P8Kcl]+iql/*e^_n;VgG{~O8!A^d^P-wIfI˫zk ѭ+gQRY]5 (+Dp* 떼 ?_iZ31Th-E $$nexA's즒4WDdѪǸTDi;HCQVy?-;aB 㰞c^8YQ'>nv޺69o 5A-ٶqpg˫ D(8;F&%*> E\*Ѕ5wR52yQ$[+ f,[RwBU}GLgk6nkK!?ps/\pHmF'+Hܭc`f`ǮƷ_ =앚gQ#/NGϹ:hS \'dRö mU~ÅŲx⭡NO5`E8#[a.{a!)(cvIPB2zރuMO7)PlM3oś&ocfnF&vG`$"&xA4nٺ"*TU>\Cu:!ffM-.V>&h`؊ .K bbkЇs[V~vOA{)ky?<nc33)% 6D2Xc~{LA0]&jaxE xRiIn@+EhvqLC̞#"YX͸ NSÂÐ-ɻR-%UNXit?HnX \ ^ )g{ذ51`{$0hn-6eV 8nf[\DQoۓ0A~^h@k᧾^e%bN:'V>NDJVꌁ3 kmIOA2:_p,Eg(NT4j #V;, 1q( _% $jYbu+R(QYM rB}Kipwnl],0)̢hwBhvEtrK3l@ Η8J\ 3)L/`f\D9d-h. >g=Ɖ* v58 R]UxI ]UJ~f#G/&*!}J ܯ9]ML5%TW.}Aۉī g}Rj(6z7"Gk ECGy0_2}J1x2J̋ISȈЪG(S߉Pq-@4eE9?nf1/e7q+T'pXp:c]"d$_L=9J&=Ih 7le>6Q% @0l3q&[C3,ʚ  YBn&Z*|T5z 78TZX̭,wس(=W1vG &]AuV"Xjm.mךlui/rZ$lS  Ha@,m:=kfƬ7;QN( & v1MF|C˘y NtVV8= pM*_CQ9EQ,9nY ddsJ`yM"e78-?Ԭ~DAؔ .U;a.o"CuV> dWSXrKiItc,9qRAb%&VY,f4M ul 騒.Y%R[=}vUlaӴ3z"4lUkq*Zz ;^Ԕ"-Y}ޟ2!F(ݎaI:bǛ1\Õdw1wlnRiHR67bwxj'$g.AJpfQMqqs ܑLD);4I7}veuqXܪ%` 2ŵ&1Jb Yl3~枞"< ,f% "Vjwlgfd$LnJu!mt2^X l,~%v\?\eA5wG݉E&6Ƹ`}ڜ)0B}RqNQXuؙ' o@V;*d 4Ruloj2"bٮp>h  HPx޽CrnΠjec_MJ3𶘷5c5a LM+e+pn wݝ\}OqńBoSJ?Jx̱ڎ uMy b3i` + OY<|R3ｬgň*l HAqQhEđ;l-L9;/oV?J)8IT=͠b҈P"~2@+ 柖eq I^dM4݋IR(J81`6Ww῟ә{qr`.3[|0o\OP?+h6vnRL4Y$;۰'U2!k ڿiVg8(YN6)bP%HP`bˆ&_M*?$R$t-lBWd/r{Sm2v_x哥8*|ǻ巪,?!;iRYHw,xP1UЫ}Ywjib6eKwʠ/T:Ú -H{m)nYБWVW ywybB扃 xP#JGl(VjY%$fL'JXO$dzxu1˥8bdGI"@/MFh끨蒏̚<mf9ACHd<)HIa iCj}VO\Ȭ+(dM ďb4wwImi^A?u6< \U'Qx UцSj{J JY%.sdG;AO̤!I&4;uJnmߨ46>dVNжnnrx6ZCR \$0@g0A ssjoFa$ &#Q;oFNNpCQӔY_;~^dNZ5[xhi030b|1dv;z!}R~G_85֊O]el|+fD P6hR3WGϨ Ws/La Wn5d({~D*2oRMN%R߉1JR;^!qD+)_I6kn<ǛFP),0옄 Pc XOKnfG4!a'WNE۳}gv)<*1'ZTPb[c 2~T0FD ͢;'F%RiL)ǔ~̔Ybrtn_g 7サI54W/RA;QɆMrpy<Љ}@zts[bw\X )n2sa?.xV --%[ͺgMF.+,X Zѣb2so`{N;ϱ{1?aW/@;U8Rp9tWbrq&t9HJ$=F>< _.4"ɭ:C;t?7^o'wͩFHokص׈5?GzvKd3@P7UtUC̵m`1ZvE*X8-,h}˺Kn2m)ԆCif,Z/].r! ٱ< Ozn n=,^i>olwm]M?}ߤQ.mP!}Ptm*sfe'g mP ҃y Ru yȉ--W4S c4Q$X*%^^UD]Tа7X]61:o#Ne(T!yfUGc7Ugˇbb"RO@m!Ёi9.D_ˀK/E.)W8?wɩiXɦſ7l ٵC(CU)RuzKvhoDԦXaN`Cf㳩0<'f>D6Sc>/vǠ%тL5P]* 7m;À+Ytn^ t(kJL}}×9e&xrZEUQVXڤ{]81QD*c^xRB%}|pχׇ44@Dzr5q "ǼęT BPjf9Z1,_s1>ibͲ; iz^cRQOO89拥 `r ~&7┹yj3A`"_P7n awJ;x(z2j<*.ɝ9pV~]YH#UC̘`x}ڧ Jն)T~>nV6*,ُ:~Lڐ:yk~c6Xśm9ٕna\-ߪRЯvD@bse}N>?/u (>3+^02m}E`cydˏ_?5=CL9aAq9B!'abS01ꝕǎ&821U \"mۖtTv 56vW名ubF"|[ېZIp7nN[l'^h BN.ܩfP2/4&m돤>wvt{rDu YMNnF;,RTt{9~Xod'QbWi1+ bAZ*\i2kfD -ҟ|j-Oie_<+iyN#ɒQ=ظt;Y=UniCucJؙ}Y7i# ũ7F$Nhi6䊼D}n|wmzY<]>$]qZ$T/TYXLx!N*L<} t $ݶlH/=h)\>`h͊ Nf9vj0gnN~HqWD~qd2] Wpol jʹ׃t;Ah;rPi3 /qԹl?Y9so_2hN66O-Qc T1*#,+OY^n,bDQ[#ńSz]@LNJM ~S219 `|b>`$9P *,|Ȟ}I*4n-U:TWl+a8ўn\;9 2 sBU &ԭj"3=c+Q8Zb5j !|09`VH-F[X.*!FxG8ؒkҼ+Mwc9PW|g #CXƅ> "ͻ_!gaP]V<<fz(}øKT3b_\xvf +\0LzhpӔҞP >M|k߉-I뚊=wońz\]y^@b$Uww!yQ:bSSR-S J_XCLF3j?\ybvf_atk+}+fTh?ʶHYxYG8nOP3 HPӨ_[>h8ퟸv>zX;)ѡҗї>a1 E8aǑwqg*9c]\Q0ɿT s. xPOw&ōKҾ9ڒ_{v'P[afgl/Qosɛ]R1?"C &(hÚ3[G8dp X{ dAS.%Kte$'Jtk0Kd_~G\iH)=X`5 ՛)5 N`X7OhPrI%H-{yiPdi5y,Qo BbNH:AoxSDNnT=hSYҲ#ݘsl:sjEuzq+eS6 $ACN¿ _BS31$x … !.>}e2z"+tac1`UjYoӾ⛺ފ-9Vx c Ф%j@-н(% b/C9zʎ_ KɒpXr#"vE>țs7q=芚ˉHM0&vĊʠ=e CqA/6&fbJzJ.G6A?K t*pi醎QN?U7WEՈ0d;vg]܆rVZs(i6^NfSrkТdYp#Ej؈ ߎ/@ 6T^'YbkO94{8$u\ "McjZF9ՑW$=aS7B8$dSx{@jAR3%.5vI9bs8j?लIRzD-AK&e8]^_b(FDv0P# JHݤq UB}'`x !QH,xd7N!3vؿUP`yBjp,e%XG#aҴ~]'C%A9 {*aև1 REAF~X;e9ݧv7kd1˖ƔPuk8(9ٯI5{.r9|peAԅCH)5maa4ؕ %We qEf4óWE{@)~"VG$,!/f1^|wjMh՞tS( j3'0y@33S؎S pfx$5SS/|%sP8 $jӄ5)bӡ2p\ls0a\jmC;9QH58-诵7H`}.caL_cvR] V8`Z_w%x?]Zvx=Q"1ES*k9t`Z> $\S95nϦv|0wsiYj"]chwfĐ4<%)_hc{^$G$ ۩\HTn|Ɔ1 |/Ikߖݶ&kE_'~>hz(nOT!I1g(lvz=qa΀SD;zY7f%]k tHjS7y0O>]G/h OOH_mXkz+81IgxQJ h:U2L&i䒯_%3Ey@qh,~p~LT0D yG=,WNM\EO篢򇱝~H6MՄD1Ƃ٣/ `ʨV\.$&Gi_#h.ŃnJ/yLG.:̾%S ^DfלɃ%g*3<O~N8`z]),!op$ֈ.>y#u<G , ,p_tm|3߫ ]k &_wup5RPr5 'Tq)_jF[unq/YqRlL[KG+4?3 qˆb7E=FVܽǎ6\IYY nTpD-5+hc{DsNJYxŋҪQ`S2MO1dl(/ԁaxid.Ufژ;y_ ϵ"Bt\Eŀ\JnL0fwA?}VHtK u7seTב{@Hf{S=%)fnh`h>,YE?1'QRh )^rh DǿiGp"+t<.-p/X0:T*;> stream xڵT{XW >B)"&$BDCN2fҙ y|Z[*TT(m]Jy+`ŲugVa/_2:su^W cD`2:"p>,WW ű`)k]Igp,W $ (ҁR,]y1-"qb+C, Š]"ul6ӉpDd s$h8PhWQR:)[)Ѝz'sHeQ% !(_DQR+?i qfȔK2,6Rd@*$H;BxI.UxipP.`0p$$Nk'Ӡ$0D2B0zLEIixfOUBLQ(>Lh-Ԏ c4iGFA bLI'R'Fm =A03$/Bc^P7fd!;`zr+L|m%(I!PZȰ'=C1&G 26Ɩ:JLL?~8,&b*B&Y|!(鞓m,`5Ԍ*3 Cð4z%A p|4Ɠf !+Cђ0 UC T(B2^ L\xK UR2u8i&/B n:U6S?lҬPV@INNCRPm!='RJiPRJ͸xоcIZHo b,}̵Yj7ɓv/A% Wm4?-,n>n("&|g,RS Hh ikMTkC%B~9'*HҞs/G~RT-\NKCi+Mkquno}z6jkRXÆç.ֽy,Qc{[bc 'vnu>mz Agb6T_>y:uJǠx:Iryf}fQ@ԘlU׉jW*4n}bz/n=mݼmM K1iYuMn_KYdnoϰ449?]`ח9 -u[=1چ,nSr|lWtw":^ݎ4tyliMյgsӚn}2k]|6 U4 tuF= N}JmóF C u[4v+أ,hqcu sX)V|l[a>%?'ejWc3O-xRq7<şrߴ;5 ~N)3w*mCGEZ4l8Li嵆>7.I#C9aŪ2ďǶ1kI^oviXT[\`Y86V]`ezBU!M18*2g}#l~w/1?`g+rI ;>v%0:5]bյ9+V]2_;@;8w~XSl?9yqvmYCC/ *J?!8FUR3]7 (3 +ТqU8>ohb+$uE%j֢o+}[zUTy<dnbхUd2_tmSukϝ!}(eSM[J]}=]Ҥ97WpŘxtpЋ,R_(螱ײ>qrn_cg]g߹S[$a0cvZ\~^ ⩍'W>mv;O Wz-s~6篖ҋwwYrFf y_?SEG;.Y ?t:n,鴘Ŧyej=iv{۳VS}iU?*^b]RzseGP~`sIJ*kP?nV,/twfc59hb'GyA|nΧ S endstream endobj 560 0 obj << /Length1 1941 /Length2 27032 /Length3 0 /Length 28252 /Filter /FlateDecode >> stream xڴyeT۶6Nqw Z(!@@Nq^(^8-ZS\}{3od$oϚkf[Pvn.7#C- (ԭ/0*=@ (U B ` hݠn/j-" vlb @X8[8T9j`!vX,m`- Rfx im]y6,t~oPyb]UVGJPC 'pcxaڋ W"aCl9\crx!+0/T@V@g7'9N/|qzCK!b:[; |U44TN g(juw%{yEv@P_/7;[xY86l+ @ ۟=9%SRSaWyi9<@h^㨊P@)a1sX&,bI@;Rk㿬5%,T0eF8tT*h ?Me%QtG;byƹH1h[)@,n8z-`v-LtBXJ-L*!tmƔo$qi&;u*Zvs;BHB_rQZV+89+Ixʗr+2>"Hk O-e+ )VLw@SE;1Du(̕0.2,Jz.gK>dWdS&(R:Hsl 6|K:祮Ntvr:WQNB6baٟL #2̼\ɤFبX14ꕉoX k0H;}G·̛6-3Q$ e X#b,Dk ˑ5Aǚ6ro!zWo/O^b@Xw;n_uӄ 6 X_ryu4JP?ɴҜ\~ECw6*0BFA0y6Lי⤗njWkqPJ'uC+*X0YHdk<M:H1W ~gr/NP߯j xgOYuapIk)6XMRfh]=ۛ!|`|~JuɎ;lZl5jko!-}o'Ns}0A&8ˏZt|hodk&NX+Qť Hi n>tu|s|  Z^?,l\W}aZY<|'&-b 屓>fqŨ[ytvJK@r(iAV銒5b&CQuM'联R4 dIբ\oqx| ?$"K-bW:~ЉjO[Ln`>C0€ fo)5tYO҄ȷ~,qr.@_O*[l_UD~F*[ucEzp<ʣl'BG.]NpydmVT6.q?%idgU@i3,w;ooggLrQSE Plȅ&zoMguWĸ"9YoΣLV]j<l$4tle_{"|[lj}r,O;!@t#T7Ze@Yrorr|hm%o[IUc 9C 2.JEy+ߕj1qnYHdJ+{pgHk)»0ƝhI*(Ɨ9EP)LƕQ2 BGGҌ?G`<7;g:3y֤{xd@LY]6?-¬f[i%hE.w"Sx"_itUlT$"GWCq9w'k7\l4~]4-̀qTf$줋]xBw&}9PrpY 4LU2+Q8Be bW'jk1'P6qL[74IQdfSFV*WFyv?{? >6fWߎ'O<״O/3ga<7-t T:KMo?!Y]Rg \MjR2&e-Wbx%ploD7ҿ]XcPa8B9'}iළ\x-iaU\M|47`^8hKW(1Jy]X/9>f637̡7v=\\avXsv^B =cn5c 6Ó\kO_ކ­Ћ& ڭO5~P^8/N:=qyrb.Y/t\܎o2GDotxdc/~h?b̾)'PaՓ@|[0 Zy>8"H3Sꛆ\?y:vLrC_H{$9~gt@VjYk w MPˠ^3ؿCpp=AF[Q3X^{KwjU#NYmZ{VI5abM[ӔP~M$>P7vC;?*JzL[Z %fDV N md`MyG&Qt5%(5ܖ'ތmlX+|48yu(vyHb}nC˜`_MC;ŴJٕ*T9Ӭ{3!=؞\R沁(P ;yIO|3썓(ԴnGdCIX-PQ-{ccKM;fCCco#EᩪN .hL>pavR|Wٴ|ʨ٨-هO]Ӳ/'ðO>JRȯHbޯ\r?KgInǼZWR_Gm1p "cK4ɏ3b/Rpeu\t#̱><'A#}e%t!7z,LFyDx<>i{tT-Ԟ(@.wM{ (,k5 RDg5a%Fo>0s?EpH =4uc'*ϼVo*AwM8P{з*37>K>>5 SRK 6䫯UNt ڑ~n0H(UDӗuo[3ߠ7l%w5ICtҋCHEz N]tcn61y 856#5C֏ڂK;tITÃH=qkeh2^-M!"BNi% ~ۀ-a$9Yk16A7"ux eeuz =Dz?OL55R;HVn[_!#+e#*ʞ/".Ubk 97X;![XQD/G۪XUP:,@a <S%!#Љt?eGr%(\""U5*;Dzzs/T( q#Sp_RF t99?62,(XX+L\v54*0=J oa/I,r77ɺq?/qxg#S4|8-|S}cJO"Ͼ}M\e=%6"9_vh@E0#dS:3Eh=^XG.~8N'HO沾N3'~3JJ{AI߻hQ٨^1tHf -e0ӦI*uV:- 1ܘ*OVvv&uۚ}4/dLWC! vAˁko~e-v#X?'HKo$X%r؞| F!f9B!ĕ5^7B #2%2]/{<FMJ4xQ䄶Z],C)T='*;Ot&4 ? I&I +KvyN*_傯3{Li3 .I_VjwO/X͏,U*ʾpb ib^la zRdTƝ;6U:14W%;^gh4KO!c` &٭|j j>SNϹεG,SD >\2>N'3;dE?)geVŴH} FM|fI P!_5C4u3:c G3(d߫p/ȬFwzLv玼ugnwH7q%_ls)Lэ4QW=]4 x7oIkF/;t}[5²ȮMڕq_gfaVSߍ_kwON(T$)bC^O+QJ"6+ZkmrŞHD ROl7cs.^M:lJ ڙgT $c:bn"o6\h5/Nhmxx72nFd i^Zدc35}ɉ7󂭘_,No4+S iqYT>sm{ rq2F܀G^a|VIQb4Mg8\V `tȈ!ڟߛ10}Z'_-{,vF]JfxX\"g4kCveu{k(} b[۴~߆7cb]:kZ|7픕AfAoG{[n|Tx{U̍ub0 9$#RA"T¬#A"A=,3:M(903t@zO <:}U2lR'\N-Qїz1/TƯ6:Ȏ6jZ$}fdxB9l'J&Ulȥd_nKc:a5Ivu8GgKi*F}n TKcэ@dθa;?0_)V&?.ԣFK5|߿+3K2*-Bjɽ(@ ÷$ڝu{OT< *Kba,iMy&2ӥ_:l"ˉR 号+LQUR@6b|8ԣ``t$f ;Dvz nԋKܑ ;&V~f<_6@K_ Mu,toHFV]%:o&b]K!Sm4Pi>cpW߽K3-N{q@ǦKSCխn pVGmQWWgT/#k =\.xCb)t덟NE ^m% 72اgq/ W΃u+T'_\̞zYR9CpGxv3Yx.tF<ъ'!] meF=exǭG4S?)ks;o\0>4#Fk>^A}#Uk,Z;X'|_s>3C"N2? R\mf˅*?ROY:8.Aze]|YrP*PSΟ[uJuRO++})i8uvSح>~%a16bʳeq8 4Ţ+zO|]!^ALUd!Ӈ|/qm X7~Fy*e CB>aZڀ9qWJ$څno]aJ U5Hb{_x;3[;ye"M5C}EӲ̒.UґZfQ!ysfs5QcҜEId E&CֳAp ۥ9@2oM%LfjU*_0J,]<{}E!6<Zw/k:g\)1FcVr,#mjSoL|EY{UN~]g.(vFǘJs!5iM83Od.E-]V:1Wтcl.P1;/IkH@ ӗBGʂ/,{A&9\/VW ~7/'PDH\KЧdy5s*bwMVdֵ%jCg)(=BXP'+\Mgq`ȟxG_廖~LjJ6$4+ Q6UӿJ]QUMoЩRD">#P2UFV)%V)SaqW{SAbNC{^gSoڇtZ.cRLN拚a1/.W:k%'t:|= KӺg)QJU)eިݧ-JVOnEBr 0d5.:SdlXoil۞ :$oTT066|gQ?ʟZ8G5|ڼOTXYwS"yI$?N,w?t 1;#{d!`L2$eK/nF5ʜJ#*iC &/uΙY_ϘݏT]:x# .0+XD]7QAKs>W<] A x'bXI{ c{Qjf~ U܁3/1_֎gE'^ ]6/x*qb=.p+ܻec!,ا6*M Â.|HA=C)+l"ׂxKfhKD <ꦱ j6 ]6&5kKGA% (4rn2k5_^A" w~Gv~▝ՕEGR 'K5X)0k/TjSwh4jHHqSzX/Ďf[+,)&`n .~C8> EIG)qr*%{?ޑWcHw ȝ1 7=u%[Jՙz|Ȩ$뇆I|zgq!m8-{X]UϬ]dwkDW!!g,Փ&]~dóȖ;[\c@t4mmKX(1|016wd,_K[ {-Բ2˖ӑd!I2F%cj(okJ<ŦP>޿҄*zdPMB9s!C*_A&zc J$Lj*tC*:ʑ`Pgry4>UPIo8R:jvWx/tBUȜ1kgG6ɧDeɯ;lxwGbu4//4~hWׯBb옚s&fx%0TUb_kD=> bd=l|n/$>:kqn-IF+˹[Qb }9:ʯßn և1ȉR ypv^Y˰TK+vٛ`:[d54aŶz7 3v2[s 1J  /zfE'ɏ3-" ϩw* y'?ڮ|ضYE\wPrCriI|U.98lz䙬n_KPCr*&8 }; 7췼Y7=ao6A)Ci.to;;߬0!yT0 +tRkӛ2RQ~(04rf=%<{Br8V+rAC!?0$"r0R?qx"d/IsIa?4say͍j{y*1Twb|)/ʼ]V <1}$ӿ@}X~Nox3fgCuM"b&'1z2k֌J~!xy[nU܄\8mۚX1iFo;E =Tn@%7Yf{Ad&"7FHB[zX`y>o  ٯZEϢV!JvTJyVN=C'unLh jΗ~Z]CٮH~/+|1VkZ'i[_»-m#9OCr_%ܜX(Ĵ;]ޕ&D"R56|8 `> 7:h u.AM+4xip!8>r,k&iX z_4LK9 rdR)&]AI82R}O9j~S]|;sċ7<SA&o %Xj·R#vi&wOfBϳiuEvPWRP9Q?+aXFJмsOb[\gtj?-Ob^<xβ t5O<ִkE &=;oۦp" r]z<'w*&?R'klг,kc{լk'+he;W.Kz]n-#x?iWޖh[5Fذ J4WqB_u`i|A0ʻL>-E 𑯑O:ͤ 2rhPcj |$NI4A[VBN9>[a;LMWCYLf=4>(W|'[^ sFtWJ}sG45)*С|- 镐qN47ڈ^\Yg] ;yӗ=}hN#ZqWhݠӴx.5kgdɧeC&A/6) }N83~nd{@wqN5+u}[Hh:ï͇@T0SY 󪤷DZвf炝C ~2oh>IcDA +'BD7tJ5D<4_)3_ j[*<>OH^Va_HQg/UIGۄVVWPВ1DNᙗ2-աb-R'+|SR%i?X3Hԡ4m([LZZ 3>#HJhDgHɅD(E-=q ۮ?Wo,f oGGռum^ޮZhս'OMg<ªذeۅE$4/(N&y𚘠V FO$qf~ȂLdLHةkzq&˸;s9Y% ]i+=Mo z'=TY;ӗ~V" & +βe8|E؎&=mG˓(C`90SqFkXG]kr$ǴmU N)w , ˰^fT| wm c6!1N-QK2'L?Y?m>~?_uA :(;bo|=mۉ{r{#uH YGlJ$q W'/%՚^b:_#E"ژ>v ^'Mb(kޢ:#ߗ)i {7Q0N 4#756B:-$gY ]ޘmGu.(˰avS%AvAɏ_zȑBjbk!)s°Kffb^Ta1,yXR &哅+TLd&xd&~WYvq_[b*-e-TnIBn wP{ʇ1}XV9!Y\DeJC(XC?ƇO{Dʜ RT`"| 56>Ơb -ZȕIj;Fg^@ҌUws\Ϫ^*ުanjMu-7oӵ̷B}qg B%ީ8_oW.><=>{I 'ɁYcV֚U xUNzUŦGᵸ߯ MpNDWh{B5v#mw;`*ZcEeo䀕/=b8<7Zb㮂wWBsĮ9BˑdtT<52e}O~UX /n8 ।5{>X<(ո0/I`tU4SgKMp[1Nr?2/^q33~,3a B72Ҹ-/KwG yeQ\VmJQfVJWI;Ry]ڠԜ5LͪO@! ܀4x#oF:q\:/Ň;dǒ1aymmfn$`tliG=~d88 6ʔW@Ϙ8t6N0LmfwYF4o, N(#3tB(bD(bEܡJ޶rz.Tjqw Ѧi)+6-oW/ЧJ(o]*..:l33Ģ軟.PvÅӊQlWZ~8Gﰦe:ND_gD>aL/v{mɨU2/lDY cW\˚MW2JsBp#-,CEF{uu!mIagۀZ!؞~6hGڷaѭ{;WF(!*jLjژ -XAo\&BQ-pMm(p2 )Qjǟ Y1kX 7߄e6!}k+3WŖ-VY ]볂XXi@" i8X|T3P_4y/y͆rgԀp-HLv֠l\g/ %W%m$IZw'قQ ZDx*ٷo貇\a+}{Ur`DO_Sl$km~\oMdI}bR{aBրHb?w@hk]ec@"c6%mX#W)4Qǻ˧ߌF>aЛU~$EE ~}qj-hāxݮύ}=s#\ ie8}G:<);hNv!sO=kc-잜M4<Ԙ'KqU\ ~0?M ,a\OVxjwO6'rgy4ܫ0sJ%`gl<^gR nc'S\I |,qnL +q1= :- 3S#n)6o945ӧŽn>l5On&7 ']dѵymRxst.09y, k%UDzD7}k1~h,?UZ;0 K@$c{q>C3i* M3 /( mbkK{׸[-)'|6xSiG1*ތ= (sD2W.u]]ac+x VEC0X)lG6YМ :JPuhelN(ʭ'߸$/0Q|!̺h!ߐZs/_&pddD9!Z?2F[ԺjYrLa`ՆOP+EE6CA<ԴZ,J04-|Пf ;~<5Lg{8@ )oY0`AҸJ@90=5pwO$utTaiZGUBdMe׭N U?aMK} 4 B |Gĥ_-POEʠ%O;e#¼ q"ĕ´wis;0R~+<͓5O\D3 7h4B6fPdP 6iב=~NQ@r(V UP0{?JPm9lM>ya0mz\,`y^U|L)"'3` kշ {$Ӧ( 8bX@eOIk)tLΝ^u<}A[\kI(Ed͹DvHGJAzMYsJϿ:I)yUT[4=d]Np|EΧqyvNj5wL5#0$I0/$W􉵅k , rf٦v @ bcMdT2{Ҭ$5f]َ&`lzM&zңޙ^.=M?(r,{;.O&U=F)O}(C֭@~H\ZcT썣,=πhBeLm< < .3l)Җm._ *v$p0sBP4/_Z@\hz{T4$3 P5@tfۥ~*}렍L.K[1)"=R5ZBbF{ 3G)>qbcG p Ó;Č*dKVMgC4MȖ7F0L箆ڊAUo< ؑEsjوHSPH&+r! weʆ.¶<@oXY.`佺 )Ey>rqR˾?ŀ]FD7B(5W{ 8ꫛmV?q )а[x@h|Γtm#zOg%`hNa0sj:Soq0Yt ̻9s,cDGX|V1{ [ [!:A|T|-%8M{y`t!8#`7b&~T .RHuĈ5>$Ln.t08í)J U+ru#+tɵ^:Inq~us4A6]a/ _pQlϪd!S2 ldSxe2 l.st4ŵV5jG\Baa_|FpV10L_fTlħq^ ftR,A^E.@LPv{"cfZw]it6ڋ09S)[ժW05<-F0Rwt01X_s.sJw"ӷ>Bqw'z~q&dgc|}b_v p0ؗtrqT?`ʼ<ΠDW\yn*M\y럤_ER2}dsIW+0 ׉E-S1̢Abٖ6eTc<&S{14]wI"UuE/ Me#6F3s-oȟR3Ma^rc{σp 2Z; 5,J b^~n *9SwVGފ0Іw&H4~bp|2ޟZps%4i>r-֕fm'@KunJʞy,s`sLAv`;1*J[Ie<&Ӹ g1}})eC;Se)ޞQXHp˙h6-I,@@FvQBAHkFLugAU|WKXU: \gDPMYD o Fz[D:Tlh1U۶y @iEq sI /If]W1ʔEDx Cf?t%"dDe=ہT|iFFcE ߖ$|=ɐwυ␨(](Ђ 9Z]xƘ6lE?nm=5._*F/V~ @b_޾Uo^rBA D9@TSL_u;Fkw/%r$;bOmV&"ĸ_M[} af&s P>xjO&. =LKtsǦ#y[ЩN6 .؍G;woI'č5?ƊwCe@}H5X 8lhiHݗ> e,Cs$}jGxnĥb@Yi ZB?7(x3_Qe~D%xZ ͓ H"l t."5)Su ~]GW1TR2xvǵ1LJw5n66$M6HuD'3I2SVf݋w6%rPZrԝ ^4-pt?ob w+J02 0<$fذL>bHެmdى9sP=ﮑ<$yFPjUfL{6;y R)'eR,[ϠyYzor$>1]w#8ⷣBcl;p,uME:A%h}vbTKUdE;8QaNV7\##R>U[LK[}Ē֐ !TOSkOcVy ¹;{L JQ>cf>x@)˩=CLevgt$دh'(Nҿ1Y/qﴼ[֣ G+e˚\' kNh&b6?f*^# lh/7+<<͋..Apn`v)DC1zh\_d lq8>RM?NrF倨azhId@-~1C/䣊x_A w[#=ط2]7|t/r=0,hNo$ܗ3T-<6U'șVɢׄ{P͕"n݅bCbA << 3H%vk5F,K`ӌ*Ͳf'I:Oa].$?bSpg_{wu&:#ye1O\0$+4hhb/u?^8}lIPPui -Q*FCt',;ɵ>gKυF/ R+f|y)6^pRPOh ,Z/].( Zm/y#˽NW|* 9M=.,VFU S&hm/q>e6Dԋd[R֚PLqРe4`LFy.g$NB:&i,jߥUTRY!Y4za& >dQ Fw|o7O8RZU3YIu&$=wO[QcK[ޗZhUQIih-k##RITxMk'%Hu~5 9c\' zSv yIwώj'6x{BDR!ȗmxPyCͼ"[f]yw;E3l\+SʿIYZǒYj+[؀&]b,zC{_~~ݕL4@ᨰܭxs`3HwB(qn]pf09X῁]{@wvY~0VrY26ϳx&&ݧg-V>E"g0sAh1ޝELN/l_(H.@]#E|Wߐ*fT(JA+|Жw98.Ȳx{5W˒<|,/vmr!$? ߂0jϨCy/KC1JX6e.h2{s{'_f;{aQ6pP\t|p C'ʭi|HtjLNNU!!BѷC U-_}N E@LRP&;ˠ~QE(r,2ʊ/zzX?̓XEg-p\2?-!u7킌c*TP` k J#9-U,ʢ=SǰRhRKӹU x¸6>d~tCz"U3!A3 pB0)2I;TX), ׻p{RpM/t# hRZ֡4A֠ˌ$gxWdHoO[Z!WE;>Os}P7$35d0<qS-(U~@ѢAOGW"-D:3F?Ni++H!;Lni!O^ )) ~Ӵ֟h8T }] I I*"%gxpfb(tM/2XZ0Nϛ'¥|Q}3ƀ/im㜠ZBx/q].*j j$@$j!%{k9! iOsmg*{0D}\aI:^lykHO3uZ@:5itBd"564Ѡ?·2T^A58@Od;S7.O,:#.qKC 9mBuф6%t~a|´X[wM6"ngաS, HM .<4.`ǥK FI_GutBDK0Q(L hr nj8挿WHo!;x/{)y38m_L&ZޫjԎ˩jV'>m¶~q׾ŃX3xvtfT^25^Qӌ7uC3嶉l;<qN|n֤E$ҿ",,w[idV,n{Ԩ$H N ܟ{0 s"3ۋ&%~ IO&'iQUiG#YKy-VMToB|n$_Ց%^^FCE"=>P`bB\@#]R;|W?\R'LU^ v\6xI5ҖqK縗v'#mi&-_CmPm8$[GeȿS }O: ɻ6IzaygCZ6wO.ECv]VUcܲd(0g2'1r4ǘKD^zdR$;9(f:JUƲvϳARyd?УŸ:Adɉ_J{g}}E2O9d<aRR"(J63Y}aa˲xP`L 0Ð~0c̔)0")z*{2]VU{dX+}{D(`*cYTIcxASؓK|룣 cP~V`Lf>>\Ǘ'{{ 5,`K'ӵjС9Y 5eDV7>Ͷ^ t8:FC{)j hV0%ys0#C r}P߸!7hV8lFEIpyWI#\#|Fj12:۰99Q2oVUŘKmiP' ;)dG"?,rgy:1&o+8h.JςL ÞugSps^AkyԕM5FL dQ$Ov'Oe`h }rk?#n\<5IU (H)*ljRXʎ0榿Vr%lLnʔDBG3+ 4GWT^ >:FPהGut9uxc јWCw8,-<KjCK;x~-ϩJ;nˋ_@ox?[XhUVrE'`ZyD&6:cf %^}ۥ.ߘjр6~*MKXj'YEdm%ZlĆvw}eQV3%3ejǽ. hI4em>~V\su2k +Rs8 XBn=X |n(O>8ut*f%b:y/_ ǭ@{nfТU{jun;i[oR__DVLDu?a[!m!B8>0Ѯolf{uCyϕ&baIf%7a-GAFMeqi[A@E1yh+XJra Ddb[pT{Jкf@ ^c evG )qD, ݓv xirVU>X{4 5e⧩4{f./ЇZvͳԃ}\aD-zT?>I L#يv`Na\#g [&u SBųڌVE«4aÁ_F_c#J'(&xHn_`g;c=eE6= Ii$6.)nĔ rR[=_T0-EQU&~|p&5ɇ,&{tVF5X˜ۛTEppP\cu}{Qrʍ4@.KruatŠb:a9y?Sz$X৊hn<g:7SЋ-WT(m\,-j$B s)_.f`Huy/^QЎ zijyQnoCl2x!5v@; WS&HAv>dA"`Nɰj.?N z`JlN$3#?rP`XJeׯi8t\I9A OL M򟩕kC*1IM+>sg:P&յuI)DC k u# :3awE:7љQD"8; CT=<[ cW]Ǥ"ʬ!Uis0ZrP6zPn+tm7&iL2R_CʭكU9y}Qh:h-G~sVL]z @LBd^B\j?0]ډ*D EyA;P }Xs0^IuSSQlR4~q|6KղcP ēy!c3)V qHf^[(_8Ĝ2P'ͫe-h.7p@ܕ= tWHRBn<@^%u: HO}nc_KLKy4 cP0w"dE86:˰ר`\v|S a7Z^GB41DYiB(fEHuJA/6d%-,kz[66Lgi N򽂟;q%p6[ʥFz 8y*»o l9I){c!G`S̞x)SҾ4FTmnfFh}ܙP,cB]5-4uîlїeGDX3{egXZk-+tdO"dV}֥zj/o#)섥W Z[Wpw)YF"Grr3/|G:﫝* Z@(m_y1f0OT_LҗD85LƶiqY+(GJh06{9#ʭ(a?aX6T%+lWm܇ FE],a`,mm7+ LSJh%{S+g=K{Ƒ젠49q39\M .S'`d!,V0CʭbTEmS s;NG;fֻCLbST*]l{_GWq{ofαЃq1l}pֆ׫DSˊr":q"HUtg}&ɾVMiRkB gPg:ïVbQ9$ E1oe &clF] !9o[u@$-oW"eȣi ieq{.Ӗ,rmTН׸MM])"%01,[кgmT]sAIR̠J̦d`ċn& n ޶oIOwax3eaI(g(u|L['6&>ν@_ԊRSzCђq l>?ql%(20]i!ʈL%λA,IX/6ͩtKv\UGԡ %r{Vlo{Y.wal:_qiپ[NNS4w_M.y'o|ODvbVA"(<49wEeGh#[;!$=t4mTqgu4`T Pq(lA߬"Gy{2p@Crpy;i椮}q[v er2j!*FxSs<CltP\9EPؗZ/gUis4E_+W ?8.pz)u"*l [{NW endstream endobj 562 0 obj << /Length1 1764 /Length2 19817 /Length3 0 /Length 20978 /Filter /FlateDecode >> stream xڴstdݺ=cc۶*ѱ1;ضmc{U|3ڣ(rbE:!;#3=#7@VN։NL GN.4t5tr8 ΟqfFF.8ri4yΆ@&? E;'g:#CO3H"bghaf7 L҆VvnNVC[4=@P֦;S*P"PVPSTLboo_IDU@uZOUgfyO:TTŘ tt[F߭}:S@elFoLohFooON7;G+h [O:́Jw"Y coݿ6T~}'sZGsCbee6@[C[OGgCg'?hBGǿ5?eua;ӵ6t3uq_m:Y89;+#`ja ۽ߙY K~ ϖN[zgwp2X"5 /}<99z0llhjakbs{5[ ~Bp̀Ft76g[Ÿx{L  +߆\1qL,?%M.ekjkTlQibgk019JjX[dhcanCQG;D_ r65s@jX?>uhle trpc~2o9ye!Y!?>bv&ff6v^L*6g`jwl?+VVv ac0ڹ8a񿖜/>3c٘ @O |f: O2HZ aaX_.rΎ:d?_M? {khaa;w/:VvF3XX#_?{s{D@w11OeJcHXT)$9i9&trT;h@_:E$Om&yFKb䭉h:Z@ܒ_i' tVVLzk\+!@mX)y:Du-ҭ` } oi =&ҰWhAn4}O.hd3yF 9`K(#!XL,XJ1RQس$(*7}(:V"/44k؃^KH5;zM/B/%-._u}/l+F("j6/6D8Y`w"/&6ڼp:;}C;d[Q1.%a)RA;G#5G!z (#UkL5/44'f_ֽmËwu>,jjUz2LA@y} Lt^߯P4GmF4adS9k W"tD_7QV~\v>, K?+@[D͛oM% uk2©cj7GXacDxƃ=}!)Y)ɘpREѡܤՑ/ʮ8A!OA35pU]u_xV>193t\ʪz~l@_ѻٸMl* Yn]_k֢!o0c%WAgzf$ܽSJk.c!qU]h#͌! s_j5\hυEJq-ntFĄdDmӻ{йF0zT0n! 'cӊ oӧl 0) APbKUP{Zh%#;LA!֡rߠAldQ;~^&7E>,/Zp Q/ѝ0)-*cE$a+Hq6/=o$>0A\tqs6H- amGIϯ Պ>J fMl&&!}nM{gA,L-g.;HNnH> 3Q ئ/,;ZPTפΚoμXJ(+ӄV r] :1y~%+u\wM "<}PxgUdľ&ܖ_;@AH~7G)}6=}%q~.\׋zzOH^Ik{(lrdDC7cCȝ,{{N7tb4Ttn'LNhe Hb.o68{UQo?(Mq 21n&eqk$@^ &2qq" 9bhqNc'AU)lj, i}>FXW~zrqgFCKt6xVȡd,ҺY>#w[|qSэ^bsL G|JإPE(kK{(piX%a-.@j]48\8gȭUb\{fޒc<{_u2a!7ɧmjSr"1(>̣w`F?P=,&h9JN5wScx 4wqLD}>u,ְَ">7h7 Oԭ}m`XU_ob `k:+AǸ'tTdZ5&3m)Ў|]u%^NT䔽?!E6iy,@k@8Fc-qm)Ei0QƘzz7*G?̚{$US(o@T=~ ZbG˔ :P@.SSwSQCMQ%bUxc/0Ħ47ġN:WO;*/BИ~8ifoɟt):#GQIq-,s5OlV>a"{V)i>+?f?.nP}E(8KLfiNE~08Sl/*Z 'G?)BZk0ڗJ஭1^lpCEx== +6c P-r Wķ"FgIHv.dts; !M@oWPk**7 ŏm)OG"cY,xcZ$9!zU,{se3e0.h&pmB9<}6CD߇~I`(H:kI؝+/|yM:oaɬT˲΃a8(xI}7m*XoL?Y}M ~x{F᧺^қHMfdg֏[͒W2tICL[>7.j=Qmjd-1&З~}Pm2-J!Llt l! V#+ ltˆ_3eiZ VڅV36 a=lpǖz H&hX ӧ_y豇3ުټHP/Ѡlo /ڐDԫh5;Im/DNoم Uڵ٬dDw2"֭0?L^}G.sv}WjBD=ޛ0h|mZK;q9AGɨ5S(>(Ÿ&@sL4>`d*JMGW؃ҽL?JUѯAafL3w(LMÈV'ʷ a!oL,HHeKߎ_U'>O(@÷#*-!F8枆;U8;]¬@ū^~ c 60G[F7e}_I:ebyܕ9v)f˦\gdVԞ`-_z~V zB֏k푷g-]#]/z( 2x8C0AVڦGΣ^8I;G 06\)%&0,q;31je.rְ39Ӄp&3 ȭ2*NBQ_igkd`/<1U+[o5bzuܡbpMj iV|X@"D^uL̿0=u jkoB(E DN?CdUI0Kry'Ư13}K$eaOzJ{+<O\2Nu^ˮSNWn)|D,-L ^B0?b#}#'VAπj|,Q}^{okz"@vA]blN*m]VkĞpS 6b=~۟ 58Cf?)zÇ\Z`3K%;ުURޭjFX.*[3/'6粗N^+dUA Mxz~CwgCɰV[KP%:bVk{,>voEqHPo%REڨc~+sr$Ǥ|yWK/^d{Qekm "w4h&(Az>"eп[pYcT#=yAb-_&⛾ON۶G̋Rx:_d!@ɌRr yݬnDSŬ=ˇ䃡uhYaBbr"(Ww.WTxÊ.!3#ڦؠOaU=o}ӥolOLCWɖ~^8giCN؊wךpթby 'x4[V1gw' NT3[L98JKPK/$ $S>3~t˯(]*;uN**Է/[Ƚ' %lilYcdhԌaU]vadKI*"tWq;8&'˃XB[9/߱3x'ı*S9[éj±M j [=UQ䨙X*n8KT+BmtG7_(`OĦ"].f l;lbѓ^ 8SjA^AIˣq<<sEy| #Ŏ]E o1]6kk> ~ZdA-TL`5g+Bei(="}w+$7WR҄Unޤ~쀊<(`]2iWs]ze~Uz^6ln!MTpx숳\mKGV /σ~MLI#_( +iA諁 KO+_2e]^v%2~ /b5_DQ?rk=s6"լŅ_:IȦͶfTx)Tl -;OЙܤ'3/8җET-.J3m)T@;,][varq VQh9Ӻ i]uLYPZCYt |; 9{NJiv\) gz#qN`ӢjʩCl-Sm+Ԉfy1zwP[i %%a4V/I-/K+r)47"TU@Q7)k J07UxHw#^UÓ{n4/I B8zIL}ue 2+ԋ _~?X%%x&Ap!rCX(jNf:#ת~#O1{Zǃm^l3nTmA nb l .هٺ0K29R$9*$L˘orV&y$ }Yl߈D |NQgl"Wc{#HAxQPDMBBf_}Mz{"-#K-oDڐfMA:CHRI(CA Xdl(pԂ2Л ;DG@]]}*$ύkjV6֌#He6\\/E/"_pB2gIݲwAbm| h746|]w6W$zmW hr96_c%W{%y*֏D)Z*-֖ r8& "o+9V^a&3'阂mg 6WsW+z.MINr$.كBY_Mk(  [G,s[zʠXm;~ѐRV1?aϳL $hu "-~{1 t k;sTdtC;,-FU2 y 2%^| . pDA0k B1,(t|ٯCpI7:jktA:l#$e_rD$4cRLAM0Tԉ;ÎAhR1a을wdCc IRz7e [iCrEfmp;!BHGH%"A~h RS`E=hyI}8R.'qj}{2؉G;G,2B9?6K'C]_e˱ û&.*u "fr(|x#U+@^_/\墯hw38WxDWb.%u*Q+]k)jM3u6m X@*|&|=v#M3 $>-rBR| ]|rBd 7: Z7Y_'l6Wz#}-FۦRѕ]S pQkRQciOD=T.!RSˆpz?mS 1vje Otj9%}FT5ylmxaRJnʷlS*\mк_'-ek.]ObIFrS_qUD Rչ1R5LDH!Nbb$MK&8zew@)ˊr.0J=LۻD8U` ueysF-9Owwѩ7z~P:ՠL̝tj ˖6II)jiFF*h/y:/qRŋy K'/;0c] ~#b)1!pJdZz߆G_b$5ә$$gzpiɨk~}S,`j-ˍ;1\K\tDC;0>+\&')m-[YSfN>(AÀyh?5ޔrm2{tLSW*vI$]2ULz,`|>E~R6|Y,SC"]Lsam7[Ck.y]\aGllv܄'ix.ih /Zua:$qƫ6*\O;Cx]O{^Gv2m[KG&+Y^zz Pqxm.%^yo,ҡ]DY3z"&UWq/Xqv&__Ɨ[SzrN]n3˃8[t%RhّC+;8AV%a Z r bW,)iʹr'`#n@ZWXs0]~`2dz+Qb)۫2am5]IJ[WQ_ѝ=*rR aw$Z>)sr~E]&|{%9tC!SAFjݺbC%ޢHNв"~H̄f4!?(K Է ^TߠFAMJ~˫ l;Dc i_e8`(A%  .ra_W_Wةs5+0tG^Lwx،*7ABE&%c%۾$l%i>g8$ℰa wlj3yн|A?U #ZBNJt5_y58p7\۬ NKmh`-|wPE)gдq߾00o 81(˕e,C/iUc%nV,%Vd.sd `TG횁Lj.fYnGU*mR²J8z^T`&]*gob~Zz}b TEϥD۲|)cC=\^Mn<$pс}0V"E6%|mgIOM4;i@9bjY_Mx\# }Xw) C,ƪCPY9eyqf'Z{(%е{d''lSrيw1$ي#XZh c`Ehpzlx~ڣÓ!(|8r^ɍ$61gf)%q1d{w/\mMZxGrqDKk}owwvDϣj(l7["2^G#¬|$T95aje3y(>h#~/ -m *p6/=A?^_[uCAcC`x"qNXtOi `'Ȍ8'@~) kN;똠ޱx_|N$r˨$.?#IlxKeub1u⧮$ }O/}uc)lfEF0J ic5ˤ$YAzz}t~Q.G/Uաk›W!IYc:$g}xko.jnb /*z_[dT:ꗢ(^50*O)&Y&XCCc85Q;!W2W,8 Ss n7M//Z0u[ SNIs߹Mƽ{Rxʬ:Ö6?oH-Jbe+xϧ$Wv-q8*TenmuFcS3**E-A&Yz+qL!3-217l9-B Aʾң5l~I2YdU猔X NnאY*E8L&*Ek4KsҢU.A 7+ނ:"늒2SW6@C@0[z Lp+dl" z(U&*9ƶ4O1({{j3o.4Yzsj,,LiN9|;?kXr\S]@aY㪱) 8oA {-$4Z?iU9|510nd*t2*OFu9H $^1M ;ףYMDyA فRϾ}AGmIHl:{y"P90P,ZS/>ؓ =3& 㿻^Odw632ǤH:k&̗'W88|7$tpsI  T( E5GYp#ġ&?k4q^1Z5[~(ߟ6YxEB=NrPóE| 1rR^A}I2^e A1>G}B^~ JG3/БdjkwIה@? txz$Fm7q'}'N`D$ ,ܻܮK&7Qn!#vIvrK3A0W7#[ctھ_S6_}EgښFhKviC>+8lЇ%_7VBNs_^fnͦkG\aYt}g,B6KӀH_%͝ I*=s-snT(eY>]d AAn໫辇W43w~QZПዱOSӔԦd0! Gȴ0CW3#yfpdU2Y7Tٰ  yR`%-E"Nb ko3+0K{f@+*?8}(/1XD2;ՑFQXgַ`#G:#P9^S=@'ocD;8;ayAkF:'dn_>Dum[fd+V̊m#9_V6B-R9ȷV^ʢ*ޏD&M5^9ʍæ9\~PTygQW8_3Ƶo۲A98C>#]5o@=eX'g^[DxHN5ƔYZy5;T1i+l)" eo*Xr |+)Ze#8ђ rk$R Q▂m̳9j(2*0:cpfm:QNWgDpv,/ԮC(L1 IG* y&o+E8A#U]11Xzڞ3\WlXl xW,h[wCI䒪 poXع6u 7v%᳔g Mn.n2$x40qBFjFါ/-"u{obXnd.*A. sS1:$/+ʸ"]p_S^ !wD Ҙ?-\/Vz٬IʯcP]^h]"wMS%PF,#b0).#>j?;d^:ԒO<-_ ԉHm5o)iL@g ȯ? %'y𼸤VkڇK_/gEf Ȗ g$CJxC[lVʾQN _;| ޸ArSezF^i&??5U"i~9VјI6i{Gi'c|lW;>'EIeC.jiR+zEg415{fDH U%FֵEJ|cHɲ8Ld HJx:av9?UDRR pgT-֣k%n#C=r`mώB%V=d51?|Z:+OVV.LHR#btт]"kvʤts xc?(e>[^syo߄((﹉] _hգJ7,DQY]`!,qaB'P>aK|/:3 K GQ]~P^m?a\lAR4>0GKMhDڸ5n~'_r>2#rh7߇I4=='`11C=mN @Uݦ1rk]O6myFzD>k.ϸ@o?pTUW`~_Bh`JJmLlFT9bv+d2-n:h %Ц~i@h'(It돭ϻ¸| FV~#iʍ@cT+B ㈜#ԩo>]N nBp$bl= ((>;Vڽ7y\ S?Ah' :r_M ޢԦ>37A+8 |ŨTU.U0?3F3H5?;V \ s"JeԼ뻪`G]0?K-3 (-au8 `5 UcN@|zSNR0aC#aW#Y3+8+dt\Dd!1{d:n!,@5o\T2۩׹)S?\]puX^2Җ0U'?qߪ?:h2~ٶ9r$KZ0ǥ]yY0: 4@ פ#=Q!K 4MDشk\ͬn~L/Lm+D؁mS/K|Ki;~F3^* %'$)w]HkᏙ0HY Vp8q t \Eh[jSLLڙMG%͎Hnn_" =%i-.CHI@ 1ubDl@+6ش>U{'tdrAo 520?‚!a^Aƕ/<`^}јRv;vRrRR|SԦA>xWgdnmWGC_zW3J&*TW" P u"BNb_%TΪWZGaxYαWv[2I'M3A@ygPB,S+!-<(Z2(x ]6"4GIYvW(08G;&ģCl4(CWm*F}.+\z+ '( lOdVkxRp2(y8V+"V_w;4,Y學pO(fبR"eRۦNhCy?C>1eӷdY},l qn uz qAJ\9F }h2Ctro26]Ț:k >=8XmHeRGwWƑ*7& iZ3FvpK7A^3Ll3#0%tb_+}Wfh@`hYyBGg|[T"L3PDf$FVՆ_y@SfBZs37͍xQ@/UÎ nAM$ jp]{MQҬ5'&X%鬮睁cڌZ2&n'eID- [53q-nam%1=9qZsө xcKIW`t.H |JSQ'Ԣ""$8" mn=#_ 5d& P XcóXS}M:9f6.0l*+T?\~o\@js$hɦ|{$ 9*/q!\L )m԰99Q2oX1Ӓ5liWy1ދeQMXhC N۽ lm}C\|/?kC߰SKGsU?w'ʵ"?߱eK![PwmP8mx=4YKeoiُfII&x~])v~bHEJ7.L!`lrù9 (80?_VSq nd C8vi^ܢ 7/v^76|@s\GS_x+ǡ$fSz&=ن\[T @+aggH!z<H.; 2ny B4;!L E3ޟB.In`bGaDr]h$֕OWe=a.q %R#DY !#i#V>f3)'&G'2ʼ?P[XJIm4w!&˴zXO$(@؏CUO4-2xdVf #6S[XOw8I9(!kBjcqDC+߄*Bx#w$N .q/,ѠL7_tj㳊--[9$v*Uk1Wf=_D`pa9hj{Yȝ#9bZ^+86&:T /O#LD [ ffnL !}@ !L9c`/nvlxV԰̒ǟOfG*h]/lwsXi<wc֢:B4~rV BÎ2]y#q>iR0r_6%/5P7 Ъ\XirN?)ig"`u@Vr^ZV>;%H]и/El-pˢĕ&'-C--mtѱ3'o=!_l [-R+d6w2܇5*ULcQ~0mu8i@j{ɫOzuKQ'rԗcy/p= A B6Ԥ 9 fMIG0#"T?}4?x96KB0-iB(&WA8ѸbM5p\'+l1yDJ_:\X|m=]50H NMy/hS^EMKP4"B޹ 0 $2ǿ;d}$ **FA;Q]4jEyWJ {N 6,rr\ H餉j\JMcʳΝz{=S*"uXj|矆ߺ54$x([uHl+LGՠn c>Cb5W^ ?T;brS נ4L1Ti74̩ڃR>-l3M ?,6-@mn*T|^D 붶> stream xڴeT\۶5 -XN5Cp $#s~_AUs̹dD*tB&vF@q;[g:&zFn# L KF&4t5tr8 fFF.X24yΆ@&_@ə 5R}{8Z;BGҟlaz M/Gs0Z(lF@sCkS)@ PSSVH(+)PVqs-"*jQ!yU1P *C-@^#Oßk0\NhK2>RMl"P;;s30ћ899[O fhxuZjG;́*gQ@['$q9m>ZawF8iph ʕUTZ:m m? ]>~&8:?4.lqe^>nb.Nlc;[' 'gUL-;Y3 ۿlrBRb*tgK'g[zgw翢p2XC*fk"bgc OD->lM-lMLtŞAMJ?L̀Ft76gC״131`jh0~z9Ύ.@:7eX; f_%vPQ>vh o1w7RwK;EWVJy;GCY8[M-٥ ?f_cbQφ܏be/P[/# /-+'E01[c; [33;c^LSmtkV v){g#dg01 F'Ao``0 #Ao 7`77b0(>TF ÿ?M?C`S?H?XY?jaoGć¬?Y~ >Ӈ4>bl!c?:~(u>lnvpvP}~[G'_+9: U&"ghq1}?~N}~#[X݋@M>+_7Mon݁ư+v<͡bd\U+ӝآy@VL";YIn=M` Ͷ;%=C_9_\D1\uzLenbRvWgS4;M nEz>[Le&3w~/XT7UY{lkD |}Ykb| d/' G?7آc9%Bl! TgN=G{_JV yyX5+WzOOoS%QVd2EA Z= O~#k#U|FR$ҘC詒 9}isR۵gs9i#C$xܩ sR2;4ɑ`2U351pxS4G UShP7v60,Aswo3_y!*tiSy Bm D&*DXFbW9PXfeK?]< /R}w iRR*Ī_sX_ #яuqhi9k2,ր_7 `$#]?-brF@|36Ӂ8(5HrF׉mn/pTV?˴xsu]Q?w4VTXX]n\T=SNkỆjKlS y}C$א"`#;zge U\ TRf;U:-Ů etH14w^:V OwO ay7kР%}SrA Mom9Sl`X(D+,~ca 蟬Aވ @[mh#I<˷s[/HoyHg2:N`!Wc&̌& O'#VP90%i8jJ8=5ҷꁇef yZΓz8(a3(_&FMJȻTd,Ւ N ,\]Qh^kr`ZЫ %^ )Lnķ0\;D~P$0`*DF_!oMf9YdpplUF^sVՂ[ #Gt+v <5?{W}ѕI [u#j%<=p#V=tXjbQu;_ ri4KKJVUO+n_I=6aFӂ*BN[VhCdw@$g ]s&X>u״|I.! bXkcs 5  Q@jP6$rt1OnU꧚A:b`֦,hxmZs{[:X4ޫֆ16NYK +y<}@b$#2 uapÝIZՄO{7ShW6|<̽k2t=~o R /Gʿ<,SZbFj!4/J#<^^G:,XWfl,|ٞ SW*niKI mD+$Ux*_~+5Ҭ诪=ţE,aHKJH:0 \AC=J\Մ@nEMӒuտY⢜Rs8ȭؾRz,3ګT OPmӗ?Jiؓfh7]@B0_N?2p+<`oĐRtp˻`Iz5aܻJ4'm Fc{".Chm`L>o{*J&)mk!I(8 HQ3* 䗿_-N-6Kw- k2T¡KTʑ>q~[R?؉pEzCs 8v xY}7/"3!ٶ` W*!q5^DqG Jrg3^Jssn܈p8ayF?.D8P;OB3a:a ^b~خU5S k:lKdvx­9L8L(r)Gމ yq CkZw9&@pԱZP_/0C#YD)'U.|!Z $!R ݪxH;Z_C_:z(ۤ ˓: dԶs|9rEH v󦸾y. =~N/ ~tW:Y;̠L,yw_H+$=Kǭ,'5밒0$X^_M>UPtmvpzoHW@?M3G%&3 %"7yfV1FىYA A&Jb@9Ծ"/IwK0\B=lx0!+ ;br]DZP ,7'FN Kƹ=xeK\:LuΊF:M&5= 7ȳިe"KHPi(%KptB5Ԍ!;y|蝖8z(w0]~S=oVs}4 2Hh -B9򣵘UMH+.! p h"1ynr(#_ȶ,yA-T&6 (t\N5,EM qrVK]3-t3jcjݟ 1@./*P]=@&>3r>F8Wa97;!(ּ@S(Cdu-&K9(Yх!/r—;G {,>R@z3ϾL:"NNI`4-s&S[k]/ex-y1b9]n?ܿ{%-*z<=W:?7t ?ռFf#ޡ`<5Q9>INwdPn^՘BVq]s~Q>-x͙D#x ,hY Vy\ɜڙFF~K<\rY8FFʷqR*73:hya>J:Z]zR` *kN hpyv[uY#dPeR5S=uxu'@ k}.VM<<PZnN@Pq=enմa[wl?+of/ 4s9 Zt9VPyzWq彾$-)"9k9w8&)GadeIE+NzZm1"MCbNQHO0k&@b8ۢľ _J k=b{4,mT@_Z>'fJ#=1Ln;y[*K;v]hԂ'yi{KS4:6s"W^adҪV6e?ǤԿ=0jVTbpn#\znJ^!SH_q!&=EB:YT !yaF4D TQB(%i*0JOw'蔒VM!jfE}>"o$ ĮĕHi6~Z!,4vH-aº5ўG:k<A(mʭHg>F⻌NKA]"UOD6)g3gT'm2gwclY\n7f:⺥h]o8/rTrneCѯYJgqf0;q`:J M+l8< (EGȤIAO#=u1]2v>=v" =J 6=,Iςvs΢o"\!<$l "q<0($I?V~qC>A+"PxXݮq6kB*E`&,7X2QJi46~47[5[T18l;/t[MъIQU4bWBhɾǍQQ'M_ G14F2ȝ!甊Ɇ K8f .v{y@I҆/:l5R&^֨4&}gdEeևQ3!YtI,YsJVERV啗&PbrTd EUjlzFקHbf Gټ[ >cc9)^QD~C̼`2Z bP#1,6|nIC1x692h2z7!,?_uvo-I$[Hv}t'r˽/j;w!V/vR-n|U nʒ\yÀ_9dsZ{} n&-"PT7GM#fS!OT* >#(C7kNz)b& x^Vl̿"1+VaU(L nmU{z߸U75;ij (n!A:fϯY(kog5,G vuŚ }|lṙ+> m^GP臷3;VLy~<౞2_^%f,3.pM +\dؒ9teuUb,~5f8CP)b5m% :;ZN?h(bz2)I6VfB5:8UjEԶ̬xNxϵ4^a3ʩt@lYzqĮ9C0(|3>AXwil泡¾'䗊$IbЮ_ J[oav0% ٝ'ܴ|\y,%`,Sh3`Icr8gbgBF$EXO5[>U!u6CJ CDWM`5B =[+ B%B(\ɑu+WEEty5a36mN`: )04m$Š]c-TD_+*d8bZ=]#H?PIɢփ+Gܼy9lC~ |.UMnJlIC8z!sNMԇ gDWtYX& JvY9Um1yXUO9D!<&8 ꭎ|v?dy.1D]6I,$4񆭋nC&YJ-%žٜv68 zǟRA(W(o7Jk,%M۵o:))9RsqWNSE[}n]a:O%j'K %C}sXŞb2j:ӤU0~fc):ָiמdVhKSSBjvJ֛FrC-94Wo?d O?Ć),-ė`;9! w8^6bS :ڲ`b}sE?I6" FMŝ4]Mq@ۄSA9% x Uwne˓L-p4Ba=5uҍ[;|@X?W5vW\RkvcMV_eN@*-_/ȸ`3($`TIcC`B2p!+gI974o]ѓ80^#ᦚSw`?lrN-rT}ɛGP<Z*\jʝǂiV{|]w1t%oro^[tsu#qoM#7N3~>fh+`XVƤFZ`>N1z<$hS5^־`UU5fZrLL_Ƃ!mfj-WI:tl%Iln-6m3as{+cIɤeS';瓏;=E7T%yx2r䛀<](HUJ!&FhZ{/), SN 6D?pd\]ZqC±O)eL3!x8phdp(-p۔g3& K`+IH|b[!k$C6] ̨MRVSW̤ɘFp4,:7" GXK=MH(hC@t)=hY}a Fyv fNƜ?cPqZ2ib TnυrrLlKāma^IU5tZ־}p,Z1 [!P7z3,9& =Uy t8[++/KT?o(f{pN寐V܉qiaKSl3Y 85?W1Gbm;l ,0X2&U_= Y+|CmQZ2CR/BIӫC_$EZ]EJY&L{*(:\5NݼRhZ} [G-kFj4k)<̓3𤚮`q@wMZ#Mt Ş1bZU_p,p[^ser/@n-F@/ .dѷ;6"4o^x" U4ImԌfsDĩJ _Bu-JKPNPM>P,:Wu'4eӹPw W$xlRZļhtKv60bU7ڋe;3S(__wչ#*P6+8ЧWw}:b8yZOl}Uq?%?ç.}E68/?Є (T+h\q"<(Lqn')~ Zy%sx aM"p :ڰ1%A'qH݀od)qΝlR~~Bەnm>œ 0J- n Qn/rPuI>`ֽ(Dh`]S3~ʒI3@j?r5ҿ& /Q `KEw vԦ_A=̷p؏º3o)=DMi|e0X{q7qf2#q&^>Jc~:j*;Wz]S(ort6*I%Ae|& u-xu5#lwF;[&Z&\jz?F}jv}#v-| { }޻(#%#rz ˗s1N[+{EՁJ5Iћ>9_oY63z8O/8 ̦`f>e'4H'0 jXO_:7#٬?ф3) 6U#L49#RC2H٠ר<;[Z;5!CǼ\ ano6I$ʨ5{o /Af R%!ۣ oXWG-a$6 l+3o;_ 椪rtoУ7Ⱁl[jW+E-l 7ȜFA$|i@ZF@\)`F75t&dz1+DR4ēG<`Zkv(cMyK5Vd8rAD6V)rdTS&L`ff::d1P$wb)5u`Up3`p:lHQp# 3nl &χ7WՓHx@wpk!VHS@(Ij./Jyѻl̂Hk?-}%D,ʼ֡LkI eoch-L:| m$ZQF~z]ie9d wN D̘˯$B uƏOR"1quc#=̝}"GZ h)Qflą1bs():6 3aaqޙ"Ɇ[ 㕲iw_5&&}"օSi-|o Ht-߀~*I7`tu,E]RE)]&{6LݖIF N[.@?Qy.C,^E&䑜#F: 7nռƖz.{|^~/wW?-g5i{k /M5闏dhhWwkΰǩ\13^B@DmRT/uZ2T{l7]q5 mΜ`V 7|"PER'(n}_bzOY]Q;.Y* 蕁.٘ќ]eb@LM\׻yi݅'F ›3G #mXPۗQTj7Bٳ$m:,%ribU5nؼ:uQ|yj>^@xgS>VH.oشt1q|"BB΋r=@:Oq=zE㉵ L뽹& .pɠ "#ªq+݂d9r*ֳ^Q|[0L,ODɿJ8B JnXc{u}٢!p="PRkU_5h Nf%CB$:3ugzEm5Snͨ^-1{ `LHF` y_]I qWWbߣ幁Tw5y\W>opU3~j"{͢glC#9xP^:u=x{hy :C < ߌ2qtYsXB~:tZ$EEǦܯ mjGb G}4Ę9ߺE,:Dr6ΌZȓWսAIn.'#&BPk)G:lXԺ\يž!Cp>MMT')ug(u!;>/1gC܍H.>j"q7n;yjkE+ŏ890+zgӐQ]gӊS*p.D?`}XsbbbH ({%bE():ĆBw+nH˧TJGi&IztClJ\g,'^uj p̝ъ^V|%wOr^DQKV`>.0Ib] >mڝƲ=Q4M\V/0gfn#ʔŅ{vzglW*p(8tUab c) qi:'[^BMqs'#o4ݪU`҄Y۱*tO*Z⩳.WkB40e/ Aƿc[leaBxWm!ǥ@l_N*Gݫ%L^Y kp` e1ԡa4x= 3:v?2- 9N WFhݾ:޼"Ug5!>ÑPfF "&$ Z;iٕ"GdkFކ'LJ8OoT=wwîJc)Lbup sCeU_NY7Ze3켅È wv|Gp& $ ;@i䯡G؝7D@듟(_4ÕWm%]^K ("ESrb%;M)|E<Aޙ:8_^%DJ6.Dh&ٜߏP:%L[*O|(}۰9X%lwps2!OT#~cRps.Rcj&9 FXVAT1ˍf7h_E,4Iulc{ t<hRaBh2z}jf'BV)ۺxX1qIRQQ=s=Pah&, kp>`*+ܔ-s}OC_fdtߤ4H ɠ4ƦoxPpYG,udGvc6mdwI2DZZkO~nʹqW_8gߞ?)I-b d$ }` 2"3*1Q2y;N8vc[Z{AQ!~\>b!6.#K/ fpSSB|IOq.wҮhg^ +VRaj vXZ4N@7:*{47sѤ'c!7eGmUU 0j6~KOPjV* Hc"z[X#sNǔTx?XD )pP4uMrQxRω X{Q&д3MĊzJlVfK[L%vVrE``Px-NIP1Vdw93nPbt{BhLG}wsI6@_`c5hYջNoGt.CvlZmM_)~^ra48" P䉏WҝFi/i/kV\(+.ٕ!an8"LQ 낪?Uwc|trJrB^ 94gd[l<SH9@ސ{ jp۹} 0cI>g|K!|nPss$W2sOPXsu.&W\,uMp$m>9 l3E$_Q 3I7 9EC;9< { 3pw'ǺI"dYSy;W oCSD2gşAʐĽ~\CQ PFPO2t)%8 zV7 W5:7]:*[b4Zs'S^B:yQ!k j˔pN_uKwY6\α-C:?EF-Ԥ u|#f8)gnό+ P nv`|`mK Ky|Ϳ5rYITيyV?pm1(pme?stTX?> _x|+7+QC;KvF,lަ.LLW#{ /uqIS;WީԏFBƈU0 ȷ|կ/8TǴ{dv.BV}B5$fQ{$(S]5>q v"r E <Te Yw+[]m6lRdHn,%ocOVư][Sj7TڭBޑ0 HaR d,Eijar.Yw!וyeyQ'*uf=Aqu;#_[h^S5Ofee_H9DZPy$Hߧv- ?2&[⯏#?vަ{y&&5{pt @h~Gl &;;>us#nv^&Jո6 7+SM ʧQ4BELx|[COnxq@**lԼWz*0g믽Rݹ\En\ ~e5!I [txXˡ#ZN3U]?JWXEn^◞xAHE$ߤ^ r>mi()uQ8[roZz3"hP՝5@eOq>YozC%@e6&E%h%B]*_oIH>+_1zoo~Dis$o[A">_Q%N$Yr<O.{K2W+XJu[i}Bцo{4⾕ە  kՠ! l۬l`ay[%apK R6`]XƩd--O gWm,kJVpzގ d"szJE%I%G:ۭ?#6b:\! e8 塛5t@:Vlg=zf}Dbc90hA&@Vju>_ 8Zqg"A Xa|*S:\y-2 ExYhy~Kłd?7|#gh`MIu%AY;] "?Q\ne/=;c._tBP`w;aw"Rzfe8x4SPT,˛sIs#٥9F, Ņ0ҖDΉU;W DS9ѬƳjVY횠%L6 s1]~s$V= 8TIA:q8sc 6HPcϞ }\[X=SVH$|'| {d -{5s{`+%{7{6Ϝ?`Ș㩁K Gz{IK-OUlIp7MJ ; >/7J2-m\ܧː&W /խVLL\1{H;46n qI^4!HS%sśg8/2Ч|SE1ѐ{G)&%K9UڬH<дnIAg T AӜYa,:OjQ@O}^SQŻ`ÓC:{Ŧ,NOh7YJc{cҴp}m&l#Y, ,ۢ`*uu,EBTWڜku1>ƪ0(ZAn@v/5}B ~Nw:oj~]QC^[MwYZ  G-^[ f3]Wbx+w*v"WB<) _ CaTΧ=3rF(=R)ߓ?[}`DL M-4PШMkA^d񂹻mq}c2v< Oa]ba\4L{`LdGss.?Ò^[X>[~N ɚ[ S5 F7n*/_uBHaV ľ %&ېV ,k#2 K:|C<'"2cth0Ĩ,іWY"b~TPɘ&6KL|оL}C˹+FgWQ#j7Q=3'*2/=稱`@R=DKvLǟd`r܈o^S\cDHCQ ElFWB%׍Dτi۟CCp+U)G,U"=iMOR,ZEDM/n U }=? jzf)Q7Gx}I@&#p::~T%T3_(lRy:<+{L/7K ǶȬ[&UO[ݖl܎(~rIIdq&mV2I<_cQ-<lbsG]2Ј2Ŷv>JRV ܁K^!Y{:?a_}R¯}Ns/_LrRn砖~]V-ڹg>S<:J**OB6{͒өco2%7<>dݣQvMQe#*ԣb5.đӕ)~2)XΉ,6*r|M%)m S; :2x3n8$NYh? H'_1;  XwlūK?' -"~^f"hȟ*bܷU5q/KI#sI[|'s91g ~xNoz*jQl~}]<%N5;[ZczœA;tlnڏ+0f .:~Qjy7ɧ tΟ>YMTX<e@ָj8vOy|iKywz&l6I'ᘓ>;..69V=rZ@JGYoX=.m 61- ]{jRΏ`hʇ= ԿQnn|״lNz t,z{ yB? Bq2?@ϸ* ttwBjkElR7E̞AQ!iP;Ѻ} e<3uiY&y,gWr^]m娑C7v2EP|B#3{lSt'$jsS:kư͸A!'Ώf"U`cF|kZ."hjenXa9?Q=ɲ[s PEumB2s[Pܤ=йd{|rŻ [b4ǹYk(gj%q"1Dn;F K^^XYh/vjVenr0jU\܄.W,`s*Y^&rl[F䍆 ʸӌ.CEs?E,~LN6JMuEI$CIGxՏ>=J;֑g³F 4ULHDƻ ni/ƍ -]h`@Sӫ%G@oRxmc6E6$D^X';8.xy"[MTVIO1z+2jpҒ:T5%LAUvO\l)c^ljn;zt,tpw?)vJ?K"~?q=|\ˁ=:1<'Dp91=|ӌ9 v=ד{3aF{wI׉8OvWmTټ/z7gD¥J2U[]l`)ы9ȼXb废J(*տ45\š&g$755. 쾥2{-kE4|qN:/+zI܊^ &4|u!-1p) GSzgPbk6{Bx(eUR-T憄$j82[ĆY5Ҧ"LOrN-Qw›ȝl&H `V:e0H0YٳlӲ l cЦ3NQո{9^rmUlA HIQťE8: e\~^J(kI6X|i%I}(# mQPwXdN*C鋂E!ʉ]oFVNbv4!2@ L:nHb?}V{~RӪ N87ǕF3 ΥUKiЫpm ElWѕ&HN`N8H $$|I{jIۉ/ 6uU DANy·:pTB:0bш1k %)k:4λH¦j4m3KMخ}pEk ~52xor}-.Ra%ވ>$j+$=<0С؂ߊr7 Ԓ= ؛g[f;$$fG[Z=sz/+Je}D8ީ_miNOk+ lFLE]MvM\δ[]ƮOK:3`}]z3gbxgzT~Ė+,=[Qɢv>!bi@JNb,%IwT4JlS?.|)2|^O{0O@">'BG9-kgL;eVEn/ie9 `^w3=LN^WfYa|RI4&1(4a7n~|'-ƙH$g2ɤQ8]&0_f8Kg\ #gGx.*us _A ʄq9Gv6gY 7_tԑN=5ߖdAtM^/ "v>Nd;^~}J$t*:} K|rFz7! {wp2Wއ* S6$, ?}?g3t1dQ{ 5}j_Z%+{56S:4;iMJ_M֭$Jl 3Ad?vi3ue}h\ Ĩ"8FwAOx\QJP0ecW%.Sj Ȳd {*^3ơBbiv|pp`b gwoT z?(Sg{z, ]!{ZmI^a˰i$,G.puv,4H{eˈ&#?jy qU*. @y'>'9X'mVoߘ \vk)'+ endstream endobj 566 0 obj << /Length1 1608 /Length2 9377 /Length3 0 /Length 10203 /Filter /FlateDecode >> stream xڭweT\ђ5Bpm݂' @c ݃wIp' Xp܃}$ofެͯuOU]j9ݗ^,jV:"y +:x4 03@D`@l 0N0 kO˟zw!֎W=x_o|6` ~ `S(0=@b PX`v` uAyĒ f v8a8a@GcP  {ӆpK x̪ On8 Z=F.J{y"G8vCe p'{cG0'/ 8 050:zпQxpsZ"s[Cqx ;?}`G@[jB)l;y}"$o&j<+&qqo8@b{!_ `? mu~F\ iC6+cA`=6ŧgst.#_?7,ަUG;=:4Ze +wu;UB}SVoyF?9mrltڳr;.4rn4{IwsY;Jzˮ *&&MY*T)ˆim]UQjg A_6{%GQ>Z tSb J~RL%#})]C MvA)2M5wpR"n{>hRYh _|7@x_iu6HEW \asEƘ]-dPXcrmUʧR H)1w:K]6>ނQ_?M,`yQ9<܇QƯhdٿ˻ ߴ] (r(8Y>ޮa= }-INnzc,vv-^;@7X9d! #o,9*e;luNdņEyXڏlڥ!նq=rId-j?//4C!h 2/)&z*G:1co']XZ~zRɋ&dz yӇ55/a~uf8.-~eTH#`uzKJ)sjrZ8Kxc:U sq+'ZR&_VbWL]vxPSHLdrvɊڡX/pө;v޻l_-fdOl}\蔚.BP9$oP j՗Ik(3y}6S(qI~^|v Wm^Qʤ{J(jy ni]dٳXw@%q` u+ٹNNIz~+AȘ=}(S\\[hCfq{znِ#FU>dOl-[qR}&챊g*/۩hntE10':ɓH:Jfgz_8 lUjrxQjqlnGvJyDŽIv#nJ8)6΁ ȁ8 XVRYgsLFڪiж?솽Wgp=NQDmH4#P~vi2p5Iu L*3~FQ؆mD7, <0$NþÈ? h-a[,:;a(1\Lj#uUcgqJ#ݟ,͌a vhd2}9KޢGȋVQ>Px`9ZP@}ōn HGNd&-5iQ' Cno^S6FJaqۺsfnmhzT9A{GG~k (xY˵x|\Zf/ru=5kTZܕhLQhpfZ]uWL.5+]%o 9wL!+ AAI Q?[Lڧ2J(kU2J$;7ѶSĊkKY} <= 3b~(L87kOR=oIG|wjg,y^fCX`M)XɱW j*BpytT~/|)qS`Dcv3)׆+HZ9>ʔ&]d@/t!Dx/!jnJr壥Z(~]wWՑ8}Gi R‚e&Ae#?Б:6g&^mm!BMƷ.^!Г'\u4,Ge 'V3z]'ovzAf?e1=tze'Eemԕ;>^.&vD8?5`2$hS;:9W9֑3tn'{6XW^ѧj#gD*:T++Wý{z J>О~7^)(Pu|+DԧG*L bF(j%HyլSs۱ZјJtWvPz%sOuOmivώHppDG٠i ͽd4\8!ݶUF E-.Y춤iY|K+V@ ʫ",0Ot;h46eH&~1cߡb>~0[xerɜi}֖ͻDm'ֺGh E)-|eHoE\r>Ԭ>{҇+ؐDaqqEr-vN+;! niY2?l4kZ প߿1~6|h.w/t]ÇA5-0.nCJ+t6iWw3[zZ8aj!˿ugul >\#YdfGŠ$ E7Ŀ-[bе_;.45UX5s~miMS9R`f؊`# Ȥd7@@x"> St4#ʽ܂~zqgV69_8!-zvH7D?W| 4%])TGk! Q)0>Vi]əwL3G ,7-aL-rU&{'{;/4q5.𛓖Yꪼ&9`hyPj@-el q 3G?/NAMwS.Z|5uG>Zotw)@>WI7/56~g@v%l D6䳞zr-DTt^^g}'huX1]/ ?1>U 4|-?S8B^zXkvO#mUBe>h3})jr%3IZc1yy󼬂sa^l(jū /ӟH4u9݃tS:%Eƹz;_(GLu7nUg>1BhgJ)0e:b;g}(Kh`V<8ޘ2wv;!' UNp# |bɩѺ[c7ԐrA8펅_t!Z^A?5*p`͚H/V:nsO I3!W%%}\;9ۙ搮ԭ34Qc\'S4{JJ]FF/J+#CʻE[h]ol?ܞEoep4CTyCuV~Pyl4쓈i)6x!1 l8Lp27FYᆴvz5UWb@YW̤?{BE![pbm+XHdd~U[ċ+,!]ak{rmn;:tYNel.9芰S~y':_6T̐]Q_&PSƦ%+d$n}<tG;UsA>BscGu0n,㖕8ϥ(}pA_>_>DQܫu/ 5%thGR36aFIxҋjS7 ͌ve۬;;'AVRvplmV zun̑63th;y~A( ['}w6 @m`])EE1L\ `2ڦ&#4 :eegZbm8:Am90~=3g%#P=]X3g#HW|+g5+_>M_Im<ߴ [:u\Y[pFJ&ЦLT|JVˊ"Tuef@"3/M6] tۆSD9IX~r5)ĥ_O6VQtyR! "?MS6As.SJmaTV#Po+Ͻ;2&e{y2aqE~6^yidz`CDY-Jz=A\D6<޹h#E~QSjܭhL -)ּ2Fkv$uehyR.S͖*]̦WQh0(8&!Y#D#S9)IE*/Fȯ1 b:/vo Ŕ~yƵ.'j*jcs% :_mLSH֣k@JvbeEDOijXTu'C *X-v <[1C?%<zJku0D5kI>9LH]v7Gv\; -y%= UL+*0N&R;~SGϪɷYt:K?giOq#F8\I!?Z^km&1j.n'oxn!T9TdX8t4|OO??,bA6m~8xm2L,աal4&V¼ ZM*7]0fP|6hD9ΐS]$. )lq8O҃ /B]$2]N ur:_o1ʜPANҵf% f9jiYJo`k֟3yi+?Tid^}k%Jm85 à%"@x㈢ETʆB ^jE; r g&F%j"ُ_3m+,30_ePy|Kt첀ƃ+c|32:/gye9.ʿ1kR%B^ aҎ+ti K4@+R-  UY֖-)/ W~n)FJ?l4޹O#IEZti,_957%5g}A~cypE#֐-r a(22Z:!R]4aH{.n1r+T y3+1Y3_16s7o<#@N)OS7ƨ~е8ԓ6{ lÙ=)CMrvef(E& “5n//@YZno;P ?aʳS {Hv5k~G~6)'d&]H!LTZϓ]-d& 2]ʟ;\Fcs3Kq3HȴERYa<gͺ,b=$N^{ѻvָcdƪ1ʥbC/SpnDn.4;&{=۴bJewif77$ڐ7:#qŸj1T\4 YA}ϩ[5xBu>{SO2t0֒bL7XYZm 6*@!'YH%BhAr^(GUK|_r)qe2Gv3oгE? Գ8t?=YE;(F2erV378od'K/V+[\2l%./dC}7Thaq/AʼȨ˨f,;YAzE#L[Qy$C)hXqG1]@Kڿ+=$lHG>fGOv..7reaB笻OiTԊ|U7F ӎzqblaJ(}1̳(K%;%Je()Ɩ}=ҋ>ZwipJ'G2-:e%rjL q]5J{ kڂ"jD-Q [ɅEhvm'8 †s_Tzͺz2@qmi׽P @TOPm4\" 2`? QMC R*߿^܄طjVy5z6{neI$6^猾Z bWf7RUӖgRr,L"1k"`msCSt2}<ͤd$;V  ~:34@P1܇C- ;Xv]KKc%>z{D߼ԡC߰7Γ9}` bl),!-D܈`SJ\ uWjrmm8KeYNѢlEI-]-hXjЯj_BgBW2݋I-.X-nWSE6rtaj`I{,g{nK_z!(:bb>f&Kƃ77@Ĝ&Rd@C^u KcJknOj줓sۊXܖpmd[ gu( wɅeyH .f\4qhUKtWODoIئC)gW6^etw[zpPk{F)z1$=ֹټYWU0@D45$#Vw#8`/':ޚK{pojIg [ LhB9sl Zn~1?YGо0B(2b/v_jBraQxưYf#F@<| B[DFAƖBK4}PNGKeK(Mp&[)dǣ/Uާ+,tlvjyȯٖKLiܱRBÚ70ˈUŪ(VpׯeV̒iU*zQùqN)y""\dY, -M(Wj]F %zJ6畭,֒Ib=c65*EB we endstream endobj 568 0 obj << /Length1 1144 /Length2 7964 /Length3 0 /Length 8726 /Filter /FlateDecode >> stream xuseX\ɺ5]www hhhB`%!-8w?vZoWj#,jR8yx`gw=kuN]`d y75 uQ= k7GGDLy@@ h` 7Rz8\`z0 rzقvϕwV< lsl|@`{YBr{.G" ] *jg zƸ\@0nB]P?1 dܔ?r/%+ HU!1{ #mH vB]vwPs`n//l@3 ka s{xxxx<|^zP w3f%'}p>;YQTê.vP_?O_{ܟ]`ӰT҄ &1y4Cd)h8HU!j G$P( {9urGP"?ગ:Ac<'O%MٕrL[~e(%?% 6yBA]_3*J|z CRq }i)foN|A Ran[N5.\sQǕ!Y,TKXؤ!m(2> tN a,pʺXT{E/fғz*-^|\ڝۿ $h0w&Y~5)ץ> WkN C~) mWճOR~&(*[ q`EJJB˦ڞ;8`B.F~_)$ U/Xf{RQ2P#IC ֻ9azӇreF_tthV&a6t[d\F~yf6F .(έ\E-G6-sc#>1kT'~ %3 `aoNEEI]lzș Wpퟑ6H`&yqfշ.#6x%9CZ%c6nz ~n.g(9\ݙYbZkH&b+ܻ鎈-_QEd-ɷ~s_Sq[ʺiK/SV*xm7i6#Kkɓ2Fi*T>âBߍMeT}T߭߭0|3(rŕ43TkAY]Ȣj@Ͽ$JMb8|!BE0RFK"CvþS}s9(LR4",V8_5xS_Cַ.}dE MyJyy_z.QȨejP-!xv[|>•7ZZNtx^?)!2\ %"Zo4gMj ߭#Z'=n*2ipz,L8bn @4TesG|+}&K%~PT%JMLeRᤏsu@OYq^`]#u[T/Wϲh{xUfcLzG+X q.^5)Ӹΰg|%<(f~j`̯gɂrf0YgaRX6ew ջZo zZI?WۡPB2۱tV/LyɕC, 58e0&O+>̟lFc30tς/GP"k8QL1)\GY$Yc^Cf2{7֣'+|U-Teg&|kxݠ8nM _ROܜ!h5%o`uԘ:7\0 5i~c>r| 7|EL2E_(ŀknE=lE񣍟!Az9M/ߺ)/<ꣷR9`_8b=n~Cc뵤:W~AC vɳE5w1?B<FXHl`8םQ6/*O3̀B(=ߤSޔ:?K~ g]$G6(gmq!}3Nޫ[E)Z'F788{IgtO<㣻lPBuq0PQ{Msx&uaQmJQSNc_ZF}ID@觀ah~7Iyc3e*"{ -a+(*W2ذvW-P[LɲF¾O_@uE6*ѯJR1յ^77-,KT/G}:d|}mK3yl|}=ogKR Ǜښ+ &!% u=icz~Ql!c-6(Ob`B;@׬B)A=U;OvDg:[҄x&΂~BQX8!OUqIe  xY+qq*C4U-*3h?h:9h^_ k}~0icQtIY;ۍRՋ ar1HO=j]ېrYr j6 ޷72džyp#[O,[JboU[5FNK),-`9YL|Kj5/֢=ovh&@KːltuD:)7{QeC'=!FSZ K0YDyx lF ul"$&nT!_N(uT>s69q.t4'l3pPKH'Vח:B&=B: Ҙ{z3 cceeU"@"#_H9{3}F$*[ 2z7`nTlNtd*7i ?Xx&⷇eMV(Q̀+뾾xP?q\(b 9֗'٬#=wen6˩90ә~e15oA.MЯp%;ʹlZNB:kA?ΆW,ŝc'5O$#S6'@8]/Ap~9%ȧɑ7o1AMRcIyF fD oIl7alBx^6,ʲ'aHkdƢ`xՅ9RM\c%K~}"dv͹4JԗD,f_SM`}{YЖL53DUaCp #^4JE`-58_vPn gR<6zGٹθtHLfk~i U޹ֽ]3~w/j^1WOfhxӧ -BdИv|8X'Nl9y@!_$rkl>30-k6QaBi8P!Dx&nZ^ӌJo+C24 TL|ivΐ*o-O֤լa(ވO^ohL|(u9;+C(Wzip3rdjU: % ?Y53۲-鉼WFB`TFη+J fC(7~B=.~kȈ)ː,mly4"d);PN#Jj%=$94rP=V1g׭ Ck VkE(#37XL< ?cv *hع_=Sv -$.&[`\BujMok?&@:u]j.2]"dO:6x.+tnG 9}IÓ Rp f9{*F18ao=0gGy fbr 2JFaA/bԬ%bW*RR+B5F" 9lWFCi+r,.>-Dl] mi1鮔)wK AT\e}tQ7`͟ =fr/Wܡ^SB˫5L"wRXT ?dk"NU$IY\O4x3~peNgo_/q,qEUUzFoF G|lqԎ}5%þb P*;Xn%.,TȌdX𤟥0N4msx  Rݨݳ?"ƃ n!=B |CzSEDo֞0"%d-YS/s3#OV 89͛>J'JL%56JRdcltVQc!i`Wb+@SlU뤎!4I}Q{yT|K~ᾎ"c}1zD6& $V^f̤ &޴2m&}ӷi YfcF/ 3EzC fVPϋpkϦi2صDsK*l7Q5:|Ŋn_3ۘoΪ4'9rUB.^EFY5-㴼_-ZdwmtXH,tmKeϛ,A!"xk~*B٩d]NIH5PݧKkX|-wi&qe;(?K<#Ns{6ЬKC|x4H:R03wnwtWu-R({Uø RX@@)gJZ {k ŐyMFd:TT[჏)nbfj%o endstream endobj 570 0 obj << /Length 696 /Filter /FlateDecode >> stream xmTMo0Wx$ ! 8l[jWHL7IPV=M̼ su;Uٛ=w]yil;<[[j<=?׾+v`&ߴț<^*;~&Q>MS >_P{=s@dkx;`VY`s4JaQܡn.Uu9\Y6><ٴ.Z.4>Dӗ}~r:-d0VWk,8yLһʮӮђ[*mLr?q 5F8@=@)& 8Rx uD\j2HV0CzL] bctI g$`htы0\F0s jd< I6zg W qȐ+#k .bsrbmXK7ǵH7Gnb>&jؐu1VljOu$՟qWS/%1{\xB!K(hHTЖ枃Jρϯv=k2UKς_:~$/ ~E+7ˢ/ l(/} -+ZXukoԝE?ZKq endstream endobj 452 0 obj << /Type /ObjStm /N 100 /First 907 /Length 4492 /Filter /FlateDecode >> stream x\ms6_;s Ic'S'u'M-6IT(I>$ʶIﶷ<32m42ft(ԍgV}\~2AosV2J|j0oshdBȔyOii Nb s: &s 0LdVnh$SC4GER RRkX& uytyH}d eT:L c7t&QASRPF *`.X*Z<*ݤ`&@X#څ8a%IJn J,j .Boܿ> boW5xS =Ťֽb(4=-ePe&7n]M}Ɵ3~T8Q#{Xe=;E+wX San4Ku՟}36ED{.Bge5ɛ}Ją(꿥@EG`,JM|4"^ _eQO4S .֨M_\@2rE;MT eI(l9dMf>䓂h\ .WSk|P fy@ K^ mb,qtr%*G[I)OO xqVM1(NGN&%?iS^YA7_aޫ? `Hxr“QS^cmރ/|::pO^U-̽x{6~?#xL L5IU U Jui`!lQMEQ#퍥d"j\ЫN~-zq!4=넿 Tv` ;^6] >I?>HL$'|:ż沿Z녰[ƚk" =5|^DJDAJ(EY#A(lj(QrBn Yon<[s_*~'m3oKLjWk?,ĥfbzFJ>9rAr @G$?#/)"L޸5| ~Ӷ1w'#%1pͪu?=~8IhD [) =)*T# /Goaգʟ{t}s4p23.ʊ4ާ uޙa% "riO U)"LB,2O&M@Z^c3=HP\(èt*%Hh#0clqb:*ȦCpKk(m;7]1c~:%LX.G'Ϥ9@EA0hIq4k0>c.zqQRCyxx}V + rYDWc5vt(}&XG:vnS@cC{FڕJC\3Zh-;lal&6lt` - 2#~n%TBUĂ->܎SR_P8 ްfz׾iĭk5Oжng,-V} 桌4X"A!-;wq3;whwM+,qin˘\m!a%;wKpn`.҇y筲: w5-&<ĺYUfKaq逿Ltq쪥[v j8 1?IY#)03۟7)CSt襽cti):لH |$۔ xoM-|;?.ʳ6 NPߦν&٠@ 7%QZ Lr5^5 ~r|+>.>>s>~Tb)>aggkI]h!N|!X ݲ06l~vpaW)T3HdJYw|Qt%jt,v_AQi56a>^R)ԲLNtt2)\9vSbnҫ_jV1{Gɠ|7-7'Z{@6E=%m _(diO.$ .kNՖJaq6]$E L::Aw7{OϤIȼ=G9|o=o_ۭv0#ݚJ"5xҳ3 ~HmhXFo V?>n Ž l*W%;Z҅ + Ȼ4saޜ/Kv/.Bo gSvl ;ɦ39 j|WНE:Ցͅz[%06XM[/?+1jWB1]X붷Ҟ=Boa~a(,(~!F-YPLZņ w Տ?Y9̤m_$Lj&Eº*\JȎZ_f.?҄<*ICQg7ATI?qQbUp 038 endstream endobj 571 0 obj << /Length 695 /Filter /FlateDecode >> stream xmTMo0Wx$ ! 8l[jWHL7IPV=M̼ su;Uٛ=w]yil;<[[j<=?׾+v`&ߴț<^*;~&Q>MS>u;q~:fc_0F)lGιmu f8Gӫ6b"!YUe.`M{My?IC4}+̝l/Bj*{pϻƲO('$ *{>J-9_eQ"V$)MP:^9 ^` br @ {@(\,RH&ti m+3ԅ ,;F$БzFFieD(0A1a8yΠFpnù[w6p@ )9r9b_ia|F-(:(nQHY^`nA|n(戥K}s\}sԑoA&vqc⠦ YK^ʛ!_my_)=^ ^{TGRw1RDž'xJzImi9j'pͽܳ/-_Z,N_: ~iyY2q,nЪ5QN Y58.] endstream endobj 573 0 obj << /Length 739 /Filter /FlateDecode >> stream xmUMo0WxvHUdCmU^!1H#x?gx]OTm$|͜s_Iss :L;<Sz==׾f`*_`ɫڟk3'iѴ}=M;7rfnj-eSӵOLg~8 )ok A8 $`I\3`Af<Z]! xNky"7 _㓧q H`nḱRONH=CpB:# =%888QA~!*zƜАT?!~> tw8y*sύ }nFE>7*QύR>7G];~<6OIyktg>O:yұϓN|I/|yIg>O:y҅ϓ.}2 L> stream xmUMo0WxvH UdC۪TBb B8߯{ .@=/ۙڽs{K;K.k6/k+[M'ҷ>dyӔKe'$cS`vfSfK}fƁVGGf\bu<19w|擬CTAW $rG]IyMsh$aW7y̟u? sK-`θtJ!'c83?NaO<Dg!;IX 0z)rЃ@kpBQ]^Z7! / U <ɉ#W m/%]cX! gȀhID8QN~ACT/sQQRs 穅ύ>7: F+}n4eE=zG~<6OɈy2kLd>O&y2ϓQ>OfdV>OF<dR'<>O)yJS*}𗏿tx>z{O->tՍ]*3>cC~ endstream endobj 575 0 obj << /Length 900 /Filter /FlateDecode >> stream xmUMo:W5?$R. d9M eCkmCp;;w~>|3E_?O]5߶w]Occ]=~?}Oyh9%?۹׬B|Ɯ>);vw%g43>\ 6 EJ78 1{~`W(-;]%=xe_,b+-O;q\L}UI--=BKE1p[! Mߊyu>.N5K)Wb٬8i[_uʕMzQ)V(Txޢjy!Z2P="Zd0\ÃGR\).2*Шa!U,H`+j.5Nα@VK-x%3%AYӀzΚ>kP#5m0Woþj.ZT$X/)n)#Wo(oRZ $Kp4Z-b\1ܰJ P"GXQi/8k^Zq:Zs9dB )sL-7xJ`aɽ)f$1 dъcCZC<73JgznHȰYɚTa,_-O87}KԴܗLloK+gJ.GZyVc48Wt]:P~`rZq.n1] S/Pu7Ue:?&?!d&1yHn5)yғBx#1ޞ]Go׏M?X endstream endobj 576 0 obj << /Length 843 /Filter /FlateDecode >> stream xmUMo0+J! ᫊"RVmk N7R$ݪ70W?g_,ɍehܬ=WWU\;;׺v7MOtҺ=po>fv8 | G՗_n}w̭][GL2sQ擾ݾk^!00jYV%H~~v}\; C}h{ϗC`Rރѩc~^ON6[7ݛ ZԲW/{FR^ww?U4H6!L@@B@q\s *G|F/+>㹴3Z~Z83f3[:٭ ߬Lg3t33 ~!>CO!>S 33>IY ?BXIAup*Çq G潪N$p|eO_:q;:'dE_kCvW endstream endobj 577 0 obj << /Length 845 /Filter /FlateDecode >> stream xuUMo@Wla_BZXʡIW ld!fm웙7շĶM[؟McpuUӃsk/zfN꺼Ɠfn݅R^w}9qdMoXj_v}EQ>>pø;en>ڲ?`1&5vaj UkNAm<}\MxHM0}Z7WuI]ǽBnz/_ N{y;:ڰox\7nXw.kP^k3^Kյ u/A )`JbD>`2$`TY'``9&Dkx+0*NXXQQ3c w"]j~1F60aG+gıcW c rn q9Qܗ8% DMq.5Sh]`4$a]~9Vk ]8 IncT5obY:socsOPcYB?9Os֙3\Q.4ٰX3Z9#>^Z} ?L[ V|V|oV|3[: } B|)W|L| ,Y a!SMV,鸞:?8C8G潪N$ĸ<ޏ< Nuν_B,u7zl endstream endobj 578 0 obj << /Length 846 /Filter /FlateDecode >> stream xuUMo@Wla_BZXʡMW ldiof<ۻW_W7nzrc7)U7Nߜk]{7+wR}uN7|5s. )裮ݏk&8n~iyQqE0N[,g IM/*D@f`B9xczOpm`>W'9WRzL E]PwWqD`PދoSφ}= imX]ӷn<7̵^y]/׵Il/ܥ: ل0%1 " 0Z{q́0R0r0QK5<T`,if,1L.S5?׃[#M cL#F3X1+N978Nsk`q KpN8q )q4ϮEp O.5Ypc.Y7ь1O*ezl,d mY%0ymȋ,aYʘ8 xA} 3/Y1<*T71މf 97g19w(g1?\֟`g Yg 9LsQ.(ulgYˊx/V|V|&٭ V|N+>cv+>7+>S} ~!>_Sϔ+>cB|&LOr`B,&+jwRP{xᇣI^U E'b\o|s C:].cDܛX=oNܙ endstream endobj 579 0 obj << /Length 845 /Filter /FlateDecode >> stream xuUMo@+H.ȲrhQիԒ ؇6jo73o{q3mfѭVOn/Cf)rtskzf꺼Ɠpi?p>fv8coJ?< a9(})suזÌ\$qATh L}s6G 7o],jotuþ{UןtptZ|MÏѩNN6[7ݫ ZԲWO&suB`ilB =@ )U 9yI(ѥ S*043``MSiv|kiCXc, pDˆzA:x0)ljsn l9u}SrI4"nXCA8%&ٵ6AI cMϱXS_S/w"': fyRy(#c^g!ch"ƨ-kC^d cRx~h K^| МQV14Nd5cY9Y?C9돡'g ?%>O:ShYggΈrYgDg>[bghX|&^V|{ig33qgng3tZ[Yog,g-g B|B|\3gg3?f)O5[TT+&GUP#a#7a/c?w:'dEgtdbP2ڂ endstream endobj 580 0 obj << /Length 665 /Filter /FlateDecode >> stream xmTMk0WhFG*! miʲV6vFrBbތf}\xM}qV'7t羋<]swrո:܉Ǿ-w$mm o\1A+Z7!؛~B?Fߗb n;nX7U{[LG5 @@N,Gw͡ 1}ԿhWWq}QEݹ-r*FNL7uY~~l+l+7tE )b,#TTHy9)9>*QKr7P:MȡQ^s$LD6aȑ*s.$S56`>ƄmÁ#TL 5kd}WXssc*{Rh/#? bE$L|ږ8^y>eSQc̯bV̯cNa'O;Q~{5pX2]$\^snaK??q FqMyc0=) &l(mi,s|d &\cV ]͸&ӈ9w{d :mB Ƈ\..Ա g~n59&\pe[N 8\4<[n6|kq_]~&)a endstream endobj 581 0 obj << /Length 666 /Filter /FlateDecode >> stream xmTn0C6U@"mTt@Կyct+%13nU틛ķR<=]tuUӽsƷÝxrN:ۦ>P)Εrus ~v?'Ǿ5~D !8뇺mRn=MuSxHiQ)YiH޽'w66Z,^DӇr}ݼ-w{s d\{?:1 kmn_~߼h!R,6ew*ؔb%k e+Kӄ$a"1x*s.$S56P>Ƅm„A Fs 5577vر׾+uaя6R:!,əCxg+ѧy*JcL|*m:fvui0ܓ`†›F2g'I`2e?fyx0j5F̹k#n'im7>T20P-9[A˲,p~nE8|p9j7o-kݸJv?ƏVR`c endstream endobj 582 0 obj << /Length 665 /Filter /FlateDecode >> stream xmTMk0WhFG*! miʲVZCcYy#9톅ļ{3񼛤es^7箰 nn8l=hzI-._뫦~^JIu]f `tTsr*o8{&X,dew+mWos~X(2X.EiTz}ܟ^7uY~lVNMєo R.bY.֔O9؄b%9vsr(MXa#D$ar bqMDs!FKRLDP0.BEHQ#͸FuŎ577v}QȕanOd$g;A,əCR;6+ѧx**Ę$90q'oקfQ%n;5pX2]$^q~+s"F!CyhIh~CMnOf1$#h)r~hмj5F̹k#ni<7>Tsa>s\8s&wsaY1:+r1\ut[ZM,k4w6_%aJ endstream endobj 583 0 obj << /Length 665 /Filter /FlateDecode >> stream xmTMk0WhFG*! miʲVZCcYy#9햅ļ{3񸟤e&Oo]&C]]Mq>zwt߉Ǯ)n.pCx?nڽVgx=itO"i [\l\WM}'ԭ̚t4pXeȉeU oq yM\-CnCW_Ey}wP dZz891euB)] W-\v\]~[S!8&+Zce"'2Ɍ5I@|"B2AQhSlLء28a}ɑFq5ҍnnbfǮCG= Wܢe$g;A,:sx l=NOTƘ$0_س/vЧQ%~Zx pX2]$^qnaK??q FqMyc0=) &l(mi,3|d &\c ]͹&ӈ9w{d-tx\ \cΜekqLJs?<@>qhx .׷8wl~1V<*m"mmDa endstream endobj 584 0 obj << /Length 700 /Filter /FlateDecode >> stream xuTMo0+J!m0U !mTto4j{zv|tv ںQf|6'op݅uM{}ugf0?DڌO!|X| J>Pu!O"qߴu?o(-ѻ0wj%/0.?]~nϧAz-j5oVz89iX[n8*w\UY_Ŝ񶟨!a)=VfYAK@=NSbxVq 5lL} C@F. 'RFh-յDz<^x1Nc΍ ljNK 8nsEҌaB2 V 1<ѬSc-УWkE88֥-^ PCgs.ǡm :.2g˂(qqqubYȫoF]43(QNA 3|۰G:Lz3 hxRE"7Yp/hJXCKH ｅR3ə$Sޛ{cYv;cYwܜΥ]ɸA7wP޿ߴ:u'dGu G} endstream endobj 603 0 obj << /Producer (pdfTeX-1.40.22) /Author()/Title(\376\377\000D\000R\000I\000M\000S\000e\000q\000:\000\040\000D\000i\000r\000i\000c\000h\000l\000e\000t\000-\000m\000u\000l\000t\000i\000n\000o\000m\000i\000a\000l\000\040\000f\000r\000a\000m\000e\000w\000o\000r\000k\000\040\000f\000o\000r\000\040\000d\000i\000f\000f\000e\000r\000e\000n\000t\000i\000a\000l\000\040\000t\000r\000a\000n\000s\000c\000r\000i\000p\000t\000\040\000u\000s\000a\000g\000e\000\040\000a\000n\000d\000\040\000t\000r\000a\000n\000s\000c\000r\000i\000p\000t\000\040\000u\000s\000a\000g\000e\000\040\000Q\000T\000L\000\040\000a\000n\000a\000l\000y\000s\000e\000s\000\040\000i\000n\000\040\000R\000N\000A\000-\000s\000e\000q)/Subject()/Creator(LaTeX with hyperref)/Keywords() /CreationDate (D:20240430233555-04'00') /ModDate (D:20240430233555-04'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.141592653-2.6-1.40.22 (TeX Live 2022/dev/Debian) kpathsea version 6.3.4/dev) >> endobj 572 0 obj << /Type /ObjStm /N 59 /First 497 /Length 1854 /Filter /FlateDecode >> stream xڝYmS8_6}BKyd 뿿GȱIejw}v%ˆb1.53r7I!$Sb$fa4 C#2qTWJ5f,#H*-IB(H%..J =G‹Y:f3`3 rL!ג dC(!)!!<%4Lb"a1" 9a2L gNL 6Oh(0K,N#EǙ~rT䦧I)Ф~FY\h0M,c![~+\p\ h޿=q2gOW y ap;z:zO̗(c.^⎋^nZ|>'7RÇ _)i#2d<#x] =AFp6r8'9L*  Ջ\z9˯6gxƳ}>M@kxȪl4 V~SF[dʘLND, 6/G|xt5j"N@bk]վb w/Pm+dF˘sкWǽb{!'ZŮh6BܺW;ɰj1~uY_bkhp4aW7u?,'{1X%|хU`}3iޗOBkS­b5:oY?<I>-pv͌;uu5JʲU. A > #U¨~} S΢^jt!nsi5[f&<ĐyRV>u5.0o@nCLEN(-CB+ΎWv'֊oN]Dh~_$huNv2-q-LTr̓-ieoannM&:Hx7r$05&K)-WY+Dfq dpWԍ^)ĥ_e~PuiRuTs@ ]5y|2a)kޥ^c)%KZ&f)f[n7"ffQ)7q7D7UfnUk*`UM#VK'J*j1ۋPRڋJ׌p.V\J%>4?Ph2ac5rϼ9|7oƫ#s}L!ݐ[ixgB6XB4 +!Y*"|CQY7WC_$Z0)I/~.v:m,gq葢H ziH@ GTBpv0qI&(∀IEq(]ú]t޶r6+?櫸BP|4}"'=]ն5/L#ՂAY݆k]k]GJyzR he6i̱9/΄| 鐭TS]Jdk\d-IߤiXtg^)U+R፯cJicpuWΫ%u5 :lk=3,pm//_с,mq8)b}XJ GIX endstream endobj 604 0 obj << /Type /XRef /Index [0 605] /Size 605 /W [1 3 1] /Root 602 0 R /Info 603 0 R /ID [<04AB5E20F9CA51E787DBB086D511F5A3> <04AB5E20F9CA51E787DBB086D511F5A3>] /Length 1538 /Filter /FlateDecode >> stream x%Yl]:ڱy"Nh;Nu;$qgp$B!@@ -PiԨꀂj З6:D(*"$R`/ֿ9s{BBmJ xkQ9֠J@U IըYě.[Ht.BAiZw|=(-k,)4IG?"[^qFlUK˭Kw )1do;}.~~iGM8~K"w)\jr{ R} Zظ8 *|;H?Bʘµw]xH*{q0rd2H&8.NHK+N"iOmZTJ_r6悜@^e (:XsTJi׃iZ+Oiy`X MkTJ7x/ˀ' naR5?\ ˍzodwq= =WVx(2}Yzb]n ͠lKzQ`7^t>I{`G.ҿ_p9>p/7׫묆A0FtK'3!] 'a\N#(8Rפ-Fb*k/Py(eKFGs6!z+`t{)V)p٥/TjAW6J-A3XMmwIeW\I"sRNEI"CP A1TlTnJ~&H]\ܧgJh"-IgNk,&R`r|0aef(F}b(]14LD 3LL1 SdY|F?0ƔgWX+jBYVʄդJhuD%߶:7:YVS*q.T[P!¥gJ''\O•?hLoO%|?p# rg]Ѷ4f6l߶ tt^F͹#k endstream endobj startxref 463505 %%EOF DRIMSeq/inst/doc/DRIMSeq.R0000644000175100017510000002061714614334230016055 0ustar00biocbuildbiocbuild## ----style, eval=TRUE, echo=FALSE, results='asis'-------------------------- BiocStyle::latex() ## ----setup_knitr, include=FALSE, cache=FALSE------------------------------- library(knitr) opts_chunk$set(cache = FALSE, warning = FALSE, out.width = "7cm", fig.width = 7, out.height = "7cm", fig.height = 7) ## ----news, eval = FALSE---------------------------------------------------- # news(package = "DRIMSeq") ## ----DSpasilla1------------------------------------------------------------ library(PasillaTranscriptExpr) data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## ----DSlibrary, message=FALSE---------------------------------------------- library(DRIMSeq) ## ----DSdmDSdata_create----------------------------------------------------- pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) d head(counts(d), 3) head(samples(d), 3) ## ----DSdmDSdata_plot------------------------------------------------------- plotData(d) ## ----DSdmDSdata_subset----------------------------------------------------- gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) %in% gene_id_subset, ] d ## ----DSdmFilter------------------------------------------------------------ # Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) ## ----DSdmPrecision_design-------------------------------------------------- ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) design_full ## ----DSdmPrecision--------------------------------------------------------- ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) d head(mean_expression(d), 3) common_precision(d) head(genewise_precision(d)) ## ----DSdmPrecision_plot1--------------------------------------------------- plotPrecision(d) ## ----DSdmPrecision_plot2--------------------------------------------------- library(ggplot2) ggp <- plotPrecision(d) ggp + geom_point(size = 4) ## ----DSdmFit--------------------------------------------------------------- d <- dmFit(d, design = design_full, verbose = 1) d ## Get fitted proportions head(proportions(d)) ## Get the DM regression coefficients (gene-level) head(coefficients(d)) ## Get the BB regression coefficients (feature-level) head(coefficients(d), level = "feature") ## ----DSdmTest1------------------------------------------------------------- d <- dmTest(d, coef = "groupKD", verbose = 1) design(d) head(results(d), 3) ## ----DSdmTest2------------------------------------------------------------- design_null <- model.matrix(~ 1, data = samples(d)) design_null d <- dmTest(d, design = design_null) head(results(d), 3) ## ----DSdmTest3------------------------------------------------------------- contrast <- c(0, 1) d <- dmTest(d, contrast = contrast) design(d) head(results(d), 3) ## ----DSdmTest_results------------------------------------------------------ head(results(d, level = "feature"), 3) ## ----DSdmTest_plot--------------------------------------------------------- plotPValues(d) plotPValues(d, level = "feature") ## ----DSdmLRT_plotProportions, out.width = "14cm", fig.width = 14----------- res <- results(d) res <- res[order(res$pvalue, decreasing = FALSE), ] top_gene_id <- res$gene_id[1] plotProportions(d, gene_id = top_gene_id, group_variable = "group") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "lineplot") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "ribbonplot") ## ----stageR, eval = FALSE-------------------------------------------------- # library(stageR) # # ## Assign gene-level pvalues to the screening stage # pScreen <- results(d)$pvalue # names(pScreen) <- results(d)$gene_id # # ## Assign transcript-level pvalues to the confirmation stage # pConfirmation <- matrix(results(d, level = "feature")$pvalue, ncol = 1) # rownames(pConfirmation) <- results(d, level = "feature")$feature_id # # ## Create the gene-transcript mapping # tx2gene <- results(d, level = "feature")[, c("feature_id", "gene_id")] # # ## Create the stageRTx object and perform the stage-wise analysis # stageRObj <- stageRTx(pScreen = pScreen, pConfirmation = pConfirmation, # pScreenAdjusted = FALSE, tx2gene = tx2gene) # # stageRObj <- stageWiseAdjustment(object = stageRObj, method = "dtu", # alpha = 0.05) # # getSignificantGenes(stageRObj) # # getSignificantTx(stageRObj) # # padj <- getAdjustedPValues(stageRObj, order = TRUE, # onlySignificantGenes = FALSE) # # head(padj) # ## ----DRIMSeq_batch--------------------------------------------------------- pasilla_samples2 <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition, library_layout = pasilla_metadata$LibraryLayout) d2 <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples2) ## Subsetting to a vignette runnable size d2 <- d2[names(d2) %in% gene_id_subset, ] ## Filtering d2 <- dmFilter(d2, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) ## Create the design matrix design_full2 <- model.matrix(~ group + library_layout, data = samples(d2)) design_full2 ## To make the analysis reproducible set.seed(123) ## Calculate precision d2 <- dmPrecision(d2, design = design_full2) common_precision(d2) head(genewise_precision(d2)) plotPrecision(d2) ## Fit proportions d2 <- dmFit(d2, design = design_full2, verbose = 1) ## Test for DTU d2 <- dmTest(d2, coef = "groupKD", verbose = 1) design(d2) head(results(d2), 3) ## Plot p-value distribution plotPValues(d2) ## ----DRIMSeq_batch_plotProportions, out.width = "14cm", fig.width = 14----- ## Plot the top significant gene res2 <- results(d2) res2 <- res2[order(res2$pvalue, decreasing = FALSE), ] top_gene_id2 <- res2$gene_id[1] ggp <- plotProportions(d2, gene_id = top_gene_id2, group_variable = "group") ggp + facet_wrap(~ library_layout) ## ----SQTLgeuvadis, message=FALSE------------------------------------------- library(GeuvadisTranscriptExpr) geuv_counts <- GeuvadisTranscriptExpr::counts geuv_genotypes <- GeuvadisTranscriptExpr::genotypes geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges ## ----SQTLlibrary, message=FALSE-------------------------------------------- library(DRIMSeq) ## ----SQTLdmSQTLdata_create, message=FALSE---------------------------------- colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") colnames(geuv_genotypes)[4] <- "snp_id" geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, samples = geuv_samples, window = 5e3) d ## ----SQTLdmSQTLdata_plot--------------------------------------------------- plotData(d, plot_type = "features") plotData(d, plot_type = "snps") plotData(d, plot_type = "blocks") ## ----SQTLdmFilter---------------------------------------------------------- d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) ## ----SQTLdmPrecision------------------------------------------------------- ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d) plotPrecision(d) ## ----SQTLdmFit------------------------------------------------------------- d <- dmFit(d) ## ----SQTLdmTest------------------------------------------------------------ d <- dmTest(d) plotPValues(d) head(results(d)) ## ----SQTLplotProportions, out.width = "14cm", fig.width = 14--------------- res <- results(d) res <- res[order(res$pvalue, decreasing = FALSE), ] top_gene_id <- res$gene_id[1] top_snp_id <- res$snp_id[1] plotProportions(d, gene_id = top_gene_id, snp_id = top_snp_id) plotProportions(d, gene_id = top_gene_id, snp_id = top_snp_id, plot_type = "boxplot2") ## ----sessionInfo----------------------------------------------------------- sessionInfo() DRIMSeq/inst/doc/DRIMSeq.Rnw0000755000175100017510000011250514614306666016437 0ustar00biocbuildbiocbuild%\VignetteIndexEntry{Differential transcript usage and transcript usage QTL analyses in RNA-seq with the DRIMSeq package} %\VignettePackage{DRIMSeq} %\VignetteEngine{knitr::knitr} \documentclass[10pt]{article} <>= BiocStyle::latex() @ \usepackage[utf8]{inputenc} \usepackage[sort]{cite} \usepackage{xstring} \bioctitle[Differential transcript usage and transcript usage QTL analyses in RNA-seq with the DRIMSeq package]{DRIMSeq: Dirichlet-multinomial framework for differential transcript usage and transcript usage QTL analyses in RNA-seq} \author{ Malgorzata Nowicka\thanks{\email{gosia.nowicka@uzh.ch}}, Mark D. Robinson\\ Institute for Molecular Life Sciences, University of Zurich, Switzerland\\ SIB Swiss Institute of Bioinformatics, University of Zurich, Switzerland } \begin{document} \maketitle \packageVersion{\Sexpr{BiocStyle::pkg_ver("DRIMSeq")}} \newpage \tableofcontents \newpage <>= library(knitr) opts_chunk$set(cache = FALSE, warning = FALSE, out.width = "7cm", fig.width = 7, out.height = "7cm", fig.height = 7) @ %------------------------------------------------------------------------------ % Introduction %------------------------------------------------------------------------------ \section{Main changes in the DRIMSeq package} For the full list of changes, type: <>= news(package = "DRIMSeq") @ Implementation of the regression framework in differential transcript usage analysis. It allows fitting more complicated than multiple group comparison experimental designs, for example, one can account for the batch effects or the fact that samples are paired or model continuous time course changes. It enables also testing of more complicated contrasts. Transcript-level analysis based on the beta-binomial model. In this case, each transcript ratio is modeled separately assuming it follows the beta-binomial distribution which is a one-dimensional version of the Dirichlet-multinomial distribution. Based on the fact that when $(Y_1,\ldots,Y_q) \sim DM(\pi_1,\ldots,\pi_q, \gamma_0)$ then $Y_j \sim BB(\pi_j,\gamma_0)$ \cite{Danaher1988}, we do not need to reestimate the beta-binomial parameters, only the likelihoods are recalculated. \Rpackage{DRIMSeq} returns gene-level and transcript-level p-values which can be used as input to the stage-wise testing procedure \cite{VandenBerge2017} as screening and confirmation p-values, respectively. Such approach provides increased power to identify transcripts which are actually differentially used in a gene detected as gene with DTU. Usage of term 'precision' instead of 'dispersion'. In the differential analysis based on the negative-binomial model, dispersion parameter is estimated. This dispersion parameter captures all sources of the inter-library variation between replicates present in the RNA-seq data. In the DM model, we do not directly estimate dispersion but a parameter called precision which is closely linked to dispersion via the formula: $dispersion = 1 / (1 + precision)$. In the previous version of \cite{Nowicka2016}, we used 'dispersion' as a name for the functions and variables calculating and storing, in fact, the precision estimates. Now, we use the term 'precision'. \section{Overview of the Dirichlet-multinomial model} For the statistical details about the Dirichlet-multinomial model, see the \Rpackage{DRIMSeq} paper \cite{Nowicka2016}. In the \Rpackage{DRIMSeq} package we implemented a Dirichlet-multinomial framework that can be used for modeling various multivariate count data with the interest in finding the instances where the ratios of observed features are different between the experimental conditions. Such a model can be applied, for example, in differential transcript usage (DTU) analysis or in the analysis that aim in detecting SNPs that are associated with differential transcript usage (tuQTL analysis). In both cases the multivariate features of a gene are transcripts. The implementation of Dirichlet-multinomial model in \Rpackage{DRIMSeq} package is customized for differential transcript usage and tuQTL analyses, but the data objects used in \Rpackage{DRIMSeq} can contain various types of counts. Therefore, other types of multivariate differential analyses can be performed such as differential methylation analysis or differential polyA usage from polyA-seq data. In short, the method consists of three statistical steps: First, we use the Cox-Reid adjusted profile likelihood to estimate the precision which is inverse proportional to dispersion, i.e., the variability of transcript ratios between samples (replicates) within conditions. Dispersion is needed in order to find the significant changes in transcript ratios between conditions which should be sufficiently stronger than the changes/variability within conditions. Second, we use maximum likelihood to estimate at the gene-level the regression coefficients in the Dirichlet-multinomial (DM) regression, the fitted transcript proportions in each sample and the full model likelihoods. For the analysis at the transcript-level we apply the beta-binomial (BB) regression to each transcript separately. In the differential transcript usage analysis, the full model is defined by the user with the design matrix. In the QTL analysis, full models are defined by the genotypes of SNPs associated with a given gene. Finally, we fit the null model DM and BB regression and use the likelihood ratio statistics to test for the differences in transcript proportions between the full and null models at the gene and transcript level. In the differential transcript usage analysis, the null model is again defined by the user. In the QTL analysis, null models correspond to regression with intercept only. \section{Important notes} Currently, transcript-level analysis based on the BB model are implemented only in the DTU analysis (\Rcode{bb\_model = TRUE}). When the model (full or null) of interest corresponds to multiple (or one) group fitting, then a shortcut algorithm called 'one way' (\Rcode{one\_way = TRUE}), which we adapted from the \Rfunction{glmFit} function in \Biocpkg{edgeR} \cite{McCarthy2012}, can be used. Choosing it is equivalent to running the original \Rpackage{DRIMSeq} implementation. In such a case, we use maximum likelihood to estimate the transcript proportions in each group separately and then the regression coefficients are calculated using matrix operations. Otherwise, the regression coefficients are directly estimated with the maximum likelihood approach. \section{Hints for DRIMSeq pipelines} In this vignette, we present how one could perform differential transcript usage analysis and tuQTL analysis with the \Rpackage{DRIMSeq} package. We use small data sets so that the whole pipelines can be run within few minutes in \R{} on a single core computer. In practice, the package is designed to take advantage of multicore computing for larger data sets. In the filtering function \Rfunction{dmFilter}, all the parameters that are influencing transcript count filtering are set to zero. This results in a very relaxed filtering, where transcripts with zero expression in all the samples and genes with only one transcript remained are removed. Functions \Rfunction{dmPrecision}, \Rfunction{dmFit} and \Rfunction{dmTest}, which perform the actual statistical analyses described above, have many other parameters available for tweaking, but they do have the default values assigned. Those values were chosen based on many real data analyses. Some of the steps are quite time consuming, especially the precision estimation, where proportions of each gene are refitted for different precision parameters. To speed up the calculations, we have parallelized many functions using \Biocpkg{BiocParallel}. Thus, if possible, we recommend to increase the number of workers in \Robject{BPPARAM}. In general, tuQTL analyses are more computationally intensive than differential transcript usage analysis because one needs to do the analysis for every SNP in the surrounding region of a gene. Additionally, a permutation scheme is used to compute the p-values. It is indeed feasible to perform tuQTL analysis for small chunks of genome, for example, per chromosome. %------------------------------------------------------------------------------ % Differential transcript usage analysis workflow %------------------------------------------------------------------------------ \section{Differential transcript usage analysis workflow} \subsection{Example data} To demonstrate the application of \Rpackage{DRIMSeq} in differential transcript usage analysis, we will use the \emph{pasilla} data set produced by Brooks et al. \cite{Brooks2011}. The aim of their study was to identify exons that are regulated by pasilla protein, the Drosophila melanogaster ortholog of mammalian NOVA1 and NOVA2 (well studied transcript usage factors). In their RNA-seq experiment, the libraries were prepared from 7 biologically independent samples: 4 control samples and 3 samples in which pasilla was knocked-down. The libraries were sequenced on Illumina Genome Analyzer II using single-end and paired-end sequencing and different read lengths. The RNA-seq data can be downloaded from the NCBI Gene Expression Omnibus (GEO) under the accession number GSE18508. In the examples below, we use a subset of \software{kallisto} \cite{Bray2016} counts available in \Biocexptpkg{PasillaTranscriptExpr} package, where you can find all the steps needed, for preprocessing the GEO data, to get a table with transcript counts. \subsection{Differential transcript usage analysis between two conditions} In this section, we present how to perform the DTU analysis between two conditions control and knock-down without accounting for the batch effect which is the library layout. Analysis where batch effects are included are presented in the next section. We start the analysis by creating a \Rclass{dmDSdata} object, which contains transcript counts and information about grouping samples into conditions. With each step of the pipeline, additional elements are added to this object. At the end of the analysis, the object contains results from all the steps, such as precision estimates, regression coefficients, fitted transcript ratios in each sample, likelihood ratio statistics, p-values, adjusted p-values at gene and transcript level. As new elements are added, the object also changes its name \Rclass{dmDSdata} $\rightarrow$ \Rclass{dmDSprecision} $\rightarrow$ \Rclass{dmDSfit} $\rightarrow$ \Rclass{dmDStest}, but each container inherits slots and methods available for the previous one. \subsubsection{Loading pasilla data into R} The transcript-level counts obtained from \software{kallisto} and metadata are saved as text files in the \Rcode{extdata} directory of the \Biocexptpkg{PasillaTranscriptExpr} package. <>= library(PasillaTranscriptExpr) data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) @ Load the \Rpackage{DRIMSeq} package. <>= library(DRIMSeq) @ To create a \Rcode{dmDSdata} object, saved as variable \Robject{d}, we need to prepare a data frame containing information about samples and we will call it \Robject{pasilla\_samples}. It has to have a variable called \Rcode{sample\_id} with unique sample names that are identical to column names in \Robject{pasilla\_counts} that correspond to samples. Additionally, it has to contain other variables that the user would like to use for the further regression analysis. Here, we are interested in the differential analysis between the control and knock-down condition. This information is stored in \Rcode{pasilla\_metadata\$condition}. The data frame with counts called \Robject{pasilla\_counts} is already formatted in the right way. It contains variables \Rcode{feature\_id} with unique transcript names and \Rcode{gene\_id} with unique gene IDs and columns with counts have the same names as \Rcode{sample\_id} in \Rcode{pasilla\_samples}. When printing variable \Robject{d}, you can see its class, size (number of genes and samples) and which accessor methods can be applied. For \Rcode{dmDSdata} object, there are two methods that return data frames with counts and samples. <>= pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) d head(counts(d), 3) head(samples(d), 3) @ You can also make a data summary plot, which is a histogram of the number of transcripts per gene. <>= plotData(d) @ To make the analysis runnable within this vignette, we want to keep only a small subset of genes, which is defined in the following file. <>= gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) %in% gene_id_subset, ] d @ \subsubsection{Filtering} \label{DS_filtering} Genes may have many transcripts that are lowly expressed or not expressed at all. You can remove them using the \Rfunction{dmFilter} function. Filtering of lowly expressed transcripts can be done at two levels: minimal \textit{expression} using \Robject{min\_samps\_feature\_expr} and \Robject{min\_feature\_expr} parameters or minimal \textit{proportion} with \Robject{min\_samps\_feature\_prop} and \Robject{min\_feature\_prop}. In the \emph{pasilla} experiment we use a filtering based only on the transcript absolute expression and parameters are adjusted according to the number of replicates per condition. Since we have 3 knock-down and 4 control samples, we set \Robject{min\_samps\_feature\_expr} equal to 3. In this way, we allow a situation where a transcript is expressed in one condition but not in another, which is a case of differential transcript usage. The level of transcript expression is controlled by \Robject{min\_feature\_expr}. We set it to the value of 10, which means that only the transcripts that have at least 10 estimated counts in at least 3 samples are kept for the downstream analysis. Filtering at the gene level ensures that the observed transcript ratios have some minimal reliability. Although, Dirichlet-multinomial model works on feature counts, and not on feature ratios, which means that it gives more confidence to the ratios based on 100 versus 500 reads than 1 versus 5, minimal filtering based on gene expression removes the genes with mostly zero counts and reduces the number of tests in multiple test correction. For the \emph{pasilla} data, we want that genes have at least 10 counts in all the samples: \Rcode{min\_samps\_gene\_expr = 7} and \Rcode{min\_gene\_expr = 10}. <>= # Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) @ \subsubsection{Precision estimation} \label{DS_precision_estimation} Ideally, we would like to get accurate precision estimates for every gene, which is problematic when analyzing small data sets because precision estimates become inaccurate when the sample size decreases, especially for lowly expressed genes. As an alternative, we could assume that all the genes have the same precision and based on all the data, we could calculate a common precision, but we expect this to be too strong of an assumption. Moderated precision is a trade-off between gene-wise and common precision. The moderated estimates originate from a weighted likelihood which is a combination of common and individual likelihoods. We recommend this approach when analyzing small sample size data sets. At this step, three values may be calculated: mean expression of genes, common precision and gene-wise precisions. In the default setting, all of them are computed and common precision is used as an initial value in the grid approach to estimate gene-wise precisions, which are shrunk toward the trended precision. The grid approach is adapted from the \Rfunction{estimateDisp} function in \Biocpkg{edgeR} \cite{McCarthy2012}. By default, to estimate the common precision, we use 10\% percent (\Rcode{prec\_subset = 0.1}) of randomly selected genes. That is due to the fact that common precision is used only as an initial value, and estimating it based on all the genes takes a substantial part of time. To ensure that the analysis are reproducible, the user should define a random seed \Rcode{set.seed()} before running the \Rcode{dmPrecision()} function. Thank to that, each time the same subset of genes is selected. To estimate precision parameters, the user has to define a design matrix with the full model of interest, which will be also used later in the proportion estimation. Here, the full model is defined by a formula $\sim group$ which indicates that samples come from two conditions. This step of our pipeline is the most time consuming. Thus, for real data analysis, consider using \Rcode{BPPARAM = BiocParallel::MulticoreParam()} with more than one worker. <>= ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) design_full @ <>= ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) d head(mean_expression(d), 3) common_precision(d) head(genewise_precision(d)) @ To inspect the behavior of precision estimates, you can plot them against the mean gene expression. Normally in the differential analysis based on RNA-seq data, such plot has dispersion parameter plotted on the y-axis. Here, the y-axis represents precision since in the Dirichlet-multinomial model this is the parameter that is directly estimated. It is important to keep in mind that the precision parameter is inverse proportional to dispersion: $dispersion = 1 / (1 + precision)$. In RNA-seq data, we can typically observe a trend where the dispersion decreases (precision increases) for genes with higher mean expression. <>= plotPrecision(d) @ All of the plotting functions from \Rpackage{DRIMSeq} package, return a \Rclass{ggplot} object which can be further modified using \CRANpkg{ggplot2} package. For example, the user can increase the size of points. <>= library(ggplot2) ggp <- plotPrecision(d) ggp + geom_point(size = 4) @ \subsubsection{Proportion estimation} In this step, we estimate the full model regression coefficients, fitted proportions and likelihoods. We use the same design matrix as in the precision estimation step. By default, \Rcode{one\_way = TRUE} which means that whenever the design corresponds to multiple group fitting, the 'one way' shortcut algorithm will be used, which in fact corresponds to the first implementation of \Rpackage{DRIMSeq}. Transcript proportions are estimated for each condition separately and then the regression coefficients are calculated using matrix operations. The 'one way' algorithm is adapted from the \Rfunction{glmFit} function in \Biocpkg{edgeR} \cite{McCarthy2012}. By setting \Rcode{verbose = 1}, we can see that the one way approach is used with the current design. When \Rcode{bb\_model = TRUE} (the default), additionally to the gene-level Dirichlet-multinomial estimates the transcript-level beta-binomial results will be computed. <>= d <- dmFit(d, design = design_full, verbose = 1) d ## Get fitted proportions head(proportions(d)) ## Get the DM regression coefficients (gene-level) head(coefficients(d)) ## Get the BB regression coefficients (feature-level) head(coefficients(d), level = "feature") @ \subsubsection{Testing for differential transcript usage} \label{DS_testing} Calling the \Rfunction{dmTest} function results in two calculations. First, null model is fitted. This null model can be defined by the user via \Rcode{coef}, \Rcode{design} or \Rcode{contrast} parameters. Second, likelihood ratio statistics are used to test for the difference between the full and null model. Both steps are done at the gene and transcript level when \Rcode{bb\_model = TRUE}. In our example, we would like to test whether there are differences in transcript usage between control (CTL) and knock-down (KD). We can achieve that by using the \Rcode{coef} parameter which should indicate which columns of the full design should be removed to get the null design. We define it equal to \Rcode{"groupKD"}. Then the null design has only an intercept column which means that all the samples are treated as if they came from one condition. Note that \Rcode{one\_way = TRUE} and the one way approach is used. <>= d <- dmTest(d, coef = "groupKD", verbose = 1) design(d) head(results(d), 3) @ The same can be achieved by directly defining the null design matrix with the \Rcode{design} parameter. <>= design_null <- model.matrix(~ 1, data = samples(d)) design_null d <- dmTest(d, design = design_null) head(results(d), 3) @ Or by using the \Rcode{contrast} parameter. The null design is calculated using the approach from the \Rfunction{glmLRT} function in \Biocpkg{edgeR} \cite{McCarthy2012}. <>= contrast <- c(0, 1) d <- dmTest(d, contrast = contrast) design(d) head(results(d), 3) @ To obtain the results of likelihood ratio tests, you have to call the function \Rfunction{results}, which returns a data frame with likelihood ratio statistics, degrees of freedom, p-values and Benjamini and Hochberg (BH) adjusted p-values for each gene by default and for each transcript when \Rcode{level = "feature"}. <>= head(results(d, level = "feature"), 3) @ You can plot a histogram of gene-level and transcript-level p-values. <>= plotPValues(d) plotPValues(d, level = "feature") @ For genes of interest, you can make plots (bar plots, line plots, box plots, ribbon plots) of observed and estimated with Dirichlet-multinomial model transcript ratios. You have to define the \Rcode{group\_variable} parameter which should indicate a variable from \Rcode{samples(d)}. Currently, plots can be done only for categorical variables. We choose the \Rcode{"group"} column since it corresponds to the comparison of our interest. Estimated proportions are marked with diamond shapes. As an example, we plot the top significant gene. <>= res <- results(d) res <- res[order(res$pvalue, decreasing = FALSE), ] top_gene_id <- res$gene_id[1] plotProportions(d, gene_id = top_gene_id, group_variable = "group") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "lineplot") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "ribbonplot") @ \subsubsection{Two-stage test} \Rpackage{DRIMSeq} returns gene and transcript level p-values which can be used as an input to the stage-wise analysis \cite{VandenBerge2017} implemented in the \Rcode{stageR} package, currently available on github \url{https://github.com/statOmics/stageR}. As pointed by the authors of \Rcode{stageR}, interpreting both gene-level and transcript-level adjusted p-values does not provide appropriate FDR control and should be avoided. However, applying a stage-wise testing provides a useful biological interpretation of these results and improved statistical performance. In short, the procedure consists of a screening stage and a confirmation stage. In the screening stage, gene-level BH-adjusted p-values are screened to detect genes for which the hypothesis of interest is significantly rejected. Only those genes are further considered in the confirmation stage, where for each gene separately, transcript-level p-values are adjusted to control the FWER and BH-adjusted significance level of the screening stage. It is important to note that transcript-level stage-wise adjusted p-values for genes that do not pass the screening stage are set to \Rcode{NA}. Also the stage-wise adjusted p-values can not be compared to significance level other than chosen in the stage-wise analysis. If that is of interest, one has to rerun this analysis with the new significance level. The following code chunk is not evaluated by this vignette and to run it, user has to make sure that the \Rcode{stageR} package is installed. It shows how one can use the \Rpackage{DRIMSeq} output in the stage-wise analysis. <>= library(stageR) ## Assign gene-level pvalues to the screening stage pScreen <- results(d)$pvalue names(pScreen) <- results(d)$gene_id ## Assign transcript-level pvalues to the confirmation stage pConfirmation <- matrix(results(d, level = "feature")$pvalue, ncol = 1) rownames(pConfirmation) <- results(d, level = "feature")$feature_id ## Create the gene-transcript mapping tx2gene <- results(d, level = "feature")[, c("feature_id", "gene_id")] ## Create the stageRTx object and perform the stage-wise analysis stageRObj <- stageRTx(pScreen = pScreen, pConfirmation = pConfirmation, pScreenAdjusted = FALSE, tx2gene = tx2gene) stageRObj <- stageWiseAdjustment(object = stageRObj, method = "dtu", alpha = 0.05) getSignificantGenes(stageRObj) getSignificantTx(stageRObj) padj <- getAdjustedPValues(stageRObj, order = TRUE, onlySignificantGenes = FALSE) head(padj) @ \subsection{Differential transcript usage analysis between two conditions with accounting for the batch effects} The regression framework implemented in \Rpackage{DRIMSeq} allows to account for the batch effects. Here, this would be the library layout stored in \Rcode{pasilla\_metadata\$LibraryLayout}. The steps of this analysis are the same as described above. The only difference is that we have to include the library layout variable in the \Rcode{sample} slot in the \Rcode{dmDSdata} object and define a full model that contains the batch effect. <>= pasilla_samples2 <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition, library_layout = pasilla_metadata$LibraryLayout) d2 <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples2) ## Subsetting to a vignette runnable size d2 <- d2[names(d2) %in% gene_id_subset, ] ## Filtering d2 <- dmFilter(d2, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) ## Create the design matrix design_full2 <- model.matrix(~ group + library_layout, data = samples(d2)) design_full2 ## To make the analysis reproducible set.seed(123) ## Calculate precision d2 <- dmPrecision(d2, design = design_full2) common_precision(d2) head(genewise_precision(d2)) plotPrecision(d2) ## Fit proportions d2 <- dmFit(d2, design = design_full2, verbose = 1) ## Test for DTU d2 <- dmTest(d2, coef = "groupKD", verbose = 1) design(d2) head(results(d2), 3) ## Plot p-value distribution plotPValues(d2) @ <>= ## Plot the top significant gene res2 <- results(d2) res2 <- res2[order(res2$pvalue, decreasing = FALSE), ] top_gene_id2 <- res2$gene_id[1] ggp <- plotProportions(d2, gene_id = top_gene_id2, group_variable = "group") ggp + facet_wrap(~ library_layout) @ %------------------------------------------------------------------------------ % tuQTL analysis workflow %------------------------------------------------------------------------------ \section{tuQTL analysis workflow} In the transcript usage QTL analysis, we want to identify genetic variants (here, bi-allelic SNPs) that are associated with changes in transcript usage. Such SNPs are then called transcript usage quantitative trait locies (tuQTLs). Ideally, we would like to test associations of every SNP with every gene. However, such an approach would be very costly computationally and in terms of multiple testing correction. Under the assumption that SNPs that directly affect transcript usage are likely to be placed in the close surrounding of genes, we test only the SNPs that are located within the gene body and within some range upstream and downstream of the gene. \subsection{Example data} To demonstrate the tuQTL analysis with the \Rpackage{DRIMSeq} package, we use data from the GEUVADIS project \cite{Lappalainen2013}, where 462 RNA-Seq samples from lymphoblastoid cell lines were obtained. The genome sequencing data of the same individuals is provided by the 1000 Genomes Project. The samples in this project come from five populations: CEPH (CEU), Finns (FIN), British (GBR), Toscani (TSI) and Yoruba (YRI). We use transcript quantification (expected counts from FluxCapacitor) and genotypes available on the GEUVADIS project website \url{http://www.ebi.ac.uk/Tools/geuvadis-das/}, and the Gencode v12 gene annotation is available at \url{http://www.gencodegenes.org/releases/12.html}. In order to make this vignette runnable, we perform the analysis on subsets of bi-allelic SNPs and transcript expected counts for CEPH population (91 individuals) that correspond to 50 randomly selected genes from chromosome 19. The full dataset can be accessed from \Biocexptpkg{GeuvadisTranscriptExpr} package along with the description of preprocessing steps. \subsection{tuQTL analysis with the DRIMSeq package} Assuming you have gene annotation, feature counts and bi-allelic genotypes that are expressed in terms of the number of alleles different from the reference, the \Rpackage{DRIMSeq} workflow for tuQTL analysis is analogous to the one for differential transcript usage. First, we have to create a \Rclass{dmSQTLdata} object, which contains feature counts, sample information and genotypes. Similarly as in the differential transcript usage pipeline, results from every step are added to this object and at the end of the analysis, it contains precision estimates, proportions estimates, likelihood ratio statistics, p-values, adjusted p-values. As new elements are added, the object also changes its name \Rclass{dmSQTLdata} $\rightarrow$ \Rclass{dmSQTLprecision} $\rightarrow$ \Rclass{dmSQTLfit} $\rightarrow$ \Rclass{dmSQTLtest}. For each object, slots and methods are inherited from the previous one. \subsubsection{Loading GEUVADIS data into R} We use the subsets of data defined in the \Biocexptpkg{GeuvadisTranscriptExpr} package. <>= library(GeuvadisTranscriptExpr) geuv_counts <- GeuvadisTranscriptExpr::counts geuv_genotypes <- GeuvadisTranscriptExpr::genotypes geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges @ Load the \Rpackage{DRIMSeq} package. <>= library(DRIMSeq) @ In the tuQTL analysis, an initial data object \Robject{d} is of \Robject{dmSQTLdata} class and, additionally to feature counts and sample information, it contains genotypes of SNPs that are in some surrounding of genes. This surrounding is defined with the parameter \Rcode{window}. In order to find out which SNPs should be tested with which genes, the \Rfunction{dmSQTLdata} functions requires as an input the location of genes (\Rcode{gene\_ranges}) and SNPs (\Rcode{snp\_ranges}) stored as \Rclass{GRanges} objects. Variables with transcript IDs and gene IDs in the \Robject{counts} data frame must have names \Rcode{feature\_id} and \Rcode{gene\_id}, respectively. In the \Robject{genotypes} data frame, the variable with SNP IDs must have name \Rcode{snp\_id}. <>= colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") colnames(geuv_genotypes)[4] <- "snp_id" geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, samples = geuv_samples, window = 5e3) d @ In our tuQTL analysis, we do not repeat tests for the SNPs that define the same grouping of samples (genotype). We identify SNPs with identical genotypes across the samples and assign them to blocks. Estimation and testing are done at the block level, but the returned results are extended to a SNP level by repeating the block statistics for each SNP that belongs to a given block. The data summary plot \Rfunction{plotData} produces three histograms: the number of features per gene, the number of SNPs per gene and the number of blocks per gene. <>= plotData(d, plot_type = "features") plotData(d, plot_type = "snps") plotData(d, plot_type = "blocks") @ \subsubsection{Filtering} The filtering step eliminates genes and features with low expression, as in the differential transcript usage analysis (see section \ref{DS_filtering}). Additionally, it filters out the SNPs/blocks that do not define at least two genotypes where each of them is present in at least \Robject{minor\_allele\_freq} individuals. Usually, \Robject{minor\_allele\_freq} is equal to roughly 5\% of the total sample size. Ideally, we would like that genes were expressed at some minimal level in all samples because this would lead to better estimates of feature ratios. However, for some genes, missing values may be present in the counts data, or genes may be lowly expressed in some samples. Setting up \Robject{min\_samps\_gene\_expr} to 91 may exclude too many genes from the analysis. We can be slightly less stringent by taking, for example, \Rcode{min\_samps\_gene\_expr = 70}. <>= d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) @ \subsubsection{Precision estimation} In the DTU analysis (section \ref{DS_precision_estimation}), the full model used in precision estimation has to be defined by the user. Here, full models are defined by genotypes. For a given SNP, genotype can have numeric values of 0, 1, and 2. When \Rcode{one\_way = TRUE}, multiple group fitting is performed. When \Rcode{one\_way = FALSE}, a regression framework is used with the design matrix defined by a formula $\sim group$ where $group$ is a continuous (not categorical) variable with genotype values 0, 1, and 2. For the tuQTL analysis, it has an additional parameter called \Rcode{speed}. If \Rcode{speed = FALSE}, gene-wise precisions are calculated for each gene-block. This calculation may take a long time, since there can be hundreds of SNPs/blocks per gene. If \Rcode{speed} is set to \Rcode{TRUE}, there will be only one precision calculated per gene (assuming a null model, i.e., model with intercept only), and it will be assigned to all the blocks matched to this gene. In the default setting, \Rcode{speed = TRUE} and common precision is used as an initial value in the grid approach to estimate gene-wise precisions with NO moderation, since the sample size is quite large. Again, this step of the pipeline is one of the most time consuming. Thus consider using \Rcode{BPPARAM = BiocParallel::MulticoreParam()} with more than one worker when performing real data analysis. <>= ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d) plotPrecision(d) @ \subsubsection{Proportion estimation} Dirichlet-multinomial full model proportions/coefficients and likelihoods are estimated for each gene-block pair. Currently, no transcript-level analysis are implemented in the tuQTL workflow. <>= d <- dmFit(d) @ \subsubsection{Testing for tuQTLs} \Rfunction{dmTest} function estimates gene-level null model proportions/coefficients and likelihoods and performs the likelihood ratio test. The null models equal to models with intercept only. In contrast to the DTU analysis, there are some additional challenges that have to handled in the tuQTL analysis. They include a large number of tests per gene with highly variable allele frequencies (models) and linkage disequilibrium. As in other sQTL studies, we apply a permutation approach to empirically assess the null distribution of associations and use it for the adjustment of nominal p-values. There are two permutation schemes available. When \Rcode{permutation\_mode} equals to \Rcode{"all\_genes"}, the null p-value distribution is calculated from all the genes. When \Rcode{permutation\_mode = "per\_gene"}, null distribution of p-values is calculated for each gene separately based on permutations of this individual gene. The latter approach may take a lot of computational time. We suggest using the first option, which is also the default one. The function \Rfunction{results} returns a data frame with likelihood ratio statistics, degrees of freedom, p-values and Benjamini and Hochberg adjusted p-values for each gene-block/SNP pair. <>= d <- dmTest(d) plotPValues(d) head(results(d)) @ You can plot the observed transcript ratios for the tuQTLs of interest. Plotting the fitted values is not possible as we do not return this estimates due to their size. When the sample size is large, we recommend using box plots as a \Rcode{plot\_type}. We plot a tuQTL with the lowest p-value. <>= res <- results(d) res <- res[order(res$pvalue, decreasing = FALSE), ] top_gene_id <- res$gene_id[1] top_snp_id <- res$snp_id[1] plotProportions(d, gene_id = top_gene_id, snp_id = top_snp_id) plotProportions(d, gene_id = top_gene_id, snp_id = top_snp_id, plot_type = "boxplot2") @ %-------------------------------------------------- % Session information %-------------------------------------------------- \section{Session information} <>= sessionInfo() @ %-------------------------------------------------- % References %-------------------------------------------------- \bibliography{References} \end{document} DRIMSeq/man/0000755000175100017510000000000014614306666013565 5ustar00biocbuildbiocbuildDRIMSeq/man/dm_plotDataDSInfo.Rd0000644000175100017510000000077114614306666017354 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dm_plotData.R \name{dm_plotDataDSInfo} \alias{dm_plotDataDSInfo} \title{Plot the frequency of present features} \usage{ dm_plotDataDSInfo(info, ds_info) } \arguments{ \item{info}{Data frame with \code{gene_id} and \code{feature_id} of ALL features} \item{ds_info}{Data frame with \code{gene_id} and \code{feature_id} of ONLY DS features} } \value{ \code{ggplot} object } \description{ Plot the frequency of present features } DRIMSeq/man/dm_plotProportions.Rd0000644000175100017510000000327214614306666017775 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dm_plotProportions.R \name{dm_plotProportions} \alias{dm_plotProportions} \title{Plot feature proportions} \usage{ dm_plotProportions(counts, group, md = NULL, fit_full = NULL, main = NULL, plot_type = "boxplot1", order_features = TRUE, order_samples = TRUE, group_colors = NULL, feature_colors = NULL) } \arguments{ \item{counts}{Matrix with rows corresponding to features and columns corresponding to samples. Row names are used as labels on the plot.} \item{group}{Factor that groups samples into conditions.} \item{md}{Data frame with additional sample information.} \item{fit_full}{Matrix of estimated proportions with rows corresponding to features and columns corresponding to samples. If \code{NULL}, nothing is plotted.} \item{main}{Character vector with main title for the plot. If \code{NULL}, nothing is plotted.} \item{plot_type}{Character defining the type of the plot produced. Possible values \code{"barplot"}, \code{"boxplot1"}, \code{"boxplot2"}, \code{"lineplot"}, \code{"ribbonplot"}.} \item{order_features}{Logical. Whether to plot the features ordered by their expression.} \item{order_samples}{Logical. Whether to plot the samples ordered by the group variable. If \code{FALSE} order from the \code{sample(x)} is kept.} \item{group_colors}{Character vector with colors for each group.} \item{feature_colors}{Character vector with colors for each feature.} } \value{ \code{ggplot} object with the observed and/or estimated with Dirichlet-multinomial model feature ratios. Estimated proportions are marked with diamond shapes. } \description{ Plot observed and/or estimated feature proportions. } DRIMSeq/man/dmDSdata-class.Rd0000644000175100017510000000607214614306666016645 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDSdata.R \docType{class} \name{dmDSdata-class} \alias{dmDSdata-class} \alias{counts,dmDSdata-method} \alias{samples} \alias{samples,dmDSdata-method} \alias{names,dmDSdata-method} \alias{length,dmDSdata-method} \alias{[,dmDSdata,ANY-method} \alias{[,dmDSdata-method} \title{dmDSdata object} \usage{ \S4method{counts}{dmDSdata}(object) samples(x, ...) \S4method{samples}{dmDSdata}(x) \S4method{names}{dmDSdata}(x) \S4method{length}{dmDSdata}(x) \S4method{[}{dmDSdata,ANY}(x, i, j) } \arguments{ \item{object, x}{dmDSdata object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{i, j}{Parameters used for subsetting.} } \value{ \itemize{ \item \code{counts(object)}: Get a data frame with counts. \item \code{samples(x)}: Get a data frame with the sample information. \item \code{names(x)}: Get the gene names. \item \code{length(x)}: Get the number of genes. \item \code{x[i, j]}: Get a subset of dmDSdata object that consists of counts for genes i and samples j. } } \description{ dmDSdata contains expression, in counts, of genomic features such as exons or transcripts and sample information needed for the differential exon/transcript usage (DEU or DTU) analysis. It can be created with function \code{\link{dmDSdata}}. } \section{Slots}{ \describe{ \item{\code{counts}}{\code{\linkS4class{MatrixList}} of expression, in counts, of genomic features. Rows correspond to genomic features, such as exons or transcripts. Columns correspond to samples. MatrixList is partitioned in a way that each of the matrices in a list contains counts for a single gene.} \item{\code{samples}}{Data frame with information about samples. It must contain \code{sample_id} variable with unique sample names and other covariates that desribe samples and are needed for the differential analysis.} }} \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] } } \seealso{ \code{\linkS4class{dmDSprecision}}, \code{\linkS4class{dmDSfit}}, \code{\linkS4class{dmDStest}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmDSdata.Rd0000644000175100017510000000371714614306666015545 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDSdata.R \name{dmDSdata} \alias{dmDSdata} \title{Create dmDSdata object} \usage{ dmDSdata(counts, samples) } \arguments{ \item{counts}{Data frame with counts. Rows correspond to features, for example, transcripts or exons. This data frame has to contain a \code{gene_id} column with gene IDs, \code{feature_id} column with feature IDs and columns with counts for each sample. Column names corresponding to sample IDs must be the same as in the \code{sample} data frame.} \item{samples}{Data frame where each row corresponds to one sample. Columns have to contain unique sample IDs in \code{sample_id} variable and a grouping variable \code{group}.} } \value{ Returns a \linkS4class{dmDSdata} object. } \description{ Constructor function for a \code{\linkS4class{dmDSdata}} object. } \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] } } \seealso{ \code{\link{plotData}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmDSfit-class.Rd0000644000175100017510000001062714614306666016517 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDSfit.R \docType{class} \name{dmDSfit-class} \alias{dmDSfit-class} \alias{design,dmDSfit-method} \alias{proportions} \alias{proportions,dmDSfit-method} \alias{coefficients,dmDSfit-method} \title{dmDSfit object} \usage{ \S4method{design}{dmDSfit}(object, type = "full_model") proportions(x, ...) \S4method{proportions}{dmDSfit}(x) \S4method{coefficients}{dmDSfit}(object, level = "gene") } \arguments{ \item{type}{Character indicating which design matrix should be returned. Possible values \code{"precision"}, \code{"full_model"} or \code{"null_model"}.} \item{x, object}{dmDSprecision object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{level}{Character specifying which type of results to return. Possible values \code{"gene"} or \code{"feature"}.} } \value{ \itemize{ \item \code{design(object)}: Get a matrix with the full design. \item \code{proportions(x)}: Get a data frame with estimated feature ratios for each sample. \item \code{coefficients(x)}: Get the DM or BB regression coefficients. } } \description{ dmDSfit extends the \code{\linkS4class{dmDSprecision}} class by adding the full model Dirichlet-multinomial (DM) and beta-binomial (BB) likelihoods, regression coefficients and feature proportion estimates. Result of calling the \code{\link{dmFit}} function. } \section{Slots}{ \describe{ \item{\code{design_fit_full}}{Numeric matrix of the design used to fit the full model.} \item{\code{fit_full}}{\code{\linkS4class{MatrixList}} containing estimated feature ratios in each sample based on the full Dirichlet-multinomial (DM) model.} \item{\code{lik_full}}{Numeric vector of the per gene DM full model likelihoods.} \item{\code{coef_full}}{\code{\linkS4class{MatrixList}} with the regression coefficients based on the DM model.} \item{\code{fit_full_bb}}{\code{\linkS4class{MatrixList}} containing estimated feature ratios in each sample based on the full beta-binomial (BB) model.} \item{\code{lik_full_bb}}{Numeric vector of the per gene BB full model likelihoods.} \item{\code{coef_full_bb}}{\code{\linkS4class{MatrixList}} with the regression coefficients based on the BB model.} }} \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) plotPrecision(d) head(mean_expression(d)) common_precision(d) head(genewise_precision(d)) ## Fit full model proportions d <- dmFit(d, design = design_full) ## Get fitted proportions head(proportions(d)) ## Get the DM regression coefficients (gene-level) head(coefficients(d)) ## Get the BB regression coefficients (feature-level) head(coefficients(d), level = "feature") } } \seealso{ \code{\linkS4class{dmDSdata}}, \code{\linkS4class{dmDSprecision}}, \code{\linkS4class{dmDStest}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmDSprecision-class.Rd0000644000175100017510000001145314614306666017726 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDSprecision.R \docType{class} \name{dmDSprecision-class} \alias{dmDSprecision-class} \alias{design,dmDSprecision-method} \alias{mean_expression} \alias{mean_expression,dmDSprecision-method} \alias{common_precision} \alias{common_precision,dmDSprecision-method} \alias{common_precision<-} \alias{common_precision<-,dmDSprecision-method} \alias{genewise_precision} \alias{genewise_precision,dmDSprecision-method} \alias{genewise_precision<-} \alias{genewise_precision<-,dmDSprecision-method} \title{dmDSprecision object} \usage{ \S4method{design}{dmDSprecision}(object, type = "precision") mean_expression(x, ...) \S4method{mean_expression}{dmDSprecision}(x) common_precision(x, ...) \S4method{common_precision}{dmDSprecision}(x) common_precision(x) <- value \S4method{common_precision}{dmDSprecision}(x) <- value genewise_precision(x, ...) \S4method{genewise_precision}{dmDSprecision}(x) genewise_precision(x) <- value \S4method{genewise_precision}{dmDSprecision}(x) <- value } \arguments{ \item{type}{Character indicating which design matrix should be returned. Possible values \code{"precision"}, \code{"full_model"} or \code{"null_model"}.} \item{x, object}{dmDSprecision object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{value}{Values that replace current attributes.} } \value{ \itemize{ \item \code{mean_expression(x)}: Get a data frame with mean gene expression. \item \code{common_precision(x), common_precision(x) <- value}: Get or set common precision. \code{value} must be numeric of length 1. \item \code{genewise_precision(x), genewise_precision(x) <- value}: Get a data frame with gene-wise precision or set new gene-wise precision. \code{value} must be a data frame with "gene_id" and "genewise_precision" columns. } } \description{ dmDSprecision extends the \code{\linkS4class{dmDSdata}} by adding the precision estimates of the Dirichlet-multinomial distribution used to model the feature (e.g., transcript, exon, exonic bin) counts for each gene in the differential usage analysis. Result of calling the \code{\link{dmPrecision}} function. } \details{ Normally, in the differential analysis based on RNA-seq data, such as, for example, differential gene expression, dispersion (of negative-binomial model) is estimated. Here, we estimate precision of the Dirichlet-multinomial model as it is more convenient computationally. To obtain dispersion estimates, one can use a formula: dispersion = 1 / (1 + precision). } \section{Slots}{ \describe{ \item{\code{mean_expression}}{Numeric vector of mean gene expression.} \item{\code{common_precision}}{Numeric value of estimated common precision.} \item{\code{genewise_precision}}{Numeric vector of estimated gene-wise precisions.} \item{\code{design_precision}}{Numeric matrix of the design used to estimate precision.} }} \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) plotPrecision(d) head(mean_expression(d)) common_precision(d) head(genewise_precision(d)) } } \seealso{ \code{\linkS4class{dmDSdata}}, \code{\linkS4class{dmDSfit}}, \code{\linkS4class{dmDStest}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmDStest-class.Rd0000644000175100017510000001155414614306666016714 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDStest.R \docType{class} \name{dmDStest-class} \alias{dmDStest-class} \alias{design,dmDStest-method} \alias{results} \alias{results,dmDStest-method} \title{dmDStest object} \usage{ \S4method{design}{dmDStest}(object, type = "null_model") results(x, ...) \S4method{results}{dmDStest}(x, level = "gene") } \arguments{ \item{type}{Character indicating which design matrix should be returned. Possible values \code{"precision"}, \code{"full_model"} or \code{"null_model"}.} \item{x, object}{dmDStest object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{level}{Character specifying which type of results to return. Possible values \code{"gene"} or \code{"feature"}.} } \value{ \itemize{ \item \code{results(x)}: get a data frame with gene-level or feature-level results.} } \description{ dmDStest extends the \code{\linkS4class{dmDSfit}} class by adding the null model Dirichlet-multinomial (DM) and beta-binomial (BB) likelihoods and the gene-level and feature-level results of testing for differential exon/transcript usage. Result of calling the \code{\link{dmTest}} function. } \section{Slots}{ \describe{ \item{\code{design_fit_null}}{Numeric matrix of the design used to fit the null model.} \item{\code{lik_null}}{Numeric vector of the per gene DM null model likelihoods.} \item{\code{lik_null_bb}}{Numeric vector of the per gene BB null model likelihoods.} \item{\code{results_gene}}{Data frame with the gene-level results including: \code{gene_id} - gene IDs, \code{lr} - likelihood ratio statistics based on the DM model, \code{df} - degrees of freedom, \code{pvalue} - p-values and \code{adj_pvalue} - Benjamini & Hochberg adjusted p-values.} \item{\code{results_feature}}{Data frame with the feature-level results including: \code{gene_id} - gene IDs, \code{feature_id} - feature IDs, \code{lr} - likelihood ratio statistics based on the BB model, \code{df} - degrees of freedom, \code{pvalue} - p-values and \code{adj_pvalue} - Benjamini & Hochberg adjusted p-values.} }} \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) plotPrecision(d) head(mean_expression(d)) common_precision(d) head(genewise_precision(d)) ## Fit full model proportions d <- dmFit(d, design = design_full) ## Get fitted proportions head(proportions(d)) ## Get the DM regression coefficients (gene-level) head(coefficients(d)) ## Get the BB regression coefficients (feature-level) head(coefficients(d), level = "feature") ## Fit null model proportions and perform the LR test to detect DTU d <- dmTest(d, coef = "groupKD") ## Plot the gene-level p-values plotPValues(d) ## Get the gene-level results head(results(d)) ## Plot feature proportions for a top DTU gene res <- results(d) res <- res[order(res$pvalue, decreasing = FALSE), ] top_gene_id <- res$gene_id[1] plotProportions(d, gene_id = top_gene_id, group_variable = "group") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "lineplot") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "ribbonplot") } \seealso{ \code{\linkS4class{dmDSdata}}, \code{\linkS4class{dmDSprecision}}, \code{\linkS4class{dmDSfit}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmFilter.Rd0000644000175100017510000001571514614306666015633 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDSdata.R, R/class_dmSQTLdata.R \docType{methods} \name{dmFilter} \alias{dmFilter} \alias{dmFilter,dmDSdata-method} \alias{dmFilter,dmSQTLdata-method} \title{Filtering} \usage{ dmFilter(x, ...) \S4method{dmFilter}{dmDSdata}(x, min_samps_gene_expr = 0, min_samps_feature_expr = 0, min_samps_feature_prop = 0, min_gene_expr = 0, min_feature_expr = 0, min_feature_prop = 0, run_gene_twice = FALSE) \S4method{dmFilter}{dmSQTLdata}(x, min_samps_gene_expr = 0, min_samps_feature_expr = 0, min_samps_feature_prop = 0, minor_allele_freq = 0.05 * nrow(samples(x)), min_gene_expr = 0, min_feature_expr = 0, min_feature_prop = 0, BPPARAM = BiocParallel::SerialParam()) } \arguments{ \item{x}{\code{\linkS4class{dmDSdata}} or \code{\linkS4class{dmSQTLdata}} object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{min_samps_gene_expr}{Minimal number of samples where genes should be expressed. See Details.} \item{min_samps_feature_expr}{Minimal number of samples where features should be expressed. See Details.} \item{min_samps_feature_prop}{Minimal number of samples where features should be expressed. See details.} \item{min_gene_expr}{Minimal gene expression.} \item{min_feature_expr}{Minimal feature expression.} \item{min_feature_prop}{Minimal proportion for feature expression. This value should be between 0 and 1.} \item{run_gene_twice}{Whether to re-run the gene-level filter after the feature-level filters.} \item{minor_allele_freq}{Minimal number of samples where each of the genotypes has to be present.} \item{BPPARAM}{Parallelization method used by \code{\link[BiocParallel]{bplapply}}.} } \value{ Returns filtered \code{\linkS4class{dmDSdata}} or \code{\linkS4class{dmSQTLdata}} object. } \description{ Filtering of genes and features with low expression. Additionally, for the dmSQTLdata object, filtering of genotypes with low frequency. } \details{ Filtering parameters should be adjusted according to the sample size of the experiment data and the number of replicates per condition. \code{min_samps_gene_expr} defines the minimal number of samples where genes are required to be expressed at the minimal level of \code{min_gene_expr} in order to be included in the downstream analysis. Ideally, we would like that genes were expressed at some minimal level in all samples because this would lead to better estimates of feature ratios. Similarly, \code{min_samps_feature_expr} and \code{min_samps_feature_prop} defines the minimal number of samples where features are required to be expressed at the minimal levels of counts \code{min_feature_expr} or proportions \code{min_feature_prop}. In differential transcript/exon usage analysis, we suggest using \code{min_samps_feature_expr} and \code{min_samps_feature_prop} equal to the minimal number of replicates in any of the conditions. For example, in an assay with 3 versus 5 replicates, we would set these parameters to 3, which allows a situation where a feature is expressed in one condition but may not be expressed at all in another one, which is an example of differential transcript/exon usage. By default, all the filtering parameters equal zero which means that features with zero expression in all samples are removed as well as genes with only one non-zero feature. In QTL analysis, usually, we deal with data that has many more replicates than data from a standard differential usage assay. Our example data set consists of 91 samples. Requiring that genes are expressed in all samples may be too stringent, especially since there may be missing values in the data and for some genes you may not observe counts in all 91 samples. Slightly lower threshold ensures that we do not eliminate such genes. For example, if \code{min_samps_gene_expr = 70} and \code{min_gene_expr = 10}, only genes with expression of at least 10 in at least 70 samples are kept. Samples with expression lower than 10 have \code{NA}s assigned and are skipped in the analysis of this gene. \code{minor_allele_freq} indicates the minimal number of samples for the minor allele presence. Usually, it is equal to roughly 5\% of total samples. } \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) } # -------------------------------------------------------------------------- # Create dmSQTLdata object # -------------------------------------------------------------------------- # Use subsets of data defined in the GeuvadisTranscriptExpr package library(GeuvadisTranscriptExpr) \donttest{ geuv_counts <- GeuvadisTranscriptExpr::counts geuv_genotypes <- GeuvadisTranscriptExpr::genotypes geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") colnames(geuv_genotypes)[4] <- "snp_id" geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, samples = geuv_samples, window = 5e3) # -------------------------------------------------------------------------- # sQTL analysis - simple group comparison # -------------------------------------------------------------------------- ## Filtering d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) plotData(d) } } \seealso{ \code{\link{plotData}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmFit.Rd0000644000175100017510000001523714614306666015127 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDSfit.R, R/class_dmSQTLfit.R \docType{methods} \name{dmFit} \alias{dmFit} \alias{dmFit,dmDSprecision-method} \alias{dmFit,dmSQTLprecision-method} \title{Fit the Dirichlet-multinomial and/or the beta-binomial full model regression} \usage{ dmFit(x, ...) \S4method{dmFit}{dmDSprecision}(x, design, one_way = TRUE, bb_model = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, add_uniform = FALSE, BPPARAM = BiocParallel::SerialParam()) \S4method{dmFit}{dmSQTLprecision}(x, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, BPPARAM = BiocParallel::SerialParam()) } \arguments{ \item{x}{\code{\linkS4class{dmDSprecision}} or \code{\linkS4class{dmSQTLprecision}} object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{design}{Numeric matrix defining the full model.} \item{one_way}{Logical. Should the shortcut fitting be used when the design corresponds to multiple group comparison. This is a similar approach as in \code{\link{edgeR}}. If \code{TRUE} (the default), then proportions are fitted per group and regression coefficients are recalculated from those fits.} \item{bb_model}{Logical. Whether to perform the feature-level analysis using the beta-binomial model.} \item{prop_mode}{Optimization method used to estimate proportions. Possible value \code{"constrOptim"}.} \item{prop_tol}{The desired accuracy when estimating proportions.} \item{coef_mode}{Optimization method used to estimate regression coefficients. Possible value \code{"optim"}.} \item{coef_tol}{The desired accuracy when estimating regression coefficients.} \item{verbose}{Numeric. Definie the level of progress messages displayed. 0 - no messages, 1 - main messages, 2 - message for every gene fitting.} \item{add_uniform}{Whether to add a small fractional count to zeros, (adding a uniform random variable between 0 and 0.1). This option allows for the fitting of genewise precision and coefficients for genes with two features having all zero for one group, or the last feature having all zero for one group.} \item{BPPARAM}{Parallelization method used by \code{\link[BiocParallel]{bplapply}}.} } \value{ Returns a \code{\linkS4class{dmDSfit}} or \code{\linkS4class{dmSQTLfit}} object. } \description{ Obtain the maximum likelihood estimates of Dirichlet-multinomial (gene-level) and/or beta-binomial (feature-level) regression coefficients, feature proportions in each sample and corresponding likelihoods. In the differential exon/transcript usage analysis, the regression model is defined by a design matrix. In the exon/transcript usage QTL analysis, regression models are defined by genotypes. Currently, beta-binomial model is implemented only in the differential usage analysis. } \details{ In the regression framework here, we adapt the idea from \code{\link[edgeR]{glmFit}} in \code{\link{edgeR}} about using a shortcut algorithm when the design is equivalent to simple group fitting. In such a case, we estimate the DM proportions for each group of samples separately and then recalculate the DM (and/or the BB) regression coefficients corresponding to the design matrix. If the design matrix does not define a simple group fitting, for example, when it contains a column with continuous values, then the regression framework is used to directly estimate the regression coefficients. Arguments that are used for the proportion estimation in each group when the shortcut fitting can be used start with \code{prop_}, and those that are used in the regression framework start with \code{coef_}. In the differential transcript usage analysis, setting \code{one_way = TRUE} allows switching to the shortcut algorithm only if the design is equivalent to simple group fitting. \code{one_way = FALSE} forces usage of the regression framework. In the QTL analysis, currently, genotypes are defined as numeric values 0, 1, and 2. When \code{one_way = TRUE}, simple multiple group fitting is performed. When \code{one_way = FALSE}, a regression framework is used with the design matrix defined by a formula \code{~ group} where group is a continuous (not categorical) variable with values 0, 1, and 2. } \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) plotPrecision(d) head(mean_expression(d)) common_precision(d) head(genewise_precision(d)) ## Fit full model proportions d <- dmFit(d, design = design_full) ## Get fitted proportions head(proportions(d)) ## Get the DM regression coefficients (gene-level) head(coefficients(d)) ## Get the BB regression coefficients (feature-level) head(coefficients(d), level = "feature") } } \references{ McCarthy, DJ, Chen, Y, Smyth, GK (2012). Differential expression analysis of multifactor RNA-Seq experiments with respect to biological variation. Nucleic Acids Research 40, 4288-4297. } \seealso{ \code{\link{plotProportions}} \code{\link[edgeR]{glmFit}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmPrecision.Rd0000644000175100017510000002234414614306666016335 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDSprecision.R, % R/class_dmSQTLprecision.R \docType{methods} \name{dmPrecision} \alias{dmPrecision} \alias{dmPrecision,dmDSdata-method} \alias{dmPrecision,dmSQTLdata-method} \title{Estimate the precision parameter in the Dirichlet-multinomial model} \usage{ dmPrecision(x, ...) \S4method{dmPrecision}{dmDSdata}(x, design, mean_expression = TRUE, common_precision = TRUE, genewise_precision = TRUE, prec_adjust = TRUE, prec_subset = 0.1, prec_interval = c(0, 1000), prec_tol = 10, prec_init = 100, prec_grid_length = 21, prec_grid_range = c(-10, 10), prec_moderation = "trended", prec_prior_df = 0, prec_span = 0.1, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, add_uniform = FALSE, BPPARAM = BiocParallel::SerialParam()) \S4method{dmPrecision}{dmSQTLdata}(x, mean_expression = TRUE, common_precision = TRUE, genewise_precision = TRUE, prec_adjust = TRUE, prec_subset = 0.1, prec_interval = c(0, 1000), prec_tol = 10, prec_init = 100, prec_grid_length = 21, prec_grid_range = c(-10, 10), prec_moderation = "none", prec_prior_df = 0, prec_span = 0.1, one_way = TRUE, speed = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, BPPARAM = BiocParallel::SerialParam()) } \arguments{ \item{x}{\code{\linkS4class{dmDSdata}} or \code{\linkS4class{dmSQTLdata}} object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{design}{Numeric matrix defining the model that should be used when estimating precision. Normally this should be a full model design used also in \code{\link{dmFit}}.} \item{mean_expression}{Logical. Whether to estimate the mean expression of genes.} \item{common_precision}{Logical. Whether to estimate the common precision.} \item{genewise_precision}{Logical. Whether to estimate the gene-wise precision.} \item{prec_adjust}{Logical. Whether to use the Cox-Reid adjusted or non-adjusted profile likelihood.} \item{prec_subset}{Value from 0 to 1 defining the percentage of genes used in common precision estimation. The default is 0.1, which uses 10% of randomly selected genes to speed up the precision estimation process. Use \code{set.seed} function to make the analysis reproducible. See Examples.} \item{prec_interval}{Numeric vector of length 2 defining the interval of possible values for the common precision.} \item{prec_tol}{The desired accuracy when estimating common precision.} \item{prec_init}{Initial precision. If \code{common_precision} is \code{TRUE}, then \code{prec_init} is overwritten by common precision estimate.} \item{prec_grid_length}{Length of the search grid.} \item{prec_grid_range}{Vector giving the limits of grid interval.} \item{prec_moderation}{Precision moderation method. One can choose to shrink the precision estimates toward the common precision (\code{"common"}) or toward the (precision versus mean expression) trend (\code{"trended"})} \item{prec_prior_df}{Degree of moderation (shrinkage) in case when it can not be calculated automaticaly (number of genes on the upper boundary of grid is smaller than 10). By default it is equal to 0.} \item{prec_span}{Value from 0 to 1 defining the percentage of genes used in smoothing sliding window when calculating the precision versus mean expression trend.} \item{one_way}{Logical. Should the shortcut fitting be used when the design corresponds to multiple group comparison. This is a similar approach as in \code{\link{edgeR}}. If \code{TRUE} (the default), then proportions are fitted per group and regression coefficients are recalculated from those fits.} \item{prop_mode}{Optimization method used to estimate proportions. Possible value \code{"constrOptim"}.} \item{prop_tol}{The desired accuracy when estimating proportions.} \item{coef_mode}{Optimization method used to estimate regression coefficients. Possible value \code{"optim"}.} \item{coef_tol}{The desired accuracy when estimating regression coefficients.} \item{verbose}{Numeric. Definie the level of progress messages displayed. 0 - no messages, 1 - main messages, 2 - message for every gene fitting.} \item{add_uniform}{Whether to add a small fractional count to zeros, (adding a uniform random variable between 0 and 0.1). This option allows for the fitting of genewise precision and coefficients for genes with two features having all zero for one group, or the last feature having all zero for one group.} \item{BPPARAM}{Parallelization method used by \code{\link[BiocParallel]{bplapply}}.} \item{speed}{Logical. If \code{FALSE}, precision is calculated per each gene-block. Such calculation may take a long time, since there can be hundreds of SNPs/blocks per gene. If \code{TRUE}, there will be only one precision calculated per gene and it will be assigned to all the blocks matched with this gene.} } \value{ Returns a \code{\linkS4class{dmDSprecision}} or \code{\linkS4class{dmSQTLprecision}} object. } \description{ Maximum likelihood estimates of the precision parameter in the Dirichlet-multinomial model used for the differential exon/transcript usage or QTL analysis. } \details{ Normally, in the differential analysis based on RNA-seq data, such as, for example, differential gene expression, dispersion (of negative-binomial model) is estimated. Here, we estimate precision of the Dirichlet-multinomial model as it is more convenient computationally. To obtain dispersion estimates, one can use a formula: dispersion = 1 / (1 + precision). Parameters that are used in the precision (dispersion = 1 / (1 + precision)) estimation start with prefix \code{prec_}. Those that are used for the proportion estimation in each group when the shortcut fitting \code{one_way = TRUE} can be used start with \code{prop_}, and those that are used in the regression framework start with \code{coef_}. There are two optimization methods implemented within dmPrecision: \code{"optimize"} for the common precision and \code{"grid"} for the gene-wise precision. Only part of the precision parameters in dmPrecision have an influence on a given optimization method. Here is a list of such active parameters: \code{"optimize"}: \itemize{ \item \code{prec_interval}: Passed as \code{interval}. \item \code{prec_tol}: The accuracy defined as \code{tol}. } \code{"grid"}, which uses the grid approach from \code{\link[edgeR]{estimateDisp}} in \code{\link{edgeR}}: \itemize{ \item \code{prec_init}, \code{prec_grid_length}, \code{prec_grid_range}: Parameters used to construct the search grid \code{prec_init * 2^seq(from = prec_grid_range[1]}, \code{to = prec_grid_range[2]}, \code{length = prec_grid_length)}. \item \code{prec_moderation}: Dipsersion shrinkage is available only with \code{"grid"} method. \item \code{prec_prior_df}: Used only when precision shrinkage is activated. Moderated likelihood is equal to \code{loglik + prec_prior_df * moderation}. Higher \code{prec_prior_df}, more shrinkage toward common or trended precision is applied. \item \code{prec_span}: Used only when precision moderation toward trend is activated. } } \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) plotPrecision(d) head(mean_expression(d)) common_precision(d) head(genewise_precision(d)) } } \references{ McCarthy, DJ, Chen, Y, Smyth, GK (2012). Differential expression analysis of multifactor RNA-Seq experiments with respect to biological variation. Nucleic Acids Research 40, 4288-4297. } \seealso{ \code{\link{plotPrecision}} \code{\link[edgeR]{estimateDisp}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmSQTLdata-class.Rd0000644000175100017510000000571614614306666017126 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmSQTLdata.R \docType{class} \name{dmSQTLdata-class} \alias{dmSQTLdata-class} \alias{counts,dmSQTLdata-method} \alias{samples,dmSQTLdata-method} \alias{names,dmSQTLdata-method} \alias{length,dmSQTLdata-method} \alias{[,dmSQTLdata,ANY-method} \alias{[,dmSQTLdata-method} \title{dmSQTLdata object} \usage{ \S4method{counts}{dmSQTLdata}(object) \S4method{samples}{dmSQTLdata}(x) \S4method{names}{dmSQTLdata}(x) \S4method{length}{dmSQTLdata}(x) \S4method{[}{dmSQTLdata,ANY}(x, i, j) } \arguments{ \item{x, object}{dmSQTLdata object.} \item{i, j}{Parameters used for subsetting.} } \value{ \itemize{ \item \code{names(x)}: Get the gene names. \item \code{length(x)}: Get the number of genes. \item \code{x[i, j]}: Get a subset of dmDSdata object that consists of counts, genotypes and blocks corresponding to genes i and samples j. } } \description{ dmSQTLdata contains genomic feature expression (counts), genotypes and sample information needed for the transcript/exon usage QTL analysis. It can be created with function \code{\link{dmSQTLdata}}. } \section{Slots}{ \describe{ \item{\code{counts}}{\code{\linkS4class{MatrixList}} of expression, in counts, of genomic features. Rows correspond to genomic features, such as exons or transcripts. Columns correspond to samples. MatrixList is partitioned in a way that each of the matrices in a list contains counts for a single gene.} \item{\code{genotypes}}{MatrixList of unique genotypes. Rows correspond to blocks, columns to samples. Each matrix in this list is a collection of unique genotypes that are matched with a given gene.} \item{\code{blocks}}{MatrixList with two columns \code{block_id} and \code{snp_id}. For each gene, it identifies SNPs with identical genotypes across the samples and assigns them to blocks.} \item{\code{samples}}{Data frame with information about samples. It must contain variable \code{sample_id} with unique sample names.} }} \examples{ # -------------------------------------------------------------------------- # Create dmSQTLdata object # -------------------------------------------------------------------------- # Use subsets of data defined in the GeuvadisTranscriptExpr package library(GeuvadisTranscriptExpr) \donttest{ geuv_counts <- GeuvadisTranscriptExpr::counts geuv_genotypes <- GeuvadisTranscriptExpr::genotypes geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") colnames(geuv_genotypes)[4] <- "snp_id" geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, samples = geuv_samples, window = 5e3) } } \seealso{ \code{\linkS4class{dmSQTLprecision}}, \code{\linkS4class{dmSQTLfit}}, \code{\linkS4class{dmSQTLtest}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmSQTLdata.Rd0000644000175100017510000000661414614306666016021 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmSQTLdata.R \name{dmSQTLdata} \alias{dmSQTLdata} \title{Create dmSQTLdata object} \usage{ dmSQTLdata(counts, gene_ranges, genotypes, snp_ranges, samples, window = 5000, BPPARAM = BiocParallel::SerialParam()) } \arguments{ \item{counts}{Data frame with counts. Rows correspond to features, for example, transcripts or exons. This data frame has to contain a \code{gene_id} column with gene IDs, \code{feature_id} column with feature IDs and columns with counts for each sample. Column names corresponding to sample IDs must be the same as in the \code{sample} data frame.} \item{gene_ranges}{\code{\linkS4class{GRanges}} object with gene location. It must contain gene names when calling names().} \item{genotypes}{Data frame with genotypes. Rows correspond to SNPs. This data frame has to contain a \code{snp_id} column with SNP IDs and columns with genotypes for each sample. Column names corresponding to sample IDs must be the same as in the \code{sample} data frame. The genotype of each sample is coded in the following way: 0 for ref/ref, 1 for ref/not ref, 2 for not ref/not ref, -1 or \code{NA} for missing value.} \item{snp_ranges}{\code{\linkS4class{GRanges}} object with SNP location. It must contain SNP names when calling names().} \item{samples}{Data frame with column \code{sample_id} corresponding to unique sample IDs} \item{window}{Size of a down and up stream window, which is defining the surrounding for a gene. Only SNPs that are located within a gene or its surrounding are considered in the sQTL analysis.} \item{BPPARAM}{Parallelization method used by \code{\link[BiocParallel]{bplapply}}.} } \value{ Returns a \code{\linkS4class{dmSQTLdata}} object. } \description{ Constructor functions for a \code{\linkS4class{dmSQTLdata}} object. dmSQTLdata assignes to a gene all the SNPs that are located in a given surrounding (\code{window}) of this gene. } \details{ It is quite common that sample grouping defined by some of the SNPs is identical. Compare \code{dim(genotypes)} and \code{dim(unique(genotypes))}. In our QTL analysis, we do not repeat tests for the SNPs that define the same grouping of samples. Each grouping is tested only once. SNPs that define such unique groupings are aggregated into blocks. P-values and adjusted p-values are estimated at the block level, but the returned results are extended to a SNP level by repeating the block statistics for each SNP that belongs to a given block. } \examples{ # -------------------------------------------------------------------------- # Create dmSQTLdata object # -------------------------------------------------------------------------- # Use subsets of data defined in the GeuvadisTranscriptExpr package library(GeuvadisTranscriptExpr) \donttest{ geuv_counts <- GeuvadisTranscriptExpr::counts geuv_genotypes <- GeuvadisTranscriptExpr::genotypes geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") colnames(geuv_genotypes)[4] <- "snp_id" geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, samples = geuv_samples, window = 5e3) } } \seealso{ \code{\link{plotData}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmSQTLfit-class.Rd0000644000175100017510000000502614614306666016771 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmSQTLfit.R \docType{class} \name{dmSQTLfit-class} \alias{dmSQTLfit-class} \title{dmSQTLfit object} \description{ dmSQTLfit extends the \code{\linkS4class{dmSQTLprecision}} class by adding the full model Dirichlet-multinomial (DM) likelihoods, regression coefficients and feature proportion estimates needed for the transcript/exon usage QTL analysis. Full model is defined by the genotype of a SNP associated with a gene. Estimation takes place for all the genes and all the SNPs/blocks assigned to the genes. Result of \code{\link{dmFit}}. } \section{Slots}{ \describe{ \item{\code{fit_full}}{List of \code{\linkS4class{MatrixList}} objects containing estimated feature ratios in each sample based on the full Dirichlet-multinomial (DM) model.} \item{\code{lik_full}}{List of numeric vectors of the per gene DM full model likelihoods.} \item{\code{coef_full}}{\code{\linkS4class{MatrixList}} with the regression coefficients based on the DM model.} }} \examples{ # -------------------------------------------------------------------------- # Create dmSQTLdata object # -------------------------------------------------------------------------- # Use subsets of data defined in the GeuvadisTranscriptExpr package library(GeuvadisTranscriptExpr) \donttest{ geuv_counts <- GeuvadisTranscriptExpr::counts geuv_genotypes <- GeuvadisTranscriptExpr::genotypes geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") colnames(geuv_genotypes)[4] <- "snp_id" geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, samples = geuv_samples, window = 5e3) # -------------------------------------------------------------------------- # sQTL analysis - simple group comparison # -------------------------------------------------------------------------- ## Filtering d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d) plotPrecision(d) ## Fit full model proportions d <- dmFit(d) } } \seealso{ \code{\linkS4class{dmSQTLdata}}, \code{\linkS4class{dmSQTLprecision}}, \code{\linkS4class{dmSQTLtest}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmSQTLprecision-class.Rd0000644000175100017510000000560514614306666020205 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmSQTLprecision.R \docType{class} \name{dmSQTLprecision-class} \alias{dmSQTLprecision-class} \alias{mean_expression,dmSQTLprecision-method} \alias{common_precision,dmSQTLprecision-method} \alias{genewise_precision,dmSQTLprecision-method} \title{dmSQTLprecision object} \usage{ \S4method{mean_expression}{dmSQTLprecision}(x) \S4method{common_precision}{dmSQTLprecision}(x) \S4method{genewise_precision}{dmSQTLprecision}(x) } \arguments{ \item{x}{dmSQTLprecision object.} } \value{ \itemize{ \item \code{mean_expression(x)}: Get a data frame with mean gene expression. \item \code{common_precision(x)}: Get common precision. \item \code{genewise_precision(x)}: Get a data frame with gene-wise precision.} } \description{ dmSQTLprecision extends the \code{\linkS4class{dmSQTLdata}} by adding the precision estimates of Dirichlet-multinomial distribution used to model the feature (e.g., transcript, exon, exonic bin) counts for each gene-SNP pair in the QTL analysis. Result of \code{\link{dmPrecision}}. } \section{Slots}{ \describe{ \item{\code{mean_expression}}{Numeric vector of mean gene expression.} \item{\code{common_precision}}{Numeric value of estimated common precision.} \item{\code{genewise_precision}}{List of estimated gene-wise precisions. Each element of this list is a vector of precisions estimated for all the genotype blocks assigned to a given gene.} }} \examples{ # -------------------------------------------------------------------------- # Create dmSQTLdata object # -------------------------------------------------------------------------- # Use subsets of data defined in the GeuvadisTranscriptExpr package library(GeuvadisTranscriptExpr) \donttest{ geuv_counts <- GeuvadisTranscriptExpr::counts geuv_genotypes <- GeuvadisTranscriptExpr::genotypes geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") colnames(geuv_genotypes)[4] <- "snp_id" geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, samples = geuv_samples, window = 5e3) # -------------------------------------------------------------------------- # sQTL analysis - simple group comparison # -------------------------------------------------------------------------- ## Filtering d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d) plotPrecision(d) } } \seealso{ \code{\linkS4class{dmSQTLdata}}, \code{\linkS4class{dmSQTLfit}}, \code{\linkS4class{dmSQTLtest}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmSQTLtest-class.Rd0000644000175100017510000000567514614306666017200 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmSQTLtest.R \docType{class} \name{dmSQTLtest-class} \alias{dmSQTLtest-class} \alias{results,dmSQTLtest-method} \title{dmSQTLtest object} \usage{ \S4method{results}{dmSQTLtest}(x) } \arguments{ \item{x}{dmSQTLtest object.} \item{...}{Other parameters that can be defined by methods using this generic.} } \value{ \itemize{ \item \code{results(x)}: Get a data frame with gene-level results. } } \description{ dmSQTLtest extends the \code{\linkS4class{dmSQTLfit}} class by adding the null model Dirichlet-multinomial likelihoods and the gene-level results of testing for differential transcript/exon usage QTLs. Result of \code{\link{dmTest}}. } \section{Slots}{ \describe{ \item{\code{lik_null}}{List of numeric vectors with the per gene-snp DM null model likelihoods.} \item{\code{results_gene}}{Data frame with the gene-level results including: \code{gene_id} - gene IDs, \code{block_id} - block IDs, \code{snp_id} - SNP IDs, \code{lr} - likelihood ratio statistics based on the DM model, \code{df} - degrees of freedom, \code{pvalue} - p-values estimated based on permutations and \code{adj_pvalue} - Benjamini & Hochberg adjusted p-values.} }} \examples{ # -------------------------------------------------------------------------- # Create dmSQTLdata object # -------------------------------------------------------------------------- # Use subsets of data defined in the GeuvadisTranscriptExpr package library(GeuvadisTranscriptExpr) geuv_counts <- GeuvadisTranscriptExpr::counts geuv_genotypes <- GeuvadisTranscriptExpr::genotypes geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") colnames(geuv_genotypes)[4] <- "snp_id" geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, samples = geuv_samples, window = 5e3) # -------------------------------------------------------------------------- # sQTL analysis - simple group comparison # -------------------------------------------------------------------------- ## Filtering d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d) plotPrecision(d) ## Fit full model proportions d <- dmFit(d) ## Fit null model proportions, perform the LR test to detect tuQTLs ## and use the permutation approach to adjust the p-values d <- dmTest(d) ## Plot the gene-level p-values plotPValues(d) ## Get the gene-level results head(results(d)) } \seealso{ \code{\linkS4class{dmSQTLdata}}, \code{\linkS4class{dmSQTLprecision}}, \code{\linkS4class{dmSQTLfit}} } \author{ Malgorzata Nowicka } DRIMSeq/man/dmTest.Rd0000644000175100017510000001553214614306666015322 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDStest.R, R/class_dmSQTLtest.R \docType{methods} \name{dmTest} \alias{dmTest} \alias{dmTest,dmDSfit-method} \alias{dmTest,dmSQTLfit-method} \title{Likelihood ratio test to detect differential transcript/exon usage} \usage{ dmTest(x, ...) \S4method{dmTest}{dmDSfit}(x, coef = NULL, design = NULL, contrast = NULL, one_way = TRUE, bb_model = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, BPPARAM = BiocParallel::SerialParam()) \S4method{dmTest}{dmSQTLfit}(x, permutation_mode = "all_genes", one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, BPPARAM = BiocParallel::SerialParam()) } \arguments{ \item{x}{\code{\linkS4class{dmDSfit}} or \code{\linkS4class{dmSQTLfit}} object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{coef}{Integer or character vector indicating which coefficients of the linear model are to be tested equal to zero. Values must indicate column numbers or column names of the \code{design} used in \code{\link{dmFit}}.} \item{design}{Numeric matrix defining the null model.} \item{contrast}{Numeric vector or matrix specifying one or more contrasts of the linear model coefficients to be tested equal to zero. For a matrix, number of rows (for a vector, its length) must equal to the number of columns of \code{design} used in \code{\link{dmFit}}.} \item{one_way}{Logical. Should the shortcut fitting be used when the design corresponds to multiple group comparison. This is a similar approach as in \code{\link{edgeR}}. If \code{TRUE} (the default), then proportions are fitted per group and regression coefficients are recalculated from those fits.} \item{bb_model}{Logical. Whether to perform the feature-level analysis using the beta-binomial model.} \item{prop_mode}{Optimization method used to estimate proportions. Possible value \code{"constrOptim"}.} \item{prop_tol}{The desired accuracy when estimating proportions.} \item{coef_mode}{Optimization method used to estimate regression coefficients. Possible value \code{"optim"}.} \item{coef_tol}{The desired accuracy when estimating regression coefficients.} \item{verbose}{Numeric. Definie the level of progress messages displayed. 0 - no messages, 1 - main messages, 2 - message for every gene fitting.} \item{BPPARAM}{Parallelization method used by \code{\link[BiocParallel]{bplapply}}.} \item{permutation_mode}{Character specifying which permutation scheme to apply for p-value calculation. When equal to \code{"all_genes"}, null distribution of p-values is calculated from all genes and the maximum number of permutation cycles is 10. When \code{permutation_mode = "per_gene"}, null distribution of p-values is calculated for each gene separately based on permutations of this individual gene. The latter approach may take a lot of computational time. We suggest using the first option.} } \value{ Returns a \code{\linkS4class{dmDStest}} or \code{\linkS4class{dmSQTLtest}} object. } \description{ First, estimate the null Dirichlet-multinomial and beta-binomial model parameters and likelihoods using the null model design. Second, perform the gene-level (DM model) and feature-level (BB model) likelihood ratio tests. In the differential exon/transcript usage analysis, the null model is defined by the null design matrix. In the exon/transcript usage QTL analysis, null models are defined by a design with intercept only. Currently, beta-binomial model is implemented only in the differential usage analysis. } \details{ One must specify one of the arguments: \code{coef}, \code{design} or \code{contrast}. When \code{contrast} is used to define the null model, the null design matrix is recalculated using the same approach as in \code{\link[edgeR]{glmLRT}} function from \code{\link{edgeR}}. } \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) plotPrecision(d) head(mean_expression(d)) common_precision(d) head(genewise_precision(d)) ## Fit full model proportions d <- dmFit(d, design = design_full) ## Get fitted proportions head(proportions(d)) ## Get the DM regression coefficients (gene-level) head(coefficients(d)) ## Get the BB regression coefficients (feature-level) head(coefficients(d), level = "feature") ## Fit null model proportions and perform the LR test to detect DTU d <- dmTest(d, coef = "groupKD") ## Plot the gene-level p-values plotPValues(d) ## Get the gene-level results head(results(d)) ## Plot feature proportions for a top DTU gene res <- results(d) res <- res[order(res$pvalue, decreasing = FALSE), ] top_gene_id <- res$gene_id[1] plotProportions(d, gene_id = top_gene_id, group_variable = "group") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "lineplot") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "ribbonplot") } } \references{ McCarthy, DJ, Chen, Y, Smyth, GK (2012). Differential expression analysis of multifactor RNA-Seq experiments with respect to biological variation. Nucleic Acids Research 40, 4288-4297. } \seealso{ \code{\link{plotPValues}} \code{\link[edgeR]{glmLRT}} } \author{ Malgorzata Nowicka } DRIMSeq/man/MatrixList-class.Rd0000644000175100017510000000535314614306666017265 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_MatrixList.R \docType{class} \name{MatrixList-class} \alias{MatrixList-class} \alias{names,MatrixList-method} \alias{names<-,MatrixList-method} \alias{rownames,MatrixList-method} \alias{rownames<-,MatrixList-method} \alias{colnames,MatrixList-method} \alias{colnames<-,MatrixList-method} \alias{length,MatrixList-method} \alias{elementNROWS,MatrixList-method} \alias{dim,MatrixList-method} \alias{nrow,MatrixList-method} \alias{ncol,MatrixList-method} \alias{[[,MatrixList-method} \alias{$,MatrixList-method} \alias{[,MatrixList,ANY-method} \alias{[,MatrixList-method} \title{MatrixList object} \usage{ \S4method{names}{MatrixList}(x) \S4method{names}{MatrixList}(x) <- value \S4method{rownames}{MatrixList}(x) \S4method{rownames}{MatrixList}(x) <- value \S4method{colnames}{MatrixList}(x) \S4method{colnames}{MatrixList}(x) <- value \S4method{length}{MatrixList}(x) \S4method{elementNROWS}{MatrixList}(x) \S4method{dim}{MatrixList}(x) \S4method{nrow}{MatrixList}(x) \S4method{ncol}{MatrixList}(x) \S4method{[[}{MatrixList}(x, i, j) \S4method{$}{MatrixList}(x, name) \S4method{[}{MatrixList,ANY}(x, i, j) } \arguments{ \item{x}{MatrixList object.} \item{value, i, j, name}{Parameters used for subsetting and assigning new attributes to x.} } \value{ \itemize{ \item \code{names(x)}, \code{names(x) <- value}: Get or set names of matrices. \item \code{rownames(x)}, \code{rownames(x) <- value}, \code{colnames(x)}, \code{colnames(x) <- value}: Get or set row names or column names of unlistData slot. \item \code{length(x)}: Get the number of matrices in a list. \item \code{elementNROWS(x)}: Get the number of rows of each of the matrices. \item \code{dim(x)}, \code{nrow(x)}, \code{ncol(x)}: Get the dimensions, number of rows or number of columns of unlistData slot. \item \code{x[[i]]}, \code{x[[i, j]]}: Get the matrix i, and optionally, get only columns j of this matrix. \item \code{x$name}: Shortcut for \code{x[["name"]]}. \item \code{x[i, j]}: Get a subset of MatrixList that consists of matrices i with columns j. } } \description{ A MatrixList object is a container for a list of matrices which have the same number of columns but can have varying number of rows. Additionally, one can store an extra information corresponding to each of the matrices in \code{metadata} matrix. } \section{Slots}{ \describe{ \item{\code{unlistData}}{Matrix which is a row binding of all the matrices in a list.} \item{\code{partitioning}}{List of indexes which defines the row partitioning of unlistData matrix into the original matrices.} \item{\code{metadata}}{Matrix of additional information where each row corresponds to one of the matrices in a list.} }} \author{ Malgorzata Nowicka } DRIMSeq/man/plotData.Rd0000644000175100017510000000755014614306666015633 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDSdata.R, R/class_dmSQTLdata.R \docType{methods} \name{plotData} \alias{plotData} \alias{plotData,dmDSdata-method} \alias{plotData,dmSQTLdata-method} \title{Plot data summary} \usage{ plotData(x, ...) \S4method{plotData}{dmDSdata}(x) \S4method{plotData}{dmSQTLdata}(x, plot_type = "features") } \arguments{ \item{x}{\code{\linkS4class{dmDSdata}} or \code{\linkS4class{dmSQTLdata}} object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{plot_type}{Character specifying which type of histogram to plot. Possible values \code{"features"}, \code{"snps"} or \code{"blocks"}.} } \value{ Returns a \code{ggplot} object and can be further modified, for example, using \code{theme()}. Plots a histogram of the number of features per gene. Additionally, for \code{\linkS4class{dmSQTLdata}} object, plots a histogram of the number of SNPs per gene and a histogram of the number of unique SNPs (blocks) per gene. } \description{ Plot data summary } \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) } # -------------------------------------------------------------------------- # Create dmSQTLdata object # -------------------------------------------------------------------------- # Use subsets of data defined in the GeuvadisTranscriptExpr package library(GeuvadisTranscriptExpr) \donttest{ geuv_counts <- GeuvadisTranscriptExpr::counts geuv_genotypes <- GeuvadisTranscriptExpr::genotypes geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") colnames(geuv_genotypes)[4] <- "snp_id" geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, samples = geuv_samples, window = 5e3) # -------------------------------------------------------------------------- # sQTL analysis - simple group comparison # -------------------------------------------------------------------------- ## Filtering d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) plotData(d) } } \seealso{ \code{\link{plotPrecision}}, \code{\link{plotProportions}}, \code{\link{plotPValues}} } \author{ Malgorzata Nowicka } DRIMSeq/man/plotPrecision.Rd0000644000175100017510000000620114614306666016705 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDSprecision.R, % R/class_dmSQTLprecision.R \docType{methods} \name{plotPrecision} \alias{plotPrecision} \alias{plotPrecision,dmDSprecision-method} \alias{plotPrecision,dmSQTLprecision-method} \title{Precision versus mean expression plot} \usage{ plotPrecision(x, ...) \S4method{plotPrecision}{dmDSprecision}(x) \S4method{plotPrecision}{dmSQTLprecision}(x) } \arguments{ \item{x}{\code{\linkS4class{dmDSprecision}} or \code{\linkS4class{dmSQTLprecision}} object.} \item{...}{Other parameters that can be defined by methods using this generic.} } \value{ Normally in the differential analysis based on RNA-seq data, such plot has dispersion parameter plotted on the y-axis. Here, the y-axis represents precision since in the Dirichlet-multinomial model this is the parameter that is directly estimated. It is important to keep in mind that the precision parameter (gamma0) is inverse proportional to dispersion (theta): theta = 1 / (1 + gamma0). In RNA-seq data, we can typically observe a trend where the dispersion decreases (here, precision increases) for genes with higher mean expression. } \description{ Precision versus mean expression plot } \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) plotPrecision(d) head(mean_expression(d)) common_precision(d) head(genewise_precision(d)) } } \seealso{ \code{\link{plotData}}, \code{\link{plotProportions}}, \code{\link{plotPValues}} } \author{ Malgorzata Nowicka } DRIMSeq/man/plotProportions.Rd0000644000175100017510000001263114614306666017314 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDSfit.R, R/class_dmSQTLfit.R \docType{methods} \name{plotProportions} \alias{plotProportions} \alias{plotProportions,dmDSfit-method} \alias{plotProportions,dmSQTLfit-method} \title{Plot feature proportions} \usage{ plotProportions(x, ...) \S4method{plotProportions}{dmDSfit}(x, gene_id, group_variable, plot_type = "barplot", order_features = TRUE, order_samples = TRUE, plot_fit = TRUE, plot_main = TRUE, group_colors = NULL, feature_colors = NULL) \S4method{plotProportions}{dmSQTLfit}(x, gene_id, snp_id, plot_type = "boxplot1", order_features = TRUE, order_samples = TRUE, plot_fit = FALSE, plot_main = TRUE, group_colors = NULL, feature_colors = NULL) } \arguments{ \item{x}{\code{\linkS4class{dmDSfit}}, \code{\linkS4class{dmDStest}} or \code{\linkS4class{dmSQTLfit}}, \code{\linkS4class{dmSQTLtest}} object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{gene_id}{Character indicating a gene ID to be plotted.} \item{group_variable}{Character indicating the grouping variable which is one of the columns in the \code{samples} slot of \code{x}.} \item{plot_type}{Character defining the type of the plot produced. Possible values \code{"barplot"}, \code{"boxplot1"}, \code{"boxplot2"}, \code{"lineplot"}, \code{"ribbonplot"}.} \item{order_features}{Logical. Whether to plot the features ordered by their expression.} \item{order_samples}{Logical. Whether to plot the samples ordered by the group variable. If \code{FALSE} order from the \code{sample(x)} is kept.} \item{plot_fit}{Logical. Whether to plot the proportions estimated by the full model.} \item{plot_main}{Logical. Whether to plot a title with the information about the Dirichlet-multinomial estimates.} \item{group_colors}{Character vector with colors for each group defined by \code{group_variable}.} \item{feature_colors}{Character vector with colors for each feature of gene defined by \code{gene_id}.} \item{snp_id}{Character indicating the ID of a SNP to be plotted.} } \value{ For a given gene, plot the observed and estimated with Dirichlet-multinomial model feature proportions in each group. Estimated group proportions are marked with diamond shapes. } \description{ This plot is available only for a group design, i.e., a design that is equivalent to multiple group fitting. } \details{ In the QTL analysis, plotting of fitted proportions is deactivated even when \code{plot_fit = TRUE}. It is due to the fact that neither fitted values nor regression coefficients are returned by the \code{dmFit} function as they occupy a lot of memory. } \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) plotPrecision(d) head(mean_expression(d)) common_precision(d) head(genewise_precision(d)) ## Fit full model proportions d <- dmFit(d, design = design_full) ## Get fitted proportions head(proportions(d)) ## Get the DM regression coefficients (gene-level) head(coefficients(d)) ## Get the BB regression coefficients (feature-level) head(coefficients(d), level = "feature") ## Fit null model proportions and perform the LR test to detect DTU d <- dmTest(d, coef = "groupKD") ## Plot the gene-level p-values plotPValues(d) ## Get the gene-level results head(results(d)) ## Plot feature proportions for a top DTU gene res <- results(d) res <- res[order(res$pvalue, decreasing = FALSE), ] top_gene_id <- res$gene_id[1] plotProportions(d, gene_id = top_gene_id, group_variable = "group") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "lineplot") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "ribbonplot") } } \seealso{ \code{\link{plotData}}, \code{\link{plotPrecision}}, \code{\link{plotPValues}} } \author{ Malgorzata Nowicka } DRIMSeq/man/plotPValues.Rd0000644000175100017510000000705014614306666016334 0ustar00biocbuildbiocbuild% Generated by roxygen2: do not edit by hand % Please edit documentation in R/class_dmDStest.R, R/class_dmSQTLtest.R \docType{methods} \name{plotPValues} \alias{plotPValues} \alias{plotPValues,dmDStest-method} \alias{plotPValues,dmSQTLtest-method} \title{Plot p-value distribution} \usage{ plotPValues(x, ...) \S4method{plotPValues}{dmDStest}(x, level = "gene") \S4method{plotPValues}{dmSQTLtest}(x) } \arguments{ \item{x}{\code{\linkS4class{dmDStest}} or \code{\linkS4class{dmSQTLtest}} object.} \item{...}{Other parameters that can be defined by methods using this generic.} \item{level}{Character specifying which type of results to return. Possible values \code{"gene"} or \code{"feature"}.} } \value{ Plot a histogram of p-values. } \description{ Plot p-value distribution } \examples{ # -------------------------------------------------------------------------- # Create dmDSdata object # -------------------------------------------------------------------------- ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package library(PasillaTranscriptExpr) \donttest{ data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) ## Create a pasilla_samples data frame pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) ## Create a dmDSdata object d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) ## Use a subset of genes, which is defined in the following file gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) \%in\% gene_id_subset, ] # -------------------------------------------------------------------------- # Differential transcript usage analysis - simple two group comparison # -------------------------------------------------------------------------- ## Filtering ## Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) plotData(d) ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) plotPrecision(d) head(mean_expression(d)) common_precision(d) head(genewise_precision(d)) ## Fit full model proportions d <- dmFit(d, design = design_full) ## Get fitted proportions head(proportions(d)) ## Get the DM regression coefficients (gene-level) head(coefficients(d)) ## Get the BB regression coefficients (feature-level) head(coefficients(d), level = "feature") ## Fit null model proportions and perform the LR test to detect DTU d <- dmTest(d, coef = "groupKD") ## Plot the gene-level p-values plotPValues(d) ## Get the gene-level results head(results(d)) ## Plot feature proportions for a top DTU gene res <- results(d) res <- res[order(res$pvalue, decreasing = FALSE), ] top_gene_id <- res$gene_id[1] plotProportions(d, gene_id = top_gene_id, group_variable = "group") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "lineplot") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "ribbonplot") } } \seealso{ \code{\link{plotData}}, \code{\link{plotPrecision}}, \code{\link{plotProportions}} } \author{ Malgorzata Nowicka } DRIMSeq/NAMESPACE0000644000175100017510000000567114614306665014241 0ustar00biocbuildbiocbuild# Generated by roxygen2: do not edit by hand export("common_precision<-") export("genewise_precision<-") export(common_precision) export(dmDSdata) export(dmFilter) export(dmFit) export(dmPrecision) export(dmSQTLdata) export(dmTest) export(genewise_precision) export(mean_expression) export(plotData) export(plotPValues) export(plotPrecision) export(plotProportions) export(proportions) export(results) export(samples) exportMethods("$") exportMethods("[") exportMethods("[[") exportMethods("colnames<-") exportMethods("common_precision<-") exportMethods("genewise_precision<-") exportMethods("names<-") exportMethods("rownames<-") exportMethods(coefficients) exportMethods(colnames) exportMethods(common_precision) exportMethods(counts) exportMethods(design) exportMethods(dim) exportMethods(dmFilter) exportMethods(dmFit) exportMethods(dmPrecision) exportMethods(dmTest) exportMethods(elementNROWS) exportMethods(genewise_precision) exportMethods(length) exportMethods(mean_expression) exportMethods(names) exportMethods(ncol) exportMethods(nrow) exportMethods(plotData) exportMethods(plotPValues) exportMethods(plotPrecision) exportMethods(plotProportions) exportMethods(proportions) exportMethods(results) exportMethods(rownames) exportMethods(samples) import(BiocGenerics) import(BiocParallel) import(GenomicRanges) import(edgeR) import(methods) importFrom(IRanges,width) importFrom(S4Vectors,elementNROWS) importFrom(S4Vectors,queryHits) importFrom(S4Vectors,subjectHits) importFrom(ggplot2,aes_string) importFrom(ggplot2,coord_cartesian) importFrom(ggplot2,element_blank) importFrom(ggplot2,element_text) importFrom(ggplot2,geom_bar) importFrom(ggplot2,geom_boxplot) importFrom(ggplot2,geom_histogram) importFrom(ggplot2,geom_hline) importFrom(ggplot2,geom_jitter) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_ribbon) importFrom(ggplot2,geom_text) importFrom(ggplot2,geom_vline) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggtitle) importFrom(ggplot2,guide_colorbar) importFrom(ggplot2,guide_legend) importFrom(ggplot2,guides) importFrom(ggplot2,position_dodge) importFrom(ggplot2,position_jitterdodge) importFrom(ggplot2,scale_colour_gradient) importFrom(ggplot2,scale_colour_manual) importFrom(ggplot2,scale_fill_manual) importFrom(ggplot2,scale_x_discrete) importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) importFrom(ggplot2,xlab) importFrom(ggplot2,ylab) importFrom(limma,nonEstimable) importFrom(reshape2,melt) importFrom(stats,aggregate) importFrom(stats,complete.cases) importFrom(stats,constrOptim) importFrom(stats,loess) importFrom(stats,loess.control) importFrom(stats,median) importFrom(stats,model.matrix) importFrom(stats,na.omit) importFrom(stats,nlm) importFrom(stats,nlminb) importFrom(stats,optim) importFrom(stats,optimHess) importFrom(stats,optimize) importFrom(stats,p.adjust) importFrom(stats,pchisq) importFrom(stats,predict) importFrom(stats,quantile) importFrom(stats,runif) importFrom(utils,head) importFrom(utils,tail) DRIMSeq/NEWS0000755000175100017510000000324514614306665013517 0ustar00biocbuildbiocbuildv0.99.0: - Bioconductor submission. v1.1.2: - Bioconductor accepted devel version. v1.1.3: - New features: i) The level of moderation is calculated automatically. ii) Permutation approach to adjust p-values in sQTL analyses. v1.1.4: - Use data frames with counts and genotypes when creating the dmDSdata and dmSQTLdata objects. v1.3.1: - Equals to v1.1.4. v1.3.2: - Implementation of the two-stage test dmTwoStageTest(). v1.3.3: - Implementation of the regression framework and feature-level analysis. Additionally: i) Removing max_features argument from dmFilter. ii) Keeping only the grid approach for estimating tagwise dispersion. iii) Allow to use only a subset of genes (disp_subset parameter) in common dispersion estimation to speed up the calculations; if disp_subset < 1, use set.seed() to make the analysis reproducible. iv) Always use tagwise dispersion for fitting full and null models. v) In one group fitting, return NA for tags having the last feature with zero counts in all samples. We always use the q-th feature as a denominator in logit calculation. In such a case all the logits are anyways Inf. vi) Use plotPValues instead of plotTest vii) Use 'prop' instead of 'pi' and 'disp' instead of 'gamma0'. viii) Use only 'constrOptim' (old 'constrOptimG') to estimate proportions and 'optim' to estimate coefficients in the regression model. ix) Use plotProportions instead of plotFit. x) No 'out_dir' parameter in plotting functions. All plotting functions return a ggplot object. xi) Use term "precision" instead of "dispersion" as in DRIMSeq we directly estimate the precision parameter. Dispersion can be calculated with formula: dispersion = 1 / (1 + precision).DRIMSeq/R/0000755000175100017510000000000014614306665013212 5ustar00biocbuildbiocbuildDRIMSeq/R/class_dmDSdata.R0000644000175100017510000004355314614306665016215 0ustar00biocbuildbiocbuild#' @include class_MatrixList.R NULL ############################################################################### ### dmDSdata class ############################################################################### #' dmDSdata object #' #' dmDSdata contains expression, in counts, of genomic features such as exons or #' transcripts and sample information needed for the differential #' exon/transcript usage (DEU or DTU) analysis. It can be created with function #' \code{\link{dmDSdata}}. #' #' @return #' #' \itemize{ \item \code{counts(object)}: Get a data frame with counts. \item #' \code{samples(x)}: Get a data frame with the sample information. \item #' \code{names(x)}: Get the gene names. \item \code{length(x)}: Get the number #' of genes. \item \code{x[i, j]}: Get a subset of dmDSdata object that consists #' of counts for genes i and samples j. } #' #' @param object,x dmDSdata object. #' @param i,j Parameters used for subsetting. #' @param ... Other parameters that can be defined by methods using this #' generic. #' #' @slot counts \code{\linkS4class{MatrixList}} of expression, in counts, of #' genomic features. Rows correspond to genomic features, such as exons or #' transcripts. Columns correspond to samples. MatrixList is partitioned in a #' way that each of the matrices in a list contains counts for a single gene. #' @slot samples Data frame with information about samples. It must contain #' \code{sample_id} variable with unique sample names and other covariates #' that desribe samples and are needed for the differential analysis. #' #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' } #' @author Malgorzata Nowicka #' @seealso \code{\linkS4class{dmDSprecision}}, \code{\linkS4class{dmDSfit}}, #' \code{\linkS4class{dmDStest}} setClass("dmDSdata", representation(counts = "MatrixList", samples = "data.frame")) ############################### setValidity("dmDSdata", function(object){ # has to return TRUE when valid object! if(!ncol(object@counts) == nrow(object@samples)) return(paste0("Unequal number of samples in 'counts' and 'samples' ", ncol(object@counts), " and ", nrow(object@samples), "!")) if(!all(c("sample_id") %in% colnames(object@samples))) return("'samples' must contain 'sample_id' variable!") if(!length(unique(object@samples$sample_id)) == nrow(object@samples)) return("There must be a unique 'sample_id' for each sample!") if(!all(colnames(object@counts) == object@samples$sample_id)) return("Column names of 'counts' must be the same as 'sample_id' in 'samples'!") return(TRUE) }) ############################################################################### ### show, accessing and subsetting methods ############################################################################### #' @rdname dmDSdata-class #' @export setMethod("counts", "dmDSdata", function(object){ data.frame(gene_id = rep(names(object@counts), elementNROWS(object@counts)), feature_id = rownames(object@counts), object@counts@unlistData, stringsAsFactors = FALSE, row.names = NULL) }) #' @rdname dmDSdata-class #' @export setGeneric("samples", function(x, ...) standardGeneric("samples")) #' @rdname dmDSdata-class #' @export setMethod("samples", "dmDSdata", function(x) x@samples ) ################################ setMethod("show", "dmDSdata", function(object){ cat("An object of class", class(object), "\n") cat("with", length(object), "genes and", ncol(object@counts), "samples\n") cat("* data accessors: counts(), samples()\n") }) ################################ #' @rdname dmDSdata-class #' @export setMethod("names", "dmDSdata", function(x) names(x@counts) ) #' @rdname dmDSdata-class #' @export setMethod("length", "dmDSdata", function(x) length(x@counts) ) #' @aliases [,dmDSdata-method [,dmDSdata,ANY-method #' @rdname dmDSdata-class #' @export setMethod("[", "dmDSdata", function(x, i, j){ if(missing(j)){ counts <- x@counts[i, , drop = FALSE] samples <- x@samples }else{ if(missing(i)){ counts <- x@counts[, j, drop = FALSE] }else{ counts <- x@counts[i, j, drop = FALSE] } samples <- x@samples rownames(samples) <- samples$sample_id samples <- samples[j, , drop = FALSE] # Drop unused levels for factors for(i in 1:ncol(samples)){ if(class(samples[, i]) == "factor") samples[, i] <- factor(samples[, i]) } rownames(samples) <- NULL } return(new("dmDSdata", counts = counts, samples = samples)) }) ############################################################################### ### dmDSdata ############################################################################### #' Create dmDSdata object #' #' Constructor function for a \code{\linkS4class{dmDSdata}} object. #' #' @param counts Data frame with counts. Rows correspond to features, for #' example, transcripts or exons. This data frame has to contain a #' \code{gene_id} column with gene IDs, \code{feature_id} column with feature #' IDs and columns with counts for each sample. Column names corresponding to #' sample IDs must be the same as in the \code{sample} data frame. #' @param samples Data frame where each row corresponds to one sample. Columns #' have to contain unique sample IDs in \code{sample_id} variable and a #' grouping variable \code{group}. #' @return Returns a \linkS4class{dmDSdata} object. #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' } #' @seealso \code{\link{plotData}} #' @author Malgorzata Nowicka #' @export dmDSdata <- function(counts, samples){ ### Check on samples stopifnot(class(samples) == "data.frame") stopifnot("sample_id" %in% colnames(samples)) stopifnot(sum(duplicated(samples$sample_id)) == 0) ### Check on counts stopifnot(class(counts) == "data.frame") stopifnot(all(c("gene_id", "feature_id") %in% colnames(counts))) stopifnot(all(samples$sample_id %in% colnames(counts))) stopifnot(sum(duplicated(counts$feature_id)) == 0) gene_id <- counts$gene_id feature_id <- counts$feature_id stopifnot(class(gene_id) %in% c("character", "factor")) stopifnot(class(feature_id) %in% c("character", "factor")) stopifnot(class(samples$sample_id) %in% c("character", "factor")) stopifnot(all(!is.na(gene_id))) stopifnot(all(!is.na(feature_id))) stopifnot(all(!is.na(samples$sample_id))) counts <- counts[, as.character(samples$sample_id), drop = FALSE] counts <- as.matrix(counts) stopifnot(mode(counts) %in% "numeric") if(class(gene_id) == "character") gene_id <- factor(gene_id, levels = unique(gene_id)) else gene_id <- factor(gene_id) for(i in 1:ncol(samples)){ if(class(samples[, i]) == "character") samples[, i] <- factor(samples[, i], levels = unique(samples[, i])) else if(class(samples[, i]) == "factor") samples[, i] <- factor(samples[, i]) } # Ordering or <- order(gene_id) counts <- counts[or, , drop = FALSE] gene_id <- gene_id[or] feature_id <- feature_id[or] rownames(counts) <- feature_id inds <- 1:length(gene_id) names(inds) <- feature_id partitioning <- split(inds, gene_id) data <- new("dmDSdata", counts = new("MatrixList", unlistData = counts, partitioning = partitioning), samples = samples) return(data) } ############################################################################### ### dmFilter ############################################################################### #' Filtering #' #' Filtering of genes and features with low expression. Additionally, for the #' dmSQTLdata object, filtering of genotypes with low frequency. #' #' @param x \code{\linkS4class{dmDSdata}} or \code{\linkS4class{dmSQTLdata}} #' object. #' @param ... Other parameters that can be defined by methods using this #' generic. #' @export setGeneric("dmFilter", function(x, ...) standardGeneric("dmFilter")) # ----------------------------------------------------------------------------- #' @details Filtering parameters should be adjusted according to the sample size #' of the experiment data and the number of replicates per condition. #' #' \code{min_samps_gene_expr} defines the minimal number of samples where #' genes are required to be expressed at the minimal level of #' \code{min_gene_expr} in order to be included in the downstream analysis. #' Ideally, we would like that genes were expressed at some minimal level in #' all samples because this would lead to better estimates of feature ratios. #' #' Similarly, \code{min_samps_feature_expr} and \code{min_samps_feature_prop} #' defines the minimal number of samples where features are required to be #' expressed at the minimal levels of counts \code{min_feature_expr} or #' proportions \code{min_feature_prop}. In differential transcript/exon usage #' analysis, we suggest using \code{min_samps_feature_expr} and #' \code{min_samps_feature_prop} equal to the minimal number of replicates in #' any of the conditions. For example, in an assay with 3 versus 5 replicates, #' we would set these parameters to 3, which allows a situation where a #' feature is expressed in one condition but may not be expressed at all in #' another one, which is an example of differential transcript/exon usage. #' #' By default, all the filtering parameters equal zero which means that #' features with zero expression in all samples are removed as well as genes #' with only one non-zero feature. #' #' @param min_samps_gene_expr Minimal number of samples where genes should be #' expressed. See Details. #' @param min_gene_expr Minimal gene expression. #' @param min_samps_feature_expr Minimal number of samples where features should #' be expressed. See Details. #' @param min_feature_expr Minimal feature expression. #' @param min_samps_feature_prop Minimal number of samples where features should #' be expressed. See details. #' @param min_feature_prop Minimal proportion for feature expression. This value #' should be between 0 and 1. #' @param run_gene_twice Whether to re-run the gene-level filter #' after the feature-level filters. #' @return Returns filtered \code{\linkS4class{dmDSdata}} or #' \code{\linkS4class{dmSQTLdata}} object. #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' } #' @seealso \code{\link{plotData}} #' @author Malgorzata Nowicka #' @rdname dmFilter #' @export setMethod("dmFilter", "dmDSdata", function(x, min_samps_gene_expr = 0, min_samps_feature_expr = 0, min_samps_feature_prop = 0, min_gene_expr = 0, min_feature_expr = 0, min_feature_prop = 0, run_gene_twice = FALSE){ stopifnot(min_samps_gene_expr >= 0 && min_samps_gene_expr <= ncol(x@counts)) stopifnot(min_gene_expr >= 0) stopifnot(min_samps_feature_expr >= 0 && min_samps_feature_expr <= ncol(x@counts)) stopifnot(min_feature_expr >= 0) stopifnot(min_samps_feature_prop >= 0 && min_samps_feature_prop <= ncol(x@counts)) stopifnot(min_feature_prop >= 0 && min_feature_prop <= 1) counts_filtered <- dmDS_filter(counts = x@counts, min_samps_gene_expr = min_samps_gene_expr, min_gene_expr = min_gene_expr, min_samps_feature_expr = min_samps_feature_expr, min_feature_expr = min_feature_expr, min_samps_feature_prop = min_samps_feature_prop, min_feature_prop = min_feature_prop, run_gene_twice = run_gene_twice) return(new("dmDSdata", counts = counts_filtered, samples = x@samples)) }) ################################################################################ ### plotData ################################################################################ #' Plot data summary #' #' @return Returns a \code{ggplot} object and can be further modified, for #' example, using \code{theme()}. Plots a histogram of the number of features #' per gene. Additionally, for \code{\linkS4class{dmSQTLdata}} object, plots a #' histogram of the number of SNPs per gene and a histogram of the number of #' unique SNPs (blocks) per gene. #' #' @param x \code{\linkS4class{dmDSdata}} or \code{\linkS4class{dmSQTLdata}} #' object. #' @param ... Other parameters that can be defined by methods using this #' generic. #' @export setGeneric("plotData", function(x, ...) standardGeneric("plotData")) # ----------------------------------------------------------------------------- #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' } #' @author Malgorzata Nowicka #' @seealso \code{\link{plotPrecision}}, \code{\link{plotProportions}}, #' \code{\link{plotPValues}} #' @rdname plotData #' @export setMethod("plotData", "dmDSdata", function(x){ tt <- elementNROWS(x@counts) ggp <- dm_plotDataFeatures(tt = tt) return(ggp) }) DRIMSeq/R/class_dmDSfit.R0000755000175100017510000005403714614306665016070 0ustar00biocbuildbiocbuild#' @include class_dmDSprecision.R NULL ################################################################################ ### dmDSfit class ################################################################################ #' dmDSfit object #' #' dmDSfit extends the \code{\linkS4class{dmDSprecision}} class by adding the #' full model Dirichlet-multinomial (DM) and beta-binomial (BB) likelihoods, #' regression coefficients and feature proportion estimates. Result of calling #' the \code{\link{dmFit}} function. #' #' @return #' #' \itemize{ \item \code{design(object)}: Get a matrix with the full design. #' \item \code{proportions(x)}: Get a data frame with estimated feature ratios #' for each sample. \item \code{coefficients(x)}: Get the DM or BB regression #' coefficients. } #' #' @param x,object dmDSprecision object. #' @param ... Other parameters that can be defined by methods using this #' generic. #' #' @slot design_fit_full Numeric matrix of the design used to fit the full #' model. #' @slot fit_full \code{\linkS4class{MatrixList}} containing estimated feature #' ratios in each sample based on the full Dirichlet-multinomial (DM) model. #' @slot lik_full Numeric vector of the per gene DM full model likelihoods. #' @slot coef_full \code{\linkS4class{MatrixList}} with the regression #' coefficients based on the DM model. #' @slot fit_full_bb \code{\linkS4class{MatrixList}} containing estimated #' feature ratios in each sample based on the full beta-binomial (BB) model. #' @slot lik_full_bb Numeric vector of the per gene BB full model likelihoods. #' @slot coef_full_bb \code{\linkS4class{MatrixList}} with the regression #' coefficients based on the BB model. #' #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## Create the design matrix #' design_full <- model.matrix(~ group, data = samples(d)) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d, design = design_full) #' #' plotPrecision(d) #' #' head(mean_expression(d)) #' common_precision(d) #' head(genewise_precision(d)) #' #' ## Fit full model proportions #' d <- dmFit(d, design = design_full) #' #' ## Get fitted proportions #' head(proportions(d)) #' ## Get the DM regression coefficients (gene-level) #' head(coefficients(d)) #' ## Get the BB regression coefficients (feature-level) #' head(coefficients(d), level = "feature") #' } #' @author Malgorzata Nowicka #' @seealso \code{\linkS4class{dmDSdata}}, \code{\linkS4class{dmDSprecision}}, #' \code{\linkS4class{dmDStest}} setClass("dmDSfit", contains = "dmDSprecision", representation(design_fit_full = "matrix", fit_full = "MatrixList", lik_full = "numeric", coef_full = "MatrixList", fit_full_bb = "MatrixList", lik_full_bb = "numeric", coef_full_bb = "MatrixList")) # ------------------------------------------------------------------------------ setValidity("dmDSfit", function(object){ # Has to return TRUE for a valid object! if(nrow(object@design_fit_full) == ncol(object@counts)){ out <- TRUE }else{ return(paste0("Number of rows in the design matrix must be equal to the number of columns in counts")) } if(!length(object@fit_full) == length(object@counts)) return("Different number of genes in 'counts' and 'fit_full'") if(!length(object@lik_full) == length(object@counts)) return("Different number of genes in 'counts' and 'lik_full'") if(!length(object@coef_full) == length(object@counts)) return("Different number of genes in 'counts' and 'coef_full'") # TODO: Add more checks for BB return(TRUE) }) ################################################################################ ### accessing methods ################################################################################ #' @rdname dmDSfit-class #' @inheritParams dmDSprecision-class #' @export setMethod("design", "dmDSfit", function(object, type = "full_model"){ stopifnot(type %in% c("precision", "full_model", "null_model")) if(type == "precision") object@design_precision else if(type == "full_model") object@design_fit_full else NULL }) #' @rdname dmDSfit-class #' @export setGeneric("proportions", function(x, ...) standardGeneric("proportions")) #' @rdname dmDSfit-class #' @export setMethod("proportions", "dmDSfit", function(x){ data.frame(gene_id = rep.int(names(x@fit_full), elementNROWS(x@fit_full)), feature_id = rownames(x@fit_full@unlistData), x@fit_full@unlistData, stringsAsFactors = FALSE, row.names = NULL) }) # Generic for coefficients already exists in the stats package #' @rdname dmDSfit-class #' @param level Character specifying which type of results to return. Possible #' values \code{"gene"} or \code{"feature"}. #' @export setMethod("coefficients", "dmDSfit", function(object, level = "gene"){ stopifnot(length(level) == 1) stopifnot(level %in% c("gene", "feature")) if(level == "gene"){ out <- data.frame(gene_id = rep.int(names(object@coef_full), elementNROWS(object@coef_full)), feature_id = rownames(object@coef_full@unlistData), object@coef_full@unlistData, stringsAsFactors = FALSE, row.names = NULL) } if(level == "feature"){ out <- data.frame(gene_id = rep.int(names(object@coef_full_bb), elementNROWS(object@coef_full_bb)), feature_id = rownames(object@coef_full_bb@unlistData), object@coef_full_bb@unlistData, stringsAsFactors = FALSE, row.names = NULL) } return(out) }) # ------------------------------------------------------------------------------ setMethod("show", "dmDSfit", function(object){ callNextMethod(object) cat(" proportions(), coefficients()\n") }) ################################################################################ ### dmFit ################################################################################ #' Fit the Dirichlet-multinomial and/or the beta-binomial full model regression #' #' Obtain the maximum likelihood estimates of Dirichlet-multinomial (gene-level) #' and/or beta-binomial (feature-level) regression coefficients, feature #' proportions in each sample and corresponding likelihoods. In the differential #' exon/transcript usage analysis, the regression model is defined by a design #' matrix. In the exon/transcript usage QTL analysis, regression models are #' defined by genotypes. Currently, beta-binomial model is implemented only in #' the differential usage analysis. #' #' @param x \code{\linkS4class{dmDSprecision}} or #' \code{\linkS4class{dmSQTLprecision}} object. #' @param ... Other parameters that can be defined by methods using this #' generic. #' @export setGeneric("dmFit", function(x, ...) standardGeneric("dmFit")) # ----------------------------------------------------------------------------- #' @inheritParams dmPrecision #' #' @details In the regression framework here, we adapt the idea from #' \code{\link[edgeR]{glmFit}} in \code{\link{edgeR}} about using a shortcut #' algorithm when the design is equivalent to simple group fitting. In such a #' case, we estimate the DM proportions for each group of samples separately #' and then recalculate the DM (and/or the BB) regression coefficients #' corresponding to the design matrix. If the design matrix does not define a #' simple group fitting, for example, when it contains a column with #' continuous values, then the regression framework is used to directly #' estimate the regression coefficients. #' #' Arguments that are used for the proportion estimation in each group when #' the shortcut fitting can be used start with \code{prop_}, and those that #' are used in the regression framework start with \code{coef_}. #' #' In the differential transcript usage analysis, setting \code{one_way = #' TRUE} allows switching to the shortcut algorithm only if the design is #' equivalent to simple group fitting. \code{one_way = FALSE} forces usage of #' the regression framework. #' #' #' @param design Numeric matrix defining the full model. #' @param bb_model Logical. Whether to perform the feature-level analysis using #' the beta-binomial model. #' @return Returns a \code{\linkS4class{dmDSfit}} or #' \code{\linkS4class{dmSQTLfit}} object. #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## Create the design matrix #' design_full <- model.matrix(~ group, data = samples(d)) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d, design = design_full) #' #' plotPrecision(d) #' #' head(mean_expression(d)) #' common_precision(d) #' head(genewise_precision(d)) #' #' ## Fit full model proportions #' d <- dmFit(d, design = design_full) #' #' ## Get fitted proportions #' head(proportions(d)) #' ## Get the DM regression coefficients (gene-level) #' head(coefficients(d)) #' ## Get the BB regression coefficients (feature-level) #' head(coefficients(d), level = "feature") #' } #' @author Malgorzata Nowicka #' @seealso \code{\link{plotProportions}} \code{\link[edgeR]{glmFit}} #' @references McCarthy, DJ, Chen, Y, Smyth, GK (2012). Differential expression #' analysis of multifactor RNA-Seq experiments with respect to biological #' variation. Nucleic Acids Research 40, 4288-4297. #' @rdname dmFit #' @importFrom limma nonEstimable #' @export setMethod("dmFit", "dmDSprecision", function(x, design, one_way = TRUE, bb_model = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, add_uniform = FALSE, BPPARAM = BiocParallel::SerialParam()){ # Check design as in edgeR design <- as.matrix(design) stopifnot(nrow(design) == ncol(x@counts)) ne <- limma::nonEstimable(design) if(!is.null(ne)) stop(paste("Design matrix not of full rank. The following coefficients not estimable:\n", paste(ne, collapse = " "))) if(!identical(x@design_precision, design)) message(paste0("! The 'design' here is not identical as the 'design' used for precision estimation !\n")) # Check other parameters stopifnot(is.logical(one_way)) stopifnot(length(prop_mode) == 1) stopifnot(prop_mode %in% c("constrOptim")) stopifnot(length(prop_tol) == 1) stopifnot(is.numeric(prop_tol) && prop_tol > 0) stopifnot(length(coef_mode) == 1) stopifnot(coef_mode %in% c("optim", "nlminb", "nlm")) stopifnot(length(coef_tol) == 1) stopifnot(is.numeric(coef_tol) && coef_tol > 0) stopifnot(verbose %in% 0:2) # add random small fractional counts to zeros counts <- if (add_uniform) addUniform(x@counts) else x@counts # Fit the DM model: proportions and likelihoods fit <- dmDS_fit(counts = counts, design = design, precision = x@genewise_precision, one_way = one_way, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) # Calculate the Beta-Binomial likelihoods for each feature if(bb_model){ fit_bb <- bbDS_fit(counts = counts, fit = fit[["fit"]], design = design, precision = x@genewise_precision, one_way = one_way, verbose = verbose, BPPARAM = BPPARAM) return(new("dmDSfit", design_fit_full = design, fit_full = fit[["fit"]], lik_full = fit[["lik"]], coef_full = fit[["coef"]], lik_full_bb = fit_bb[["lik"]], coef_full_bb = fit_bb[["coef"]], mean_expression = x@mean_expression, common_precision = x@common_precision, genewise_precision = x@genewise_precision, design_precision = x@design_precision, counts = x@counts, samples = x@samples)) }else{ return(new("dmDSfit", design_fit_full = design, fit_full = fit[["fit"]], lik_full = fit[["lik"]], coef_full = fit[["coef"]], mean_expression = x@mean_expression, common_precision = x@common_precision, genewise_precision = x@genewise_precision, design_precision = x@design_precision, counts = x@counts, samples = x@samples)) } }) ################################################################################ ### plotProportions ################################################################################ #' Plot feature proportions #' #' This plot is available only for a group design, i.e., a design that is #' equivalent to multiple group fitting. #' #' @return For a given gene, plot the observed and estimated with #' Dirichlet-multinomial model feature proportions in each group. Estimated #' group proportions are marked with diamond shapes. #' #' @param x \code{\linkS4class{dmDSfit}}, \code{\linkS4class{dmDStest}} or #' \code{\linkS4class{dmSQTLfit}}, \code{\linkS4class{dmSQTLtest}} object. #' @param ... Other parameters that can be defined by methods using this #' generic. #' @export setGeneric("plotProportions", function(x, ...) standardGeneric("plotProportions")) # ------------------------------------------------------------------------------ #' @inheritParams plotData #' @param gene_id Character indicating a gene ID to be plotted. #' @param group_variable Character indicating the grouping variable which is one #' of the columns in the \code{samples} slot of \code{x}. #' @param plot_type Character defining the type of the plot produced. Possible #' values \code{"barplot"}, \code{"boxplot1"}, \code{"boxplot2"}, #' \code{"lineplot"}, \code{"ribbonplot"}. #' @param order_features Logical. Whether to plot the features ordered by their #' expression. #' @param order_samples Logical. Whether to plot the samples ordered by the #' group variable. If \code{FALSE} order from the \code{sample(x)} is kept. #' @param plot_fit Logical. Whether to plot the proportions estimated by the #' full model. #' @param plot_main Logical. Whether to plot a title with the information about #' the Dirichlet-multinomial estimates. #' @param group_colors Character vector with colors for each group defined by #' \code{group_variable}. #' @param feature_colors Character vector with colors for each feature of gene #' defined by \code{gene_id}. #' #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## Create the design matrix #' design_full <- model.matrix(~ group, data = samples(d)) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d, design = design_full) #' #' plotPrecision(d) #' #' head(mean_expression(d)) #' common_precision(d) #' head(genewise_precision(d)) #' #' ## Fit full model proportions #' d <- dmFit(d, design = design_full) #' #' ## Get fitted proportions #' head(proportions(d)) #' ## Get the DM regression coefficients (gene-level) #' head(coefficients(d)) #' ## Get the BB regression coefficients (feature-level) #' head(coefficients(d), level = "feature") #' #' ## Fit null model proportions and perform the LR test to detect DTU #' d <- dmTest(d, coef = "groupKD") #' #' ## Plot the gene-level p-values #' plotPValues(d) #' #' ## Get the gene-level results #' head(results(d)) #' #' ## Plot feature proportions for a top DTU gene #' res <- results(d) #' res <- res[order(res$pvalue, decreasing = FALSE), ] #' #' top_gene_id <- res$gene_id[1] #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group") #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group", #' plot_type = "lineplot") #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group", #' plot_type = "ribbonplot") #' } #' @author Malgorzata Nowicka #' @seealso \code{\link{plotData}}, \code{\link{plotPrecision}}, #' \code{\link{plotPValues}} #' @rdname plotProportions #' @export setMethod("plotProportions", "dmDSfit", function(x, gene_id, group_variable, plot_type = "barplot", order_features = TRUE, order_samples = TRUE, plot_fit = TRUE, plot_main = TRUE, group_colors = NULL, feature_colors = NULL){ stopifnot(gene_id %in% names(x@counts)) stopifnot(plot_type %in% c("barplot", "boxplot1", "boxplot2", "lineplot", "ribbonplot")) stopifnot(is.logical(order_features)) stopifnot(is.logical(order_samples)) stopifnot(is.logical(plot_fit)) stopifnot(is.logical(plot_main)) stopifnot(length(group_variable) == 1) stopifnot(group_variable %in% colnames(samples(x))) group <- x@samples[, group_variable] if(is.factor(group)){ group <- factor(group) }else{ group <- factor(group, levels = group) } counts_gene <- x@counts[[gene_id]] if(!is.null(group_colors) && plot_type %in% c("barplot", "boxplot1", "lineplot")) stopifnot(length(group_colors) == nlevels(group)) if(!is.null(feature_colors) && plot_type %in% c("boxplot2", "ribbonplot")) stopifnot(length(feature_colors) == nrow(counts_gene)) if(nrow(counts_gene) <= 1) stop("!Gene has to have at least 2 features! \n") main <- NULL if(plot_main){ mean_expression_gene <- mean(colSums(counts_gene), na.rm = TRUE) main <- paste0(gene_id, "\n Mean expression = ", round(mean_expression_gene)) precision_gene <- x@genewise_precision[gene_id] main <- paste0(main, ", Precision = ", round(precision_gene, 2)) } fit_full <- NULL if(plot_fit){ fit_full <- x@fit_full[[gene_id]] } ggp <- dm_plotProportions(counts = counts_gene, group = group, md = x@samples, fit_full = fit_full, main = main, plot_type = plot_type, order_features = order_features, order_samples = order_samples, group_colors = group_colors, feature_colors = feature_colors) return(ggp) }) DRIMSeq/R/class_dmDSprecision.R0000755000175100017510000006357014614306665017303 0ustar00biocbuildbiocbuild#' @include class_dmDSdata.R NULL ################################################################################ ### dmDSprecision class ################################################################################ #' dmDSprecision object #' #' dmDSprecision extends the \code{\linkS4class{dmDSdata}} by adding the #' precision estimates of the Dirichlet-multinomial distribution used to model #' the feature (e.g., transcript, exon, exonic bin) counts for each gene in the #' differential usage analysis. Result of calling the \code{\link{dmPrecision}} #' function. #' #' @details Normally, in the differential analysis based on RNA-seq data, such #' as, for example, differential gene expression, dispersion (of #' negative-binomial model) is estimated. Here, we estimate precision of the #' Dirichlet-multinomial model as it is more convenient computationally. To #' obtain dispersion estimates, one can use a formula: dispersion = 1 / (1 + #' precision). #' #' @return #' #' \itemize{ \item \code{mean_expression(x)}: Get a data frame with mean gene #' expression. \item \code{common_precision(x), common_precision(x) <- value}: #' Get or set common precision. \code{value} must be numeric of length 1. \item #' \code{genewise_precision(x), genewise_precision(x) <- value}: Get a data #' frame with gene-wise precision or set new gene-wise precision. \code{value} #' must be a data frame with "gene_id" and "genewise_precision" columns. } #' #' @param x,object dmDSprecision object. #' @param value Values that replace current attributes. #' @param ... Other parameters that can be defined by methods using this #' generic. #' #' @slot mean_expression Numeric vector of mean gene expression. #' @slot common_precision Numeric value of estimated common precision. #' @slot genewise_precision Numeric vector of estimated gene-wise precisions. #' @slot design_precision Numeric matrix of the design used to estimate #' precision. #' #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## Create the design matrix #' design_full <- model.matrix(~ group, data = samples(d)) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d, design = design_full) #' #' plotPrecision(d) #' #' head(mean_expression(d)) #' common_precision(d) #' head(genewise_precision(d)) #' } #' @author Malgorzata Nowicka #' @seealso \code{\linkS4class{dmDSdata}}, \code{\linkS4class{dmDSfit}}, #' \code{\linkS4class{dmDStest}} setClass("dmDSprecision", contains = "dmDSdata", representation(mean_expression = "numeric", common_precision = "numeric", genewise_precision = "numeric", design_precision = "matrix")) # ----------------------------------------------------------------------------- setValidity("dmDSprecision", function(object){ ## Has to return TRUE when valid object! out <- TRUE if(length(object@mean_expression) > 0){ if(length(object@mean_expression) == length(object@counts)){ if(all(names(object@mean_expression) == names(object@counts))) out <- TRUE else return(paste0("Different names of 'counts' and 'mean_expression'")) } else return(paste0("Unequal length of 'counts' and 'mean_expression'")) } if(length(object@genewise_precision) > 0){ if(length(object@genewise_precision) == length(object@counts)){ if(all(names(object@genewise_precision) == names(object@counts))) out <- TRUE else return(paste0("Different names of 'counts' and 'genewise_precision'")) } else return(paste0("Unequal length of 'counts' and 'genewise_precision'")) } if(length(object@common_precision) > 0){ if(length(object@common_precision) == 1) out <- TRUE else return(paste0("'common_precision' must be a vector of length 1'")) } if(nrow(object@design_precision) == ncol(object@counts)){ out <- TRUE }else{ return(paste0("Number of rows in the design matrix must be equal to the number of columns in counts")) } return(out) }) ################################################################################ ### accessing methods ################################################################################ #' @rdname dmDSprecision-class #' @param type Character indicating which design matrix should be returned. #' Possible values \code{"precision"}, \code{"full_model"} or #' \code{"null_model"}. #' @export setMethod("design", "dmDSprecision", function(object, type = "precision"){ stopifnot(type %in% c("precision", "full_model", "null_model")) if(type == "precision") object@design_precision else NULL }) #' @rdname dmDSprecision-class #' @export setGeneric("mean_expression", function(x, ...) standardGeneric("mean_expression")) #' @rdname dmDSprecision-class #' @export setMethod("mean_expression", "dmDSprecision", function(x){ data.frame(gene_id = names(x@mean_expression), mean_expression = x@mean_expression, stringsAsFactors = FALSE, row.names = NULL) }) #' @rdname dmDSprecision-class #' @export setGeneric("common_precision", function(x, ...) standardGeneric("common_precision")) #' @rdname dmDSprecision-class #' @export setMethod("common_precision", "dmDSprecision", function(x) x@common_precision ) #' @rdname dmDSprecision-class #' @export setGeneric("common_precision<-", function(x, value) standardGeneric("common_precision<-")) #' @rdname dmDSprecision-class #' @export setMethod("common_precision<-", "dmDSprecision", function(x, value){ ### value must be a numeric of length 1 names(value) <- NULL return(new("dmDSprecision", mean_expression = x@mean_expression, common_precision = value, genewise_precision = x@genewise_precision, design_precision = x@design_precision, counts = x@counts, samples = x@samples)) }) #' @rdname dmDSprecision-class #' @export setGeneric("genewise_precision", function(x, ...) standardGeneric("genewise_precision")) #' @rdname dmDSprecision-class #' @export setMethod("genewise_precision", "dmDSprecision", function(x){ data.frame(gene_id = names(x@genewise_precision), genewise_precision = x@genewise_precision, stringsAsFactors = FALSE, row.names = NULL) }) #' @rdname dmDSprecision-class #' @export setGeneric("genewise_precision<-", function(x, value) standardGeneric("genewise_precision<-")) #' @rdname dmDSprecision-class #' @export setMethod("genewise_precision<-", "dmDSprecision", function(x, value){ # value must be a data frame with gene_id and genewise_precision stopifnot(all(c("gene_id", "genewise_precision") %in% colnames(value))) stopifnot(all(names(x@counts) %in% value[,"gene_id"])) order <- match(names(x@counts), value[,"gene_id"]) return(new("dmDSprecision", mean_expression = x@mean_expression, common_precision = x@common_precision, genewise_precision = value[order, "genewise_precision"], design_precision = x@design_precision, counts = x@counts, samples = x@samples)) }) # ----------------------------------------------------------------------------- setMethod("show", "dmDSprecision", function(object){ callNextMethod(object) cat(" design()\n") cat(" mean_expression(), common_precision(), genewise_precision()\n") }) ################################################################################ ### dmPrecision ################################################################################ #' Estimate the precision parameter in the Dirichlet-multinomial model #' #' Maximum likelihood estimates of the precision parameter in the #' Dirichlet-multinomial model used for the differential exon/transcript usage #' or QTL analysis. #' #' @details Normally, in the differential analysis based on RNA-seq data, such #' as, for example, differential gene expression, dispersion (of #' negative-binomial model) is estimated. Here, we estimate precision of the #' Dirichlet-multinomial model as it is more convenient computationally. To #' obtain dispersion estimates, one can use a formula: dispersion = 1 / (1 + #' precision). #' #' @param x \code{\linkS4class{dmDSdata}} or \code{\linkS4class{dmSQTLdata}} #' object. #' @param ... Other parameters that can be defined by methods using this #' generic. #' @export setGeneric("dmPrecision", function(x, ...) standardGeneric("dmPrecision")) # ----------------------------------------------------------------------------- #' @details Parameters that are used in the precision (dispersion = 1 / (1 + #' precision)) estimation start with prefix \code{prec_}. Those that are used #' for the proportion estimation in each group when the shortcut fitting #' \code{one_way = TRUE} can be used start with \code{prop_}, and those that #' are used in the regression framework start with \code{coef_}. #' #' There are two optimization methods implemented within dmPrecision: #' \code{"optimize"} for the common precision and \code{"grid"} for the #' gene-wise precision. #' #' Only part of the precision parameters in dmPrecision have an influence on #' a given optimization method. Here is a list of such active parameters: #' #' \code{"optimize"}: #' #' \itemize{ \item \code{prec_interval}: Passed as \code{interval}. \item #' \code{prec_tol}: The accuracy defined as \code{tol}. } #' #' \code{"grid"}, which uses the grid approach from #' \code{\link[edgeR]{estimateDisp}} in \code{\link{edgeR}}: #' #' \itemize{ \item \code{prec_init}, \code{prec_grid_length}, #' \code{prec_grid_range}: Parameters used to construct the search grid #' \code{prec_init * 2^seq(from = prec_grid_range[1]}, \code{to = #' prec_grid_range[2]}, \code{length = prec_grid_length)}. \item #' \code{prec_moderation}: Dipsersion shrinkage is available only with #' \code{"grid"} method. \item \code{prec_prior_df}: Used only when precision #' shrinkage is activated. Moderated likelihood is equal to \code{loglik + #' prec_prior_df * moderation}. Higher \code{prec_prior_df}, more shrinkage #' toward common or trended precision is applied. \item \code{prec_span}: #' Used only when precision moderation toward trend is activated. } #' #' @param design Numeric matrix defining the model that should be used when #' estimating precision. Normally this should be a full model design used #' also in \code{\link{dmFit}}. #' @param mean_expression Logical. Whether to estimate the mean expression of #' genes. #' @param common_precision Logical. Whether to estimate the common precision. #' @param genewise_precision Logical. Whether to estimate the gene-wise #' precision. #' @param prec_adjust Logical. Whether to use the Cox-Reid adjusted or #' non-adjusted profile likelihood. #' @param one_way Logical. Should the shortcut fitting be used when the design #' corresponds to multiple group comparison. This is a similar approach as in #' \code{\link{edgeR}}. If \code{TRUE} (the default), then proportions are #' fitted per group and regression coefficients are recalculated from those #' fits. #' @param prec_subset Value from 0 to 1 defining the percentage of genes used in #' common precision estimation. The default is 0.1, which uses 10% of #' randomly selected genes to speed up the precision estimation process. Use #' \code{set.seed} function to make the analysis reproducible. See Examples. #' @param prec_interval Numeric vector of length 2 defining the interval of #' possible values for the common precision. #' @param prec_tol The desired accuracy when estimating common precision. #' @param prec_init Initial precision. If \code{common_precision} is #' \code{TRUE}, then \code{prec_init} is overwritten by common precision #' estimate. #' @param prec_grid_length Length of the search grid. #' @param prec_grid_range Vector giving the limits of grid interval. #' @param prec_moderation Precision moderation method. One can choose to shrink #' the precision estimates toward the common precision (\code{"common"}) or #' toward the (precision versus mean expression) trend (\code{"trended"}) #' @param prec_prior_df Degree of moderation (shrinkage) in case when it can not #' be calculated automaticaly (number of genes on the upper boundary of grid #' is smaller than 10). By default it is equal to 0. #' @param prec_span Value from 0 to 1 defining the percentage of genes used in #' smoothing sliding window when calculating the precision versus mean #' expression trend. #' @param prop_mode Optimization method used to estimate proportions. Possible #' value \code{"constrOptim"}. #' @param prop_tol The desired accuracy when estimating proportions. #' @param coef_mode Optimization method used to estimate regression #' coefficients. Possible value \code{"optim"}. #' @param coef_tol The desired accuracy when estimating regression coefficients. #' @param verbose Numeric. Definie the level of progress messages displayed. 0 - #' no messages, 1 - main messages, 2 - message for every gene fitting. #' @param add_uniform Whether to add a small fractional count to zeros, #' (adding a uniform random variable between 0 and 0.1). #' This option allows for the fitting of genewise precision and coefficients #' for genes with two features having all zero for one group, or the last #' feature having all zero for one group. #' @param BPPARAM Parallelization method used by #' \code{\link[BiocParallel]{bplapply}}. #' #' @return Returns a \code{\linkS4class{dmDSprecision}} or #' \code{\linkS4class{dmSQTLprecision}} object. #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## Create the design matrix #' design_full <- model.matrix(~ group, data = samples(d)) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d, design = design_full) #' #' plotPrecision(d) #' #' head(mean_expression(d)) #' common_precision(d) #' head(genewise_precision(d)) #' } #' @seealso \code{\link{plotPrecision}} \code{\link[edgeR]{estimateDisp}} #' @author Malgorzata Nowicka #' @references McCarthy, DJ, Chen, Y, Smyth, GK (2012). Differential expression #' analysis of multifactor RNA-Seq experiments with respect to biological #' variation. Nucleic Acids Research 40, 4288-4297. #' @rdname dmPrecision #' @importFrom limma nonEstimable #' @importFrom stats runif #' @export setMethod("dmPrecision", "dmDSdata", function(x, design, mean_expression = TRUE, common_precision = TRUE, genewise_precision = TRUE, prec_adjust = TRUE, prec_subset = 0.1, prec_interval = c(0, 1e+3), prec_tol = 1e+01, prec_init = 100, prec_grid_length = 21, prec_grid_range = c(-10, 10), prec_moderation = "trended", prec_prior_df = 0, prec_span = 0.1, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, add_uniform = FALSE, BPPARAM = BiocParallel::SerialParam()){ # Check design as in edgeR design <- as.matrix(design) stopifnot(nrow(design) == ncol(x@counts)) ne <- limma::nonEstimable(design) if(!is.null(ne)) stop(paste("Design matrix not of full rank. The following coefficients not estimable:\n", paste(ne, collapse = " "))) # Check other parameters stopifnot(is.logical(mean_expression)) stopifnot(is.logical(common_precision)) stopifnot(is.logical(genewise_precision)) stopifnot(is.logical(prec_adjust)) stopifnot(length(prec_subset) == 1) stopifnot(is.numeric(prec_subset) && prec_subset > 0 && prec_subset <= 1) stopifnot(length(prec_interval) == 2) stopifnot(prec_interval[1] < prec_interval[2]) stopifnot(length(prec_tol) == 1) stopifnot(is.numeric(prec_tol) && prec_tol > 0) stopifnot(length(prec_init) == 1) stopifnot(is.numeric(prec_init)) stopifnot(prec_grid_length > 2) stopifnot(length(prec_grid_range) == 2) stopifnot(prec_grid_range[1] < prec_grid_range[2]) stopifnot(length(prec_moderation) == 1) stopifnot(prec_moderation %in% c("none", "common", "trended")) stopifnot(length(prec_prior_df) == 1) stopifnot(is.numeric(prec_prior_df) && prec_prior_df >= 0) stopifnot(length(prec_span) == 1) stopifnot(is.numeric(prec_span) && prec_span > 0 && prec_span < 1) stopifnot(is.logical(one_way)) stopifnot(length(prop_mode) == 1) stopifnot(prop_mode %in% c("constrOptim")) stopifnot(length(prop_tol) == 1) stopifnot(is.numeric(prop_tol) && prop_tol > 0) stopifnot(length(coef_mode) == 1) stopifnot(coef_mode %in% c("optim", "nlminb", "nlm")) stopifnot(length(coef_tol) == 1) stopifnot(is.numeric(coef_tol) && coef_tol > 0) stopifnot(verbose %in% 0:2) if(mean_expression || (genewise_precision && prec_moderation == "trended")){ mean_expression <- dm_estimateMeanExpression(counts = x@counts, verbose = verbose) }else{ mean_expression <- numeric() } if(common_precision){ if(prec_subset < 1){ message(paste0("! Using a subset of ", prec_subset, " genes to estimate common precision !\n")) genes2keep <- sample(1:length(x@counts), max(round(prec_subset * length(x@counts)), 1), replace = FALSE) }else{ genes2keep <- 1:length(x@counts) } common_precision <- dmDS_estimateCommonPrecision( counts = x@counts[genes2keep, ], design = design, prec_adjust = prec_adjust, prec_interval = prec_interval, prec_tol = prec_tol, one_way = one_way, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) }else{ common_precision <- numeric() } if(genewise_precision){ if(length(common_precision) == 1){ message("! Using common_precision = ", round(common_precision, 4), " as prec_init !\n") prec_init <- common_precision } # add random small fractional counts to zeros counts <- if (add_uniform) addUniform(x@counts) else x@counts genewise_precision <- dmDS_estimateTagwisePrecision(counts = counts, design = design, mean_expression = mean_expression, prec_adjust = prec_adjust, prec_init = prec_init, prec_grid_length = prec_grid_length, prec_grid_range = prec_grid_range, prec_moderation = prec_moderation, prec_prior_df = prec_prior_df, prec_span = prec_span, one_way = one_way, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) }else{ genewise_precision <- numeric() } return(new("dmDSprecision", mean_expression = mean_expression, common_precision = common_precision, genewise_precision = genewise_precision, design_precision = design, counts = x@counts, samples = x@samples)) }) ################################################################################ ### plotPrecision ################################################################################ #' Precision versus mean expression plot #' #' @return Normally in the differential analysis based on RNA-seq data, such #' plot has dispersion parameter plotted on the y-axis. Here, the y-axis #' represents precision since in the Dirichlet-multinomial model this is the #' parameter that is directly estimated. It is important to keep in mind that #' the precision parameter (gamma0) is inverse proportional to dispersion #' (theta): theta = 1 / (1 + gamma0). In RNA-seq data, we can typically #' observe a trend where the dispersion decreases (here, precision increases) #' for genes with higher mean expression. #' #' @param x \code{\linkS4class{dmDSprecision}} or #' \code{\linkS4class{dmSQTLprecision}} object. #' @param ... Other parameters that can be defined by methods using this #' generic. #' @export setGeneric("plotPrecision", function(x, ...) standardGeneric("plotPrecision")) # ----------------------------------------------------------------------------- #' @inheritParams plotData #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## Create the design matrix #' design_full <- model.matrix(~ group, data = samples(d)) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d, design = design_full) #' #' plotPrecision(d) #' #' head(mean_expression(d)) #' common_precision(d) #' head(genewise_precision(d)) #' } #' @author Malgorzata Nowicka #' @seealso \code{\link{plotData}}, \code{\link{plotProportions}}, #' \code{\link{plotPValues}} #' #' @rdname plotPrecision #' @export setMethod("plotPrecision", "dmDSprecision", function(x){ if(!length(x@genewise_precision) == length(x@counts)) stop("Genewise precision must be estimated for each gene!") if(!length(x@genewise_precision) == length(x@mean_expression)) stop("Mean expression must be estimated for each gene!") if(length(x@common_precision) == 0){ common_precision <- NULL }else{ common_precision <- x@common_precision } ggp <- dm_plotPrecision(genewise_precision = x@genewise_precision, mean_expression = x@mean_expression, nr_features = elementNROWS(x@counts), common_precision = common_precision) return(ggp) }) # function to add small fraction of counts to zeros addUniform <- function(counts, uniform_max=0.1) { counts_new <- lapply(seq_along(counts), function(g) { expr <- counts[[g]] zeros <- expr == 0 expr[zeros] <- runif(sum(zeros), 0, uniform_max) expr }) names(counts_new) <- names(counts) MatrixList(counts_new) } DRIMSeq/R/class_dmDStest.R0000755000175100017510000005253514614306665016266 0ustar00biocbuildbiocbuild#' @include class_dmDSfit.R NULL ############################################################################### ### dmDStest class ############################################################################### #' dmDStest object #' #' dmDStest extends the \code{\linkS4class{dmDSfit}} class by adding the null #' model Dirichlet-multinomial (DM) and beta-binomial (BB) likelihoods and the #' gene-level and feature-level results of testing for differential #' exon/transcript usage. Result of calling the \code{\link{dmTest}} function. #' #' @return #' #' \itemize{ \item \code{results(x)}: get a data frame with gene-level or #' feature-level results.} #' #' @param x,object dmDStest object. #' @param ... Other parameters that can be defined by methods using this #' generic. #' #' @slot design_fit_null Numeric matrix of the design used to fit the null #' model. #' @slot lik_null Numeric vector of the per gene DM null model likelihoods. #' @slot lik_null_bb Numeric vector of the per gene BB null model likelihoods. #' @slot results_gene Data frame with the gene-level results including: #' \code{gene_id} - gene IDs, \code{lr} - likelihood ratio statistics based on #' the DM model, \code{df} - degrees of freedom, \code{pvalue} - p-values and #' \code{adj_pvalue} - Benjamini & Hochberg adjusted p-values. #' @slot results_feature Data frame with the feature-level results including: #' \code{gene_id} - gene IDs, \code{feature_id} - feature IDs, \code{lr} - #' likelihood ratio statistics based on the BB model, \code{df} - degrees of #' freedom, \code{pvalue} - p-values and \code{adj_pvalue} - Benjamini & #' Hochberg adjusted p-values. #' #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## Create the design matrix #' design_full <- model.matrix(~ group, data = samples(d)) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d, design = design_full) #' #' plotPrecision(d) #' #' head(mean_expression(d)) #' common_precision(d) #' head(genewise_precision(d)) #' #' ## Fit full model proportions #' d <- dmFit(d, design = design_full) #' #' ## Get fitted proportions #' head(proportions(d)) #' ## Get the DM regression coefficients (gene-level) #' head(coefficients(d)) #' ## Get the BB regression coefficients (feature-level) #' head(coefficients(d), level = "feature") #' #' ## Fit null model proportions and perform the LR test to detect DTU #' d <- dmTest(d, coef = "groupKD") #' #' ## Plot the gene-level p-values #' plotPValues(d) #' #' ## Get the gene-level results #' head(results(d)) #' #' ## Plot feature proportions for a top DTU gene #' res <- results(d) #' res <- res[order(res$pvalue, decreasing = FALSE), ] #' #' top_gene_id <- res$gene_id[1] #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group") #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group", #' plot_type = "lineplot") #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group", #' plot_type = "ribbonplot") #' #' @author Malgorzata Nowicka #' @seealso \code{\linkS4class{dmDSdata}}, \code{\linkS4class{dmDSprecision}}, #' \code{\linkS4class{dmDSfit}} setClass("dmDStest", contains = "dmDSfit", representation(design_fit_null = "matrix", lik_null = "numeric", lik_null_bb = "numeric", results_gene = "data.frame", results_feature = "data.frame")) # ------------------------------------------------------------------------------ setValidity("dmDStest", function(object){ # Has to return TRUE when valid object! if(!length(object@lik_null) == length(object@counts)) return("Different number of genes in 'counts' and 'lik_null'") if(length(object@lik_null_bb) > 0){ if(!length(object@lik_null_bb) == nrow(object@counts)) return("Different number of features in 'counts' and 'lik_null_bb'") } # TODO: Add more checks for results return(TRUE) }) ############################################################################### ### accessing methods ############################################################################### #' @rdname dmDStest-class #' @inheritParams dmDSprecision-class #' @export setMethod("design", "dmDStest", function(object, type = "null_model"){ stopifnot(type %in% c("precision", "full_model", "null_model")) if(type == "precision") object@design_precision else if(type == "full_model") object@design_fit_full else object@design_fit_null }) #' @rdname dmDStest-class #' @export setGeneric("results", function(x, ...) standardGeneric("results")) #' @rdname dmDStest-class #' @inheritParams dmDSfit-class #' @export setMethod("results", "dmDStest", function(x, level = "gene"){ stopifnot(length(level) == 1) stopifnot(level %in% c("gene", "feature")) slot(x, paste0("results_", level)) }) # ----------------------------------------------------------------------------- setMethod("show", "dmDStest", function(object){ callNextMethod(object) cat(" results()\n") }) ############################################################################### ### dmTest ############################################################################### #' Likelihood ratio test to detect differential transcript/exon usage #' #' First, estimate the null Dirichlet-multinomial and beta-binomial model #' parameters and likelihoods using the null model design. Second, perform the #' gene-level (DM model) and feature-level (BB model) likelihood ratio tests. In #' the differential exon/transcript usage analysis, the null model is defined by #' the null design matrix. In the exon/transcript usage QTL analysis, null #' models are defined by a design with intercept only. Currently, beta-binomial #' model is implemented only in the differential usage analysis. #' #' @param x \code{\linkS4class{dmDSfit}} or \code{\linkS4class{dmSQTLfit}} #' object. #' @param ... Other parameters that can be defined by methods using this #' generic. #' @export setGeneric("dmTest", function(x, ...) standardGeneric("dmTest")) # ----------------------------------------------------------------------------- #' @inheritParams dmFit #' @param coef Integer or character vector indicating which coefficients of the #' linear model are to be tested equal to zero. Values must indicate column #' numbers or column names of the \code{design} used in \code{\link{dmFit}}. #' @param design Numeric matrix defining the null model. #' @param contrast Numeric vector or matrix specifying one or more contrasts of #' the linear model coefficients to be tested equal to zero. For a matrix, #' number of rows (for a vector, its length) must equal to the number of #' columns of \code{design} used in \code{\link{dmFit}}. #' #' @details One must specify one of the arguments: \code{coef}, \code{design} or #' \code{contrast}. #' #' When \code{contrast} is used to define the null model, the null design #' matrix is recalculated using the same approach as in #' \code{\link[edgeR]{glmLRT}} function from \code{\link{edgeR}}. #' #' @return Returns a \code{\linkS4class{dmDStest}} or #' \code{\linkS4class{dmSQTLtest}} object. #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## Create the design matrix #' design_full <- model.matrix(~ group, data = samples(d)) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d, design = design_full) #' #' plotPrecision(d) #' #' head(mean_expression(d)) #' common_precision(d) #' head(genewise_precision(d)) #' #' ## Fit full model proportions #' d <- dmFit(d, design = design_full) #' #' ## Get fitted proportions #' head(proportions(d)) #' ## Get the DM regression coefficients (gene-level) #' head(coefficients(d)) #' ## Get the BB regression coefficients (feature-level) #' head(coefficients(d), level = "feature") #' #' ## Fit null model proportions and perform the LR test to detect DTU #' d <- dmTest(d, coef = "groupKD") #' #' ## Plot the gene-level p-values #' plotPValues(d) #' #' ## Get the gene-level results #' head(results(d)) #' #' ## Plot feature proportions for a top DTU gene #' res <- results(d) #' res <- res[order(res$pvalue, decreasing = FALSE), ] #' #' top_gene_id <- res$gene_id[1] #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group") #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group", #' plot_type = "lineplot") #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group", #' plot_type = "ribbonplot") #' } #' @author Malgorzata Nowicka #' @seealso \code{\link{plotPValues}} \code{\link[edgeR]{glmLRT}} #' @references McCarthy, DJ, Chen, Y, Smyth, GK (2012). Differential expression #' analysis of multifactor RNA-Seq experiments with respect to biological #' variation. Nucleic Acids Research 40, 4288-4297. #' @rdname dmTest #' @importFrom limma nonEstimable #' @export setMethod("dmTest", "dmDSfit", function(x, coef = NULL, design = NULL, contrast = NULL, one_way = TRUE, bb_model = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, BPPARAM = BiocParallel::SerialParam()){ # Check parameters stopifnot(is.logical(one_way)) stopifnot(length(prop_mode) == 1) stopifnot(prop_mode %in% c("constrOptim")) stopifnot(length(prop_tol) == 1) stopifnot(is.numeric(prop_tol) && prop_tol > 0) stopifnot(length(coef_mode) == 1) stopifnot(coef_mode %in% c("optim", "nlminb", "nlm")) stopifnot(length(coef_tol) == 1) stopifnot(is.numeric(coef_tol) && coef_tol > 0) stopifnot(verbose %in% 0:2) if(!sum(!unlist(lapply(list(coef, design, contrast), is.null))) == 1) stop(paste0("Only one of the ways to define the null model 'coef', 'design' or 'contrast' can be used!")) # Check coef if(!is.null(coef)){ # Check the full model design matrix nbeta <- ncol(x@design_fit_full) if(nbeta < 2) stop("Need at least two columns for design, usually the first is the intercept column!") if(length(coef) > 1) coef <- unique(coef) if(is.numeric(coef)){ stopifnot(max(coef) <= nbeta) }else if(is.character(coef)){ if(!all(coef %in% colnames(x@design_fit_full))) stop("'coef' does not match the columns of the design matrix!") coef <- match(coef, colnames(x@design_fit_full)) } # Null design matrix design0 <- x@design_fit_full[, -coef, drop = FALSE] } # Check design if(!is.null(design)){ # Check design as in edgeR design <- as.matrix(design) stopifnot(nrow(design) == ncol(x@counts)) ne <- limma::nonEstimable(design) if(!is.null(ne)) stop(paste("Design matrix not of full rank. The following coefficients not estimable:\n", paste(ne, collapse = " "))) # Null design matrix design0 <- design } # Check contrast exactly as in edgeR in glmLRT() if(!is.null(contrast)){ design <- x@design_fit_full contrast <- as.matrix(contrast) stopifnot(nrow(contrast) == ncol(design)) qrc <- qr(contrast) ncontrasts <- qrc$rank if(ncontrasts == 0) stop("Contrasts are all zero!") coef <- 1:ncontrasts nlibs <- nrow(design) Dvec <- rep.int(1, nlibs) Dvec[coef] <- diag(qrc$qr)[coef] Q <- qr.Q(qrc, complete = TRUE, Dvec = Dvec) design <- design %*% Q # Null design matrix design0 <- design[, -coef, drop = FALSE] } # Fit the DM null model: proportions and likelihoods fit0 <- dmDS_fit(counts = x@counts, design = design0, precision = x@genewise_precision, one_way = one_way, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) # Calculate the DM degrees of freedom for the LR test: df_full - df_null df <- (ncol(x@design_fit_full) - ncol(design0)) * (elementNROWS(x@coef_full) - 1) results_gene <- dm_LRT(lik_full = x@lik_full, lik_null = fit0[["lik"]], df = df, verbose = verbose) results_gene <- data.frame(gene_id = rownames(results_gene), results_gene, stringsAsFactors = FALSE, row.names = NULL) # Calculate the Beta-Binomial null likelihoods for each feature if(bb_model && length(x@lik_full_bb) > 0){ fit0_bb <- bbDS_fit(counts = x@counts, fit = fit0[["fit"]], design = design0, precision = x@genewise_precision, one_way = one_way, verbose = verbose, BPPARAM = BPPARAM) # Calculate the BB degrees of freedom for the LR test df <- rep.int(ncol(x@design_fit_full) - ncol(design0), length(x@lik_full_bb)) results_feature <- dm_LRT(lik_full = x@lik_full_bb, lik_null = fit0_bb[["lik"]], df = df, verbose = verbose) results_feature <- data.frame( gene_id = rep.int(names(x@counts), elementNROWS(x@counts)), feature_id = rownames(results_feature), results_feature, stringsAsFactors = FALSE, row.names = NULL) return(new("dmDStest", results_gene = results_gene, results_feature = results_feature, design_fit_null = design0, lik_null = fit0[["lik"]], lik_null_bb = fit0_bb[["lik"]], design_fit_full = x@design_fit_full, fit_full = x@fit_full, lik_full = x@lik_full, coef_full = x@coef_full, lik_full_bb = x@lik_full_bb, coef_full_bb = x@coef_full_bb, mean_expression = x@mean_expression, common_precision = x@common_precision, genewise_precision = x@genewise_precision, design_precision = x@design_precision, counts = x@counts, samples = x@samples)) }else{ if(bb_model && length(x@lik_full_bb) == 0) message("Beta-Binomial model is not fitted because bb_model=FALSE in dmFit! Rerun dmFit with bb_model=TRUE.") return(new("dmDStest", results_gene = results_gene, design_fit_null = design0, lik_null = fit0[["lik"]], design_fit_full = x@design_fit_full, fit_full = x@fit_full, lik_full = x@lik_full, coef_full = x@coef_full, lik_full_bb = x@lik_full_bb, coef_full_bb = x@coef_full_bb, mean_expression = x@mean_expression, common_precision = x@common_precision, genewise_precision = x@genewise_precision, design_precision = x@design_precision, counts = x@counts, samples = x@samples)) } }) ############################################################################### ### plotPValues ############################################################################### #' Plot p-value distribution #' #' @return Plot a histogram of p-values. #' #' @param x \code{\linkS4class{dmDStest}} or \code{\linkS4class{dmSQTLtest}} #' object. #' @export setGeneric("plotPValues", function(x, ...) standardGeneric("plotPValues")) # ---------------------------------------------------------------------------- #' @inheritParams results #' @examples #' # -------------------------------------------------------------------------- #' # Create dmDSdata object #' # -------------------------------------------------------------------------- #' ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package #' #' library(PasillaTranscriptExpr) #' \donttest{ #' data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") #' #' ## Load metadata #' pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Load counts #' pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), #' header = TRUE, as.is = TRUE) #' #' ## Create a pasilla_samples data frame #' pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, #' group = pasilla_metadata$condition) #' levels(pasilla_samples$group) #' #' ## Create a dmDSdata object #' d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) #' #' ## Use a subset of genes, which is defined in the following file #' gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) #' #' d <- d[names(d) %in% gene_id_subset, ] #' #' # -------------------------------------------------------------------------- #' # Differential transcript usage analysis - simple two group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' ## Check what is the minimal number of replicates per condition #' table(samples(d)$group) #' #' d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, #' min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## Create the design matrix #' design_full <- model.matrix(~ group, data = samples(d)) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d, design = design_full) #' #' plotPrecision(d) #' #' head(mean_expression(d)) #' common_precision(d) #' head(genewise_precision(d)) #' #' ## Fit full model proportions #' d <- dmFit(d, design = design_full) #' #' ## Get fitted proportions #' head(proportions(d)) #' ## Get the DM regression coefficients (gene-level) #' head(coefficients(d)) #' ## Get the BB regression coefficients (feature-level) #' head(coefficients(d), level = "feature") #' #' ## Fit null model proportions and perform the LR test to detect DTU #' d <- dmTest(d, coef = "groupKD") #' #' ## Plot the gene-level p-values #' plotPValues(d) #' #' ## Get the gene-level results #' head(results(d)) #' #' ## Plot feature proportions for a top DTU gene #' res <- results(d) #' res <- res[order(res$pvalue, decreasing = FALSE), ] #' #' top_gene_id <- res$gene_id[1] #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group") #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group", #' plot_type = "lineplot") #' #' plotProportions(d, gene_id = top_gene_id, group_variable = "group", #' plot_type = "ribbonplot") #' } #' @author Malgorzata Nowicka #' @seealso \code{\link{plotData}}, \code{\link{plotPrecision}}, #' \code{\link{plotProportions}} #' @rdname plotPValues #' @export setMethod("plotPValues", "dmDStest", function(x, level = "gene"){ stopifnot(length(level) == 1) stopifnot(level %in% c("gene", "feature")) res <- slot(x, paste0("results_", level)) if(nrow(res) > 0) ggp <- dm_plotPValues(pvalues = res[, "pvalue"]) else stop("Feature-level results are not available! Set bb_model=TRUE in dmFit and dmTest") return(ggp) }) DRIMSeq/R/class_dmSQTLdata.R0000755000175100017510000005036214614306665016471 0ustar00biocbuildbiocbuild#' @include class_MatrixList.R NULL ############################################################################### ### dmSQTLdata class ############################################################################### #' dmSQTLdata object #' #' dmSQTLdata contains genomic feature expression (counts), genotypes and sample #' information needed for the transcript/exon usage QTL analysis. It can be #' created with function \code{\link{dmSQTLdata}}. #' #' @return #' #' \itemize{ \item \code{names(x)}: Get the gene names. \item \code{length(x)}: #' Get the number of genes. \item \code{x[i, j]}: Get a subset of dmDSdata #' object that consists of counts, genotypes and blocks corresponding to genes i #' and samples j. } #' #' @param x,object dmSQTLdata object. #' @param i,j Parameters used for subsetting. #' #' @slot counts \code{\linkS4class{MatrixList}} of expression, in counts, of #' genomic features. Rows correspond to genomic features, such as exons or #' transcripts. Columns correspond to samples. MatrixList is partitioned in a #' way that each of the matrices in a list contains counts for a single gene. #' @slot genotypes MatrixList of unique genotypes. Rows correspond to blocks, #' columns to samples. Each matrix in this list is a collection of unique #' genotypes that are matched with a given gene. #' @slot blocks MatrixList with two columns \code{block_id} and \code{snp_id}. #' For each gene, it identifies SNPs with identical genotypes across the #' samples and assigns them to blocks. #' @slot samples Data frame with information about samples. It must contain #' variable \code{sample_id} with unique sample names. #' #' @examples #' # -------------------------------------------------------------------------- #' # Create dmSQTLdata object #' # -------------------------------------------------------------------------- #' # Use subsets of data defined in the GeuvadisTranscriptExpr package #' #' library(GeuvadisTranscriptExpr) #' \donttest{ #' geuv_counts <- GeuvadisTranscriptExpr::counts #' geuv_genotypes <- GeuvadisTranscriptExpr::genotypes #' geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges #' geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges #' #' colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") #' colnames(geuv_genotypes)[4] <- "snp_id" #' geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) #' #' d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, #' genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, #' samples = geuv_samples, window = 5e3) #' } #' @author Malgorzata Nowicka #' @seealso \code{\linkS4class{dmSQTLprecision}}, #' \code{\linkS4class{dmSQTLfit}}, \code{\linkS4class{dmSQTLtest}} setClass("dmSQTLdata", representation(counts = "MatrixList", genotypes = "MatrixList", blocks = "MatrixList", samples = "data.frame")) ################################### setValidity("dmSQTLdata", function(object){ ### Has to return TRUE when valid object! if(!ncol(object@counts) == ncol(object@genotypes)) return(paste0("Unequal number of samples in 'counts' and 'genotypes' ", ncol(object@counts), " and ", ncol(object@genotypes))) ### Mystery: This does not pass # if(!all(colnames(object@blocks) %in% c("block_id", "snp_id"))) # return(paste0("'blocks' must contain 'block_id' and 'snp_id' variables")) if(!all(names(object@counts) == names(object@genotypes))) return("'genotypes' and 'counts' do not contain the same genes") if(!all(names(object@blocks) == names(object@genotypes))) return("'genotypes' and 'blocks' do not contain the same genes or SNPs") return(TRUE) }) ############################################################################### ### show, accessing and subsetting methods ############################################################################### #' @rdname dmSQTLdata-class #' @export setMethod("counts", "dmSQTLdata", function(object){ data.frame(gene_id = rep(names(object@counts), elementNROWS(object@counts)), feature_id = rownames(object@counts), object@counts@unlistData, stringsAsFactors = FALSE, row.names = NULL) }) #' @rdname dmSQTLdata-class #' @export setMethod("samples", "dmSQTLdata", function(x) x@samples ) ################################ setMethod("show", "dmSQTLdata", function(object){ cat("An object of class", class(object), "\n") cat("with", length(object), "genes and", ncol(object@counts), "samples\n") cat("* data accessors: counts(), samples()\n") }) ################################ #' @rdname dmSQTLdata-class #' @export setMethod("names", "dmSQTLdata", function(x) names(x@counts) ) #' @rdname dmSQTLdata-class #' @export setMethod("length", "dmSQTLdata", function(x) length(x@counts) ) #' @aliases [,dmSQTLdata-method [,dmSQTLdata,ANY-method #' @rdname dmSQTLdata-class #' @export setMethod("[", "dmSQTLdata", function(x, i, j){ if(missing(j)){ counts <- x@counts[i, , drop = FALSE] genotypes <- x@genotypes[i, , drop = FALSE] blocks <- x@blocks[i, , drop = FALSE] samples <- x@samples }else{ if(missing(i)){ counts <- x@counts[, j, drop = FALSE] genotypes <- x@genotypes[, j, drop = FALSE] }else{ counts <- x@counts[i, j, drop = FALSE] genotypes <- x@genotypes[i, j, drop = FALSE] blocks <- x@blocks[i, , drop = FALSE] } samples <- x@samples rownames(samples) <- samples$sample_id samples <- samples[j, , drop = FALSE] samples$sample_id <- factor(samples$sample_id) rownames(samples) <- NULL } return(new("dmSQTLdata", counts = counts, genotypes = genotypes, blocks = blocks, samples = samples)) }) ############################################################################### ### dmSQTLdata ############################################################################### blocks_per_gene <- function(g, genotypes){ # g = 1 genotypes_df <- data.frame(t(genotypes[[g]])) matching_snps <- match(genotypes_df, genotypes_df) oo <- order(matching_snps, decreasing = FALSE) block_id <- paste0("block_", as.numeric(factor(matching_snps))) snp_id <- colnames(genotypes_df) blocks_tmp <- cbind(block_id, snp_id) return(blocks_tmp[oo, , drop = FALSE]) } #' Create dmSQTLdata object #' #' Constructor functions for a \code{\linkS4class{dmSQTLdata}} object. #' dmSQTLdata assignes to a gene all the SNPs that are located in a given #' surrounding (\code{window}) of this gene. #' #' It is quite common that sample grouping defined by some of the SNPs is #' identical. Compare \code{dim(genotypes)} and \code{dim(unique(genotypes))}. #' In our QTL analysis, we do not repeat tests for the SNPs that define the #' same grouping of samples. Each grouping is tested only once. SNPs that define #' such unique groupings are aggregated into blocks. P-values and adjusted #' p-values are estimated at the block level, but the returned results are #' extended to a SNP level by repeating the block statistics for each SNP that #' belongs to a given block. #' #' @inheritParams dmDSdata #' @param genotypes Data frame with genotypes. Rows correspond to SNPs. This #' data frame has to contain a \code{snp_id} column with SNP IDs and columns #' with genotypes for each sample. Column names corresponding to sample IDs #' must be the same as in the \code{sample} data frame. The genotype of each #' sample is coded in the following way: 0 for ref/ref, 1 for ref/not ref, 2 #' for not ref/not ref, -1 or \code{NA} for missing value. #' @param gene_ranges \code{\linkS4class{GRanges}} object with gene location. It #' must contain gene names when calling names(). #' @param snp_ranges \code{\linkS4class{GRanges}} object with SNP location. It #' must contain SNP names when calling names(). #' @param window Size of a down and up stream window, which is defining the #' surrounding for a gene. Only SNPs that are located within a gene or its #' surrounding are considered in the sQTL analysis. #' @param samples Data frame with column \code{sample_id} corresponding to #' unique sample IDs #' @param BPPARAM Parallelization method used by #' \code{\link[BiocParallel]{bplapply}}. #' #' @return Returns a \code{\linkS4class{dmSQTLdata}} object. #' #' @examples #' # -------------------------------------------------------------------------- #' # Create dmSQTLdata object #' # -------------------------------------------------------------------------- #' # Use subsets of data defined in the GeuvadisTranscriptExpr package #' #' library(GeuvadisTranscriptExpr) #' \donttest{ #' geuv_counts <- GeuvadisTranscriptExpr::counts #' geuv_genotypes <- GeuvadisTranscriptExpr::genotypes #' geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges #' geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges #' #' colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") #' colnames(geuv_genotypes)[4] <- "snp_id" #' geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) #' #' d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, #' genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, #' samples = geuv_samples, window = 5e3) #' } #' @seealso \code{\link{plotData}} #' @author Malgorzata Nowicka #' @export #' @importFrom IRanges width #' @importFrom S4Vectors queryHits subjectHits dmSQTLdata <- function(counts, gene_ranges, genotypes, snp_ranges, samples, window = 5e3, BPPARAM = BiocParallel::SerialParam()){ stopifnot(is.numeric(window)) stopifnot(window >= 0) ### Check on samples stopifnot(class(samples) == "data.frame") stopifnot("sample_id" %in% colnames(samples)) stopifnot(sum(duplicated(samples$sample_id)) == 0) ### Check on counts stopifnot(class(counts) == "data.frame") stopifnot(all(c("gene_id", "feature_id") %in% colnames(counts))) stopifnot(all(samples$sample_id %in% colnames(counts))) ### Check on genotypes stopifnot(class(genotypes) == "data.frame") stopifnot("snp_id" %in% colnames(genotypes)) stopifnot(all(samples$sample_id %in% colnames(counts))) sample_id <- samples$sample_id gene_id <- counts$gene_id feature_id <- counts$feature_id snp_id <- genotypes$snp_id stopifnot( class( gene_id ) %in% c("character", "factor")) stopifnot( class( feature_id ) %in% c("character", "factor")) stopifnot( class( sample_id ) %in% c("character", "factor")) stopifnot( class( snp_id ) %in% c("character", "factor")) stopifnot(all(!is.na(gene_id))) stopifnot(all(!is.na(feature_id))) stopifnot(all(!is.na(sample_id))) stopifnot(all(!is.na(snp_id))) counts <- counts[, as.character(sample_id), drop = FALSE] counts <- as.matrix(counts) stopifnot(mode(counts) %in% "numeric") genotypes <- genotypes[, as.character(sample_id), drop = FALSE] genotypes <- as.matrix(genotypes) stopifnot(mode(genotypes) %in% "numeric") stopifnot(all(genotypes %in% c(-1, 0, 1, 2, NA))) rownames(genotypes) <- snp_id stopifnot(class(gene_ranges) == "GRanges") stopifnot(class(snp_ranges) == "GRanges") stopifnot(!is.null(names(snp_ranges))) stopifnot(!is.null(names(gene_ranges))) ### Keep genes that are in counts and in gene_ranges genes_overlap <- intersect(names(gene_ranges), gene_id) genes2keep <- gene_id %in% genes_overlap counts <- counts[genes2keep, , drop = FALSE] gene_id <- gene_id[genes2keep] feature_id <- feature_id[genes2keep] gene_ranges <- gene_ranges[genes_overlap, ] ### Keep SNPs that are in genotypes and in snp_ranges ### and make them in the same order snps_overlap <- intersect(names(snp_ranges), snp_id) genotypes <- genotypes[snps_overlap, , drop = FALSE] snp_ranges <- snp_ranges[snps_overlap, ] gene_ranges <- GenomicRanges::resize(gene_ranges, width(gene_ranges) + 2 * window, fix = "center") ## Match genes and SNPs variantMatch <- GenomicRanges::findOverlaps(gene_ranges, snp_ranges, select = "all") q <- queryHits(variantMatch) s <- subjectHits(variantMatch) genotypes <- genotypes[s, ] snp_id <- snp_id[s] gene_id_genotypes <- names(gene_ranges)[q] ### keep genes that are in counts and in genotypes genes2keep <- gene_id %in% gene_id_genotypes counts <- counts[genes2keep, , drop = FALSE] gene_id <- gene_id[genes2keep] feature_id <- feature_id[genes2keep] genes2keep <- gene_id_genotypes %in% gene_id genotypes <- genotypes[genes2keep, , drop = FALSE] gene_id_genotypes <- gene_id_genotypes[genes2keep] snp_id <- snp_id[genes2keep] ### order genes in counts and in genotypes if(class(gene_id) == "character") gene_id <- factor(gene_id, levels = unique(gene_id)) order_counts <- order(gene_id) counts <- counts[order_counts, , drop = FALSE] gene_id <- gene_id[order_counts] feature_id <- feature_id[order_counts] gene_id_genotypes <- factor(gene_id_genotypes, levels = levels(gene_id)) order_genotypes <- order(gene_id_genotypes) genotypes <- genotypes[order_genotypes, , drop = FALSE] gene_id_genotypes <- gene_id_genotypes[order_genotypes] snp_id <- snp_id[order_genotypes] colnames(counts) <- sample_id rownames(counts) <- feature_id colnames(genotypes) <- sample_id rownames(genotypes) <- snp_id inds_counts <- 1:length(gene_id) names(inds_counts) <- feature_id partitioning_counts <- split(inds_counts, gene_id) inds_genotypes <- 1:length(gene_id_genotypes) names(inds_genotypes) <- snp_id partitioning_genotypes <- split(inds_genotypes, gene_id_genotypes) counts <- new( "MatrixList", unlistData = counts, partitioning = partitioning_counts) genotypes <- new( "MatrixList", unlistData = genotypes, partitioning = partitioning_genotypes) ### Keep unique genotypes and create info about blocs inds <- 1:length(genotypes) blocks <- MatrixList(BiocParallel::bplapply(inds, blocks_per_gene, genotypes = genotypes, BPPARAM = BPPARAM)) names(blocks) <- names(genotypes) genotypes_u <- MatrixList(lapply(inds, function(g){ # g = 1 genotypes_tmp <- unique(genotypes[[g]]) rownames(genotypes_tmp) <- paste0("block_", 1:nrow(genotypes_tmp)) return(genotypes_tmp) })) names(genotypes_u) <- names(genotypes) samples <- data.frame(sample_id = sample_id) data <- new("dmSQTLdata", counts = counts, genotypes = genotypes_u, blocks = blocks, samples = samples) return(data) } ################################################################################ ### dmFilter ################################################################################ #' @param minor_allele_freq Minimal number of samples where each of the #' genotypes has to be present. #' @param BPPARAM Parallelization method used by #' \code{\link[BiocParallel]{bplapply}}. #' @details #' #' In QTL analysis, usually, we deal with data that has many more replicates #' than data from a standard differential usage assay. Our example data set #' consists of 91 samples. Requiring that genes are expressed in all samples may #' be too stringent, especially since there may be missing values in the data #' and for some genes you may not observe counts in all 91 samples. Slightly #' lower threshold ensures that we do not eliminate such genes. For example, if #' \code{min_samps_gene_expr = 70} and \code{min_gene_expr = 10}, only genes #' with expression of at least 10 in at least 70 samples are kept. Samples with #' expression lower than 10 have \code{NA}s assigned and are skipped in the #' analysis of this gene. \code{minor_allele_freq} indicates the minimal number #' of samples for the minor allele presence. Usually, it is equal to roughly 5\% #' of total samples. #' #' @examples #' # -------------------------------------------------------------------------- #' # Create dmSQTLdata object #' # -------------------------------------------------------------------------- #' # Use subsets of data defined in the GeuvadisTranscriptExpr package #' #' library(GeuvadisTranscriptExpr) #' \donttest{ #' geuv_counts <- GeuvadisTranscriptExpr::counts #' geuv_genotypes <- GeuvadisTranscriptExpr::genotypes #' geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges #' geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges #' #' colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") #' colnames(geuv_genotypes)[4] <- "snp_id" #' geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) #' #' d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, #' genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, #' samples = geuv_samples, window = 5e3) #' #' # -------------------------------------------------------------------------- #' # sQTL analysis - simple group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, #' minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' } #' @rdname dmFilter #' @export setMethod("dmFilter", "dmSQTLdata", function(x, min_samps_gene_expr = 0, min_samps_feature_expr = 0, min_samps_feature_prop = 0, minor_allele_freq = 0.05 * nrow(samples(x)), min_gene_expr = 0, min_feature_expr = 0, min_feature_prop = 0, BPPARAM = BiocParallel::SerialParam()){ stopifnot(min_samps_gene_expr >= 0 && min_samps_gene_expr <= ncol(x@counts)) stopifnot(min_gene_expr >= 0) stopifnot(min_samps_feature_expr >= 0 && min_samps_feature_expr <= ncol(x@counts)) stopifnot(min_feature_expr >= 0) stopifnot(min_samps_feature_prop >= 0 && min_samps_feature_prop <= ncol(x@counts)) stopifnot(min_feature_prop >= 0 && min_feature_prop <= 1) stopifnot(minor_allele_freq >= 1 && minor_allele_freq <= floor(nrow(samples(x))/2)) data_filtered <- dmSQTL_filter(counts = x@counts, genotypes = x@genotypes, blocks = x@blocks, samples = x@samples, min_samps_gene_expr = min_samps_gene_expr, min_gene_expr = min_gene_expr, min_samps_feature_expr = min_samps_feature_expr, min_feature_expr = min_feature_expr, min_samps_feature_prop = min_samps_feature_prop, min_feature_prop = min_feature_prop, minor_allele_freq = minor_allele_freq, BPPARAM = BPPARAM) return(data_filtered) }) ############################################################################### ### plotData ############################################################################### #' @param plot_type Character specifying which type of histogram to plot. Possible #' values \code{"features"}, \code{"snps"} or \code{"blocks"}. #' @examples #' # -------------------------------------------------------------------------- #' # Create dmSQTLdata object #' # -------------------------------------------------------------------------- #' # Use subsets of data defined in the GeuvadisTranscriptExpr package #' #' library(GeuvadisTranscriptExpr) #' \donttest{ #' geuv_counts <- GeuvadisTranscriptExpr::counts #' geuv_genotypes <- GeuvadisTranscriptExpr::genotypes #' geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges #' geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges #' #' colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") #' colnames(geuv_genotypes)[4] <- "snp_id" #' geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) #' #' d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, #' genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, #' samples = geuv_samples, window = 5e3) #' #' # -------------------------------------------------------------------------- #' # sQTL analysis - simple group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, #' minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' } #' @rdname plotData #' @export setMethod("plotData", "dmSQTLdata", function(x, plot_type = "features"){ stopifnot(length(plot_type) == 1) stopifnot(plot_type %in% c("features", "snps", "blocks")) switch(plot_type, features = { tt <- elementNROWS(x@counts) ggp <- dm_plotDataFeatures(tt) }, snps = { tt <- elementNROWS(x@blocks) ggp <- dm_plotDataSnps(tt) }, blocks = { tt <- elementNROWS(x@genotypes) ggp <- dm_plotDataBlocks(tt) } ) return(ggp) }) DRIMSeq/R/class_dmSQTLfit.R0000755000175100017510000001776514614306665016354 0ustar00biocbuildbiocbuild#' @include class_dmSQTLprecision.R class_dmDSfit.R NULL ################################################################################ ### dmSQTLfit class ################################################################################ #' dmSQTLfit object #' #' dmSQTLfit extends the \code{\linkS4class{dmSQTLprecision}} class by adding #' the full model Dirichlet-multinomial (DM) likelihoods, #' regression coefficients and feature proportion estimates needed for the #' transcript/exon usage QTL analysis. Full model is defined by the genotype of #' a SNP associated with a gene. Estimation takes place for all the genes and #' all the SNPs/blocks assigned to the genes. Result of \code{\link{dmFit}}. #' #' @slot fit_full List of \code{\linkS4class{MatrixList}} objects containing #' estimated feature ratios in each sample based on the full #' Dirichlet-multinomial (DM) model. #' @slot lik_full List of numeric vectors of the per gene DM full model #' likelihoods. #' @slot coef_full \code{\linkS4class{MatrixList}} with the regression #' coefficients based on the DM model. #' @examples #' # -------------------------------------------------------------------------- #' # Create dmSQTLdata object #' # -------------------------------------------------------------------------- #' # Use subsets of data defined in the GeuvadisTranscriptExpr package #' #' library(GeuvadisTranscriptExpr) #' \donttest{ #' geuv_counts <- GeuvadisTranscriptExpr::counts #' geuv_genotypes <- GeuvadisTranscriptExpr::genotypes #' geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges #' geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges #' #' colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") #' colnames(geuv_genotypes)[4] <- "snp_id" #' geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) #' #' d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, #' genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, #' samples = geuv_samples, window = 5e3) #' #' # -------------------------------------------------------------------------- #' # sQTL analysis - simple group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, #' minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d) #' #' plotPrecision(d) #' #' ## Fit full model proportions #' d <- dmFit(d) #' } #' @author Malgorzata Nowicka #' @seealso \code{\linkS4class{dmSQTLdata}}, #' \code{\linkS4class{dmSQTLprecision}}, \code{\linkS4class{dmSQTLtest}} setClass("dmSQTLfit", contains = "dmSQTLprecision", representation(fit_full = "list", lik_full = "list", coef_full = "list")) ######################################## setValidity("dmSQTLfit", function(object){ # Has to return TRUE when valid object # TODO: Add checks for other slots if(!length(object@counts) == length(object@lik_full)) return("Different number of genes in 'counts' and 'lik_full'") return(TRUE) }) ################################################################################ ### show methods ################################################################################ setMethod("show", "dmSQTLfit", function(object){ callNextMethod(object) }) ################################################################################ ### dmFit ################################################################################ #' @details In the QTL analysis, currently, genotypes are defined as numeric #' values 0, 1, and 2. When \code{one_way = TRUE}, simple multiple group fitting #' is performed. When \code{one_way = FALSE}, a regression framework is used #' with the design matrix defined by a formula \code{~ group} where group is a #' continuous (not categorical) variable with values 0, 1, and 2. #' @rdname dmFit #' @export setMethod("dmFit", "dmSQTLprecision", function(x, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, BPPARAM = BiocParallel::SerialParam()){ # Check parameters stopifnot(is.logical(one_way)) stopifnot(length(prop_mode) == 1) stopifnot(prop_mode %in% c("constrOptim")) stopifnot(length(prop_tol) == 1) stopifnot(is.numeric(prop_tol) && prop_tol > 0) stopifnot(length(coef_mode) == 1) stopifnot(coef_mode %in% c("optim", "nlminb", "nlm")) stopifnot(length(coef_tol) == 1) stopifnot(is.numeric(coef_tol) && coef_tol > 0) stopifnot(verbose %in% 0:3) fit <- dmSQTL_fit(counts = x@counts, genotypes = x@genotypes, precision = x@genewise_precision, one_way = one_way, group_formula = ~ group, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, return_fit = FALSE, return_coef = FALSE, verbose = verbose, BPPARAM = BPPARAM) return(new("dmSQTLfit", lik_full = fit[["lik"]], fit_full = fit[["fit"]], mean_expression = x@mean_expression, common_precision = x@common_precision, genewise_precision = x@genewise_precision, counts = x@counts, genotypes = x@genotypes, blocks = x@blocks, samples = x@samples)) }) ################################################################################ ### plotProportions ################################################################################ #' @param snp_id Character indicating the ID of a SNP to be plotted. #' @details In the QTL analysis, plotting of fitted proportions is deactivated #' even when \code{plot_fit = TRUE}. It is due to the fact that neither fitted #' values nor regression coefficients are returned by the \code{dmFit} #' function as they occupy a lot of memory. #' @rdname plotProportions #' @export setMethod("plotProportions", "dmSQTLfit", function(x, gene_id, snp_id, plot_type = "boxplot1", order_features = TRUE, order_samples = TRUE, plot_fit = FALSE, plot_main = TRUE, group_colors = NULL, feature_colors = NULL){ stopifnot(gene_id %in% names(x@blocks)) if(!snp_id %in% x@blocks[[gene_id, "snp_id"]]) stop(paste0("gene ",gene_id, " and SNP ", snp_id, " do not match!")) stopifnot(plot_type %in% c("barplot", "boxplot1", "boxplot2", "lineplot", "ribbonplot")) stopifnot(is.logical(order_features)) stopifnot(is.logical(order_samples)) stopifnot(is.logical(plot_fit)) stopifnot(is.logical(plot_main)) counts_gene <- x@counts[[gene_id]] block_id <- x@blocks[[gene_id]][x@blocks[[gene_id]][, "snp_id"] == snp_id, "block_id"] group <- x@genotypes[[gene_id]][block_id, ] if(!is.null(group_colors) && plot_type %in% c("barplot", "boxplot1", "lineplot")) stopifnot(length(group_colors) == nlevels(group)) if(!is.null(feature_colors) && plot_type %in% c("boxplot2", "ribbonplot")) stopifnot(length(feature_colors) == nrow(counts_gene)) if(nrow(counts_gene) <= 1) stop("!Gene has to have at least 2 features! \n") # Remove NAs nonNAs <- !(is.na(counts_gene[1,]) | is.na(group)) counts_gene <- counts_gene[, nonNAs, drop = FALSE] group <- factor(group[nonNAs]) main <- NULL if(plot_main){ mean_expression_gene <- mean(colSums(counts_gene), na.rm = TRUE) main <- paste0(gene_id, " : ", snp_id, " : ", block_id, "\n Mean expression = ", round(mean_expression_gene)) precision_gene <- x@genewise_precision[[gene_id]][block_id] main <- paste0(main, ", Precision = ", round(precision_gene, 2)) } fit_full <- NULL if(plot_fit && length(x@fit_full) > 0){ fit_full <- x@fit_full[[gene_id]][[which(rownames(x@genotypes[[gene_id]]) == block_id)]][, nonNAs, drop = FALSE] } ggp <- dm_plotProportions(counts = counts_gene, group = group, fit_full = fit_full, main = main, plot_type = plot_type, order_features = order_features, order_samples = order_samples, group_colors = group_colors, feature_colors = feature_colors) return(ggp) }) DRIMSeq/R/class_dmSQTLprecision.R0000755000175100017510000003105214614306665017546 0ustar00biocbuildbiocbuild#' @include class_dmSQTLdata.R NULL ############################################################################### ### dmSQTLprecision class ############################################################################### #' dmSQTLprecision object #' #' dmSQTLprecision extends the \code{\linkS4class{dmSQTLdata}} by adding the #' precision estimates of Dirichlet-multinomial distribution used to model the #' feature (e.g., transcript, exon, exonic bin) counts for each gene-SNP pair in #' the QTL analysis. Result of \code{\link{dmPrecision}}. #' #' @return #' #' \itemize{ \item \code{mean_expression(x)}: Get a data frame with mean gene #' expression. \item \code{common_precision(x)}: Get common precision. \item #' \code{genewise_precision(x)}: Get a data frame with gene-wise precision.} #' #' @param x dmSQTLprecision object. #' #' @slot mean_expression Numeric vector of mean gene expression. #' @slot common_precision Numeric value of estimated common precision. #' @slot genewise_precision List of estimated gene-wise precisions. Each element #' of this list is a vector of precisions estimated for all the genotype #' blocks assigned to a given gene. #' #' @examples #' # -------------------------------------------------------------------------- #' # Create dmSQTLdata object #' # -------------------------------------------------------------------------- #' # Use subsets of data defined in the GeuvadisTranscriptExpr package #' #' library(GeuvadisTranscriptExpr) #' \donttest{ #' geuv_counts <- GeuvadisTranscriptExpr::counts #' geuv_genotypes <- GeuvadisTranscriptExpr::genotypes #' geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges #' geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges #' #' colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") #' colnames(geuv_genotypes)[4] <- "snp_id" #' geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) #' #' d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, #' genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, #' samples = geuv_samples, window = 5e3) #' #' # -------------------------------------------------------------------------- #' # sQTL analysis - simple group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, #' minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d) #' #' plotPrecision(d) #' } #' @author Malgorzata Nowicka #' @seealso \code{\linkS4class{dmSQTLdata}}, \code{\linkS4class{dmSQTLfit}}, #' \code{\linkS4class{dmSQTLtest}} setClass("dmSQTLprecision", contains = "dmSQTLdata", representation(mean_expression = "numeric", common_precision = "numeric", genewise_precision = "list")) # ----------------------------------------------------------------------------- setValidity("dmSQTLprecision", function(object){ # Has to return TRUE when valid object! out <- TRUE if(length(object@mean_expression) > 0){ if(length(object@mean_expression) == length(object@counts)){ if(all(names(object@mean_expression) == names(object@counts))) out <- TRUE else return("Different names of 'counts' and 'mean_expression'") } else return("Unequal length of 'counts' and 'mean_expression'") } if(length(object@genewise_precision) > 0){ if(length(object@genewise_precision) == length(object@counts)){ if(all(lapply(object@genewise_precision, length) == elementNROWS(object@genotypes))) out <- TRUE else return("Different numbers of blocks in 'genotypes' and in 'genewise_precision'") } else return("Unequal number of genes in 'counts' and in 'genewise_precision'") } if(length(object@common_precision) > 0){ if(length(object@common_precision) == 1) out <- TRUE else return("'common_precision' must be a vector of length 1") } return(out) }) ################################################################################ ### accessing methods ################################################################################ #' @rdname dmSQTLprecision-class #' @export setMethod("mean_expression", "dmSQTLprecision", function(x){ data.frame(gene_id = names(x@mean_expression), mean_expression = x@mean_expression, stringsAsFactors = FALSE, row.names = NULL) }) #' @rdname dmSQTLprecision-class #' @export setMethod("common_precision", "dmSQTLprecision", function(x) x@common_precision ) #' @rdname dmSQTLprecision-class #' @export setMethod("genewise_precision", "dmSQTLprecision", function(x){ data.frame(gene_id = rep(names(x@genewise_precision), sapply(x@genewise_precision, length)), block_id = unlist(lapply(x@genewise_precision, names)), genewise_precision = unlist(x@genewise_precision), stringsAsFactors = FALSE, row.names = NULL) }) ################################################################################ ### show methods ################################################################################ setMethod("show", "dmSQTLprecision", function(object){ callNextMethod(object) cat(" mean_expression(), common_precision(), genewise_precision()\n") }) ################################################################################ ### dmPrecision ################################################################################ #' @rdname dmPrecision #' @param speed Logical. If \code{FALSE}, precision is calculated per each #' gene-block. Such calculation may take a long time, since there can be #' hundreds of SNPs/blocks per gene. If \code{TRUE}, there will be only one #' precision calculated per gene and it will be assigned to all the blocks #' matched with this gene. #' @export setMethod("dmPrecision", "dmSQTLdata", function(x, mean_expression = TRUE, common_precision = TRUE, genewise_precision = TRUE, prec_adjust = TRUE, prec_subset = 0.1, prec_interval = c(0, 1e+3), prec_tol = 1e+01, prec_init = 100, prec_grid_length = 21, prec_grid_range = c(-10, 10), prec_moderation = "none", prec_prior_df = 0, prec_span = 0.1, one_way = TRUE, speed = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, BPPARAM = BiocParallel::SerialParam()){ ### Parameter checks: stopifnot(is.logical(mean_expression)) stopifnot(is.logical(common_precision)) stopifnot(is.logical(genewise_precision)) stopifnot(is.logical(prec_adjust)) stopifnot(length(prec_subset) == 1) stopifnot(is.numeric(prec_subset) && prec_subset > 0 && prec_subset <= 1) stopifnot(length(prec_interval) == 2) stopifnot(prec_interval[1] < prec_interval[2]) stopifnot(length(prec_tol) == 1) stopifnot(is.numeric(prec_tol) && prec_tol > 0) stopifnot(length(prec_init) == 1) stopifnot(is.numeric(prec_init)) stopifnot(prec_grid_length > 2) stopifnot(length(prec_grid_range) == 2) stopifnot(prec_grid_range[1] < prec_grid_range[2]) stopifnot(length(prec_moderation) == 1) stopifnot(prec_moderation %in% c("none", "common", "trended")) stopifnot(length(prec_prior_df) == 1) stopifnot(is.numeric(prec_prior_df) && prec_prior_df >= 0) stopifnot(length(prec_span) == 1) stopifnot(is.numeric(prec_span) && prec_span > 0 && prec_span < 1) stopifnot(is.logical(one_way)) stopifnot(is.logical(speed)) stopifnot(length(prop_mode) == 1) stopifnot(prop_mode %in% c("constrOptim")) stopifnot(length(prop_tol) == 1) stopifnot(is.numeric(prop_tol) && prop_tol > 0) stopifnot(length(coef_mode) == 1) stopifnot(coef_mode %in% c("optim", "nlminb", "nlm")) stopifnot(length(coef_tol) == 1) stopifnot(is.numeric(coef_tol) && coef_tol > 0) stopifnot(verbose %in% 0:2) if(mean_expression || (genewise_precision && prec_moderation == "trended")){ mean_expression <- dm_estimateMeanExpression(counts = x@counts, verbose = verbose) }else{ mean_expression <- numeric() } if(common_precision){ if(prec_subset < 1){ message(paste0("! Using a subset of ", prec_subset, " genes to estimate common precision !\n")) genes2keep <- sample(1:length(x@counts), max(round(prec_subset * length(x@counts)), 1), replace = FALSE) }else{ genes2keep <- 1:length(x@counts) } ### Use only one SNP per gene and a null model to make computation faster genotypes_null <- new("MatrixList", unlistData = matrix(1, nrow = length(genes2keep), ncol = ncol(x@genotypes)), partitioning = split(1:length(genes2keep), factor(names(x@genotypes[genes2keep, ]), levels = names(x@genotypes[genes2keep, ])))) common_precision <- dmSQTL_estimateCommonPrecision( counts = x@counts[genes2keep, ], genotypes = genotypes_null, prec_adjust = prec_adjust, prec_interval = prec_interval, prec_tol = prec_tol, one_way = one_way, group_formula = ~ 1, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) }else{ common_precision <- numeric() } if(genewise_precision){ if(length(common_precision)){ message("! Using common_precision = ", round(common_precision, 4), " as prec_init !") prec_init <- common_precision } if(speed){ ### Use only one SNP per gene and a null model to make computation faster G <- length(x@genotypes) inds <- 1:G genotypes_null <- new( "MatrixList", unlistData = matrix(1, nrow = G, ncol = ncol(x@genotypes)), partitioning = split(inds, factor(names(x@genotypes), levels = names(x@genotypes))) ) genewise_precision <- dmSQTL_estimateTagwisePrecision(counts = x@counts, genotypes = genotypes_null, mean_expression = mean_expression, prec_adjust = prec_adjust, prec_init = prec_init, prec_grid_length = prec_grid_length, prec_grid_range = prec_grid_range, prec_moderation = prec_moderation, prec_prior_df = prec_prior_df, prec_span = prec_span, one_way = one_way, group_formula = ~ 1, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) ### Replicate the values for all the snps genewise_precision <- relist(rep(unlist(genewise_precision), times = elementNROWS(x@genotypes)), x@genotypes@partitioning) }else{ genewise_precision <- dmSQTL_estimateTagwisePrecision(counts = x@counts, genotypes = x@genotypes, mean_expression = mean_expression, prec_adjust = prec_adjust, prec_init = prec_init, prec_grid_length = prec_grid_length, prec_grid_range = prec_grid_range, prec_moderation = prec_moderation, prec_prior_df = prec_prior_df, prec_span = prec_span, one_way = one_way, group_formula = ~ group, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) } }else{ genewise_precision <- list() } return(new("dmSQTLprecision", mean_expression = mean_expression, common_precision = common_precision, genewise_precision = genewise_precision, counts = x@counts, genotypes = x@genotypes, blocks = x@blocks, samples = x@samples)) }) ############################################################################### ### plotPrecision ############################################################################### #' @rdname plotPrecision #' @export setMethod("plotPrecision", "dmSQTLprecision", function(x){ if(!length(x@genewise_precision) == length(x@counts)) stop("Genewise precision must be estimated for each gene!") if(!length(x@genewise_precision) == length(x@mean_expression)) stop("Mean expression must be estimated for each gene!") w <- sapply(x@genewise_precision, length) mean_expression <- rep(x@mean_expression, w) nr_features <- rep(elementNROWS(x@counts), w) genewise_precision <- unlist(x@genewise_precision) if(length(x@common_precision) == 0){ common_precision <- NULL }else{ common_precision <- x@common_precision } ggp <- dm_plotPrecision(genewise_precision = genewise_precision, mean_expression = mean_expression, nr_features = nr_features, common_precision = common_precision) return(ggp) }) DRIMSeq/R/class_dmSQTLtest.R0000755000175100017510000002206014614306665016531 0ustar00biocbuildbiocbuild#' @include class_dmSQTLfit.R class_dmDStest.R NULL ############################################################################### ### dmSQTLtest class ############################################################################### #' dmSQTLtest object #' #' dmSQTLtest extends the \code{\linkS4class{dmSQTLfit}} class by adding the #' null model Dirichlet-multinomial likelihoods and the gene-level results of #' testing for differential transcript/exon usage QTLs. Result of #' \code{\link{dmTest}}. #' #' @return #' #' \itemize{ \item \code{results(x)}: Get a data frame with gene-level results. #' } #' #' @param x dmSQTLtest object. #' @param ... Other parameters that can be defined by methods using this #' generic. #' #' @slot lik_null List of numeric vectors with the per gene-snp DM null model #' likelihoods. #' @slot results_gene Data frame with the gene-level results including: #' \code{gene_id} - gene IDs, \code{block_id} - block IDs, \code{snp_id} - SNP #' IDs, \code{lr} - likelihood ratio statistics based on the DM model, #' \code{df} - degrees of freedom, \code{pvalue} - p-values estimated based on #' permutations and \code{adj_pvalue} - Benjamini & Hochberg adjusted #' p-values. #' #' @examples #' # -------------------------------------------------------------------------- #' # Create dmSQTLdata object #' # -------------------------------------------------------------------------- #' # Use subsets of data defined in the GeuvadisTranscriptExpr package #' #' library(GeuvadisTranscriptExpr) #' #' geuv_counts <- GeuvadisTranscriptExpr::counts #' geuv_genotypes <- GeuvadisTranscriptExpr::genotypes #' geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges #' geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges #' #' colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") #' colnames(geuv_genotypes)[4] <- "snp_id" #' geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) #' #' d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, #' genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, #' samples = geuv_samples, window = 5e3) #' #' # -------------------------------------------------------------------------- #' # sQTL analysis - simple group comparison #' # -------------------------------------------------------------------------- #' #' ## Filtering #' d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, #' minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) #' #' plotData(d) #' #' ## To make the analysis reproducible #' set.seed(123) #' ## Calculate precision #' d <- dmPrecision(d) #' #' plotPrecision(d) #' #' ## Fit full model proportions #' d <- dmFit(d) #' #' ## Fit null model proportions, perform the LR test to detect tuQTLs #' ## and use the permutation approach to adjust the p-values #' d <- dmTest(d) #' #' ## Plot the gene-level p-values #' plotPValues(d) #' #' ## Get the gene-level results #' head(results(d)) #' #' @author Malgorzata Nowicka #' @seealso \code{\linkS4class{dmSQTLdata}}, #' \code{\linkS4class{dmSQTLprecision}}, \code{\linkS4class{dmSQTLfit}} setClass("dmSQTLtest", contains = "dmSQTLfit", representation(lik_null = "list", results_gene = "data.frame")) ##################################### setValidity("dmSQTLtest", function(object){ # has to return TRUE when valid object! # TODO: Add more checks if(!length(object@counts) == length(object@lik_null)) return("Different number of genes in 'counts' and 'lik_null'") return(TRUE) }) ############################################################################### ### show and accessing methods ############################################################################### #' @rdname dmSQTLtest-class #' @export setMethod("results", "dmSQTLtest", function(x) x@results_gene) # ----------------------------------------------------------------------------- setMethod("show", "dmSQTLtest", function(object){ callNextMethod(object) cat(" results()\n") }) ############################################################################### ### dmTest ############################################################################### #' @param permutation_mode Character specifying which permutation scheme to #' apply for p-value calculation. When equal to \code{"all_genes"}, null #' distribution of p-values is calculated from all genes and the maximum #' number of permutation cycles is 10. When \code{permutation_mode = #' "per_gene"}, null distribution of p-values is calculated for each gene #' separately based on permutations of this individual gene. The latter #' approach may take a lot of computational time. We suggest using the first #' option. #' @rdname dmTest #' @export setMethod("dmTest", "dmSQTLfit", function(x, permutation_mode = "all_genes", one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, BPPARAM = BiocParallel::SerialParam()){ # Check parameters stopifnot(permutation_mode %in% c("all_genes", "per_gene")) stopifnot(is.logical(one_way)) stopifnot(length(prop_mode) == 1) stopifnot(prop_mode %in% c("constrOptim")) stopifnot(length(prop_tol) == 1) stopifnot(is.numeric(prop_tol) && prop_tol > 0) stopifnot(length(coef_mode) == 1) stopifnot(coef_mode %in% c("optim", "nlminb", "nlm")) stopifnot(length(coef_tol) == 1) stopifnot(is.numeric(coef_tol) && coef_tol > 0) stopifnot(verbose %in% 0:2) # Prepare null (one group) genotypes genotypes_null <- x@genotypes genotypes_null@unlistData[!is.na(genotypes_null@unlistData)] <- 1 # Fit the DM null model fit0 <- dmSQTL_fit(counts = x@counts, genotypes = genotypes_null, precision = x@genewise_precision, one_way = one_way, group_formula = ~ 1, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, return_fit = FALSE, return_coef = FALSE, verbose = verbose, BPPARAM = BPPARAM) ## Perform the LR test results_list <- lapply(1:length(x@counts), function(g){ # g = 1 ## Calculate the degrees of freedom df <- (nrow(x@counts[[g]]) - 1) * (apply(x@genotypes[[g]], 1, function(x) length(unique(x))) - 1) out <- dm_LRT(lik_full = x@lik_full[[g]], lik_null = fit0[["lik"]][[g]], df = df, verbose = FALSE) return(out) }) if(verbose) message("\n** Running permutations..\n") ### Calculate adjusted p-values using permutations switch(permutation_mode, all_genes = { ## P-value for a gene computed using all the permutations pvalues <- unlist(lapply(results_list, function(x) x[, "pvalue"])) pval_adj_perm <- dmSQTL_permutations_all_genes(x = x, pvalues = pvalues, max_nr_perm_cycles = 10, max_nr_min_nr_sign_pval = 1e3, one_way = one_way, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) pval_adj_perm <- relist(pval_adj_perm, x@lik_full) }, per_gene = { ## P-value for a gene computed using permutations of that gene pvalues <- lapply(results_list, function(x) x[, "pvalue"]) pval_adj_perm <- dmSQTL_permutations_per_gene(x = x, pvalues = pvalues, max_nr_perm = 1e6, max_nr_sign_pval = 1e2, one_way = one_way, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) } ) pval_adj_perm_BH <- relist(p.adjust(unlist(pval_adj_perm), method="BH"), pval_adj_perm) inds <- 1:length(results_list) for(i in inds){ results_list[[i]][, "pvalue"] <- pval_adj_perm[[i]] results_list[[i]][, "adj_pvalue"] <- pval_adj_perm_BH[[i]] } gene_ids <- names(x@blocks) ## Output the original SNPs results_new <- lapply(inds, function(i){ # i = 4 mm <- match(x@blocks[[i]][, "block_id"], rownames(x@genotypes[[i]])) out <- data.frame(gene_id = gene_ids[i], x@blocks[[i]], results_list[[i]][mm, , drop = FALSE], stringsAsFactors = FALSE) return(out) }) results_new <- do.call(rbind, results_new) return(new("dmSQTLtest", lik_null = fit0[["lik"]], results_gene = results_new, lik_full = x@lik_full, fit_full = x@fit_full, mean_expression = x@mean_expression, common_precision = x@common_precision, genewise_precision = x@genewise_precision, counts = x@counts, genotypes = x@genotypes, blocks = x@blocks, samples = x@samples)) }) ############################################################################### ### plotPValues ############################################################################### #' @rdname plotPValues #' @export setMethod("plotPValues", "dmSQTLtest", function(x){ ### Plot p-values for unique blocks (not SNPs) keep <- !duplicated(x@results_gene[, c("gene_id", "block_id"), drop = FALSE]) ggp <- dm_plotPValues(pvalues = x@results_gene[keep, "pvalue"]) return(ggp) }) DRIMSeq/R/class_MatrixList.R0000644000175100017510000002073414614306665016630 0ustar00biocbuildbiocbuild#' @include class_show_utils.R NULL ############################################################################### ### MatrixList class ############################################################################### #' MatrixList object #' #' A MatrixList object is a container for a list of matrices which have the same #' number of columns but can have varying number of rows. Additionally, one can #' store an extra information corresponding to each of the matrices in #' \code{metadata} matrix. #' #' @return #' #' \itemize{ #' \item \code{names(x)}, \code{names(x) <- value}: Get or set names #' of matrices. #' \item \code{rownames(x)}, \code{rownames(x) <- value}, #' \code{colnames(x)}, \code{colnames(x) <- value}: Get or set row names or #' column names of unlistData slot. #' \item \code{length(x)}: Get the number of #' matrices in a list. #' \item \code{elementNROWS(x)}: Get the number of rows of each of #' the matrices. #' \item \code{dim(x)}, \code{nrow(x)}, \code{ncol(x)}: Get the #' dimensions, number of rows or number of columns of unlistData slot. #' \item #' \code{x[[i]]}, \code{x[[i, j]]}: Get the matrix i, and optionally, get only #' columns j of this matrix. #' \item \code{x$name}: Shortcut for #' \code{x[["name"]]}. #' \item \code{x[i, j]}: Get a subset of MatrixList that #' consists of matrices i with columns j. } #' #' @param x MatrixList object. #' @param value,i,j,name Parameters used for subsetting and assigning new #' attributes to x. #' #' @slot unlistData Matrix which is a row binding of all the matrices in a list. #' @slot partitioning List of indexes which defines the row partitioning of #' unlistData matrix into the original matrices. #' #' @slot metadata Matrix of additional information where each row corresponds to #' one of the matrices in a list. #' @author Malgorzata Nowicka setClass("MatrixList", representation(unlistData = "matrix", partitioning = "list", metadata = "matrix")) ################################### setValidity("MatrixList", function(object){ # has to return TRUE when valid object! partitioning_unlist <- unlist(object@partitioning) if(length(partitioning_unlist) == nrow(object@unlistData)) out <- TRUE else return(paste0("Unequal lengths of partitioning indexes and rows in unlistData: ", length(partitioning_unlist), " and ", nrow(object@unlistData))) if(nrow(object@metadata) > 0){ if(nrow(object@metadata) == length(object@partitioning)) out <- TRUE else return(paste0("Unequal lengths of partitioning and metadata: ", length(object@partitioning), " and ", nrow(object@metadata))) } return(out) }) ############################################################################### ### MatrixList ############################################################################### MatrixList <- function(..., metadata){ listData <- list(...) if (length(listData) == 1L && is.list(listData[[1L]])) listData <- listData[[1L]] if (length(listData) == 0L) { return(new("MatrixList")) } else { if (!all(sapply(listData, is, "matrix"))) stop("all elements in '...' must be matrices!") unlistData <- do.call(rbind, listData) w <- sapply(listData, nrow) partitioning <- vector("list", length(w)) inds <- 1:nrow(unlistData) names(inds) <- rownames(unlistData) partitioning[w != 0] <- split(inds, rep(1:length(w), w)) if(!is.null(names(listData))) names(partitioning) <- names(listData) if(!missing(metadata)) return(new("MatrixList", unlistData = unlistData, partitioning = partitioning, metadata = metadata)) else return(new("MatrixList", unlistData = unlistData, partitioning = partitioning)) } } ################################################################################ ### show method ################################################################################ setMethod("show", "MatrixList", function(object){ nhead <- 2 nl <- length(object) cat(mode(object@unlistData),"MatrixList of length", nl,"\n") if(nl > 0){ np <- min(nl, nhead) object_sub <- object[1:np] if(is.null(names(object_sub))) print_names <- paste0("[[", 1:np, "]]\n") else print_names <- paste0("$", names(object_sub), "\n") for(i in 1:np){ # i = 1 cat(print_names[i]) show_matrix(object_sub[[i]]) cat("\n") } if(np < nl){ if(is.null(names(object_sub))) cat(paste0("[[...]]\n")) else cat(paste0("$...\n")) } } if(nrow(object@metadata) != 0){ cat("\nwith metadata slot\n") show_matrix(object@metadata) } }) ############################################################################### ### accessing methods ############################################################################### #' @rdname MatrixList-class #' @export setMethod("names", "MatrixList", function(x){ names(x@partitioning) }) #' @rdname MatrixList-class #' @export setMethod("names<-", "MatrixList", function(x, value){ names(x@partitioning) <- value x }) #' @rdname MatrixList-class #' @export setMethod("rownames", "MatrixList", function(x){ rownames(x@unlistData) }) #' @rdname MatrixList-class #' @export setMethod("rownames<-", "MatrixList", function(x, value){ rownames(x@unlistData) <- value x }) #' @rdname MatrixList-class #' @export setMethod("colnames", "MatrixList", function(x){ colnames(x@unlistData) }) #' @rdname MatrixList-class #' @export setMethod("colnames<-", "MatrixList", function(x, value){ colnames(x@unlistData) <- value x }) #' @rdname MatrixList-class #' @export setMethod("length", "MatrixList", function(x){ length(x@partitioning) }) #' @rdname MatrixList-class #' @export #' @importFrom S4Vectors elementNROWS setMethod("elementNROWS", "MatrixList", function(x){ sapply(x@partitioning, length) }) #' @rdname MatrixList-class #' @export setMethod("dim", "MatrixList", function(x){ dim(x@unlistData) }) #' @rdname MatrixList-class #' @export setMethod("nrow", "MatrixList", function(x){ nrow(x@unlistData) }) #' @rdname MatrixList-class #' @export setMethod("ncol", "MatrixList", function(x){ ncol(x@unlistData) }) ############################################################################### ### subsetting methods ############################################################################### #' @aliases [[,MatrixList-method #' @rdname MatrixList-class #' @export setMethod("[[", signature(x = "MatrixList"), function(x, i, j){ if(!missing(j)) return(x@unlistData[x@partitioning[[i]], j , drop = FALSE]) else return(x@unlistData[x@partitioning[[i]], , drop = FALSE]) }) #' @rdname MatrixList-class #' @export setMethod("$", "MatrixList", function(x, name){ x[[name]] }) ################################ #' @aliases [,MatrixList-method [,MatrixList,ANY-method #' @rdname MatrixList-class #' @export setMethod("[", signature(x = "MatrixList"), function(x, i, j){ if(!missing(i)){ if(!missing(j)){ if(nrow(x@metadata) != 0) return(new("MatrixList", unlistData = x@unlistData[unlist(x@partitioning[i]), j, drop = FALSE], partitioning = relist(1:nrow(x@unlistData), x@partitioning[i]), metadata = x@metadata[i, , drop = FALSE])) else return(new("MatrixList", unlistData = x@unlistData[unlist(x@partitioning[i]), j, drop = FALSE], partitioning = relist(1:nrow(x@unlistData), x@partitioning[i]), metadata = x@metadata)) }else{ if(nrow(x@metadata) != 0) return(new("MatrixList", unlistData = x@unlistData[unlist(x@partitioning[i]), , drop = FALSE], partitioning = relist(1:nrow(x@unlistData), x@partitioning[i]), metadata = x@metadata[i, , drop = FALSE])) else return(new("MatrixList", unlistData = x@unlistData[unlist(x@partitioning[i]), , drop = FALSE], partitioning = relist(1:nrow(x@unlistData), x@partitioning[i]), metadata = x@metadata)) } }else{ if(!missing(j)){ return(new("MatrixList", unlistData = x@unlistData[, j, drop = FALSE], partitioning = x@partitioning, metadata = x@metadata)) }else{ return(x) } } }) DRIMSeq/R/class_show_utils.R0000644000175100017510000000754614614306665016736 0ustar00biocbuildbiocbuild### Functions that are used in show methods ################################################################################ #' @importFrom utils head tail show_matrix <- function(object, nhead = 2, ntail = 2){ # object is a matrix nr <- nrow(object) nc <- ncol(object) cat(class(object), " with ", nr, ifelse(nr == 1, " row and ", " rows and "), nc, ifelse(nc == 1, " column\n", " columns\n"), sep = "") if(nr > 0 && nc > 0){ if(is.null(colnames(object))){ colnames(object) <- paste0("[,", 1:ncol(object), "]") } if(is.null(rownames(object))){ rownames(object) <- paste0("[", 1:nrow(object), ",]") } if(nr <= (nhead + ntail)){ out <- object }else{ out <- do.call(rbind, list(head(object, nhead), matrix(rep.int("...", nc), 1, nc, dimnames = list(NULL, colnames(object))), tail(object, ntail))) nms <- rownames(object) if(nhead > 0) s1 <- paste0(head(nms, nhead)) if(ntail > 0) s2 <- paste0(tail(nms, ntail)) rownames(out) <- c(s1, "...", s2) } if(nc > (nhead + ntail)){ out <- do.call(cbind, list(out[, 1:nhead, drop = FALSE], matrix(rep.int("...", ifelse(nr < (nhead + ntail + 1L), min(nr, nhead + ntail), nhead + ntail + 1L)), ncol = 1, dimnames = list(NULL, "...")), out[, (nc-ntail+1):nc, drop = FALSE])) } ### print adjusted for numeric or character if(mode(object) == "numeric"){ print(out, quote = FALSE, right = TRUE, na.print = "NA") }else{ print(out, quote = TRUE, right = TRUE, na.print = "NA") } } } ################################################################################ show_numeric <- function(object, nhead = 2, ntail = 2, class = TRUE, print = TRUE){ nl <- length(object) if(class) cat(class(object), "of length", length(object), "\n") if(nl > 0){ if(nl < (nhead + ntail + 1L)) { out <- round(object, 2) } else { dots <- "..." if(!is.null(names(object))) names(dots) <- "..." out <- c(round(head(object, nhead), 2), dots , round(tail(object, ntail), 2)) } if(print) print(out, quote = FALSE, right = TRUE) else return(out) }else{ if(print) print(object) else return(object) } } ################################################################################ show_numeric_list <- function(object, nhead = 2){ nl <- length(object) cat(class(object), "of length", nl, "\n") if(nl > 0){ np <- min(nl, nhead) object <- object[1:np] if(is.null(names(object))) print_names <- paste0("[[", 1:np, "]]\n") else print_names <- paste0("$", names(object), "\n") for(i in 1:np){ cat(print_names[i]) show_numeric(object[[i]]) cat("\n") } if(np < nl){ if(is.null(names(object))) cat(paste0("[[...]]\n")) else cat(paste0("$...\n")) } }else{ print(object) } } ################################################################################ show_MatrixList_list <- function(object, nhead = 2){ nl <- length(object) cat(class(object), "of length", nl, "\n") if(nl > 0){ np <- min(nl, nhead) object <- object[1:np] if(is.null(names(object))) print_names <- paste0("[[", 1:np, "]]\n") else print_names <- paste0("$", names(object), "\n") for(i in 1:np){ cat(print_names[i]) print(object[[i]]) cat("\n") } if(np < nl){ if(is.null(names(object))) cat(paste0("[[...]]\n")) else cat(paste0("$...\n")) } }else{ print(object) } } DRIMSeq/R/dm_core_colorb.R0000644000175100017510000000104114614306665016301 0ustar00biocbuildbiocbuildcolorb <- function(n){ clrs <- c("dodgerblue3", "maroon2", "forestgreen", "darkorange1" , "blueviolet", "firebrick2", "deepskyblue", "orchid2", "chartreuse3", "gold", "slateblue1", "tomato" , "blue", "magenta", "green3", "yellow", "purple3", "red" ,"darkslategray1", "lightpink1", "lightgreen", "khaki1", "plum3", "salmon") nc <- length(clrs) if(n > nc) clrs <- rep(clrs, ceiling(n/nc)) clrs[1:n] # colorRampPalette(clrs)(n) } # nb <- 24 # barplot(rep(1, nb), col = colorb(nb)) # dev.off() DRIMSeq/R/dm_core_deviance.R0000644000175100017510000000127414614306665016607 0ustar00biocbuildbiocbuild############################################################################## ## Computes the deviance -- with gamma functions -- for q-1 parameters ############################################################################## dm_devG <- function(prop, prec, y){ ## prop has length of q-1 ## prec has length 1 ## y has q rows and n columns prop <- c(prop, 1 - sum(prop)) ll_mod <- sum(lgamma(y + prop * prec) - lgamma(prop * prec) , na.rm = TRUE ) prop_sat <- y/matrix(colSums(y), nrow(y), ncol(y), byrow = TRUE) ll_sat <- sum(lgamma(y + prop_sat * prec) - lgamma(prop_sat * prec) , na.rm = TRUE) # Inf for y = 0 D <- 2 * (ll_sat - ll_mod) return(D) } DRIMSeq/R/dm_core_Hessian.R0000644000175100017510000001171514614306665016424 0ustar00biocbuildbiocbuild############################################################################## # Hessian for q-1 parameters -- with gamma functions ############################################################################## dm_HessianG <- function(prop, prec, y){ # prop has length of q-1 # prec has length 1 # y has q rows and n columns q <- nrow(y) n <- ncol(y) Djj <- rep(0, q-1) propq <- 1-sum(prop) yq <- y[q, ] y <- y[-q, , drop=FALSE] Djl <- prec^2 * sum(trigamma(yq + propq * prec) - trigamma(propq * prec)) Djj <- prec^2 * rowSums(trigamma(y + prop * prec) - trigamma(prop * prec)) H <- matrix(Djl, q-1, q-1) diag(H) <- diag(H) + Djj # H martix (q-1) x (q-1) return(H) } dm_Hessian_regG_prop <- function(y, prec, prop, x){ # y n x q matrix !!! # prop n x q matrix of fitted proportions # x n x p matrix with the design q <- ncol(y) p <- ncol(x) prop_prec <- prop * prec # Some calculations for later ldg_y <- digamma(y + prop_prec) ldg <- digamma(prop_prec) ldgp_y <- ldg_y * prop ldgp_y_sum <- rowSums(ldgp_y) ldgp <- ldg * prop ldgp_sum <- rowSums(ldgp) ltgp_y <- trigamma(y + prop_prec) * prop * prec ltgp <- trigamma(prop_prec) * prop * prec ltgpp_y <- ltgp_y * prop ltgpp_y_sum <- rowSums(ltgpp_y) ltgpp <- ltgp * prop ltgpp_sum <- rowSums(ltgpp) H <- matrix(0, p*(q-1), p*(q-1)) rownames(H) <- colnames(H) <- paste0(rep(colnames(y)[-q], each = p), ":", rep(colnames(x), q-1)) jp_index <- matrix(1:p, nrow = q-1, ncol = p, byrow = TRUE) + p * 0:(q-2) for(jp in 1:(q-1)){ for(jpp in 1:jp){ # jp = 1; jpp = 1 W <- prec * ( - prop[, jp] * prop[, jpp] * (-ldgp_y_sum + ldg_y[, jp] + ldgp_sum - ldg[, jp]) + prop[, jp] * (ltgpp_y_sum * prop[, jpp] - ltgpp_y[, jpp] + ldgp_y_sum * prop[, jpp] - ldgp_y[, jpp] - ltgp_y[, jp] * prop[, jpp] - ltgpp_sum * prop[, jpp] + ltgpp[, jpp] - ldgp_sum * prop[, jpp] + ldgp[, jpp] + ltgp[, jp] * prop[, jpp]) ) if(jp == jpp){ W <- W + prec * ( prop[, jp] * (-ldgp_y_sum + ldg_y[, jp] + ldgp_sum - ldg[, jp]) + prop[, jp] * (ltgp_y[, jp] + ltgp[, jp]) ) } h <- t(x) %*% (W * x) H[jp_index[jp, ], jp_index[jpp, ]] <- h # Use the fact that H is symetric if(!jp == jpp){ H[jp_index[jpp, ], jp_index[jp, ]] <- t(h) } } } # H martix p(q-1) x p(q-1) return(H) } dm_Hessian_regG <- function(b, x, prec, y){ ## b has length of (q-1) * p ## x is a matrix n x p ## y has q rows and n columns y <- t(y) # n x q q <- ncol(y) p <- ncol(x) b <- matrix(b, p, q-1) # p x (q-1) z <- exp(x %*% b) # n x (q-1) prop_qm1 <- z/(1 + rowSums(z)) prop <- cbind(prop_qm1, 1 - rowSums(prop_qm1)) # n x q H <- dm_Hessian_regG_prop(y = y, prec = prec, prop = prop, x = x) return(H) } # Hessian for the multinomial distribution m_Hessian_regG <- function(b, x, y){ ## b has length of (q-1) * p ## x is a matrix n x p ## y has q rows and n columns y <- t(y) # n x q q <- ncol(y) p <- ncol(x) b <- matrix(b, p, q-1) # p x (q-1) z <- exp(x %*% b) # n x (q-1) prop_qm1 <- z/(1 + rowSums(z)) prop <- cbind(prop_qm1, 1 - rowSums(prop_qm1)) # n x q m <- rowSums(y) # n H <- matrix(0, p*(q-1), p*(q-1)) rownames(H) <- colnames(H) <- paste0(rep(colnames(y)[-q], each = p), ":", rep(colnames(x), q-1)) jp_index <- matrix(1:p, nrow = q-1, ncol = p, byrow = TRUE) + p * 0:(q-2) for(jp in 1:(q-1)){ for(jpp in 1:jp){ # jp = 1; jpp = 1 W <- m * prop[, jp] * (prop[, jpp] - as.numeric(jp == jpp)) h <- t(x) %*% (W * x) H[jp_index[jp, ], jp_index[jpp, ]] <- h # Use the fact that H is symetric if(!jp == jpp){ H[jp_index[jpp, ], jp_index[jp, ]] <- t(h) } } } # H martix p(q-1) x p(q-1) return(H) } ############################################################################## # Hessian for q-1 parameters -- with sums ############################################################################## dm_Hessian <- function(prop, prec, y){ # prop has length of q-1 # prec has length 1 # y has q rows and n columns q <- nrow(y) n <- ncol(y) propq <- 1 - sum(prop) Djj <- rep(0, q-1) Djl <- 0 for(i in 1:n){ # i=1 if(y[q, i] == 0){ Djl <- Djl + 0 }else{ Djl <- Djl + sum(-prec^2 / (propq * prec + 1:y[q, i] - 1) ^2) } for(j in 1:(q-1)){ # j=1 if(y[j,i] == 0){ Djj[j] <- Djj[j] + 0 }else{ Djj[j] <- Djj[j] + sum(-prec^2 / (prop[j] * prec + 1:y[j,i] - 1) ^2) } } } H <- matrix(Djl, q-1, q-1) diag(H) <- diag(H) + Djj # H martix (q-1) x (q-1) return(H) } DRIMSeq/R/dm_core_lik.R0000644000175100017510000000715014614306665015607 0ustar00biocbuildbiocbuild############################################################################## ## Computes the DM log-likelihood -- with gamma functions -- for q-1 parameters ############################################################################## dm_likG <- function(prop, prec, y){ # prop has length of q-1 # prec has length 1 # y has q rows and n columns # This function returns likelihhod without normalizing component, # but it is OK for optimization and the LR test n <- ncol(y) m <- colSums(y) prop <- c(prop, 1 - sum(prop)) l <- n * lgamma(prec) - sum(lgamma(m + prec)) + sum( colSums( lgamma(y + prop * prec) - lgamma(prop * prec) ) ) # normalizing_part <- sum(lgamma(m + 1) - colSums(lgamma(y + 1))) return(l) } dm_likG_neg <- function(prop, prec, y) -dm_likG(prop, prec, y) dm_lik_regG_prop <- function(y, prec, prop){ # y n x q matrix !!! # prop n x q matrix of fitted proportions n <- nrow(y) m <- rowSums(y) l <- n * lgamma(prec) - sum(lgamma(m + prec)) + sum(rowSums(lgamma(y + prec * prop) - lgamma(prop * prec))) # normalizing_part <- sum(lgamma(m + 1) - rowSums(lgamma(y + 1))) return(l) } dm_lik_regG <- function(b, x, prec, y){ ## b has length of (q-1) * p ## x is a matrix n x p ## prec has length 1 ## y q x n matrix ## This function returns likelihhod without normalizing component, ## but it is OK for optimization and the LR test y <- t(y) # n x q # Get prop from x and b q <- ncol(y) p <- ncol(x) b <- matrix(b, p, q-1) z <- exp(x %*% b) prop <- z/(1 + rowSums(z)) # n x (q-1) prop <- cbind(prop, 1 - rowSums(prop)) l <- dm_lik_regG_prop(y = y, prec = prec, prop = prop) return(l) } dm_lik_regG_neg <- function(b, design, prec, y) -dm_lik_regG(b, x = design, prec, y) ############################################################################## ## Computes the DM log-likelihood -- with sums -- for q-1 parameters ############################################################################## dm_lik <- function(prop, prec, y){ # prop has length q-1 # prec has length 1 # y has q rows and n columns # This function returns likelihhod without normalizing component, # but it is OK for optimization and the LR test q <- nrow(y) n <- ncol(y) m <- colSums(y) prop <- c(prop, 1 - sum(prop)) l <- 0 for(i in 1:n){ # i=1 l <- l - sum(log(prec + 1:m[i] - 1)) for(j in 1:q){ # j=3 if(y[j, i] == 0){ lji <- 0 }else{ lji <- sum(log(prop[j] * prec + 1:y[j, i] - 1)) } l <- l + lji } } return(l) } ############################################################################## ## Computes the BB log-likelihood -- with gamma functions -- for q parameters ############################################################################## bb_likG <- function(prop, prec, y){ # prop has length of q # prec has length 1 # y has q rows and n number of columns m <- colSums(y) q <- length(prop) l <- rep(NA, q) for(i in 1:q){ l[i] <- dm_likG(prop = prop[i], prec = prec, y = rbind(y[i, ], m - y[i, ])) } # l vector of length q return(l) } bb_lik_regG_prop <- function(y, prec, prop){ # y n x q matrix !!! # prop n x q matrix of fitted proportions m <- rowSums(y) q <- ncol(prop) l <- rep(NA, q) for(i in 1:q){ l[i] <- dm_lik_regG_prop(y = cbind(y[, i], m - y[, i]), prec = prec, prop = cbind(prop[, i], 1 - prop[, i])) } # l vector of length q return(l) } DRIMSeq/R/dm_core_score.R0000644000175100017510000000440314614306665016141 0ustar00biocbuildbiocbuild############################################################################## # Score-function for q-1 parameters -- with gamma functions ############################################################################## dm_scoreG <- function(prop, prec, y){ # prop has length of q-1 # prec has length 1 # y has q rows and n columns q <- nrow(y) n <- ncol(y) yq <- y[q,] y <- y[-q, , drop=FALSE] propq <- 1-sum(prop) S <- prec * rowSums( digamma(y + prop * prec) - digamma(prop * prec) - matrix(digamma(yq + prec * propq) - digamma(prec * propq), nrow = q-1, ncol = n, byrow = TRUE) ) return(S) } dm_scoreG_neg <- function(prop, prec, y) -dm_scoreG(prop, prec, y) dm_score_regG <- function(b, x, prec, y){ ## b has length of (q-1) * p ## x is a matrix n x p ## prec has length 1 ## y has q rows and n columns y <- t(y) # n x q n <- nrow(x) q <- ncol(y) p <- ncol(x) b <- matrix(b, p, q-1) # p x (q-1) z <- exp(x %*% b) prop_qm1 <- z/(1 + rowSums(z)) prop <- cbind(prop_qm1, 1 - rowSums(prop_qm1)) y_qm1 <- y[, -q, drop = FALSE] # n x (q-1) S <- t(x) %*% (prec * prop_qm1 * (- rowSums(digamma(y + prop*prec) * prop) + digamma(y_qm1 + prop_qm1*prec) + rowSums(digamma(prop*prec) * prop) - digamma(prop_qm1*prec))) # p x (q-1) return(c(S)) } dm_score_regG_neg <- function(b, design, prec, y) -dm_score_regG(b, x = design, prec, y) ############################################################################## # Score-function for q-1 parameters -- with sums ############################################################################## dm_score <- function(prop, prec, y){ # prop has length of q-1 # prec has length 1 # y has q rows and n columns q <- nrow(y) n <- ncol(y) propq <- 1 - sum(prop) S <- rep(0, q-1) for(i in 1:n){ # i=1 if(y[q, i] == 0){ Sqi <- 0 }else{ Sqi <- sum(prec / (propq * prec + 1:y[q, i] - 1)) } for(j in 1:(q-1)){ # j=1 if(y[j, i] == 0){ Sji <- 0 }else{ Sji <- sum(prec / (prop[j] * prec + 1:y[j, i] - 1)) } S[j] <- S[j] + Sji } S <- S - Sqi } return(S) } DRIMSeq/R/dm_CRadjustmentManyGroups.R0000755000175100017510000000112714614306665020451 0ustar00biocbuildbiocbuild dm_CRadjustmentManyGroups <- function(y, ngroups, lgroups, igroups, prec, prop){ # y can not have any rowSums(y) == 0 - assured during dmFilter # prop matrix q x ngroups if(any(is.na(prop[1, ]))) return(NA) adj <- numeric(ngroups) for(gr in 1:ngroups){ # gr=1 prop_tmp <- prop[, gr] y_tmp <- y[, igroups[[gr]], drop = FALSE] a <- dm_CRadjustmentOneGroup(y = y_tmp, prec, prop = prop_tmp) adj[gr] <- a } adj <- sum(adj) if(is.na(adj)) return(NA) if(abs(adj) == Inf) return(NA) return(adj) } DRIMSeq/R/dm_CRadjustmentOneGroup.R0000755000175100017510000000177214614306665020111 0ustar00biocbuildbiocbuild dm_CRadjustmentOneGroup <- function(y, prec, prop){ # y martix q x n # prop vector of length q # If something is wrong, return NAs if(any(is.na(prop))) return(NA) q <- nrow(y) # NAs for genes with one feature if(q < 2 || is.na(prec)) return(NA) # Check for 0s in rows (features) keep_row <- rowSums(y) > 0 # There must be at least two non-zero features if(sum(keep_row) < 2) return(NA) # Last feature can not be zero since # we use the last feature as a denominator in logit if(keep_row[q] == 0) return(NA) y <- y[keep_row, , drop=FALSE] q <- nrow(y) # Check for 0s in columns (replicates) keep_col <- colSums(y) > 0 y <- y[, keep_col, drop=FALSE] prop <- prop[keep_row] n <- ncol(y) H <- dm_HessianG(prop = prop[-q], prec, y) adj <- log(det(n * (- H) ))/2 ## with Gamma functions ## if prop is NULL then: # Error in is.data.frame(x) : # dims [product 6] do not match the length of object [0] return(adj) } DRIMSeq/R/dm_CRadjustmentRegression.R0000755000175100017510000000177314614306665020474 0ustar00biocbuildbiocbuild #' @importFrom stats optimHess dm_CRadjustmentRegression <- function(y, x, prec, prop){ # prop q x n matrix of fitted proportions # y q x n matrix # x n x p matrix with the design # y can not have any rowSums(y) == 0 - assured during dmFilter if(any(is.na(prop[1, ]))) return(NA) prop <- t(prop) # n x q n <- nrow(prop) q <- ncol(prop) H <- dm_Hessian_regG_prop(y = t(y), prec = prec, prop = prop, x = x) adj <- log(det(n * (-H))) / 2 ## If the above calculation returns NA, try optimHess() if(is.na(adj)){ # Recalculate betas from proportions and the design logit_prop <- log(prop / prop[, q]) # n x q par <- c(MASS::ginv(x) %*% logit_prop[, -q, drop = FALSE]) # Maximization H <- optimHess(par = par, fn = dm_lik_regG, gr = dm_score_regG, x = x, prec = prec, y = y) adj <- log(det(n * (-H))) / 2 if(is.na(adj)) return(NA) } if(abs(adj) == Inf) return(NA) return(adj) } DRIMSeq/R/dm_estimateMeanExpression.R0000644000175100017510000000101714614306665020510 0ustar00biocbuildbiocbuild dm_estimateMeanExpression <- function(counts, verbose = FALSE){ # Calculate mean expression of genes time_start <- Sys.time() if(verbose) message("* Calculating mean gene expression.. \n") inds <- 1:length(counts) mean_expression <- unlist(lapply(inds, function(g){ mean(colSums(counts[[g]]), na.rm = TRUE) })) names(mean_expression) <- names(counts) time_end <- Sys.time() if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") return(mean_expression) } DRIMSeq/R/dm_fitManyGroups.R0000644000175100017510000000353414614306665016631 0ustar00biocbuildbiocbuild dm_fitManyGroups <- function(y, ngroups, lgroups, igroups, prec, prop_mode = "constrOptim", prop_tol = 1e-12){ # y can not have any rowSums(y) == 0 - assured during dmFilter q <- nrow(y) prop <- matrix(NA, nrow = q, ncol = ngroups) colnames(prop) <- lgroups rownames(prop) <- rownames(y) lik <- rep(NA, ngroups) names(lik) <- lgroups if(q < 2 || is.na(prec)) return(list(prop = prop, lik = lik)) for(gr in 1:ngroups){ # gr = 1 fit_gr <- dm_fitOneGroup(y = y[, igroups[[gr]], drop = FALSE], prec = prec, prop_mode = prop_mode, prop_tol = prop_tol) if(is.na(fit_gr[["lik"]])) { prop <- matrix(NA, nrow = q, ncol = ngroups) colnames(prop) <- lgroups rownames(prop) <- rownames(y) lik <- rep(NA, ngroups) names(lik) <- lgroups return(list(prop = prop, lik = lik)) } prop[, gr] <- fit_gr[["prop"]] lik[gr] <- fit_gr[["lik"]] } # prop and lik can have NAs # prop matrix q x ngroups # lik vector of length ngroups return(list(prop = prop, lik = lik)) } bb_fitManyGroups <- function(y, ngroups, lgroups, igroups, prec, prop){ # This function calculates BB likelihoods # Proportions prop are estimated with the DM model # y can not have any rowSums(y) == 0 - assured during dmFilter q <- nrow(y) lik <- matrix(NA, nrow = q, ncol = ngroups) colnames(lik) <- lgroups if(is.na(prec)) return(list(prop = prop, lik = lik)) for(gr in 1:ngroups){ # gr = 1 fit_gr <- bb_fitOneGroup(y = y[, igroups[[gr]], drop = FALSE], prec = prec, prop = prop[, gr]) lik[, gr] <- fit_gr[["lik"]] } lik[rowSums(is.na(lik)) > 0, ] <- NA # prop and lik can have NAs # prop matrix q x ngroups # lik matrix q x ngroups return(list(prop = prop, lik = lik)) } DRIMSeq/R/dm_fitOneGroup.R0000755000175100017510000000650014614306665016262 0ustar00biocbuildbiocbuild############################################################################## ## estimate prop for given precision ############################################################################## #' @importFrom stats constrOptim dm_fitOneGroup <- function(y, prec, prop_mode = "constrOptim", prop_tol = 1e-12){ # y matrix q x n # If something is wrong, return NAs q <- nrow(y) # NAs for genes with one feature if(q < 2 || is.na(prec)) return(list(prop = rep(NA, q), lik = NA)) # Check for 0s in rows (features) keep_row <- rowSums(y) > 0 # There must be at least two non-zero features if(sum(keep_row) < 2) return(list(prop = rep(NA, q), lik = NA)) # Last feature can not be zero since # we use the last feature as a denominator in logit if(keep_row[q] == 0) return(list(prop = rep(NA, q), lik = NA)) y <- y[keep_row, , drop=FALSE] q <- nrow(y) # Check for 0s in columns (replicates) keep_col <- colSums(y) > 0 y <- y[, keep_col, drop=FALSE] prop_init <- rowSums(y)/sum(y) # If there is only one replicate, use empirical props as output if(sum(keep_col) == 1){ lik <- dm_likG(prop = prop_init[-q], prec = prec, y = y) keep_row[keep_row] <- prop_init prop <- keep_row return(list(prop = prop, lik = lik)) } switch(prop_mode, constrOptim = { ### Must have constraint for SUM prop = 1 --> ### sum(prop) < 1 + eps & sum(prop) > 1 - eps ui <- rbind(diag(rep(1, q-1), q-1), diag(rep(-1, q-1), q-1), rep(-1, q-1)) ci <- c(rep(0, q-1), rep(-1, q-1), -1 + .Machine$double.eps) # ui <- rbind(diag(rep(1, q-1)), diag(rep(-1, q-1))) # ci <- c(rep(0, q-1), rep(-1, q-1)) # Maximization co <- constrOptim(theta = prop_init[-q], f = dm_likG, grad = dm_scoreG, ui = ui, ci = ci, control = list(fnscale = -1, reltol = prop_tol), method = "BFGS", prec = prec, y = y) if(co$convergence == 0){ prop <- co$par prop <- c(prop, 1 - sum(prop)) lik <- co$value }else{ return(list(prop = rep(NA, length(keep_row)), lik = NA)) } }) keep_row[keep_row] <- prop prop <- keep_row # prop numeric vector of length q # lik numeric of lenght 1 return(list(prop = prop, lik = lik)) } bb_fitOneGroup <- function(y, prec, prop){ # Recalculates likelihood for BB, where prop is estimated with DM q <- nrow(y) # BB lik only for non-NA prop from DM if(any(is.na(prop))) return(list(prop = rep(NA, q), lik = rep(NA, q))) # NAs for genes with one feature if(q < 2 || is.na(prec)) return(list(prop = rep(NA, q), lik = rep(NA, q))) # Check for 0s in rows (features with zero proportions) keep_row <- rowSums(y) > 0 # Must be at least two non zero features if(sum(keep_row) < 2) return(list(prop = rep(NA, q), lik = rep(NA, q))) y <- y[keep_row, , drop=FALSE] prop <- prop[keep_row] # Check for 0s in columns (replicates) keep_col <- colSums(y) > 0 y <- y[, keep_col, drop=FALSE] lik <- rep(NA, q) lik[keep_row] <- bb_likG(prop = prop, prec = prec, y = y) keep_row[keep_row] <- prop prop <- keep_row # prop numeric vector of length q # lik numeric vector of length q return(list(prop = prop, lik = lik)) } DRIMSeq/R/dm_fitRegression.R0000755000175100017510000000771014614306665016650 0ustar00biocbuildbiocbuild #' @importFrom stats optim nlminb nlm dm_fitRegression <- function(y, design, prec, coef_mode = "optim", coef_tol = 1e-12){ # y can not have any rowSums(y) == 0 - assured during dmFilter q <- nrow(y) p <- ncol(design) n <- ncol(y) # NAs for genes with one feature if(q < 2 || is.na(prec)){ b <- matrix(NA, nrow = q, ncol = p) prop <- matrix(NA, nrow = q, ncol = n) rownames(prop) <- rownames(y) rownames(b) <- rownames(y) return(list(b = b, lik = NA, fit = prop)) } # Get the initial values for b # Add 1 to get rid of NaNs and Inf and -Inf values in logit # Double check if this approach is correct!!! # Alternative, use 0s: b_init = rep(0, p*(q-1)) yt <- t(y) + 1 # n x q prop <- yt / rowSums(yt) # n x q logit_prop <- log(prop / prop[, q]) b_init <- c(MASS::ginv(design) %*% logit_prop[, -q, drop = FALSE]) switch(coef_mode, optim = { # Maximization co <- optim(par = b_init, fn = dm_lik_regG, gr = dm_score_regG, x = design, prec = prec, y = y, method = "BFGS", control = list(fnscale = -1, reltol = coef_tol)) if(co$convergence == 0){ b <- rbind(t(matrix(co$par, p, q-1)), rep(0, p)) lik <- co$value }else{ b <- matrix(NA, nrow = q, ncol = p) lik <- NA } }, nlminb = { # Minimization co <- nlminb(start = b_init, objective = dm_lik_regG_neg, gradient = dm_score_regG_neg, hessian = NULL, design = design, prec = prec, y = y, control = list(rel.tol = coef_tol)) if(co$convergence == 0){ b <- rbind(t(matrix(co$par, p, q-1)), rep(0, p)) lik <- -co$objective }else{ b <- matrix(NA, nrow = q, ncol = p) lik <- NA } }, nlm = { # Minimization co <- nlm(f = dm_lik_regG_neg, p = b_init, design = design, prec = prec, y = y) if(co$code < 5){ b <- rbind(t(matrix(co$estimate, p, q-1)), rep(0, p)) lik <- -co$minimum }else{ b <- matrix(NA, nrow = q, ncol = p) lik <- NA } } ) # Compute the fitted proportions if(!is.na(lik)){ z <- exp(design %*% t(b[-q, , drop = FALSE])) prop <- z/(1 + rowSums(z)) # n x (q-1) prop <- t(cbind(prop, 1 - rowSums(prop))) # q x n }else{ prop <- matrix(NA, nrow = q, ncol = n) } rownames(prop) <- rownames(y) rownames(b) <- rownames(y) # b matrix q x p # lik vector of length 1 # fit matrix q x n return(list(b = b, lik = lik, fit = prop)) } # ----------------------------------------------------------------------------- # Fitting the Beta-binomial model # Currently, recalculating the BB likelihoods and coefficients using the # DM fittings/proportions bb_fitRegression <- function(y, design, prec, fit){ # y can not have any rowSums(y) == 0 - assured during dmFilter q <- nrow(y) p <- ncol(design) n <- ncol(y) # NAs for genes with one feature if(q < 2 || is.na(prec)){ b <- matrix(NA, nrow = q, ncol = p) prop <- matrix(NA, nrow = q, ncol = n) rownames(prop) <- rownames(y) rownames(b) <- rownames(y) return(list(b = b, lik = rep(NA, q), fit = prop)) } y <- t(y) # n x q prop <- t(fit) # n x q lik <- bb_lik_regG_prop(y = y, prec = prec, prop = prop) # Get the coefficients like in edgeR::mglmOneWay # But use MASS::ginv instead of solve since the design does not have to be # a squared matrix # Keep only the unique rows in the design and logit_prop unique_samps <- !duplicated(design) design <- design[unique_samps, , drop = FALSE] prop <- prop[unique_samps, , drop = FALSE] logit_prop <- log(prop / (1 - prop)) b <- t(MASS::ginv(design) %*% logit_prop) rownames(b) <- colnames(y) # b matrix q x p # lik vector of length q # fit matrix q x n return(list(b = b, lik = lik, fit = fit)) } DRIMSeq/R/dm_LRT.R0000644000175100017510000000142214614306665014455 0ustar00biocbuildbiocbuild#' @importFrom stats pchisq p.adjust dm_LRT <- function(lik_full, lik_null, df, verbose = FALSE){ if(verbose) message("* Calculating likelihood ratio statistics.. \n") time_start <- Sys.time() lr <- 2*(lik_full - lik_null) pvalue <- pchisq(lr, df = df , lower.tail = FALSE) adj_pvalue <- p.adjust(pvalue, method="BH") table <- matrix(c(lr, df, pvalue, adj_pvalue), ncol = 4, byrow = FALSE) colnames(table) <- c("lr", "df", "pvalue", "adj_pvalue") # table <- data.frame(lr = lr, df = df, # pvalue = pvalue, adj_pvalue = adj_pvalue, # stringsAsFactors = FALSE) rownames(table) <- names(lik_full) time_end <- Sys.time() if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") return(table) } DRIMSeq/R/dm_plotData.R0000644000175100017510000000721014614306665015565 0ustar00biocbuildbiocbuild#' @importFrom ggplot2 ggplot aes_string theme_bw xlab ylab ggtitle #' geom_histogram theme element_text coord_cartesian geom_text geom_bar #' scale_fill_manual dm_plotDataFeatures <- function(tt, fill_color = "seagreen4"){ df <- data.frame(tt = tt) ggp <- ggplot(df, aes_string(x = "tt")) + theme_bw() + xlab("Number of features per gene") + ylab("Frequency") + ggtitle(paste0(length(tt), " genes / ", sum(tt) , " features")) + geom_histogram(fill = fill_color, breaks = seq(min(df$tt), max(df$tt), by = 1)) + theme(axis.text = element_text(size=16), axis.title = element_text(size=18, face="bold"), plot.title = element_text(size=18, face="bold")) + coord_cartesian(xlim = c(0, max(tt) + 2)) return(ggp) } dm_plotDataBlocks <- function(tt, fill_color = "mediumpurple4"){ df <- data.frame(tt = tt) binwidth <- ceiling(max(df$tt)/100) ggp <- ggplot(df, aes_string(x = "tt")) + theme_bw() + xlab("Number of blocks per gene") + ylab("Frequency") + ggtitle(paste0(length(tt), " genes / ", sum(tt) , " blocks")) + geom_histogram(fill = fill_color, breaks = seq(min(df$tt), max(df$tt), by = binwidth)) + theme(axis.text = element_text(size=16), axis.title = element_text(size=18, face="bold"), plot.title = element_text(size=18, face="bold")) + coord_cartesian(xlim = c(0, max(tt) + 2)) return(ggp) } dm_plotDataSnps <- function(tt, fill_color = "royalblue4"){ df <- data.frame(tt = tt) binwidth <- ceiling(max(df$tt)/100) ggp <- ggplot(df, aes_string(x = "tt")) + theme_bw() + xlab("Number of SNPs per gene") + ylab("Frequency") + ggtitle(paste0(length(tt), " genes / ", sum(tt) , " SNPs")) + geom_histogram(fill = fill_color, breaks = seq(min(df$tt), max(df$tt), by = binwidth)) + theme(axis.text = element_text(size=16), axis.title = element_text(size=18, face="bold"), plot.title = element_text(size=18, face="bold")) + coord_cartesian(xlim = c(0, max(tt) + 2)) return(ggp) } #' Plot the frequency of present features #' #' @param info Data frame with \code{gene_id} and \code{feature_id} of ALL #' features #' @param ds_info Data frame with \code{gene_id} and \code{feature_id} of ONLY #' DS features #' #' @return \code{ggplot} object dm_plotDataDSInfo <- function(info, ds_info){ ds_info_spl <- split(as.character(ds_info$feature_id), factor(ds_info$gene_id)) info_spl <- split(as.character(info$feature_id), factor(info$gene_id)) genes <- names(info_spl) tas <- table(unlist(lapply(names(ds_info_spl), function(g){ # g = "FBgn0004636" if(! g %in% genes) return(NA) features_in <- sum(info_spl[[g]] %in% ds_info_spl[[g]]) return(features_in) })), useNA = "always") tas <- tas[c(length(tas), 1:(length(tas) -1))] names(tas)[1] <- "NoGene" df <- data.frame(x = factor(names(tas), levels = names(tas)), y = as.numeric(tas), colors = "2", stringsAsFactors = FALSE) df[df$x == "NoGene" | df$x == "0", "colors"] <- "1" df$colors <- factor(df$colors) ggp <- ggplot(data = df, aes_string(x = "x", y = "y", label = "y", fill = "colors")) + geom_bar(stat = "identity") + geom_text(hjust = 0.5, vjust = 0, size = 6) + theme_bw() + xlab("Number of DS features left within DS gene") + ylab("Number of DS genes") + theme(axis.text = element_text(size=16), axis.title = element_text(size=18, face="bold"), plot.title = element_text(size=18, face="bold"), legend.position = "none") + scale_fill_manual(values = c("darkred", "grey")) return(ggp) } DRIMSeq/R/dm_plotPrecision.R0000644000175100017510000000432214614306665016650 0ustar00biocbuildbiocbuild#' @importFrom ggplot2 ggplot aes_string theme_bw xlab ylab theme element_text #' guides guide_colorbar scale_colour_gradient geom_point geom_hline #' @importFrom stats quantile na.omit dm_plotPrecision <- function(genewise_precision, mean_expression, nr_features = NULL, common_precision = NULL, low_color = "royalblue2", high_color = "red2", na_value_color = "red2"){ if(!is.null(nr_features)){ df <- data.frame(mean_expression = log10(mean_expression + 1), precision = log10(genewise_precision), nr_features = nr_features) df_quant <- min(quantile(na.omit(df$nr_features), probs = 0.95), 30) breaks <- seq(2, df_quant, ceiling(df_quant/10)) ggp <- ggplot(df, aes_string(x = "mean_expression", y = "precision", colour = "nr_features" )) + theme_bw() + xlab("Log10 of mean expression") + ylab("Log10 of precision") + geom_point(alpha = 0.7, na.rm = TRUE) + theme(axis.text = element_text(size=16), axis.title = element_text(size=18, face="bold"), legend.title = element_text(size=16, face="bold"), legend.text = element_text(size = 14), legend.position = "top") + guides(colour = guide_colorbar(barwidth = 20, barheight = 0.5)) + scale_colour_gradient(limits = c(2, max(breaks)), breaks = breaks, low = low_color, high = high_color, name = "Number of features", na.value = na_value_color) }else{ df <- data.frame(mean_expression = log10(mean_expression + 1), precision = log10(genewise_precision)) ggp <- ggplot(df, aes_string(x = "mean_expression", y = "precision")) + theme_bw() + xlab("Log10 of mean expression") + ylab("Log10 of precision") + geom_point(size = 1, alpha = 0.4, na.rm = TRUE) + theme(axis.text = element_text(size=16), axis.title = element_text(size=18, face="bold"), legend.title = element_text(size=16, face="bold"), legend.text = element_text(size = 14), legend.position = "top") } if(!is.null(common_precision)){ ggp <- ggp + geom_hline(yintercept = log10(common_precision), colour = "black", linetype = "dashed") } return(ggp) } DRIMSeq/R/dm_plotProportions.R0000755000175100017510000003157214614306665017265 0ustar00biocbuildbiocbuild dm_plotProportions_barplot <- function(prop_samp, prop_fit = NULL, main = NULL, group_colors){ ## Plotting ggp <- ggplot() + geom_bar(data = prop_samp, aes_string(x = "feature_id", y = "proportion", group = "sample_id", fill = "group"), stat = "identity", position = position_dodge(width = 0.9)) + theme_bw() + theme(axis.text.x = element_text(angle = 90, vjust = 0.5), axis.text=element_text(size=16), axis.title = element_text(size=14, face="bold"), plot.title = element_text(size=16), legend.position = "right", legend.title = element_text(size = 14), legend.text = element_text(size = 14)) + ggtitle(main) + scale_fill_manual(name = "Groups", values = group_colors, breaks = names(group_colors)) + xlab("Features") + ylab("Proportions") if(!is.null(prop_fit)){ ggp <- ggp + geom_point(data = prop_fit, aes_string(x = "feature_id", y = "proportion", group = "sample_id", fill = "group"), position = position_dodge(width = 0.9), size = 3, shape = 23, alpha = 0.75) } return(ggp) } dm_plotProportions_boxplot1 <- function(prop_samp, prop_fit = NULL, main = NULL, group_colors){ ## Plotting ggp <- ggplot() + geom_jitter(data = prop_samp, aes_string(x = "feature_id", y = "proportion", fill = "group", colour = "group"), position = position_jitterdodge(), alpha = 0.9, size = 2, show.legend = FALSE, na.rm = TRUE) + geom_boxplot(data = prop_samp, aes_string(x = "feature_id", y = "proportion", colour = "group", fill = "group"), outlier.size = NA, alpha = 0.4, lwd = 0.5) + theme_bw() + theme(axis.text.x = element_text(angle = 90, vjust = 0.5), axis.text=element_text(size=16), axis.title=element_text(size=14, face="bold"), plot.title = element_text(size=16), legend.position = "right", legend.title = element_text(size = 14), legend.text = element_text(size = 14)) + ggtitle(main) + scale_fill_manual(name = "Groups", values = group_colors, breaks = names(group_colors)) + scale_colour_manual(name = "Groups", values = group_colors, breaks = names(group_colors)) + xlab("Features") + ylab("Proportions") if(!is.null(prop_fit)){ ggp <- ggp + geom_point(data = prop_fit, aes_string(x = "feature_id", y = "proportion", fill = "group"), position = position_jitterdodge(jitter.width = 0), size = 3, shape = 23) + guides(colour=FALSE) } return(ggp) } dm_plotProportions_lineplot <- function(prop_samp, prop_fit = NULL, main = NULL, group_colors){ ## Plotting ggp <- ggplot() + geom_line(data = prop_samp, aes_string(x = "feature_id", y = "proportion", group = "sample_id", colour = "group"), size = 1.1) + theme_bw() + theme(axis.text.x = element_text(angle = 90, vjust = 0.5), axis.text=element_text(size=16), axis.title = element_text(size=14, face="bold"), plot.title = element_text(size=16), legend.position = "right", legend.title = element_text(size = 14), legend.text = element_text(size = 14)) + ggtitle(main) + scale_fill_manual(name = "Groups", values = group_colors, breaks = names(group_colors)) + scale_colour_manual(name = "Groups", values = group_colors, breaks = names(group_colors)) + xlab("Features") + ylab("Proportions") if(!is.null(prop_fit)){ ggp <- ggp + geom_point(data = prop_fit, aes_string(x = "feature_id", y = "proportion", group = "group", fill = "group"), size = 3, shape = 23) + guides(colour=FALSE) } return(ggp) } dm_plotProportions_boxplot2 <- function(prop_samp, prop_fit = NULL, main = NULL, feature_colors){ ## Plotting ggp <- ggplot() + geom_boxplot(data = prop_samp, aes_string(x = "group", y = "proportion", fill = "feature_id"), outlier.size = NA) + geom_jitter(data = prop_samp, aes_string(x = "group", y = "proportion", fill = "feature_id"), position = position_jitterdodge(), shape = 21, show.legend = FALSE, na.rm = TRUE) + theme_bw() + theme(axis.text.x = element_text(angle = 90, vjust = 0.5), axis.text=element_text(size=14), axis.title=element_text(size=14, face="bold"), plot.title = element_text(size=14), panel.grid.major = element_blank(), legend.title = element_text(size = 14), legend.text = element_text(size = 14)) + geom_vline(xintercept = seq(1, nlevels(prop_samp$group) - 1, 1) + 0.5, color = "gray90") + ggtitle(main) + scale_fill_manual(name = "Features", values = feature_colors) + guides(fill = guide_legend(nrow = 20)) + xlab("Groups") + ylab("Proportions") if(!is.null(prop_fit)){ ggp <- ggp + geom_point(data = prop_fit, aes_string(x = "group", y = "proportion", fill = "feature_id"), position = position_jitterdodge(jitter.width = 0), size = 3, shape = 23, colour = "black") } return(ggp) } dm_plotProportions_ribbonplot <- function(prop_fit, main = NULL, feature_colors){ prop_fit_order <- prop_fit[order(prop_fit$feature_id, decreasing = TRUE), ] prop_fit_order <- prop_fit_order[order(prop_fit_order$group), ] breaks <- unique(prop_fit_order$feature_id) width <- 0.5 ## Get ribbons gr <- list() for (i in 1:(nlevels(prop_fit$group) - 1)){ # i = 1 prop_fit_ribbon <- prop_fit_order[prop_fit_order$group %in% levels(prop_fit_order$group )[c(i, i+1)], ] prop_fit_ribbon$group <- factor(prop_fit_ribbon$group) prop_fit_ribbon$cumsum <- matrix(t(aggregate(prop_fit_ribbon[,"proportion"], by = list(group = prop_fit_ribbon$group), cumsum)[, -1]), ncol = 1) prop_fit_ribbon$offset <- c(width/2, -width/2)[as.numeric(prop_fit_ribbon$group)] prop_fit_ribbon$xid <- i - 1 prop_fit_ribbon$x <- as.numeric(prop_fit_ribbon$group) + prop_fit_ribbon$offset + prop_fit_ribbon$xid prop_fit_ribbon$ymin <- prop_fit_ribbon$cumsum - prop_fit_ribbon$proportion prop_fit_ribbon$ymax <- prop_fit_ribbon$cumsum gr[[i]] <- geom_ribbon(data = prop_fit_ribbon, aes_string(x = "x", ymin = "ymin", ymax = "ymax", group = "feature_id", fill = "feature_id"), alpha = 0.3) } ## Plotting ggp <- ggplot() + geom_bar(data = prop_fit_order, aes_string(x = "group", y = "proportion", fill = "feature_id"), stat = "identity", width = width, position="stack") + gr + theme_bw() + theme(axis.text.x = element_text(angle = 90, vjust = 0.5), axis.text=element_text(size=16), axis.title=element_text(size=14, face="bold"), plot.title = element_text(size=16), legend.title = element_text(size = 14), legend.text = element_text(size = 14)) + ggtitle(main) + coord_cartesian(ylim = c(-0.1, 1.1)) + coord_cartesian(ylim = c(-0.1, 1.1)) + scale_fill_manual(name = "Features", values = feature_colors, breaks = breaks) + guides(fill = guide_legend(nrow = 20)) + xlab("Groups") + ylab("Estimated proportions") return(ggp) } #' Plot feature proportions #' #' Plot observed and/or estimated feature proportions. #' #' @param counts Matrix with rows corresponding to features and columns #' corresponding to samples. Row names are used as labels on the plot. #' @param group Factor that groups samples into conditions. #' @param md Data frame with additional sample information. #' @param fit_full Matrix of estimated proportions with rows corresponding to #' features and columns corresponding to samples. If \code{NULL}, nothing is #' plotted. #' @param main Character vector with main title for the plot. If \code{NULL}, #' nothing is plotted. #' @param plot_type Character defining the type of the plot produced. Possible #' values \code{"barplot"}, \code{"boxplot1"}, \code{"boxplot2"}, #' \code{"lineplot"}, \code{"ribbonplot"}. #' @param order_features Logical. Whether to plot the features ordered by their #' expression. #' @param order_samples Logical. Whether to plot the samples ordered by the #' group variable. If \code{FALSE} order from the \code{sample(x)} is kept. #' @param group_colors Character vector with colors for each group. #' @param feature_colors Character vector with colors for each feature. #' #' @return \code{ggplot} object with the observed and/or estimated with #' Dirichlet-multinomial model feature ratios. Estimated proportions are #' marked with diamond shapes. #' @importFrom reshape2 melt #' @importFrom ggplot2 ggplot aes_string theme_bw xlab ylab theme element_text #' coord_cartesian geom_text ggtitle geom_bar scale_fill_manual geom_point #' geom_jitter position_dodge position_jitterdodge geom_boxplot #' scale_colour_manual scale_colour_manual guides element_blank geom_vline #' scale_x_discrete guide_legend geom_line geom_ribbon #' @importFrom stats aggregate median dm_plotProportions <- function(counts, group, md = NULL, fit_full = NULL, main = NULL, plot_type = "boxplot1", order_features = TRUE, order_samples = TRUE, group_colors = NULL, feature_colors = NULL){ ## Calculate observed proportions proportions <- prop.table(counts, 2) proportions[proportions == "NaN"] <- NA prop_samp <- data.frame(feature_id = rownames(proportions), proportions, stringsAsFactors = FALSE) prop_fit <- NULL if(!is.null(fit_full)) prop_fit <- data.frame(feature_id = rownames(fit_full), fit_full, stringsAsFactors = FALSE) ## Order transcipts by decreasing proportion if(order_features){ oo <- order(apply(aggregate(t(prop_samp[, -1]), by = list(group = group), median)[, -1], 2, max), decreasing = TRUE) feature_levels <- rownames(prop_samp)[oo] }else{ feature_levels <- rownames(counts) } ## Order samples by group if(order_samples){ o <- order(group) sample_levels <- colnames(counts)[o] }else{ sample_levels <- colnames(counts) } ## Melt prop_samp prop_samp <- melt(prop_samp, id.vars = "feature_id", variable.name = "sample_id", value.name = "proportion", factorsAsStrings = FALSE) prop_samp$feature_id <- factor(prop_samp$feature_id, levels = feature_levels) prop_samp$group <- rep(group, each = nrow(counts)) prop_samp$sample_id <- factor(prop_samp$sample_id, levels = sample_levels) ## Add extra info from md about samples if(!is.null(md)){ mm <- match(prop_samp$sample_id, md$sample_id) for(i in setdiff(colnames(md), c("sample_id", "group"))){ prop_samp[, i] <- md[mm, i] } } ## Melt prop_fit if(!is.null(prop_fit)){ prop_fit <- melt(prop_fit, id.vars = "feature_id", variable.name = "sample_id", value.name = "proportion", factorsAsStrings = FALSE) prop_fit$feature_id <- factor(prop_fit$feature_id, levels = feature_levels) prop_fit$group <- rep(group, each = nrow(fit_full)) prop_fit$sample_id <- factor(prop_fit$sample_id, levels = sample_levels) ## Add extra info from md about samples if(!is.null(md)){ mm <- match(prop_fit$sample_id, md$sample_id) for(i in setdiff(colnames(md), c("sample_id", "group"))){ prop_fit[, i] <- md[mm, i] } } } ## Prepare colors for groups if(is.null(group_colors)){ group_colors <- colorb(nlevels(group)) } names(group_colors) <- levels(group) ## Prepare colors for features if(is.null(feature_colors)){ feature_colors <- colorb(nrow(counts)) } names(feature_colors) <- rownames(counts) switch(plot_type, barplot = { dm_plotProportions_barplot(prop_samp = prop_samp, prop_fit = prop_fit, main = main, group_colors = group_colors) }, lineplot = { dm_plotProportions_lineplot(prop_samp = prop_samp, prop_fit = prop_fit, main = main, group_colors = group_colors) }, boxplot1 = { dm_plotProportions_boxplot1(prop_samp = prop_samp, prop_fit = prop_fit, main = main, group_colors = group_colors) }, boxplot2 = { dm_plotProportions_boxplot2(prop_samp = prop_samp, prop_fit = prop_fit, main = main, feature_colors = feature_colors) }, ribbonplot = { if(!is.null(prop_fit)){ keep <- !duplicated(prop_fit[, c("feature_id", "proportion", "group")]) prop_fit <- prop_fit[keep, , drop = FALSE] if(nlevels(factor(prop_fit$sample_id)) != nlevels(factor(prop_fit$group))){ message("Ribbonplot can not be generated.") }else{ dm_plotProportions_ribbonplot(prop_fit, main = main, feature_colors = feature_colors) } }else{ message("Ribbonplot can not be generated.") } } ) } DRIMSeq/R/dm_plotPvalues.R0000644000175100017510000000150014614306665016327 0ustar00biocbuildbiocbuild#' @importFrom ggplot2 ggplot aes_string theme_bw xlab ylab geom_histogram theme #' element_text coord_cartesian geom_text dm_plotPValues <- function(pvalues){ df <- data.frame(pvalues = pvalues[!is.na(pvalues)]) ggp <- ggplot(df, aes_string(x = "pvalues")) + theme_bw() + xlab("P-Values") + ylab("Frequency") + geom_histogram(breaks = seq(0, 1, by = 0.01), fill = "deeppink4") + theme(axis.text = element_text(size=16), axis.title = element_text(size=18, face="bold"), plot.title = element_text(size=16, face="bold")) + coord_cartesian(xlim = c(0, 1)) + geom_text(data = data.frame(x = Inf, y = Inf, label = paste0(nrow(df), " tests ")), aes_string(x = "x", y = "y", label = "label"), hjust = 1, vjust = 3, size = 6) return(ggp) } DRIMSeq/R/dm_profileLikModeration.R0000644000175100017510000001311214614306666020136 0ustar00biocbuildbiocbuild############################################################################## # calculate the moderated profile likelihood ############################################################################## #' @importFrom stats loess predict loess.control dm_profileLikModeration <- function(loglik, mean_expression, prec_moderation = "trended", prec_prior_df, prec_span){ prec_grid_length <- ncol(loglik) ### Check where the grid is maximized grid_max <- apply(loglik, 1, which.max) # In the calculation of moderation, do not take into account genes # that have precision on the top and bottom boundry of the grid # (skipp 4 last grid points and 1 first grid point) not_boundry <- grid_max < (prec_grid_length - 3) & grid_max > 1 boundry_last <- grid_max == prec_grid_length ### Calculate the span of the boundry loglikelihoods if(sum(boundry_last) > 1){ loglik_span_boundry <- apply(loglik[boundry_last, , drop = FALSE], 1, function(x){max(x) - min(x)}) } switch(prec_moderation, common={ ### Calculate the moderating likelihood if(sum(not_boundry) == length(not_boundry)){ moderation <- colMeans(loglik) }else{ moderation <- colMeans(loglik[not_boundry, , drop = FALSE]) } # Estimate priorN - calculate the ratio between moderation lik span # and lik span of boundry genes if(sum(boundry_last) > 10){ moderation_span <- max(moderation) - min(moderation) span_ratio <- moderation_span / loglik_span_boundry priorN <- 1/span_ratio ### Use median priorN <- quantile(priorN, 0.5) }else{ priorN <- prec_prior_df } message(paste0("! Using ", round(priorN, 4), " as a shrinkage factor !\n")) loglik <- sweep(loglik, 2, priorN * moderation, FUN = "+") }, trended={ moderation <- dm_movingAverageByCol(loglik = loglik, mean_expression = mean_expression, not_boundry = not_boundry, prec_span = prec_span) # Estimate priorN - calculate the ratio between moderation lik span # and lik span of boundry genes if(sum(boundry_last) > 10){ moderation_span_boundry <- apply( moderation[boundry_last, , drop = FALSE], 1, function(x){max(x) - min(x)}) span_ratio <- moderation_span_boundry / loglik_span_boundry priorN <- 1/span_ratio ### Do loess fitting if there is enough points. Otherwise, use median if(length(loglik_span_boundry) > 100){ df_priorN_loglog <- data.frame(priorN = log10(priorN), mean_expression = log10(mean_expression[boundry_last])) priorN_loess_loglog <- loess(priorN ~ mean_expression, df_priorN_loglog, control = loess.control(surface = "direct")) priorN_predict_loglog <- predict(priorN_loess_loglog, data.frame(mean_expression = log10(mean_expression)), se = FALSE) priorN <- 10 ^ priorN_predict_loglog }else{ priorN <- quantile(priorN, 0.5) } }else{ priorN <- prec_prior_df } if(length(priorN) == 1){ message(paste0("! Using ", round(priorN, 6), " as a shrinkage factor !\n")) }else{ message(paste0("! Using loess fit as a shrinkage factor !\n")) } loglik <- loglik + priorN * moderation } ) return(loglik) } dm_movingAverageByCol <- function(loglik, mean_expression, not_boundry, prec_span){ if(sum(not_boundry) == length(not_boundry)){ o <- order(mean_expression) oo <- order(o) width <- floor(prec_span * nrow(loglik)) moderation <- edgeR::movingAverageByCol(loglik[o,], width = width)[oo,] }else{ ### Use non boundry genes for calculating the moderation mean_expression_not_boundry <- mean_expression[not_boundry] loglik_not_boundry <- loglik[not_boundry, , drop = FALSE] o <- order(mean_expression_not_boundry) oo <- order(o) width <- floor(prec_span * nrow(loglik_not_boundry)) moderation_not_boundry <- edgeR::movingAverageByCol( loglik_not_boundry[o, , drop = FALSE], width = width)[oo, , drop = FALSE] ### Fill in moderation values for the boundy genes moderation <- matrix(NA, nrow = nrow(loglik), ncol = ncol(loglik)) moderation[not_boundry, ] <- moderation_not_boundry o <- order(mean_expression) oo <- order(o) moderation <- moderation[o, , drop = FALSE] not_boundry <- not_boundry[o] ### Last value in not_boundry must be TRUE if(not_boundry[length(not_boundry)] == FALSE){ last_true <- max(which(not_boundry)) moderation[length(not_boundry), ] <- moderation[last_true, ] not_boundry[length(not_boundry)] <- TRUE } not_boundry_diff <- diff(not_boundry, lag = 1) not_boundry_cumsum <- cumsum(not_boundry) ### Values used for filling in the boundry NAs - swith from FALSE to TRUE replacement_indx <- which(not_boundry_diff == 1) + 1 replaced_indx <- which(!not_boundry) replaced_freq <- as.numeric(table(not_boundry_cumsum[replaced_indx])) moderation_boundry <- moderation[rep(replacement_indx, times = replaced_freq), , drop = FALSE] moderation[!not_boundry, ] <- moderation_boundry moderation <- moderation[oo, , drop = FALSE] } return(moderation) } DRIMSeq/R/dmDS_CRadjustment.R0000755000175100017510000000443214614306665016655 0ustar00biocbuildbiocbuild dmDS_CRadjustmentManyGroups_gene <- function(g, counts, ngroups, lgroups, igroups, prec, prop, verbose){ if(verbose >= 2) message(" Gene:", g) a <- dm_CRadjustmentManyGroups(y = counts[[g]], ngroups = ngroups, lgroups = lgroups, igroups = igroups, prec = prec[g], prop = prop[[g]]) return(a) } dmDS_CRadjustmentRegression_gene <- function(g, counts, design, prec, fit, verbose){ if(verbose >= 2) message(" Gene:", g) a <- dm_CRadjustmentRegression(y = counts[[g]], x = design, prec = prec[g], prop = fit[[g]]) return(a) } dmDS_CRadjustment <- function(counts, fit, design, precision, one_way = TRUE, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ time_start <- Sys.time() if(verbose) message("* Calculating Cox-Reid adjustment.. \n") inds <- 1:length(counts) # Prepare precision if(length(precision) == 1){ prec <- rep(precision, length(inds)) } else { prec <- precision } # If the design is equivalent to a oneway layout, use a shortcut algorithm groups <- edgeR::designAsFactor(design) if(nlevels(groups) == ncol(design) && one_way){ groups <- factor(groups, labels = paste0("gr", levels(groups))) ngroups <- nlevels(groups) lgroups <- levels(groups) igroups <- lapply(lgroups, function(gr){which(groups == gr)}) names(igroups) <- lgroups # Get the column number of a first occurance of a group level figroups <- unlist(lapply(igroups, function(x){x[1]})) prop <- fit[, figroups] a <- BiocParallel::bplapply(inds, dmDS_CRadjustmentManyGroups_gene, counts = counts, ngroups = ngroups, lgroups = lgroups, igroups = igroups, prec = prec, prop = prop, verbose = verbose, BPPARAM = BPPARAM) names(a) <- names(counts) adj <- unlist(a) }else{ a <- BiocParallel::bplapply(inds, dmDS_CRadjustmentRegression_gene, counts = counts, design = design, prec = prec, fit = fit, verbose = verbose, BPPARAM = BPPARAM) names(a) <- names(counts) adj <- unlist(a) } time_end <- Sys.time() if(verbose >= 2) message("\n") if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") # adj is a vector of length G return(adj) } DRIMSeq/R/dmDS_estimateCommonPrecision.R0000755000175100017510000000310314614306665021104 0ustar00biocbuildbiocbuild#' @importFrom stats optimize dmDS_profileLikCommon <- function(prec, counts, design, prec_adjust = TRUE, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ if(verbose >= 2) message("Precision in optimize:", prec) adj_lik <- dmDS_profileLik(prec = prec, counts = counts, design = design, prec_adjust = prec_adjust, one_way = one_way, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) adj_lik_common <- sum(adj_lik, na.rm = TRUE) return(adj_lik_common) } dmDS_estimateCommonPrecision <- function(counts, design, prec_adjust = TRUE, prec_interval = c(0, 1e+5), prec_tol = 1e-01, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ time_start <- Sys.time() if(verbose) message("* Estimating common precision.. \n") optimum <- optimize(f = dmDS_profileLikCommon, interval = prec_interval, counts = counts, design = design, prec_adjust = prec_adjust, one_way = one_way, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = max(0, verbose-1), BPPARAM = BPPARAM, maximum = TRUE, tol = prec_tol) precision <- optimum$maximum time_end <- Sys.time() if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") return(precision) } DRIMSeq/R/dmDS_estimateTagwisePrecision.R0000644000175100017510000000413414614306665021261 0ustar00biocbuildbiocbuild#' @importFrom stats complete.cases dmDS_estimateTagwisePrecision <- function(counts, design, mean_expression, prec_adjust = TRUE, prec_init = 100, prec_grid_length = 21, prec_grid_range = c(-10, 10), prec_moderation = "none", prec_prior_df = 0, prec_span = 0.1, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ time_start <- Sys.time() if(verbose) message("* Estimating genewise precision.. \n") ### Standard grid like in edgeR spline_pts <- seq(from = prec_grid_range[1], to = prec_grid_range[2], length = prec_grid_length) spline_prec <- prec_init * 2^spline_pts # Calculate the likelihood for each gene at the spline precision points loglik <- matrix(NA, nrow = length(counts), ncol = prec_grid_length) for(i in seq(prec_grid_length)){ # i = 1 loglik[, i] <- dmDS_profileLik(prec = spline_prec[i], counts = counts, design = design, prec_adjust = prec_adjust, one_way = one_way, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = max(0, verbose - 1), BPPARAM = BPPARAM) } not_nas <- complete.cases(loglik) loglik <- loglik[not_nas, , drop = FALSE] if(nrow(loglik) == 0){ precision <- rep(NA, length(counts)) names(precision) <- names(counts) return(precision) } if(prec_moderation != "none"){ mean_expression <- mean_expression[not_nas] loglik <- dm_profileLikModeration(loglik = loglik, mean_expression = mean_expression, prec_moderation = prec_moderation, prec_prior_df = prec_prior_df, prec_span = prec_span) } out <- edgeR::maximizeInterpolant(spline_pts, loglik) # Set NA for genes that tagwise prec could not be calculated precision <- rep(NA, length(counts)) names(precision) <- names(counts) precision[not_nas] <- prec_init * 2^out time_end <- Sys.time() if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") return(precision) } DRIMSeq/R/dmDS_filter.R0000644000175100017510000000467314614306665015543 0ustar00biocbuildbiocbuild dmDS_filter <- function(counts, min_samps_gene_expr = 6, min_gene_expr = 10, min_samps_feature_expr = 3, min_feature_expr = 10, min_samps_feature_prop = 3, min_feature_prop = 0.01, run_gene_twice=FALSE){ inds <- which(elementNROWS(counts) > 1) counts_new <- lapply(inds, function(g){ # g = 117 # print(g) expr_features <- counts[[g]] ### no genes with no expression if(sum(expr_features, na.rm = TRUE) == 0) return(NULL) ### genes with min expression if(! sum(colSums(expr_features) >= min_gene_expr, na.rm = TRUE) >= min_samps_gene_expr ) return(NULL) ### no features with no expression features2keep <- rowSums(expr_features > 0, na.rm = TRUE) > 0 ### no genes with one feature if(sum(features2keep) <= 1) return(NULL) expr_features <- expr_features[features2keep, , drop = FALSE] ### features with min expression features2keep <- rowSums(expr_features >= min_feature_expr, na.rm = TRUE) >= min_samps_feature_expr ### no genes with one feature if(sum(features2keep) <= 1) return(NULL) expr_features <- expr_features[features2keep, , drop = FALSE] ### genes with zero expression samps2keep <- colSums(expr_features) > 0 & !is.na(expr_features[1, ]) if(sum(samps2keep) < max(1, min_samps_feature_prop)) return(NULL) prop <- prop.table(expr_features[, samps2keep, drop = FALSE], 2) # prop.table(matrix(c(1,0), 2, 1), 2) # prop.table(matrix(c(0,0), 2, 1), 2) # prop.table(matrix(c(0,0, 1, 0), 2, 2), 2) ### features with min proportion features2keep <- rowSums(prop >= min_feature_prop) >= min_samps_feature_prop ### no genes with one feature if(sum(features2keep) <= 1) return(NULL) expr <- expr_features[features2keep, , drop = FALSE] if (run_gene_twice) { ### no genes with no expression if(sum(expr_features, na.rm = TRUE) == 0) return(NULL) ### genes with min expression if(! sum(colSums(expr_features) >= min_gene_expr, na.rm = TRUE) >= min_samps_gene_expr ) return(NULL) } return(expr) }) names(counts_new) <- names(counts)[inds] counts_new <- counts_new[!sapply(counts_new, is.null)] if(length(counts_new) == 0) stop("!No genes left after filtering!") counts_new <- MatrixList(counts_new) return(counts_new) } DRIMSeq/R/dmDS_fit.R0000755000175100017510000001610514614306665015034 0ustar00biocbuildbiocbuild# Fitting the Dirichlet-multinomial model dmDS_fitManyGroups_gene <- function(g, counts, ngroups, lgroups, igroups, prec, prop_mode, prop_tol, verbose){ if(verbose >= 2) message(" Gene:", g) f <- dm_fitManyGroups(y = counts[[g]], ngroups = ngroups, lgroups = lgroups, igroups = igroups, prec = prec[g], prop_mode = prop_mode, prop_tol = prop_tol) return(f) } dmDS_fitRegression_gene <- function(g, counts, design, prec, coef_mode, coef_tol, verbose){ if(verbose >= 2) message(" Gene:", g) f <- dm_fitRegression(y = counts[[g]], design = design, prec = prec[g], coef_mode = coef_mode, coef_tol = coef_tol) return(f) } dmDS_fit <- function(counts, design, precision, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ time_start <- Sys.time() if(verbose) message("* Fitting the DM model.. \n") inds <- 1:length(counts) # Prepare precision if(length(precision) == 1){ prec <- rep(precision, length(inds)) } else { prec <- precision } # Approach from edgeR glmFit.default: # If the design is equivalent to a oneway layout, use a shortcut algorithm groups <- edgeR::designAsFactor(design) if(nlevels(groups) == ncol(design) && one_way && all(c(design) %in% c(0, 1))){ if(verbose) message(" Using the one way approach. \n") groups <- factor(groups, labels = paste0("gr", levels(groups))) ngroups <- nlevels(groups) lgroups <- levels(groups) igroups <- lapply(lgroups, function(gr){which(groups == gr)}) names(igroups) <- lgroups ff <- BiocParallel::bplapply(inds, dmDS_fitManyGroups_gene, counts = counts, ngroups = ngroups, lgroups = lgroups, igroups = igroups, prec = prec, prop_mode = prop_mode, prop_tol = prop_tol, verbose = verbose, BPPARAM = BPPARAM) names(ff) <- names(counts) lik <- unlist(lapply(ff, function(f) sum(f[["lik"]]))) prop <- MatrixList(lapply(ff, function(f) f[["prop"]])) fit <- prop[, groups] colnames(fit) <- colnames(counts) # Get the coefficients like in edgeR::mglmOneWay design_unique <- unique(design) # Use the last feature (q-th) as a denominator logit_prop <- MatrixList(lapply(ff, function(f) t(t(f[["prop"]])/f[["prop"]][nrow(f[["prop"]]), ]))) logit_prop <- log(logit_prop@unlistData) coef <- t(solve(design_unique, t(logit_prop))) coef <- new("MatrixList", unlistData = coef, partitioning = prop@partitioning) colnames(coef) <- colnames(design) }else{ if(verbose) message(" Using the regression approach. \n") ff <- BiocParallel::bplapply(inds, dmDS_fitRegression_gene, counts = counts, design = design, prec = prec, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) names(ff) <- names(counts) lik <- unlist(lapply(ff, function(f) f[["lik"]])) coef <- MatrixList(lapply(ff, function(f) f[["b"]])) colnames(coef) <- colnames(design) fit <- MatrixList(lapply(ff, function(f) f[["fit"]])) colnames(fit) <- colnames(counts) } time_end <- Sys.time() if(verbose >= 2) message("\n") if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") # fit is a MatrixList of matrices q x p # lik is a vector of length G # coef is a MatrixList of matrices q x p return(list(fit = fit, lik = lik, coef = coef)) } # ----------------------------------------------------------------------------- # Fitting the Beta-binomial model # Currently, recalculating the BB likelihoods and coefficients using the # DM fittings/proportions bbDS_fitManyGroups_gene <- function(g, counts, prop, ngroups, lgroups, igroups, prec, verbose){ if(verbose >= 2) message(" Gene:", g) f <- bb_fitManyGroups(y = counts[[g]], prop = prop[[g]], ngroups = ngroups, lgroups = lgroups, igroups = igroups, prec = prec[g]) return(f) } bbDS_fitRegression_gene <- function(g, counts, design, prec, fit, verbose){ if(verbose >= 2) message(" Gene:", g) f <- bb_fitRegression(y = counts[[g]], design = design, prec = prec[g], fit = fit[[g]]) return(f) } bbDS_fit <- function(counts, fit, design, precision, one_way = TRUE, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ time_start <- Sys.time() if(verbose) message("* Fitting the BB model.. \n") inds <- 1:length(counts) # Prepare precision if(length(precision) == 1){ prec <- rep(precision, length(inds)) } else { prec <- precision } # Approach from edgeR: # If the design is equivalent to a oneway layout, use a shortcut algorithm groups <- edgeR::designAsFactor(design) if(nlevels(groups) == ncol(design) && one_way && all(c(design) %in% c(0, 1))){ if(verbose) message(" Using the one way approach. \n") groups <- factor(groups, labels = paste0("gr", levels(groups))) ngroups <- nlevels(groups) lgroups <- levels(groups) igroups <- lapply(lgroups, function(gr){which(groups == gr)}) names(igroups) <- lgroups # Use proportions estimated with the DM model prop <- fit[, unlist(lapply(igroups, function(x){x[1]}))] # Recalculate BB likelihoods ff <- BiocParallel::bplapply(inds, bbDS_fitManyGroups_gene, counts = counts, prop = prop, ngroups = ngroups, lgroups = lgroups, igroups = igroups, prec = prec, verbose = verbose, BPPARAM = BPPARAM) lik <- lapply(ff, function(f){rowSums(f[["lik"]])}) names(lik) <- NULL lik <- unlist(lik) names(lik) <- rownames(counts) # Get the coefficients like in edgeR::mglmOneWay design_unique <- unique(design) logit_prop <- MatrixList(lapply(ff, function(f){ f[["prop"]]/(1 - f[["prop"]]) })) logit_prop <- log(logit_prop@unlistData) # design_unique must be squared for solve() coef <- t(solve(design_unique, t(logit_prop))) coef <- new("MatrixList", unlistData = coef, partitioning = prop@partitioning) }else{ if(verbose) message(" Using the regression approach. \n") ff <- BiocParallel::bplapply(inds, bbDS_fitRegression_gene, counts = counts, design = design, prec = prec, fit = fit, verbose = verbose, BPPARAM = BPPARAM) names(ff) <- names(counts) lik <- unlist(lapply(ff, function(f) f[["lik"]])) names(lik) <- rownames(counts) coef <- MatrixList(lapply(ff, function(f) f[["b"]])) colnames(coef) <- colnames(design) fit <- MatrixList(lapply(ff, function(f) f[["fit"]])) colnames(fit) <- colnames(counts) } time_end <- Sys.time() if(verbose >= 2) message("\n") if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") # fit is a MatrixList of matrices q x p # lik is a vector of length nrow(counts) = total number of features # coef is a MatrixList of matrices q x p return(list(fit = fit, lik = lik, coef = coef)) } DRIMSeq/R/dmDS_profileLik.R0000644000175100017510000000137214614306665016347 0ustar00biocbuildbiocbuild dmDS_profileLik <- function(prec, counts, design, prec_adjust = TRUE, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ fit <- dmDS_fit(counts = counts, design = design, precision = prec, one_way = one_way, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) if(!prec_adjust) return(fit$lik) adj <- dmDS_CRadjustment(counts = counts, fit = fit$fit, design = design, precision = prec, one_way = one_way, verbose = verbose, BPPARAM = BPPARAM) adj_lik <- fit$lik - adj # adj_lik has length G return(adj_lik) } DRIMSeq/R/dmSQTL_CRadjustment.R0000644000175100017510000000556614614306665017140 0ustar00biocbuildbiocbuild dmSQTL_CRadjustmentManyGroups_gene <- function(g, counts, genotypes, prec, fit, verbose){ if(verbose >= 2) message(" Gene:", g) y <- counts[[g]] x <- genotypes[[g]] a <- numeric(nrow(x)) for(i in 1:nrow(x)){ # i = 2 NAs <- is.na(x[i, ]) | is.na(y[1, ]) yy <- y[, !NAs, drop = FALSE] xx <- x[i, !NAs] ff <- fit[[g]][[i]][, !NAs, drop = FALSE] groups <- factor(xx) ngroups <- nlevels(groups) lgroups <- levels(groups) igroups <- lapply(lgroups, function(gr){which(groups == gr)}) names(igroups) <- lgroups # Get the column number of a first occurance of a group level figroups <- unlist(lapply(igroups, function(x){x[1]})) a[i] <- dm_CRadjustmentManyGroups(y = yy, ngroups = ngroups, lgroups = lgroups, igroups = igroups, prec = prec[[g]][i], prop = ff[, figroups, drop = FALSE]) } # a vector of length #snps for gene g return(a) } #' @importFrom stats model.matrix dmSQTL_CRadjustmentRegression_gene <- function(g, counts, genotypes, group_formula = ~ group, prec, fit, verbose){ if(verbose >= 2) message(" Gene:", g) y <- counts[[g]] x <- genotypes[[g]] a <- numeric(nrow(x)) for(i in 1:nrow(x)){ # i = 2 NAs <- is.na(x[i, ]) | is.na(y[1, ]) yy <- y[, !NAs, drop = FALSE] xx <- x[i, !NAs] ff <- fit[[g]][[i]][, !NAs, drop = FALSE] design <- model.matrix(group_formula, data = data.frame(group = xx)) a[i] <- dm_CRadjustmentRegression(y = yy, x = design, prec = prec[[g]][i], prop = ff) } # a vector of length #snps for gene g return(a) } dmSQTL_CRadjustment <- function(counts, fit, genotypes, group_formula = ~ group, precision, one_way = TRUE, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ time_start <- Sys.time() if(verbose) message("* Calculating Cox-Reid adjustment.. \n") inds <- 1:length(counts) # Prepare precision if(class(precision) == "numeric"){ prec <- relist(rep(precision, nrow(genotypes)), genotypes@partitioning) } else { prec <- precision } if(one_way){ adj <- BiocParallel::bplapply(inds, dmSQTL_CRadjustmentManyGroups_gene, counts = counts, genotypes = genotypes, prec = prec, fit = fit, verbose = verbose, BPPARAM = BPPARAM) names(adj) <- names(counts) }else{ adj <- BiocParallel::bplapply(inds, dmSQTL_CRadjustmentRegression_gene, counts = counts, genotypes = genotypes, group_formula = ~ group, prec = prec, fit = fit, verbose = verbose, BPPARAM = BPPARAM) names(adj) <- names(counts) } time_end <- Sys.time() if(verbose >= 2) message("\n") if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") # adj is a list of length G return(adj) } DRIMSeq/R/dmSQTL_estimateCommonPrecision.R0000644000175100017510000000337414614306665021370 0ustar00biocbuildbiocbuild dmSQTL_profileLikCommon <- function(prec, counts, genotypes, prec_adjust = TRUE, prec_interval = c(0, 1e+5), prec_tol = 1e+01, one_way = TRUE, group_formula = ~ group, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ if(verbose >= 2) message("Gamma in optimize:", prec, "\n") adj_lik <- dmSQTL_profileLik(prec = prec, counts = counts, genotypes = genotypes, prec_adjust = prec_adjust, one_way = one_way, group_formula = group_formula, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) adj_lik_common <- sum(adj_lik, na.rm = TRUE) return(adj_lik_common) } #' @importFrom stats optimize dmSQTL_estimateCommonPrecision <- function(counts, genotypes, prec_adjust = TRUE, prec_interval = c(0, 1e+5), prec_tol = 1e+01, one_way = TRUE, group_formula = ~ group, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ time_start <- Sys.time() if(verbose) message("* Estimating common precision.. \n") optimum <- optimize(f = dmSQTL_profileLikCommon, interval = prec_interval, counts = counts, genotypes = genotypes, prec_adjust = prec_adjust, one_way = one_way, group_formula = group_formula, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = max(0, verbose-1), BPPARAM = BPPARAM, maximum = TRUE, tol = prec_tol) precision <- optimum$maximum time_end <- Sys.time() if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") return(precision) } DRIMSeq/R/dmSQTL_estimateTagwisePrecision.R0000644000175100017510000000453114614306665021537 0ustar00biocbuildbiocbuild#' @importFrom stats complete.cases dmSQTL_estimateTagwisePrecision <- function(counts, genotypes, mean_expression, prec_adjust = TRUE, prec_init = 100, prec_grid_length = 21, prec_grid_range = c(-10, 10), prec_moderation = "none", prec_prior_df = 0, prec_span = 0.1, one_way = TRUE, group_formula = ~ group, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ time_start <- Sys.time() if(verbose) message("* Estimating genewise precision.. \n") ### Standard grid like in edgeR spline_pts <- seq(from = prec_grid_range[1], to = prec_grid_range[2], length = prec_grid_length) spline_prec <- prec_init * 2^spline_pts # Calculate the likelihood for each gene and snp # at the spline precision points loglik <- matrix(NA, nrow = nrow(genotypes), ncol = prec_grid_length) for(i in seq(prec_grid_length)){ # i = 1 loglik[, i] <- dmSQTL_profileLik(prec = spline_prec[i], counts = counts, genotypes = genotypes, prec_adjust = prec_adjust, one_way = one_way, group_formula = group_formula, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, verbose = max(0, verbose - 1), BPPARAM = BPPARAM) } not_nas <- complete.cases(loglik) loglik <- loglik[not_nas, , drop = FALSE] if(nrow(loglik) == 0){ precision <- rep(NA, nrow(genotypes)) names(precision) <- rownames(genotypes) precision <- relist(precision, genotypes@partitioning) return(precision) } if(prec_moderation != "none"){ mean_expression <- rep(mean_expression, elementNROWS(genotypes))[not_nas] loglik <- dm_profileLikModeration(loglik = loglik, mean_expression = mean_expression, prec_moderation = prec_moderation, prec_prior_df = prec_prior_df, prec_span = prec_span) } out <- edgeR::maximizeInterpolant(spline_pts, loglik) # Set NA for genes that tagwise prec could not be calculated precision <- rep(NA, nrow(genotypes)) names(precision) <- rownames(genotypes) precision[not_nas] <- prec_init * 2^out precision <- relist(precision, genotypes@partitioning) time_end <- Sys.time() if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") return(precision) } DRIMSeq/R/dmSQTL_filter.R0000644000175100017510000001226114614306665016010 0ustar00biocbuildbiocbuild dmSQTL_filter_genotypes_per_gene <- function(g, counts_new, genotypes, minor_allele_freq){ # g = 1 counts_gene <- counts_new[[g]] genotypes_gene <- genotypes[[g]] ## NA for samples with non expressed genes and missing genotype genotypes_gene[, is.na(counts_gene[1,])] <- NA genotypes_gene[genotypes_gene == -1] <- NA ### Keep genotypes with at least minor_allele_freq number of ### variants per group; in other case replace them with NAs genotypes_gene <- apply(genotypes_gene, 1, function(x){ # x <- genotypes_gene[6,] tt <- table(x) if(length(tt) == 1) return(NULL) if(length(tt) == 2){ if(any(tt <= minor_allele_freq)) return(NULL) return(x) }else{ if(sum(tt <= minor_allele_freq) >= 2) return(NULL) x[x == names(tt[tt <= minor_allele_freq])] <- NA return(x) } }) if(!is.null(genotypes_gene)){ if(is.list(genotypes_gene)) genotypes_gene <- do.call(rbind, genotypes_gene) else genotypes_gene <- t(genotypes_gene) } return(genotypes_gene) } dmSQTL_filter <- function(counts, genotypes, blocks, samples, min_samps_gene_expr = 70, min_gene_expr = 20, min_samps_feature_expr = 5, min_feature_expr = 20, min_samps_feature_prop = 5, min_feature_prop = 0.05, minor_allele_freq = 5, run_gene_twice = FALSE, BPPARAM = BiocParallel::SerialParam()){ ######################################################## # filtering on counts, put NA for samples with low gene expression ######################################################## inds <- which(elementNROWS(counts) > 1) counts_new <- lapply(inds, function(g){ # g = 1 expr_features <- counts[[g]] ### no genes with no expression if(sum(expr_features, na.rm = TRUE) == 0) return(NULL) ### genes with min expression if(! sum(colSums(expr_features) >= min_gene_expr, na.rm = TRUE) >= min_samps_gene_expr ) return(NULL) ### no features with no expression features2keep <- rowSums(expr_features > 0, na.rm = TRUE) > 0 ### no genes with one feature if(sum(features2keep) <= 1) return(NULL) expr_features <- expr_features[features2keep, , drop = FALSE] ### features with min expression features2keep <- rowSums(expr_features >= min_feature_expr, na.rm = TRUE) >= min_samps_feature_expr ### no genes with one feature if(sum(features2keep) <= 1) return(NULL) expr_features <- expr_features[features2keep, , drop = FALSE] ### genes with zero expression samps2keep <- colSums(expr_features) > 0 & !is.na(expr_features[1, ]) if(sum(samps2keep) < max(1, min_samps_feature_prop)) return(NULL) ### consider only samples that have min gene expression, to other assign NAs samps2keep <- colSums(expr_features) >= min_gene_expr & !is.na(expr_features[1, ]) if(sum(samps2keep) < max(1, min_samps_feature_prop)) return(NULL) prop <- prop.table(expr_features[, samps2keep, drop = FALSE], 2) features2keep <- rowSums(prop >= min_feature_prop) >= min_samps_feature_prop ### no genes with one feature if(sum(features2keep) <= 1) return(NULL) expr <- expr_features[features2keep, , drop = FALSE] expr[, !samps2keep] <- NA if (run_gene_twice) { ### no genes with no expression if(sum(expr_features, na.rm = TRUE) == 0) return(NULL) ### genes with min expression if(! sum(colSums(expr_features) >= min_gene_expr, na.rm = TRUE) >= min_samps_gene_expr ) return(NULL) } return(expr) }) names(counts_new) <- names(counts)[inds] NULLs <- !sapply(counts_new, is.null) counts_new <- counts_new[NULLs] if(length(counts_new) == 0) stop("!No genes left after filtering!") counts_new <- MatrixList(counts_new) ######################################################## # filtering on genotypes ######################################################## genotypes <- genotypes[inds[NULLs]] blocks <- blocks[inds[NULLs], ] genotypes_new <- BiocParallel::bplapply(1:length(counts_new), dmSQTL_filter_genotypes_per_gene, counts_new = counts_new, genotypes = genotypes, minor_allele_freq = minor_allele_freq, BPPARAM = BPPARAM) names(genotypes_new) <- names(genotypes) NULLs <- !sapply(genotypes_new, is.null) genotypes_new <- genotypes_new[NULLs] if(length(genotypes_new) == 0) stop("!No SNPs left after filtering!") genotypes_new <- MatrixList(genotypes_new) counts_new <- counts_new[NULLs] blocks <- blocks[NULLs, ] ######################################################## # filtering on blocks ######################################################## inds <- 1:length(genotypes_new) blocks_new <- MatrixList(lapply(inds, function(b){ # b = 1 blocks[[b]][blocks[[b]][, "block_id"] %in% rownames(genotypes_new[[b]]), , drop = FALSE] })) names(blocks_new) <- names(genotypes_new) data <- new("dmSQTLdata", counts = counts_new, genotypes = genotypes_new, blocks = blocks_new, samples = samples) return(data) } DRIMSeq/R/dmSQTL_fit.R0000644000175100017510000001047214614306665015307 0ustar00biocbuildbiocbuild# Fitting the Dirichlet-multinomial model dmSQTL_fitManyGroups_gene <- function(g, counts, genotypes, prec, prop_mode, prop_tol, verbose){ # g = 6 if(verbose >= 2) message(" Gene:", g) y <- counts[[g]] x <- genotypes[[g]] ff <- lapply(1:nrow(x), function(i){ # i = 2 NAs <- is.na(x[i, ]) | is.na(y[1, ]) yy <- y[, !NAs, drop = FALSE] xx <- x[i, !NAs] groups <- factor(xx) ngroups <- nlevels(groups) lgroups <- levels(groups) igroups <- lapply(lgroups, function(gr){which(groups == gr)}) names(igroups) <- lgroups f <- dm_fitManyGroups(y = yy, ngroups = ngroups, lgroups = lgroups, igroups = igroups, prec = prec[[g]][i], prop_mode = prop_mode, prop_tol = prop_tol) lik <- sum(f$lik) fit <- matrix(NA, nrow = nrow(y), ncol = ncol(y)) fit[, !NAs] <- f$prop[, groups] return(list(lik = lik, fit = fit)) }) lik <- unlist(lapply(ff, function(f) f[["lik"]])) fit <- MatrixList(lapply(ff, function(f) f[["fit"]])) colnames(fit) <- colnames(counts) # lik is a vector of length nrow(x) # fit is a MatrixList of matrices q x n # DOES NOT return coef return(list(lik = lik, fit = fit)) } #' @importFrom stats model.matrix dmSQTL_fitRegression_gene <- function(g, counts, genotypes, group_formula = ~ group, prec, coef_mode, coef_tol, verbose){ if(verbose >= 2) message(" Gene:", g) y <- counts[[g]] x <- genotypes[[g]] ff <- lapply(1:nrow(x), function(i){ # i = 2 NAs <- is.na(x[i, ]) | is.na(y[1, ]) yy <- y[, !NAs, drop = FALSE] xx <- x[i, !NAs] design <- model.matrix(group_formula, data = data.frame(group = xx)) f <- dm_fitRegression(y = yy, design = design, prec = prec[[g]][i], coef_mode = coef_mode, coef_tol = coef_tol) fit <- matrix(NA, nrow = nrow(y), ncol = ncol(y)) fit[, !NAs] <- f$fit return(list(lik = f$lik, fit = fit)) }) lik <- unlist(lapply(ff, function(f) f[["lik"]])) fit <- MatrixList(lapply(ff, function(f) f[["fit"]])) colnames(fit) <- colnames(counts) # lik is a vector of length nrow(x) # fit is a MatrixList of matrices q x n # DOES NOT return coef return(list(lik = lik, fit = fit)) } dmSQTL_fit <- function(counts, genotypes, precision, one_way = TRUE, group_formula = ~ group, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, return_fit = FALSE, return_coef = FALSE, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ time_start <- Sys.time() if(verbose) message("* Fitting the DM model.. \n") inds <- 1:length(counts) # Prepare precision if(class(precision) == "numeric"){ prec <- relist(rep(precision, nrow(genotypes)), genotypes@partitioning) } else { prec <- precision } # Approach from edgeR glmFit.default: # If oneway layout, use a shortcut algorithm if(one_way){ if(verbose) message(" Using the one way approach. \n") ff <- BiocParallel::bplapply(inds, dmSQTL_fitManyGroups_gene, counts = counts, genotypes = genotypes, prec = prec, prop_mode = prop_mode, prop_tol = prop_tol, verbose = verbose, BPPARAM = BPPARAM) names(ff) <- names(counts) lik <- lapply(ff, function(f) f[["lik"]]) if(return_fit){ fit <- lapply(ff, function(f) f[["fit"]]) }else{ fit <- list() } }else{ if(verbose) message(" Using the regression approach. \n") ff <- BiocParallel::bplapply(inds, dmSQTL_fitRegression_gene, counts = counts, genotypes = genotypes, group_formula = group_formula, prec = prec, coef_mode = coef_mode, coef_tol = coef_tol, verbose = verbose, BPPARAM = BPPARAM) names(ff) <- names(counts) lik <- lapply(ff, function(f) f[["lik"]]) if(return_fit){ fit <- lapply(ff, function(f) f[["fit"]]) }else{ fit <- list() } } time_end <- Sys.time() if(verbose >= 2) message("\n") if(verbose) message("Took ", round(time_end - time_start, 4), " seconds.\n") # fit is a list of length G of MatrixLists # lik is a list of length G ofvectors # coef Currently, do not compute coef return(list(fit = fit, lik = lik, coef = list())) } DRIMSeq/R/dmSQTL_permutations.R0000755000175100017510000001700614614306665017262 0ustar00biocbuildbiocbuild dmSQTL_permutations_all_genes <- function(x, pvalues, max_nr_perm_cycles = 10, max_nr_min_nr_sign_pval = 1e3, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, BPPARAM = BiocParallel::SerialParam()){ # x dmSQTLfit object # pvalues vector of nominal p-values nas <- is.na(pvalues) pvalues <- pvalues[!nas] pvalues <- factor(pvalues) sum_sign_pval <- rep(0, length(pvalues)) nr_perm_tot <- 0 nr_perm_cycles <- 0 min_nr_sign_pval <- 0 while(nr_perm_cycles < max_nr_perm_cycles && min_nr_sign_pval < max_nr_min_nr_sign_pval){ if(verbose) message(paste0("** Running permutation cycle number ", nr_perm_cycles + 1 , "..")) ### Permute counts for all genes n <- ncol(x@counts) permutation <- sample(n, n) counts_perm <- x@counts[, permutation] # Fit the DM full model fit_full_perm <- dmSQTL_fit(counts = counts_perm, genotypes = x@genotypes, precision = x@genewise_precision, one_way = one_way, group_formula = ~ group, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, return_fit = FALSE, return_coef = FALSE, verbose = verbose, BPPARAM = BPPARAM) # Prepare null (one group) genotypes genotypes_null <- x@genotypes genotypes_null@unlistData[!is.na(genotypes_null@unlistData)] <- 1 # Fit the DM null model fit_null_perm <- dmSQTL_fit(counts = counts_perm, genotypes = genotypes_null, precision = x@genewise_precision, one_way = one_way, group_formula = ~ 1, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, return_fit = FALSE, return_coef = FALSE, verbose = verbose, BPPARAM = BPPARAM) ## Perform the LR test pval_perm <- lapply(1:length(counts_perm), function(g){ # g = 1 ## Calculate the degrees of freedom df <- (nrow(counts_perm[[g]]) - 1) * (apply(x@genotypes[[g]], 1, function(xx) length(unique(xx))) - 1) out <- dm_LRT(lik_full = fit_full_perm[["lik"]][[g]], lik_null = fit_null_perm[["lik"]][[g]], df = df, verbose = FALSE) return(out[, "pvalue"]) }) pval_perm <- unlist(pval_perm) nr_perm <- length(pval_perm) nr_perm_tot <- nr_perm_tot + nr_perm nr_perm_cycles <- nr_perm_cycles + 1 ### Count how many pval_permuted is lower than pvalues from the model nas_perm <- is.na(pval_perm) pval_perm <- pval_perm[!nas_perm] pval_perm_cut <- cut(pval_perm, c(-1, levels(pvalues), 2), right=FALSE) pval_perm_sum <- table(pval_perm_cut) pval_perm_cumsum <- cumsum(pval_perm_sum)[-length(pval_perm_sum)] names(pval_perm_cumsum) <- levels(pvalues) sum_sign_pval <- sum_sign_pval + pval_perm_cumsum[pvalues] pval_adj <- (sum_sign_pval + 1) / (nr_perm_tot + 1) min_nr_sign_pval <- min(sum_sign_pval) } pval_out <- rep(NA, length(pvalues)) pval_out[!nas] <- pval_adj # pval_out vector of permutation adjusted p-values return(pval_out) } dmSQTL_permutations_per_gene <- function(x, pvalues, max_nr_perm = 1e6, max_nr_sign_pval = 1e2, one_way = TRUE, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = 0, BPPARAM = BiocParallel::SerialParam()){ # x dmSQTLfit object # pvalues list of length G of vector with nominal p-values pvalues <- lapply(pvalues, function(x){ pval_tmp <- x[!is.na(x)] pval_tmp <- factor(pval_tmp) return(pval_tmp) }) results_width <- unlist(lapply(pvalues, length)) nas <- results_width == 0 genes2permute <- which(!nas) sum_sign_pval <- vector("list", length(pvalues)) sum_sign_pval[!nas] <- split(rep(0, sum(results_width)), factor(rep(1:length(results_width), times = results_width))) nr_perm_tot <- rep(0, length(x@counts)) nr_perm_tot[nas] <- NA min_nr_sign_pval <- rep(0, length(x@counts)) min_nr_sign_pval[nas] <- NA n <- ncol(x@counts) while(length(genes2permute) > 0){ if(verbose) message(paste0("** ", length(genes2permute), " genes left for permutation..")) ### Permute counts for all genes that need additional permutations permutation <- sample(n, n) counts_perm <- x@counts[genes2permute, permutation] genotypes <- x@genotypes[genes2permute, ] precision <- x@genewise_precision[genes2permute] # Fit the DM full model fit_full_perm <- dmSQTL_fit(counts = counts_perm, genotypes = genotypes, precision = precision, one_way = one_way, group_formula = ~ group, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, return_fit = FALSE, return_coef = FALSE, verbose = verbose, BPPARAM = BPPARAM) # Prepare null (one group) genotypes genotypes_null <- genotypes genotypes_null@unlistData[!is.na(genotypes_null@unlistData)] <- 1 # Fit the DM null model fit_null_perm <- dmSQTL_fit(counts = counts_perm, genotypes = genotypes_null, precision = precision, one_way = one_way, group_formula = ~ 1, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, return_fit = FALSE, return_coef = FALSE, verbose = verbose, BPPARAM = BPPARAM) ## Perform the LR test pval_perm <- lapply(1:length(counts_perm), function(g){ # g = 1 ## Calculate the degrees of freedom df <- (nrow(counts_perm[[g]]) - 1) * (apply(genotypes[[g]], 1, function(xx) length(unique(xx))) - 1) out <- dm_LRT(lik_full = fit_full_perm[["lik"]][[g]], lik_null = fit_null_perm[["lik"]][[g]], df = df, verbose = FALSE) return(out[, "pvalue"]) }) ### Count how many pval_perm is lower than pvalues from the model update_nr_sign_pval <- lapply(1:length(pval_perm), function(i){ # i = 1 pval_perm_gene <- pval_perm[[i]] pval_perm_gene <- pval_perm_gene[!is.na(pval_perm_gene)] pval_perm_cut <- cut(pval_perm_gene, c(-1, levels(pvalues[[genes2permute[i]]]), 2), right=FALSE) pval_perm_sum <- table(pval_perm_cut) pval_perm_cumsum <- cumsum(pval_perm_sum)[-length(pval_perm_sum)] names(pval_perm_cumsum) <- levels(pvalues[[genes2permute[i]]]) nr_sign_pval <- pval_perm_cumsum[pvalues[[genes2permute[i]]]] names(nr_sign_pval) <- NULL return(nr_sign_pval) }) ### Update values in sum_sign_pval for(i in 1:length(update_nr_sign_pval)){ sum_sign_pval[[genes2permute[i]]] <- sum_sign_pval[[genes2permute[i]]] + update_nr_sign_pval[[i]] } nr_perm <- unlist(lapply(pval_perm, length)) nr_perm_tot[genes2permute] <- nr_perm_tot[genes2permute] + nr_perm min_nr_sign_pval[genes2permute] <- unlist(lapply(sum_sign_pval[genes2permute], min)) ### Update genes2permute genes2permute <- which(nr_perm_tot < max_nr_perm & min_nr_sign_pval < max_nr_sign_pval) } ### Calculate permutation adjusted p-values pval_adj <- lapply(1:length(pvalues), function(i){ pval_tmp <- pvalues[[i]] nas <- is.na(pval_tmp) if(sum(!nas) == 0) return(pval_tmp) pval_tmp[!nas] <- (sum_sign_pval[[i]] + 1) / (nr_perm_tot[i] + 1) return(pval_tmp) }) # pval_adj list of length G with vectors of permutation adjusted p-values return(pval_adj) } DRIMSeq/R/dmSQTL_profileLik.R0000644000175100017510000000171614614306665016626 0ustar00biocbuildbiocbuild dmSQTL_profileLik <- function(prec, counts, genotypes, prec_adjust = TRUE, one_way = TRUE, group_formula = ~ group, prop_mode = "constrOptim", prop_tol = 1e-12, coef_mode = "optim", coef_tol = 1e-12, verbose = FALSE, BPPARAM = BiocParallel::SerialParam()){ fit <- dmSQTL_fit(counts = counts, genotypes = genotypes, precision = prec, one_way = one_way, group_formula = group_formula, prop_mode = prop_mode, prop_tol = prop_tol, coef_mode = coef_mode, coef_tol = coef_tol, return_fit = TRUE, return_coef = FALSE, verbose = verbose, BPPARAM = BPPARAM) if(!prec_adjust) return(unlist(fit$lik)) adj <- dmSQTL_CRadjustment(counts = counts, fit = fit$fit, genotypes = genotypes, group_formula = group_formula, precision = prec, one_way = one_way, verbose = verbose, BPPARAM = BPPARAM) adj_lik <- unlist(fit$lik) - unlist(adj) # adj_lik is a vector containing all the genes and snps return(adj_lik) } DRIMSeq/R/DRIMSeq.R0000755000175100017510000001115414614306665014546 0ustar00biocbuildbiocbuild#' @import BiocGenerics #' @import methods #' @import BiocParallel #' @import edgeR #' @import GenomicRanges NULL # ### EXAMPLES ### # # -------------------------------------------------------------------------- # # Create dmDSdata object # # -------------------------------------------------------------------------- # ## Get kallisto transcript counts from the 'PasillaTranscriptExpr' package # # library(PasillaTranscriptExpr) # # data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") # # ## Load metadata # pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), # header = TRUE, as.is = TRUE) # # ## Load counts # pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), # header = TRUE, as.is = TRUE) # # ## Create a pasilla_samples data frame # pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, # group = pasilla_metadata$condition) # levels(pasilla_samples$group) # # ## Create a dmDSdata object # d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) # # ## Use a subset of genes, which is defined in the following file # gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) # # d <- d[names(d) %in% gene_id_subset, ] # # # -------------------------------------------------------------------------- # # Differential transcript usage analysis - simple two group comparison # # -------------------------------------------------------------------------- # # ## Filtering # ## Check what is the minimal number of replicates per condition # table(samples(d)$group) # # d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, # min_gene_expr = 10, min_feature_expr = 10) # # plotData(d) # # ## Create the design matrix # design_full <- model.matrix(~ group, data = samples(d)) # # ## To make the analysis reproducible # set.seed(123) # ## Calculate precision # d <- dmPrecision(d, design = design_full) # # plotPrecision(d) # # head(mean_expression(d)) # common_precision(d) # head(genewise_precision(d)) # # ## Fit full model proportions # d <- dmFit(d, design = design_full) # # ## Get fitted proportions # head(proportions(d)) # ## Get the DM regression coefficients (gene-level) # head(coefficients(d)) # ## Get the BB regression coefficients (feature-level) # head(coefficients(d), level = "feature") # # ## Fit null model proportions and perform the LR test to detect DTU # d <- dmTest(d, coef = "groupKD") # # ## Plot the gene-level p-values # plotPValues(d) # # ## Get the gene-level results # head(results(d)) # # ## Plot feature proportions for a top DTU gene # res <- results(d) # res <- res[order(res$pvalue, decreasing = FALSE), ] # # top_gene_id <- res$gene_id[1] # # plotProportions(d, gene_id = top_gene_id, group_variable = "group") # # plotProportions(d, gene_id = top_gene_id, group_variable = "group", # plot_type = "lineplot") # # plotProportions(d, gene_id = top_gene_id, group_variable = "group", # plot_type = "ribbonplot") # # # # # # # # -------------------------------------------------------------------------- # # Create dmSQTLdata object # # -------------------------------------------------------------------------- # # Use subsets of data defined in the GeuvadisTranscriptExpr package # # library(GeuvadisTranscriptExpr) # # geuv_counts <- GeuvadisTranscriptExpr::counts # geuv_genotypes <- GeuvadisTranscriptExpr::genotypes # geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges # geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges # # colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") # colnames(geuv_genotypes)[4] <- "snp_id" # geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) # # d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, # genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, # samples = geuv_samples, window = 5e3) # # # -------------------------------------------------------------------------- # # sQTL analysis - simple group comparison # # -------------------------------------------------------------------------- # # ## Filtering # d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, # minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) # # plotData(d) # # ## To make the analysis reproducible # set.seed(123) # ## Calculate precision # d <- dmPrecision(d) # # plotPrecision(d) # # ## Fit full model proportions # d <- dmFit(d) # # ## Fit null model proportions, perform the LR test to detect tuQTLs # ## and use the permutation approach to adjust the p-values # d <- dmTest(d) # # ## Plot the gene-level p-values # plotPValues(d) # # ## Get the gene-level results # head(results(d)) DRIMSeq/README.md0000755000175100017510000000437414614306666014304 0ustar00biocbuildbiocbuild## DRIMSeq - differential transcript usage and transcript usage QTL analyses with a Dirichlet-multinomial model in RNA-Seq `DRIMSeq` package provides two frameworks. One for the differential transcript usage (DTU) analysis between different designs and one for the tuQTL analysis. Both are based on modeling transcript counts with the Dirichlet-multinomial distribution. DTU analysis can be performed at the gene and/or transcript level. The package also makes available functions for visualization and exploration of the data and results. # Bioconductor installation `DRIMSeq` is available on [Bioconductor](https://www.bioconductor.org/packages/release/bioc/html/DRIMSeq.html) and can be installed with the command: ``` r ## try http:// if https:// URLs are not supported if (!requireNamespace("BiocManager", quietly=TRUE)) install.packages("BiocManager") BiocManager::install("DRIMSeq") ``` The vignette containing all the instructions on how to use the DRIMSeq package for DTU and tuQTL analyses can be accessed by entering: ``` r browseVignettes("DRIMSeq") ``` or on the [Bioconductor website](https://www.bioconductor.org/packages/release/bioc/vignettes/DRIMSeq/inst/doc/DRIMSeq.pdf). # Devel installation from Github To install the latest development version, use the `devtools` package (available [here](https://github.com/hadley/devtools)): ``` r devtools::install_github("markrobinsonuzh/DRIMSeq") ``` To install it with the vignette type: ``` r devtools::install_github("markrobinsonuzh/DRIMSeq", build_vignettes = TRUE) ``` The vignette can be accessed from the R console by typing: ``` r vignette("DRIMSeq") ``` or ``` r browseVignettes("DRIMSeq") ``` # Data packages In order to run the examples from the vignette and the manual, you need to install two data packages [PasillaTranscriptExpr](https://www.bioconductor.org/packages/release/data/experiment/html/PasillaTranscriptExpr.html) and [GeuvadisTranscriptExpr](https://www.bioconductor.org/packages/release/data/experiment/html/GeuvadisTranscriptExpr.html). ``` r ## try http:// if https:// URLs are not supported if (!requireNamespace("BiocManager", quietly=TRUE)) install.packages("BiocManager") BiocManager::install("PasillaTranscriptExpr") BiocManager::install("GeuvadisTranscriptExpr") ``` DRIMSeq/tests/0000755000175100017510000000000014614306666014154 5ustar00biocbuildbiocbuildDRIMSeq/tests/testthat/0000755000175100017510000000000014614306666016014 5ustar00biocbuildbiocbuildDRIMSeq/tests/testthat.R0000644000175100017510000000007214614306666016136 0ustar00biocbuildbiocbuildlibrary(testthat) library(DRIMSeq) test_check("DRIMSeq") DRIMSeq/tests/testthat/test_dm_adjustment.R0000755000175100017510000000037014614306666022037 0ustar00biocbuildbiocbuildcontext("DM adjustement") prec = 10 y = matrix(c(30, 75, 35, 70), nrow = 2) prop = c(0.3, 0.7) test_that("dm_CRadjustmentOneGroup returns the right values", { expect_equal(round(dm_CRadjustmentOneGroup(y, prec, prop), 4), 2.6562) }) DRIMSeq/tests/testthat/test_gene_filter.R0000644000175100017510000000234614614306666021466 0ustar00biocbuildbiocbuildcontext("gene filter") test_that("gene filtering is working", { cts <- matrix(rnbinom(120, mu=100, size=10), ncol=10, dimnames=list(1:12,paste0("s",1:10))) cts[1,] <- 0 cts[2:3,] <- 10 cts[1:3,1] <- c(10,0,0) counts <- data.frame(gene_id=factor(rep(1:4, each=3)), feature_id=factor(1:12), cts) samples <- data.frame(sample_id=paste0("s",1:10), condition=rep(c("A","B"),each=5)) d <- dmDSdata(counts, samples) d <- dmFilter(d, min_samps_gene_expr = 10, min_gene_expr = 10, min_samps_feature_expr = 5, min_feature_expr = 0, min_samps_feature_prop = 5, min_feature_prop = 0) d2 <- dmFilter(d, min_samps_gene_expr = 10, min_gene_expr = 10, min_samps_feature_expr = 5, min_feature_expr = 10, min_samps_feature_prop = 5, min_feature_prop = 0) expect_true(length(d2) == 4) sum(counts(d2[1,])$s1) # has 0 counts for this gene # now use 'run_gene_twice' d3 <- dmFilter(d, min_samps_gene_expr = 10, min_gene_expr = 10, min_samps_feature_expr = 5, min_feature_expr = 10, min_samps_feature_prop = 5, min_feature_prop = 0, run_gene_twice=TRUE) expect_true(length(d3) == 3) }) DRIMSeq/tests/testthat/test_lik_score.R0000755000175100017510000000077114614306666021160 0ustar00biocbuildbiocbuildcontext("DM likelihood and score") prec = 10 y = matrix(c(35, 70, 100, 100), nrow = 2) prop = 0.3 test_that("dm_lik and dm_likG are equal", { expect_equal(dm_lik(prop, prec, y), dm_likG(prop, prec, y)) }) test_that("dm_score and dm_scoreG are equal", { expect_equal(dm_score(prop, prec, y), dm_scoreG(prop, prec, y)) }) y = matrix(c(0, 0, 35, 70), nrow = 2) test_that("dm_lik and dm_likG are diff. for matrix with 0 column", { expect_true(dm_lik(prop, prec, y) < dm_likG(prop, prec, y)) }) DRIMSeq/tests/testthat/test_MatrixList.R0000644000175100017510000000145014614306666021276 0ustar00biocbuildbiocbuildcontext("MatrixList") x1 <- matrix(1, 10, 6) colnames(x1) <- paste0("C", 1:6) rownames(x1) <- paste0("R1", 1:10) x2 <- matrix(2, 5, 6) colnames(x2) <- paste0("C", 1:6) rownames(x2) <- paste0("R2", 1:5) x <- MatrixList(x1 = x1, x2 = x2) test_that("methods return correct arributes of MatrixList", { expect_equal(names(x), c("x1", "x2")) expect_equal(rownames(x), c(paste0("R1", 1:10), paste0("R2", 1:5))) expect_equal(colnames(x), paste0("C", 1:6)) expect_equal(length(x), 2) expect_equal(elementNROWS(x), c(x1 = 10, x2 = 5)) expect_equal(dim(x), c(15, 6)) expect_equal(nrow(x), 15) expect_equal(ncol(x), 6) }) test_that("subsetting of MatrixList is correct", { expect_equal(x[["x2"]], x2) expect_equal(x$x2, x2) expect_equal(x[1, 1], MatrixList(x1 = x1[, 1, drop = FALSE])) }) DRIMSeq/tests/testthat/test_total_switch.R0000644000175100017510000000202514614306666021701 0ustar00biocbuildbiocbuildcontext("total switch") test_that("total switch retains precision estimates", { cts <- matrix(rnbinom(100, mu=100, size=10), ncol=10, dimnames=list(1:10,paste0("s",1:10))) cts[1,1:5] <- 0 cts[2,6:10] <- 0 counts <- data.frame(gene_id=factor(rep(1:5, each=2)), feature_id=factor(1:10), cts) samples <- data.frame(sample_id=paste0("s",1:10), condition=rep(c("A","B"),each=5)) d <- dmDSdata(counts, samples) design <- model.matrix(~condition, samples(d)) d <- dmPrecision(d, design=design, prec_subset=1) expect_true(is.na(genewise_precision(d)$genewise_precision[1])) d2 <- dmPrecision(d, design=design, prec_subset=1, add_uniform=TRUE) expect_true(!is.na(genewise_precision(d2)$genewise_precision)[1]) d <- dmFit(d, design=design) d <- dmTest(d, coef="conditionB") res <- results(d) expect_true(is.na(res$pvalue[1])) d2 <- dmFit(d2, design=design, add_uniform=TRUE) d2 <- dmTest(d2, coef="conditionB") res <- results(d2) expect_true(!is.na(res$pvalue[1])) }) DRIMSeq/vignettes/0000755000175100017510000000000014614334234015012 5ustar00biocbuildbiocbuildDRIMSeq/vignettes/DRIMSeq.Rnw0000755000175100017510000011250514614306666016725 0ustar00biocbuildbiocbuild%\VignetteIndexEntry{Differential transcript usage and transcript usage QTL analyses in RNA-seq with the DRIMSeq package} %\VignettePackage{DRIMSeq} %\VignetteEngine{knitr::knitr} \documentclass[10pt]{article} <>= BiocStyle::latex() @ \usepackage[utf8]{inputenc} \usepackage[sort]{cite} \usepackage{xstring} \bioctitle[Differential transcript usage and transcript usage QTL analyses in RNA-seq with the DRIMSeq package]{DRIMSeq: Dirichlet-multinomial framework for differential transcript usage and transcript usage QTL analyses in RNA-seq} \author{ Malgorzata Nowicka\thanks{\email{gosia.nowicka@uzh.ch}}, Mark D. Robinson\\ Institute for Molecular Life Sciences, University of Zurich, Switzerland\\ SIB Swiss Institute of Bioinformatics, University of Zurich, Switzerland } \begin{document} \maketitle \packageVersion{\Sexpr{BiocStyle::pkg_ver("DRIMSeq")}} \newpage \tableofcontents \newpage <>= library(knitr) opts_chunk$set(cache = FALSE, warning = FALSE, out.width = "7cm", fig.width = 7, out.height = "7cm", fig.height = 7) @ %------------------------------------------------------------------------------ % Introduction %------------------------------------------------------------------------------ \section{Main changes in the DRIMSeq package} For the full list of changes, type: <>= news(package = "DRIMSeq") @ Implementation of the regression framework in differential transcript usage analysis. It allows fitting more complicated than multiple group comparison experimental designs, for example, one can account for the batch effects or the fact that samples are paired or model continuous time course changes. It enables also testing of more complicated contrasts. Transcript-level analysis based on the beta-binomial model. In this case, each transcript ratio is modeled separately assuming it follows the beta-binomial distribution which is a one-dimensional version of the Dirichlet-multinomial distribution. Based on the fact that when $(Y_1,\ldots,Y_q) \sim DM(\pi_1,\ldots,\pi_q, \gamma_0)$ then $Y_j \sim BB(\pi_j,\gamma_0)$ \cite{Danaher1988}, we do not need to reestimate the beta-binomial parameters, only the likelihoods are recalculated. \Rpackage{DRIMSeq} returns gene-level and transcript-level p-values which can be used as input to the stage-wise testing procedure \cite{VandenBerge2017} as screening and confirmation p-values, respectively. Such approach provides increased power to identify transcripts which are actually differentially used in a gene detected as gene with DTU. Usage of term 'precision' instead of 'dispersion'. In the differential analysis based on the negative-binomial model, dispersion parameter is estimated. This dispersion parameter captures all sources of the inter-library variation between replicates present in the RNA-seq data. In the DM model, we do not directly estimate dispersion but a parameter called precision which is closely linked to dispersion via the formula: $dispersion = 1 / (1 + precision)$. In the previous version of \cite{Nowicka2016}, we used 'dispersion' as a name for the functions and variables calculating and storing, in fact, the precision estimates. Now, we use the term 'precision'. \section{Overview of the Dirichlet-multinomial model} For the statistical details about the Dirichlet-multinomial model, see the \Rpackage{DRIMSeq} paper \cite{Nowicka2016}. In the \Rpackage{DRIMSeq} package we implemented a Dirichlet-multinomial framework that can be used for modeling various multivariate count data with the interest in finding the instances where the ratios of observed features are different between the experimental conditions. Such a model can be applied, for example, in differential transcript usage (DTU) analysis or in the analysis that aim in detecting SNPs that are associated with differential transcript usage (tuQTL analysis). In both cases the multivariate features of a gene are transcripts. The implementation of Dirichlet-multinomial model in \Rpackage{DRIMSeq} package is customized for differential transcript usage and tuQTL analyses, but the data objects used in \Rpackage{DRIMSeq} can contain various types of counts. Therefore, other types of multivariate differential analyses can be performed such as differential methylation analysis or differential polyA usage from polyA-seq data. In short, the method consists of three statistical steps: First, we use the Cox-Reid adjusted profile likelihood to estimate the precision which is inverse proportional to dispersion, i.e., the variability of transcript ratios between samples (replicates) within conditions. Dispersion is needed in order to find the significant changes in transcript ratios between conditions which should be sufficiently stronger than the changes/variability within conditions. Second, we use maximum likelihood to estimate at the gene-level the regression coefficients in the Dirichlet-multinomial (DM) regression, the fitted transcript proportions in each sample and the full model likelihoods. For the analysis at the transcript-level we apply the beta-binomial (BB) regression to each transcript separately. In the differential transcript usage analysis, the full model is defined by the user with the design matrix. In the QTL analysis, full models are defined by the genotypes of SNPs associated with a given gene. Finally, we fit the null model DM and BB regression and use the likelihood ratio statistics to test for the differences in transcript proportions between the full and null models at the gene and transcript level. In the differential transcript usage analysis, the null model is again defined by the user. In the QTL analysis, null models correspond to regression with intercept only. \section{Important notes} Currently, transcript-level analysis based on the BB model are implemented only in the DTU analysis (\Rcode{bb\_model = TRUE}). When the model (full or null) of interest corresponds to multiple (or one) group fitting, then a shortcut algorithm called 'one way' (\Rcode{one\_way = TRUE}), which we adapted from the \Rfunction{glmFit} function in \Biocpkg{edgeR} \cite{McCarthy2012}, can be used. Choosing it is equivalent to running the original \Rpackage{DRIMSeq} implementation. In such a case, we use maximum likelihood to estimate the transcript proportions in each group separately and then the regression coefficients are calculated using matrix operations. Otherwise, the regression coefficients are directly estimated with the maximum likelihood approach. \section{Hints for DRIMSeq pipelines} In this vignette, we present how one could perform differential transcript usage analysis and tuQTL analysis with the \Rpackage{DRIMSeq} package. We use small data sets so that the whole pipelines can be run within few minutes in \R{} on a single core computer. In practice, the package is designed to take advantage of multicore computing for larger data sets. In the filtering function \Rfunction{dmFilter}, all the parameters that are influencing transcript count filtering are set to zero. This results in a very relaxed filtering, where transcripts with zero expression in all the samples and genes with only one transcript remained are removed. Functions \Rfunction{dmPrecision}, \Rfunction{dmFit} and \Rfunction{dmTest}, which perform the actual statistical analyses described above, have many other parameters available for tweaking, but they do have the default values assigned. Those values were chosen based on many real data analyses. Some of the steps are quite time consuming, especially the precision estimation, where proportions of each gene are refitted for different precision parameters. To speed up the calculations, we have parallelized many functions using \Biocpkg{BiocParallel}. Thus, if possible, we recommend to increase the number of workers in \Robject{BPPARAM}. In general, tuQTL analyses are more computationally intensive than differential transcript usage analysis because one needs to do the analysis for every SNP in the surrounding region of a gene. Additionally, a permutation scheme is used to compute the p-values. It is indeed feasible to perform tuQTL analysis for small chunks of genome, for example, per chromosome. %------------------------------------------------------------------------------ % Differential transcript usage analysis workflow %------------------------------------------------------------------------------ \section{Differential transcript usage analysis workflow} \subsection{Example data} To demonstrate the application of \Rpackage{DRIMSeq} in differential transcript usage analysis, we will use the \emph{pasilla} data set produced by Brooks et al. \cite{Brooks2011}. The aim of their study was to identify exons that are regulated by pasilla protein, the Drosophila melanogaster ortholog of mammalian NOVA1 and NOVA2 (well studied transcript usage factors). In their RNA-seq experiment, the libraries were prepared from 7 biologically independent samples: 4 control samples and 3 samples in which pasilla was knocked-down. The libraries were sequenced on Illumina Genome Analyzer II using single-end and paired-end sequencing and different read lengths. The RNA-seq data can be downloaded from the NCBI Gene Expression Omnibus (GEO) under the accession number GSE18508. In the examples below, we use a subset of \software{kallisto} \cite{Bray2016} counts available in \Biocexptpkg{PasillaTranscriptExpr} package, where you can find all the steps needed, for preprocessing the GEO data, to get a table with transcript counts. \subsection{Differential transcript usage analysis between two conditions} In this section, we present how to perform the DTU analysis between two conditions control and knock-down without accounting for the batch effect which is the library layout. Analysis where batch effects are included are presented in the next section. We start the analysis by creating a \Rclass{dmDSdata} object, which contains transcript counts and information about grouping samples into conditions. With each step of the pipeline, additional elements are added to this object. At the end of the analysis, the object contains results from all the steps, such as precision estimates, regression coefficients, fitted transcript ratios in each sample, likelihood ratio statistics, p-values, adjusted p-values at gene and transcript level. As new elements are added, the object also changes its name \Rclass{dmDSdata} $\rightarrow$ \Rclass{dmDSprecision} $\rightarrow$ \Rclass{dmDSfit} $\rightarrow$ \Rclass{dmDStest}, but each container inherits slots and methods available for the previous one. \subsubsection{Loading pasilla data into R} The transcript-level counts obtained from \software{kallisto} and metadata are saved as text files in the \Rcode{extdata} directory of the \Biocexptpkg{PasillaTranscriptExpr} package. <>= library(PasillaTranscriptExpr) data_dir <- system.file("extdata", package = "PasillaTranscriptExpr") ## Load metadata pasilla_metadata <- read.table(file.path(data_dir, "metadata.txt"), header = TRUE, as.is = TRUE) ## Load counts pasilla_counts <- read.table(file.path(data_dir, "counts.txt"), header = TRUE, as.is = TRUE) @ Load the \Rpackage{DRIMSeq} package. <>= library(DRIMSeq) @ To create a \Rcode{dmDSdata} object, saved as variable \Robject{d}, we need to prepare a data frame containing information about samples and we will call it \Robject{pasilla\_samples}. It has to have a variable called \Rcode{sample\_id} with unique sample names that are identical to column names in \Robject{pasilla\_counts} that correspond to samples. Additionally, it has to contain other variables that the user would like to use for the further regression analysis. Here, we are interested in the differential analysis between the control and knock-down condition. This information is stored in \Rcode{pasilla\_metadata\$condition}. The data frame with counts called \Robject{pasilla\_counts} is already formatted in the right way. It contains variables \Rcode{feature\_id} with unique transcript names and \Rcode{gene\_id} with unique gene IDs and columns with counts have the same names as \Rcode{sample\_id} in \Rcode{pasilla\_samples}. When printing variable \Robject{d}, you can see its class, size (number of genes and samples) and which accessor methods can be applied. For \Rcode{dmDSdata} object, there are two methods that return data frames with counts and samples. <>= pasilla_samples <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition) levels(pasilla_samples$group) d <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples) d head(counts(d), 3) head(samples(d), 3) @ You can also make a data summary plot, which is a histogram of the number of transcripts per gene. <>= plotData(d) @ To make the analysis runnable within this vignette, we want to keep only a small subset of genes, which is defined in the following file. <>= gene_id_subset <- readLines(file.path(data_dir, "gene_id_subset.txt")) d <- d[names(d) %in% gene_id_subset, ] d @ \subsubsection{Filtering} \label{DS_filtering} Genes may have many transcripts that are lowly expressed or not expressed at all. You can remove them using the \Rfunction{dmFilter} function. Filtering of lowly expressed transcripts can be done at two levels: minimal \textit{expression} using \Robject{min\_samps\_feature\_expr} and \Robject{min\_feature\_expr} parameters or minimal \textit{proportion} with \Robject{min\_samps\_feature\_prop} and \Robject{min\_feature\_prop}. In the \emph{pasilla} experiment we use a filtering based only on the transcript absolute expression and parameters are adjusted according to the number of replicates per condition. Since we have 3 knock-down and 4 control samples, we set \Robject{min\_samps\_feature\_expr} equal to 3. In this way, we allow a situation where a transcript is expressed in one condition but not in another, which is a case of differential transcript usage. The level of transcript expression is controlled by \Robject{min\_feature\_expr}. We set it to the value of 10, which means that only the transcripts that have at least 10 estimated counts in at least 3 samples are kept for the downstream analysis. Filtering at the gene level ensures that the observed transcript ratios have some minimal reliability. Although, Dirichlet-multinomial model works on feature counts, and not on feature ratios, which means that it gives more confidence to the ratios based on 100 versus 500 reads than 1 versus 5, minimal filtering based on gene expression removes the genes with mostly zero counts and reduces the number of tests in multiple test correction. For the \emph{pasilla} data, we want that genes have at least 10 counts in all the samples: \Rcode{min\_samps\_gene\_expr = 7} and \Rcode{min\_gene\_expr = 10}. <>= # Check what is the minimal number of replicates per condition table(samples(d)$group) d <- dmFilter(d, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) @ \subsubsection{Precision estimation} \label{DS_precision_estimation} Ideally, we would like to get accurate precision estimates for every gene, which is problematic when analyzing small data sets because precision estimates become inaccurate when the sample size decreases, especially for lowly expressed genes. As an alternative, we could assume that all the genes have the same precision and based on all the data, we could calculate a common precision, but we expect this to be too strong of an assumption. Moderated precision is a trade-off between gene-wise and common precision. The moderated estimates originate from a weighted likelihood which is a combination of common and individual likelihoods. We recommend this approach when analyzing small sample size data sets. At this step, three values may be calculated: mean expression of genes, common precision and gene-wise precisions. In the default setting, all of them are computed and common precision is used as an initial value in the grid approach to estimate gene-wise precisions, which are shrunk toward the trended precision. The grid approach is adapted from the \Rfunction{estimateDisp} function in \Biocpkg{edgeR} \cite{McCarthy2012}. By default, to estimate the common precision, we use 10\% percent (\Rcode{prec\_subset = 0.1}) of randomly selected genes. That is due to the fact that common precision is used only as an initial value, and estimating it based on all the genes takes a substantial part of time. To ensure that the analysis are reproducible, the user should define a random seed \Rcode{set.seed()} before running the \Rcode{dmPrecision()} function. Thank to that, each time the same subset of genes is selected. To estimate precision parameters, the user has to define a design matrix with the full model of interest, which will be also used later in the proportion estimation. Here, the full model is defined by a formula $\sim group$ which indicates that samples come from two conditions. This step of our pipeline is the most time consuming. Thus, for real data analysis, consider using \Rcode{BPPARAM = BiocParallel::MulticoreParam()} with more than one worker. <>= ## Create the design matrix design_full <- model.matrix(~ group, data = samples(d)) design_full @ <>= ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d, design = design_full) d head(mean_expression(d), 3) common_precision(d) head(genewise_precision(d)) @ To inspect the behavior of precision estimates, you can plot them against the mean gene expression. Normally in the differential analysis based on RNA-seq data, such plot has dispersion parameter plotted on the y-axis. Here, the y-axis represents precision since in the Dirichlet-multinomial model this is the parameter that is directly estimated. It is important to keep in mind that the precision parameter is inverse proportional to dispersion: $dispersion = 1 / (1 + precision)$. In RNA-seq data, we can typically observe a trend where the dispersion decreases (precision increases) for genes with higher mean expression. <>= plotPrecision(d) @ All of the plotting functions from \Rpackage{DRIMSeq} package, return a \Rclass{ggplot} object which can be further modified using \CRANpkg{ggplot2} package. For example, the user can increase the size of points. <>= library(ggplot2) ggp <- plotPrecision(d) ggp + geom_point(size = 4) @ \subsubsection{Proportion estimation} In this step, we estimate the full model regression coefficients, fitted proportions and likelihoods. We use the same design matrix as in the precision estimation step. By default, \Rcode{one\_way = TRUE} which means that whenever the design corresponds to multiple group fitting, the 'one way' shortcut algorithm will be used, which in fact corresponds to the first implementation of \Rpackage{DRIMSeq}. Transcript proportions are estimated for each condition separately and then the regression coefficients are calculated using matrix operations. The 'one way' algorithm is adapted from the \Rfunction{glmFit} function in \Biocpkg{edgeR} \cite{McCarthy2012}. By setting \Rcode{verbose = 1}, we can see that the one way approach is used with the current design. When \Rcode{bb\_model = TRUE} (the default), additionally to the gene-level Dirichlet-multinomial estimates the transcript-level beta-binomial results will be computed. <>= d <- dmFit(d, design = design_full, verbose = 1) d ## Get fitted proportions head(proportions(d)) ## Get the DM regression coefficients (gene-level) head(coefficients(d)) ## Get the BB regression coefficients (feature-level) head(coefficients(d), level = "feature") @ \subsubsection{Testing for differential transcript usage} \label{DS_testing} Calling the \Rfunction{dmTest} function results in two calculations. First, null model is fitted. This null model can be defined by the user via \Rcode{coef}, \Rcode{design} or \Rcode{contrast} parameters. Second, likelihood ratio statistics are used to test for the difference between the full and null model. Both steps are done at the gene and transcript level when \Rcode{bb\_model = TRUE}. In our example, we would like to test whether there are differences in transcript usage between control (CTL) and knock-down (KD). We can achieve that by using the \Rcode{coef} parameter which should indicate which columns of the full design should be removed to get the null design. We define it equal to \Rcode{"groupKD"}. Then the null design has only an intercept column which means that all the samples are treated as if they came from one condition. Note that \Rcode{one\_way = TRUE} and the one way approach is used. <>= d <- dmTest(d, coef = "groupKD", verbose = 1) design(d) head(results(d), 3) @ The same can be achieved by directly defining the null design matrix with the \Rcode{design} parameter. <>= design_null <- model.matrix(~ 1, data = samples(d)) design_null d <- dmTest(d, design = design_null) head(results(d), 3) @ Or by using the \Rcode{contrast} parameter. The null design is calculated using the approach from the \Rfunction{glmLRT} function in \Biocpkg{edgeR} \cite{McCarthy2012}. <>= contrast <- c(0, 1) d <- dmTest(d, contrast = contrast) design(d) head(results(d), 3) @ To obtain the results of likelihood ratio tests, you have to call the function \Rfunction{results}, which returns a data frame with likelihood ratio statistics, degrees of freedom, p-values and Benjamini and Hochberg (BH) adjusted p-values for each gene by default and for each transcript when \Rcode{level = "feature"}. <>= head(results(d, level = "feature"), 3) @ You can plot a histogram of gene-level and transcript-level p-values. <>= plotPValues(d) plotPValues(d, level = "feature") @ For genes of interest, you can make plots (bar plots, line plots, box plots, ribbon plots) of observed and estimated with Dirichlet-multinomial model transcript ratios. You have to define the \Rcode{group\_variable} parameter which should indicate a variable from \Rcode{samples(d)}. Currently, plots can be done only for categorical variables. We choose the \Rcode{"group"} column since it corresponds to the comparison of our interest. Estimated proportions are marked with diamond shapes. As an example, we plot the top significant gene. <>= res <- results(d) res <- res[order(res$pvalue, decreasing = FALSE), ] top_gene_id <- res$gene_id[1] plotProportions(d, gene_id = top_gene_id, group_variable = "group") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "lineplot") plotProportions(d, gene_id = top_gene_id, group_variable = "group", plot_type = "ribbonplot") @ \subsubsection{Two-stage test} \Rpackage{DRIMSeq} returns gene and transcript level p-values which can be used as an input to the stage-wise analysis \cite{VandenBerge2017} implemented in the \Rcode{stageR} package, currently available on github \url{https://github.com/statOmics/stageR}. As pointed by the authors of \Rcode{stageR}, interpreting both gene-level and transcript-level adjusted p-values does not provide appropriate FDR control and should be avoided. However, applying a stage-wise testing provides a useful biological interpretation of these results and improved statistical performance. In short, the procedure consists of a screening stage and a confirmation stage. In the screening stage, gene-level BH-adjusted p-values are screened to detect genes for which the hypothesis of interest is significantly rejected. Only those genes are further considered in the confirmation stage, where for each gene separately, transcript-level p-values are adjusted to control the FWER and BH-adjusted significance level of the screening stage. It is important to note that transcript-level stage-wise adjusted p-values for genes that do not pass the screening stage are set to \Rcode{NA}. Also the stage-wise adjusted p-values can not be compared to significance level other than chosen in the stage-wise analysis. If that is of interest, one has to rerun this analysis with the new significance level. The following code chunk is not evaluated by this vignette and to run it, user has to make sure that the \Rcode{stageR} package is installed. It shows how one can use the \Rpackage{DRIMSeq} output in the stage-wise analysis. <>= library(stageR) ## Assign gene-level pvalues to the screening stage pScreen <- results(d)$pvalue names(pScreen) <- results(d)$gene_id ## Assign transcript-level pvalues to the confirmation stage pConfirmation <- matrix(results(d, level = "feature")$pvalue, ncol = 1) rownames(pConfirmation) <- results(d, level = "feature")$feature_id ## Create the gene-transcript mapping tx2gene <- results(d, level = "feature")[, c("feature_id", "gene_id")] ## Create the stageRTx object and perform the stage-wise analysis stageRObj <- stageRTx(pScreen = pScreen, pConfirmation = pConfirmation, pScreenAdjusted = FALSE, tx2gene = tx2gene) stageRObj <- stageWiseAdjustment(object = stageRObj, method = "dtu", alpha = 0.05) getSignificantGenes(stageRObj) getSignificantTx(stageRObj) padj <- getAdjustedPValues(stageRObj, order = TRUE, onlySignificantGenes = FALSE) head(padj) @ \subsection{Differential transcript usage analysis between two conditions with accounting for the batch effects} The regression framework implemented in \Rpackage{DRIMSeq} allows to account for the batch effects. Here, this would be the library layout stored in \Rcode{pasilla\_metadata\$LibraryLayout}. The steps of this analysis are the same as described above. The only difference is that we have to include the library layout variable in the \Rcode{sample} slot in the \Rcode{dmDSdata} object and define a full model that contains the batch effect. <>= pasilla_samples2 <- data.frame(sample_id = pasilla_metadata$SampleName, group = pasilla_metadata$condition, library_layout = pasilla_metadata$LibraryLayout) d2 <- dmDSdata(counts = pasilla_counts, samples = pasilla_samples2) ## Subsetting to a vignette runnable size d2 <- d2[names(d2) %in% gene_id_subset, ] ## Filtering d2 <- dmFilter(d2, min_samps_gene_expr = 7, min_samps_feature_expr = 3, min_gene_expr = 10, min_feature_expr = 10) ## Create the design matrix design_full2 <- model.matrix(~ group + library_layout, data = samples(d2)) design_full2 ## To make the analysis reproducible set.seed(123) ## Calculate precision d2 <- dmPrecision(d2, design = design_full2) common_precision(d2) head(genewise_precision(d2)) plotPrecision(d2) ## Fit proportions d2 <- dmFit(d2, design = design_full2, verbose = 1) ## Test for DTU d2 <- dmTest(d2, coef = "groupKD", verbose = 1) design(d2) head(results(d2), 3) ## Plot p-value distribution plotPValues(d2) @ <>= ## Plot the top significant gene res2 <- results(d2) res2 <- res2[order(res2$pvalue, decreasing = FALSE), ] top_gene_id2 <- res2$gene_id[1] ggp <- plotProportions(d2, gene_id = top_gene_id2, group_variable = "group") ggp + facet_wrap(~ library_layout) @ %------------------------------------------------------------------------------ % tuQTL analysis workflow %------------------------------------------------------------------------------ \section{tuQTL analysis workflow} In the transcript usage QTL analysis, we want to identify genetic variants (here, bi-allelic SNPs) that are associated with changes in transcript usage. Such SNPs are then called transcript usage quantitative trait locies (tuQTLs). Ideally, we would like to test associations of every SNP with every gene. However, such an approach would be very costly computationally and in terms of multiple testing correction. Under the assumption that SNPs that directly affect transcript usage are likely to be placed in the close surrounding of genes, we test only the SNPs that are located within the gene body and within some range upstream and downstream of the gene. \subsection{Example data} To demonstrate the tuQTL analysis with the \Rpackage{DRIMSeq} package, we use data from the GEUVADIS project \cite{Lappalainen2013}, where 462 RNA-Seq samples from lymphoblastoid cell lines were obtained. The genome sequencing data of the same individuals is provided by the 1000 Genomes Project. The samples in this project come from five populations: CEPH (CEU), Finns (FIN), British (GBR), Toscani (TSI) and Yoruba (YRI). We use transcript quantification (expected counts from FluxCapacitor) and genotypes available on the GEUVADIS project website \url{http://www.ebi.ac.uk/Tools/geuvadis-das/}, and the Gencode v12 gene annotation is available at \url{http://www.gencodegenes.org/releases/12.html}. In order to make this vignette runnable, we perform the analysis on subsets of bi-allelic SNPs and transcript expected counts for CEPH population (91 individuals) that correspond to 50 randomly selected genes from chromosome 19. The full dataset can be accessed from \Biocexptpkg{GeuvadisTranscriptExpr} package along with the description of preprocessing steps. \subsection{tuQTL analysis with the DRIMSeq package} Assuming you have gene annotation, feature counts and bi-allelic genotypes that are expressed in terms of the number of alleles different from the reference, the \Rpackage{DRIMSeq} workflow for tuQTL analysis is analogous to the one for differential transcript usage. First, we have to create a \Rclass{dmSQTLdata} object, which contains feature counts, sample information and genotypes. Similarly as in the differential transcript usage pipeline, results from every step are added to this object and at the end of the analysis, it contains precision estimates, proportions estimates, likelihood ratio statistics, p-values, adjusted p-values. As new elements are added, the object also changes its name \Rclass{dmSQTLdata} $\rightarrow$ \Rclass{dmSQTLprecision} $\rightarrow$ \Rclass{dmSQTLfit} $\rightarrow$ \Rclass{dmSQTLtest}. For each object, slots and methods are inherited from the previous one. \subsubsection{Loading GEUVADIS data into R} We use the subsets of data defined in the \Biocexptpkg{GeuvadisTranscriptExpr} package. <>= library(GeuvadisTranscriptExpr) geuv_counts <- GeuvadisTranscriptExpr::counts geuv_genotypes <- GeuvadisTranscriptExpr::genotypes geuv_gene_ranges <- GeuvadisTranscriptExpr::gene_ranges geuv_snp_ranges <- GeuvadisTranscriptExpr::snp_ranges @ Load the \Rpackage{DRIMSeq} package. <>= library(DRIMSeq) @ In the tuQTL analysis, an initial data object \Robject{d} is of \Robject{dmSQTLdata} class and, additionally to feature counts and sample information, it contains genotypes of SNPs that are in some surrounding of genes. This surrounding is defined with the parameter \Rcode{window}. In order to find out which SNPs should be tested with which genes, the \Rfunction{dmSQTLdata} functions requires as an input the location of genes (\Rcode{gene\_ranges}) and SNPs (\Rcode{snp\_ranges}) stored as \Rclass{GRanges} objects. Variables with transcript IDs and gene IDs in the \Robject{counts} data frame must have names \Rcode{feature\_id} and \Rcode{gene\_id}, respectively. In the \Robject{genotypes} data frame, the variable with SNP IDs must have name \Rcode{snp\_id}. <>= colnames(geuv_counts)[c(1,2)] <- c("feature_id", "gene_id") colnames(geuv_genotypes)[4] <- "snp_id" geuv_samples <- data.frame(sample_id = colnames(geuv_counts)[-c(1,2)]) d <- dmSQTLdata(counts = geuv_counts, gene_ranges = geuv_gene_ranges, genotypes = geuv_genotypes, snp_ranges = geuv_snp_ranges, samples = geuv_samples, window = 5e3) d @ In our tuQTL analysis, we do not repeat tests for the SNPs that define the same grouping of samples (genotype). We identify SNPs with identical genotypes across the samples and assign them to blocks. Estimation and testing are done at the block level, but the returned results are extended to a SNP level by repeating the block statistics for each SNP that belongs to a given block. The data summary plot \Rfunction{plotData} produces three histograms: the number of features per gene, the number of SNPs per gene and the number of blocks per gene. <>= plotData(d, plot_type = "features") plotData(d, plot_type = "snps") plotData(d, plot_type = "blocks") @ \subsubsection{Filtering} The filtering step eliminates genes and features with low expression, as in the differential transcript usage analysis (see section \ref{DS_filtering}). Additionally, it filters out the SNPs/blocks that do not define at least two genotypes where each of them is present in at least \Robject{minor\_allele\_freq} individuals. Usually, \Robject{minor\_allele\_freq} is equal to roughly 5\% of the total sample size. Ideally, we would like that genes were expressed at some minimal level in all samples because this would lead to better estimates of feature ratios. However, for some genes, missing values may be present in the counts data, or genes may be lowly expressed in some samples. Setting up \Robject{min\_samps\_gene\_expr} to 91 may exclude too many genes from the analysis. We can be slightly less stringent by taking, for example, \Rcode{min\_samps\_gene\_expr = 70}. <>= d <- dmFilter(d, min_samps_gene_expr = 70, min_samps_feature_expr = 5, minor_allele_freq = 5, min_gene_expr = 10, min_feature_expr = 10) @ \subsubsection{Precision estimation} In the DTU analysis (section \ref{DS_precision_estimation}), the full model used in precision estimation has to be defined by the user. Here, full models are defined by genotypes. For a given SNP, genotype can have numeric values of 0, 1, and 2. When \Rcode{one\_way = TRUE}, multiple group fitting is performed. When \Rcode{one\_way = FALSE}, a regression framework is used with the design matrix defined by a formula $\sim group$ where $group$ is a continuous (not categorical) variable with genotype values 0, 1, and 2. For the tuQTL analysis, it has an additional parameter called \Rcode{speed}. If \Rcode{speed = FALSE}, gene-wise precisions are calculated for each gene-block. This calculation may take a long time, since there can be hundreds of SNPs/blocks per gene. If \Rcode{speed} is set to \Rcode{TRUE}, there will be only one precision calculated per gene (assuming a null model, i.e., model with intercept only), and it will be assigned to all the blocks matched to this gene. In the default setting, \Rcode{speed = TRUE} and common precision is used as an initial value in the grid approach to estimate gene-wise precisions with NO moderation, since the sample size is quite large. Again, this step of the pipeline is one of the most time consuming. Thus consider using \Rcode{BPPARAM = BiocParallel::MulticoreParam()} with more than one worker when performing real data analysis. <>= ## To make the analysis reproducible set.seed(123) ## Calculate precision d <- dmPrecision(d) plotPrecision(d) @ \subsubsection{Proportion estimation} Dirichlet-multinomial full model proportions/coefficients and likelihoods are estimated for each gene-block pair. Currently, no transcript-level analysis are implemented in the tuQTL workflow. <>= d <- dmFit(d) @ \subsubsection{Testing for tuQTLs} \Rfunction{dmTest} function estimates gene-level null model proportions/coefficients and likelihoods and performs the likelihood ratio test. The null models equal to models with intercept only. In contrast to the DTU analysis, there are some additional challenges that have to handled in the tuQTL analysis. They include a large number of tests per gene with highly variable allele frequencies (models) and linkage disequilibrium. As in other sQTL studies, we apply a permutation approach to empirically assess the null distribution of associations and use it for the adjustment of nominal p-values. There are two permutation schemes available. When \Rcode{permutation\_mode} equals to \Rcode{"all\_genes"}, the null p-value distribution is calculated from all the genes. When \Rcode{permutation\_mode = "per\_gene"}, null distribution of p-values is calculated for each gene separately based on permutations of this individual gene. The latter approach may take a lot of computational time. We suggest using the first option, which is also the default one. The function \Rfunction{results} returns a data frame with likelihood ratio statistics, degrees of freedom, p-values and Benjamini and Hochberg adjusted p-values for each gene-block/SNP pair. <>= d <- dmTest(d) plotPValues(d) head(results(d)) @ You can plot the observed transcript ratios for the tuQTLs of interest. Plotting the fitted values is not possible as we do not return this estimates due to their size. When the sample size is large, we recommend using box plots as a \Rcode{plot\_type}. We plot a tuQTL with the lowest p-value. <>= res <- results(d) res <- res[order(res$pvalue, decreasing = FALSE), ] top_gene_id <- res$gene_id[1] top_snp_id <- res$snp_id[1] plotProportions(d, gene_id = top_gene_id, snp_id = top_snp_id) plotProportions(d, gene_id = top_gene_id, snp_id = top_snp_id, plot_type = "boxplot2") @ %-------------------------------------------------- % Session information %-------------------------------------------------- \section{Session information} <>= sessionInfo() @ %-------------------------------------------------- % References %-------------------------------------------------- \bibliography{References} \end{document} DRIMSeq/vignettes/References.bib0000755000175100017510000003210414614306666017564 0ustar00biocbuildbiocbuild@article{Nowicka2016, author = {Nowicka, M and Robinson, M D}, doi = {10.12688/f1000research.8900.2}, journal = {F1000Research}, number = {1356}, title = {{DRIMSeq: a Dirichlet-multinomial framework for multivariate count outcomes in genomics [version 2; referees: 2 approved]}}, url = {https://f1000research.com/articles/5-1356/v2}, volume = {5}, year = {2016} } @article{Brooks2011, abstract = {Alternative splicing is generally controlled by proteins that bind directly to regulatory sequence elements and either activate or repress splicing of adjacent splice sites in a target pre-mRNA. Here, we have combined RNAi and mRNA-seq to identify exons that are regulated by Pasilla (PS), the Drosophila melanogaster ortholog of mammalian NOVA1 and NOVA2. We identified 405 splicing events in 323 genes that are significantly affected upon depletion of ps, many of which were annotated as being constitutively spliced. The sequence regions upstream and within PS-repressed exons and downstream from PS-activated exons are enriched for YCAY repeats, and these are consistent with the location of these motifs near NOVA-regulated exons in mammals. Thus, the RNA regulatory map of PS and NOVA1/2 is highly conserved between insects and mammals despite the fact that the target gene orthologs regulated by PS and NOVA1/2 are almost entirely nonoverlapping. This observation suggests that the regulatory codes of individual RNA binding proteins may be nearly immutable, yet the regulatory modules controlled by these proteins are highly evolvable.}, author = {Brooks, Angela N and Yang, Li and Duff, Michael O and Hansen, Kasper D and Park, Jung W and Dudoit, Sandrine and Brenner, Steven E and Graveley, Brenton R}, file = {:Users/gosia/Documents/Mendeley Desktop/Brooks et al/Brooks et al. - 2011 - Conservation of an RNA regulatory map between Drosophila and mammals.pdf:pdf}, institution = {Department of Molecular and Cell Biology, University of California, Berkeley, California 94720, USA.}, journal = {Genome research}, keywords = {Pasilla}, mendeley-groups = {Data}, mendeley-tags = {Pasilla}, number = {2}, pages = {193--202}, title = {{Conservation of an RNA regulatory map between Drosophila and mammals.}}, volume = {21}, year = {2011} } @article{Lappalainen2013, abstract = {Genome sequencing projects are discovering millions of genetic variants in humans, and interpretation of their functional effects is essential for understanding the genetic basis of variation in human traits. Here we report sequencing and deep analysis of messenger RNA and microRNA from lymphoblastoid cell lines of 462 individuals from the 1000 Genomes Project--the first uniformly processed high-throughput RNA-sequencing data from multiple human populations with high-quality genome sequences. We discover extremely widespread genetic variation affecting the regulation of most genes, with transcript structure and expression level variation being equally common but genetically largely independent. Our characterization of causal regulatory variation sheds light on the cellular mechanisms of regulatory and loss-of-function variation, and allows us to infer putative causal variants for dozens of disease-associated loci. Altogether, this study provides a deep understanding of the cellular mechanisms of transcriptome variation and of the landscape of functional variants in the human genome.}, author = {Lappalainen, Tuuli and Sammeth, Michael and Friedl{\"{a}}nder, Marc R and {'t Hoen}, Peter A C and Monlong, Jean and Rivas, Manuel A and Gonz{\`{a}}lez-Porta, Mar and Kurbatova, Natalja and Griebel, Thasso and Ferreira, Pedro G and Barann, Matthias and Wieland, Thomas and Greger, Liliana and van Iterson, Maarten and Alml{\"{o}}f, Jonas and Ribeca, Paolo and Pulyakhina, Irina and Esser, Daniela and Giger, Thomas and Tikhonov, Andrew and Sultan, Marc and Bertier, Gabrielle and MacArthur, Daniel G and Lek, Monkol and Lizano, Esther and Buermans, Henk P J and Padioleau, Ismael and Schwarzmayr, Thomas and Karlberg, Olof and Ongen, Halit and Kilpinen, Helena and Beltran, Sergi and Gut, Marta and Kahlem, Katja and Amstislavskiy, Vyacheslav and Stegle, Oliver and Pirinen, Matti and Montgomery, Stephen B and Donnelly, Peter and McCarthy, Mark I and Flicek, Paul and Strom, Tim M and Lehrach, Hans and Schreiber, Stefan and Sudbrak, Ralf and Carracedo, Angel and Antonarakis, Stylianos E and H{\"{a}}sler, Robert and Syv{\"{a}}nen, Ann-Christine and van Ommen, Gert-Jan and Brazma, Alvis and Meitinger, Thomas and Rosenstiel, Philip and Guig{\'{o}}, Roderic and Gut, Ivo G and Estivill, Xavier and Dermitzakis, Emmanouil T}, file = {:Users/gosia/Documents/Mendeley Desktop/Lappalainen et al/Lappalainen et al. - 2013 - Transcriptome and genome sequencing uncovers functional variation in humans(2).pdf:pdf;:Users/gosia/Documents/Mendeley Desktop/Lappalainen et al/Lappalainen et al. - 2013 - Transcriptome and genome sequencing uncovers functional variation in humans.pdf:pdf}, issn = {1476-4687}, journal = {Nature}, keywords = {Alleles,Cell Line,Exons,Exons: genetics,GEUVADIS,Gene Expression Profiling,Genetic Variation,Genetic Variation: genetics,Genome,High-Throughput Nucleotide Sequencing,Human,Human: genetics,Humans,Messenger,Messenger: analysis,Messenger: genetics,Polymorphism,Quantitative Trait Loci,Quantitative Trait Loci: genetics,RNA,Sequence Analysis,Single Nucleotide,Single Nucleotide: genetics,Transcriptome,Transcriptome: genetics,Transformed}, mendeley-groups = {sQTL analysis/Geuvadis,.PhD report CM2,sQTL analysis/Data}, mendeley-tags = {GEUVADIS}, number = {7468}, pages = {506--11}, pmid = {24037378}, title = {{Transcriptome and genome sequencing uncovers functional variation in humans.}}, url = {http://www.pubmedcentral.nih.gov/articlerender.fcgi?artid=3918453{\&}tool=pmcentrez{\&}rendertype=abstract}, volume = {501}, year = {2013} } @article{Bray2016, abstract = {We present kallisto, an RNA-seq quantification program that is two orders of magnitude faster than previous approaches and achieves similar accuracy. Kallisto pseudoaligns reads to a reference, producing a list of transcripts that are compatible with each read while avoiding alignment of individual bases. We use kallisto to analyze 30 million unaligned paired-end RNA-seq reads in {\textless}10 min on a standard laptop computer. This removes a major computational bottleneck in RNA-seq analysis.}, author = {Bray, Nicolas L and Pimentel, Harold and Melsted, Pall and Pachter, Lior}, issn = {1546-1696}, journal = {Nat Biotech}, keywords = {kallisto}, mendeley-groups = {.DRIMSeq paper,RNA-seq quantification/Transcript quantification}, mendeley-tags = {kallisto}, month = {apr}, publisher = {Nature Publishing Group, a division of Macmillan Publishers Limited. All Rights Reserved.}, title = {{Near-optimal probabilistic RNA-seq quantification}}, url = {http://dx.doi.org/10.1038/nbt.3519 http://10.0.4.14/nbt.3519 http://www.nature.com/nbt/journal/vaop/ncurrent/abs/nbt.3519.html{\#}supplementary-information}, volume = {advance on}, year = {2016} } @article{VandenBerge2017, abstract = {Background: Reductions in sequencing cost and innovations in expression quantification have prompted an emergence of RNA-seq studies with complex designs and data analysis at transcript resolution. These applications involve multiple hypotheses per gene, leading to challenging multiple testing problems. Conventional approaches provide separate top-lists for every contrast and false discovery rate (FDR) control at individual hypothesis level. Hence, they fail to establish proper gene-level error control, which compromises downstream validation experiments. Tests that aggregate individual hypotheses are more powerful and provide gene-level FDR control, but in the RNA-seq literature no methods are available for post-hoc analysis of individual hypotheses. Results: We introduce a two-stage procedure that leverages the increased power of aggregated hypothesis tests while maintaining high biological resolution by post-hoc analysis of genes passing the screening hypothesis. Our method is evaluated on simulated and real RNA-seq experiments. It provides gene-level FDR control in studies with complex designs while boosting power for interaction effects without compromising the discovery of main effects. In a differential transcript usage/expression context, stage-wise testing gains power by aggregating hypotheses at the gene level, while providing transcript-level assessment of genes passing the screening stage. Finally, a prostate cancer case study highlights the relevance of combining gene with transcript level results. Conclusion: Stage-wise testing is a general paradigm that can be adopted whenever individual hypotheses can be aggregated. In our context, it achieves an optimal middle ground between biological resolution and statistical power while providing gene-level FDR control, which is beneficial for downstream biological interpretation and validation.}, author = {{Van den Berge}, Koen and Soneson, Charlotte and Robinson, Mark D and Clement, Lieven}, file = {:Users/gosia/Mendeley Desktop/Van den Berge et al/Van den Berge et al. - 2017 - A general and powerful stage-wise testing procedure for differential expression and differential transcrip.pdf:pdf}, journal = {bioRxiv}, mendeley-groups = {RNA-seq DE,.DRIMSeq paper}, month = {feb}, title = {{A general and powerful stage-wise testing procedure for differential expression and differential transcript usage}}, url = {http://biorxiv.org/content/early/2017/02/16/109082.abstract}, year = {2017} } @article{McCarthy2012, abstract = {A flexible statistical framework is developed for the analysis of read counts from RNA-Seq gene expression studies. It provides the ability to analyse complex experiments involving multiple treatment conditions and blocking variables while still taking full account of biological variation. Biological variation between RNA samples is estimated separately from the technical variation associated with sequencing technologies. Novel empirical Bayes methods allow each gene to have its own specific variability, even when there are relatively few biological replicates from which to estimate such variability. The pipeline is implemented in the edgeR package of the Bioconductor project. A case study analysis of carcinoma data demonstrates the ability of generalized linear model methods (GLMs) to detect differential expression in a paired design, and even to detect tumour-specific expression changes. The case study demonstrates the need to allow for gene-specific variability, rather than assuming a common dispersion across genes or a fixed relationship between abundance and variability. Genewise dispersions de-prioritize genes with inconsistent results and allow the main analysis to focus on changes that are consistent between biological replicates. Parallel computational approaches are developed to make non-linear model fitting faster and more reliable, making the application of GLMs to genomic data more convenient and practical. Simulations demonstrate the ability of adjusted profile likelihood estimators to return accurate estimators of biological variability in complex situations. When variation is gene-specific, empirical Bayes estimators provide an advantageous compromise between the extremes of assuming common dispersion or separate genewise dispersion. The methods developed here can also be applied to count data arising from DNA-Seq applications, including ChIP-Seq for epigenetic marks and DNA methylation analyses.}, author = {McCarthy, Davis J. and Chen, Yunshun and Smyth, Gordon K.}, file = {:Users/gosia/Mendeley Desktop/McCarthy, Chen, Smyth/McCarthy, Chen, Smyth - 2012 - Differential expression analysis of multifactor RNA-Seq experiments with respect to biological variation.pdf:pdf}, journal = {Nucleic Acids Research}, keywords = {edgeR}, mendeley-groups = {.CM2 PhD report,.DRIMSeq paper,RNA-seq DE/Gene DE/edgeR,Project DM/edgeR}, mendeley-tags = {edgeR}, number = {10}, pages = {4288--4297}, pmid = {22287627}, title = {{Differential expression analysis of multifactor RNA-Seq experiments with respect to biological variation}}, volume = {40}, year = {2012} } @article{Danaher1988, abstract = {We develop estimates for the parameters of the Dirichlet-multinomial distribution (DMD) when there is insufficient data to obtain maximum likelihood or method of moment estimates known in the literature. We do, however, have supplemetary beta-binomial data pertaining to the marginals of the DMD, and use these data when estimating the DMD parameters. A real situation and data set are given where our estimates are applicable.}, annote = {doi: 10.1080/03610928808829713}, author = {Danaher, Peter J}, doi = {10.1080/03610928808829713}, file = {:Users/gosia/Mendeley Desktop/Danaher/Danaher - 1988 - Parameter estimation for the dirichlet-multinomial distribution using supplementary beta-binomial data(2).pdf:pdf}, issn = {0361-0926}, journal = {Communications in Statistics - Theory and Methods}, mendeley-groups = {Project DM/Beta-Binomial}, month = {jan}, number = {6}, pages = {1777--1788}, publisher = {Taylor {\&} Francis}, title = {{Parameter estimation for the dirichlet-multinomial distribution using supplementary beta-binomial data}}, url = {http://dx.doi.org/10.1080/03610928808829713}, volume = {17}, year = {1988} }