phangorn/0000755000175100001440000000000012547516462012120 5ustar hornikusersphangorn/TODO0000644000175100001440000000035612547236635012615 0ustar hornikusers1.99-4 modelTest * check optimisation * AIC, AICc, BIC optim.pml * start tree optimisation * unique tree (multifurcations) 2.0.0 Rcpp, RcppArmadillo imprevements pmlPart, pmlCluster phangorn/inst/0000755000175100001440000000000012507002037013055 5ustar hornikusersphangorn/inst/CITATION0000644000175100001440000000114612507002037014214 0ustar hornikuserscitHeader("To cite phangorn in a publication use:") citEntry(entry="Article", title = "phangorn: phylogenetic analysis in R", author = personList(as.person("K.P. Schliep")), journal = "Bioinformatics", year = "2011", volume = "27", number = "4", pages = "592--593", textVersion = "Schliep K.P. 2011. phangorn: phylogenetic analysis in R. Bioinformatics, 27(4) 592-593") citFooter("As phangorn is evolving quickly, you may want to cite also its version number (found with 'library(help = phangorn)').") if(!exists("meta") || is.null(meta)) meta <- packageDescription("phangorn") phangorn/inst/README0000644000175100001440000000123212507002037013733 0ustar hornikusersThe following persons and institutions helped in the development of phangorn at one stage or another. Emmanuel Paradis and all the other authors of the APE package. Tim White for provinding some C-code to compute the Hadamard distances. Bennet McComish for providing the allTrees function. Francois-Joiseph Lapointe for feedback on clans and clips. Further thanks to all the user that send bug reports/fixes and have helped to improve this package. Financial support was provided by the Alan Wilson Centre of Molecular Ecology and Evolution and the Muséum national d'Histoire naturelle and Universidade de Vigo. phangorn/inst/extdata/0000755000175100001440000000000012507002037014507 5ustar hornikusersphangorn/inst/extdata/Blosum62.dat0000644000175100001440000000561012507002037016614 0ustar hornikusers 0.735790389698 0.485391055466 1.297446705134 0.543161820899 0.500964408555 3.180100048216 1.45999531047 0.227826574209 0.397358949897 0.240836614802 1.199705704602 3.020833610064 1.839216146992 1.190945703396 0.32980150463 1.1709490428 1.36057419042 1.24048850864 3.761625208368 0.140748891814 5.528919177928 1.95588357496 0.418763308518 1.355872344485 0.798473248968 0.418203192284 0.609846305383 0.423579992176 0.716241444998 1.456141166336 2.414501434208 0.778142664022 0.354058109831 2.43534113114 1.626891056982 0.539859124954 0.605899003687 0.232036445142 0.283017326278 0.418555732462 0.774894022794 0.236202451204 0.186848046932 0.189296292376 0.252718447885 0.800016530518 0.622711669692 0.211888159615 0.218131577594 0.831842640142 0.580737093181 0.372625175087 0.217721159236 0.348072209797 3.890963773304 1.295201266783 5.411115141489 1.593137043457 1.032447924952 0.285078800906 3.945277674515 2.802427151679 0.752042440303 1.022507035889 0.406193586642 0.445570274261 1.253758266664 0.983692987457 0.648441278787 0.222621897958 0.76768882348 2.494896077113 0.55541539747 0.459436173579 0.984311525359 3.364797763104 6.030559379572 1.073061184332 0.492964679748 0.371644693209 0.354861249223 0.281730694207 0.441337471187 0.14435695975 0.291409084165 0.368166464453 0.714533703928 1.517359325954 2.064839703237 0.266924750511 1.77385516883 1.173275900924 0.448133661718 0.494887043702 0.730628272998 0.356008498769 0.858570575674 0.926563934846 0.504086599527 0.527007339151 0.388355409206 0.374555687471 1.047383450722 0.454123625103 0.233597909629 4.325092687057 1.12278310421 2.904101656456 1.582754142065 1.197188415094 1.934870924596 1.769893238937 1.509326253224 1.11702976291 0.35754441246 0.352969184527 1.752165917819 0.918723415746 0.540027644824 1.169129577716 1.729178019485 0.914665954563 1.898173634533 0.934187509431 1.119831358516 1.277480294596 1.071097236007 0.641436011405 0.585407090225 1.17909119726 0.915259857694 1.303875200799 1.488548053722 0.488206118793 1.005451683149 5.15155629227 0.465839367725 0.426382310122 0.191482046247 0.145345046279 0.527664418872 0.758653808642 0.407635648938 0.508358924638 0.30124860078 0.34198578754 0.6914746346 0.332243040634 0.888101098152 2.074324893497 0.252214830027 0.387925622098 0.513128126891 0.718206697586 0.720517441216 0.538222519037 0.261422208965 0.470237733696 0.95898974285 0.596719300346 0.308055737035 4.218953969389 0.674617093228 0.811245856323 0.7179934869 0.951682162246 6.747260430801 0.369405319355 0.796751520761 0.801010243199 4.054419006558 2.187774522005 0.438388343772 0.312858797993 0.258129289418 1.116352478606 0.530785790125 0.524253846338 0.25334079019 0.20155597175 8.311839405458 2.231405688913 0.498138475304 2.575850755315 0.838119610178 0.496908410676 0.561925457442 2.253074051176 0.266508731426 1 0.074 0.052 0.045 0.054 0.025 0.034 0.054 0.074 0.026 0.068 0.099 0.058 0.025 0.047 0.039 0.057 0.051 0.013 0.032 0.073 phangorn/inst/extdata/RtREV.dat0000644000175100001440000000136212507002037016145 0ustar hornikusers 34 51 35 10 30 384 439 92 128 1 32 221 236 78 70 81 10 79 542 1 372 135 41 94 61 48 18 70 30 90 320 91 124 387 34 68 1 24 35 1 104 33 1 1 34 45 18 15 5 110 54 21 3 51 385 38 593 123 20 16 309 141 30 76 34 23 235 57 1 1 156 158 1 37 116 375 581 134 1 7 49 1 70 1 1 7 141 64 179 14 247 97 24 33 55 1 68 52 17 44 10 22 43 1 11 460 102 294 136 75 225 95 152 183 4 24 77 1 20 134 258 64 148 55 117 146 82 7 49 72 25 110 131 69 62 671 5 13 16 1 55 10 17 23 48 39 47 6 111 182 9 14 1 55 47 28 1 131 45 1 21 307 26 64 1 74 1017 14 31 34 176 197 29 21 6 295 36 35 3 1 1048 112 19 236 92 25 39 196 26 59 0.0646 0.0453 0.0376 0.0422 0.0114 0.0606 0.0607 0.0639 0.0273 0.0679 0.1018 0.0751 0.015 0.0287 0.0681 0.0488 0.0622 0.0251 0.0318 0.0619 phangorn/inst/extdata/MtZoa.dat0000644000175100001440000000261312507002037016235 0ustar hornikusers 3.3 1.7 33.6 16.1 3.2 617.0 272.5 61.1 94.6 9.5 7.3 231.0 190.3 19.3 49.1 17.1 6.4 174.0 883.6 3.4 349.4 289.3 7.2 99.3 26.0 82.4 8.9 43.1 2.3 61.7 228.9 55.6 37.5 421.8 14.9 7.4 33.2 0.2 24.3 1.5 48.8 0.2 7.3 3.4 1.6 15.6 4.1 7.9 0.5 59.7 23.0 1.0 3.5 6.6 425.2 0.2 292.3 413.4 0.2 0.2 334.0 163.2 10.1 23.9 8.4 6.7 136.5 3.8 73.7 0.2 264.8 83.9 0.2 52.2 7.1 449.7 636.3 83.0 26.5 0.2 12.9 2.0 167.8 9.5 0.2 5.8 13.1 90.3 234.2 16.3 215.6 61.8 7.5 22.6 0.2 8.1 52.2 20.6 1.3 15.6 2.6 11.4 24.3 5.4 10.5 644.9 11.8 420.2 51.4 656.3 96.4 38.4 257.1 23.1 7.2 15.2 144.9 95.3 32.2 79.7 378.1 3.2 184.6 2.3 199.0 39.4 34.5 5.2 19.4 222.3 50.0 75.5 305.1 19.3 56.9 666.3 3.1 16.9 6.4 0.2 36.1 6.1 3.5 12.3 4.5 9.7 27.2 6.6 48.7 58.2 1.3 10.3 3.6 2.1 13.8 141.6 13.9 76.7 52.3 10.0 4.3 266.5 13.1 5.7 45.0 41.4 590.5 4.2 29.7 29.0 79.8 321.9 5.1 7.1 3.7 243.8 9.0 16.3 23.7 0.3 1710.6 126.1 11.1 279.6 59.6 17.9 49.5 396.4 13.7 15.6 0.068880 0.021037 0.030390 0.020696 0.009966 0.018623 0.024989 0.071968 0.026814 0.085072 0.156717 0.019276 0.050652 0.081712 0.044803 0.080535 0.056386 0.027998 0.037404 0.066083 Ala Arg Asn Asp Cys Gln Glu Gly His Ile Leu Lys Met Phe Pro Ser Thr Trp Tyr Val // end of file Rota-Stabelli, O., Z. Yang, and M. Telford. 2009. MtZoa: a general mitochondrial amino acid substitutions model for animal evolutionary studies. Mol. Phyl. Evol. phangorn/inst/extdata/wag.dat0000644000175100001440000000577712507002037015777 0ustar hornikusers0.551571 0.509848 0.635346 0.738998 0.147304 5.429420 1.027040 0.528191 0.265256 0.0302949 0.908598 3.035500 1.543640 0.616783 0.0988179 1.582850 0.439157 0.947198 6.174160 0.021352 5.469470 1.416720 0.584665 1.125560 0.865584 0.306674 0.330052 0.567717 0.316954 2.137150 3.956290 0.930676 0.248972 4.294110 0.570025 0.249410 0.193335 0.186979 0.554236 0.039437 0.170135 0.113917 0.127395 0.0304501 0.138190 0.397915 0.497671 0.131528 0.0848047 0.384287 0.869489 0.154263 0.0613037 0.499462 3.170970 0.906265 5.351420 3.012010 0.479855 0.0740339 3.894900 2.584430 0.373558 0.890432 0.323832 0.257555 0.893496 0.683162 0.198221 0.103754 0.390482 1.545260 0.315124 0.174100 0.404141 4.257460 4.854020 0.934276 0.210494 0.102711 0.0961621 0.0467304 0.398020 0.0999208 0.0811339 0.049931 0.679371 1.059470 2.115170 0.088836 1.190630 1.438550 0.679489 0.195081 0.423984 0.109404 0.933372 0.682355 0.243570 0.696198 0.0999288 0.415844 0.556896 0.171329 0.161444 3.370790 1.224190 3.974230 1.071760 1.407660 1.028870 0.704939 1.341820 0.740169 0.319440 0.344739 0.967130 0.493905 0.545931 1.613280 2.121110 0.554413 2.030060 0.374866 0.512984 0.857928 0.822765 0.225833 0.473307 1.458160 0.326622 1.386980 1.516120 0.171903 0.795384 4.378020 0.113133 1.163920 0.0719167 0.129767 0.717070 0.215737 0.156557 0.336983 0.262569 0.212483 0.665309 0.137505 0.515706 1.529640 0.139405 0.523742 0.110864 0.240735 0.381533 1.086000 0.325711 0.543833 0.227710 0.196303 0.103604 3.873440 0.420170 0.398618 0.133264 0.428437 6.454280 0.216046 0.786993 0.291148 2.485390 2.006010 0.251849 0.196246 0.152335 1.002140 0.301281 0.588731 0.187247 0.118358 7.821300 1.800340 0.305434 2.058450 0.649892 0.314887 0.232739 1.388230 0.365369 0.314730 0.0866279 0.043972 0.0390894 0.0570451 0.0193078 0.0367281 0.0580589 0.0832518 0.0244313 0.048466 0.086209 0.0620286 0.0195027 0.0384319 0.0457631 0.0695179 0.0610127 0.0143859 0.0352742 0.0708956 A R N D C Q E G H I L K M F P S T W Y V Ala Arg Asn Asp Cys Gln Glu Gly His Ile Leu Lys Met Phe Pro Ser Thr Trp Tyr Val #Symmetrical part of the WAG rate matrix and aa frequencies, #estimated from 3905 globular protein amino acid sequences forming 182 #protein families. #The first part above indicates the symmetric 'exchangeability' #parameters, where s_ij = s_ji. The s_ij above are not scaled, but the #PAML package will perform this scaling. #The second part gives the amino acid frequencies (pi_i) #estimated from the 3905 sequences. The net replacement rate from i to #j is Q_ij = s_ij*pi_j. #Prepared by Simon Whelan and Nick Goldman, December 2000. # #Citation: #Whelan, S. and N. Goldman. 2001. A general empirical model of #protein evolution derived from multiple protein families using #a maximum likelihood approach. Molecular Biology and #Evolution 18:691-699. phangorn/inst/extdata/jtt-dcmut.dat0000644000175100001440000000564612507002037017127 0ustar hornikusers0.531678 0.557967 0.451095 0.827445 0.154899 5.549530 0.574478 1.019843 0.313311 0.105625 0.556725 3.021995 0.768834 0.521646 0.091304 1.066681 0.318483 0.578115 7.766557 0.053907 3.417706 1.740159 1.359652 0.773313 1.272434 0.546389 0.231294 1.115632 0.219970 3.210671 4.025778 1.032342 0.724998 5.684080 0.243768 0.201696 0.361684 0.239195 0.491003 0.115968 0.150559 0.078270 0.111773 0.053769 0.181788 0.310007 0.372261 0.137289 0.061486 0.164593 0.709004 0.097485 0.069492 0.540571 2.335139 0.369437 6.529255 2.529517 0.282466 0.049009 2.966732 1.731684 0.269840 0.525096 0.202562 0.146481 0.469395 0.431045 0.330720 0.190001 0.409202 0.456901 0.175084 0.130379 0.329660 4.831666 3.856906 0.624581 0.138293 0.065314 0.073481 0.032522 0.678335 0.045683 0.043829 0.050212 0.453428 0.777090 2.500294 0.024521 0.436181 1.959599 0.710489 0.121804 0.127164 0.123653 1.608126 0.191994 0.208081 1.141961 0.098580 1.060504 0.216345 0.164215 0.148483 3.887095 1.001551 5.057964 0.589268 2.155331 0.548807 0.312449 1.874296 0.743458 0.405119 0.592511 0.474478 0.285564 0.943971 2.788406 4.582565 0.650282 2.351311 0.425159 0.469823 0.523825 0.331584 0.316862 0.477355 2.553806 0.272514 0.965641 2.114728 0.138904 1.176961 4.777647 0.084329 1.257961 0.027700 0.057466 1.104181 0.172206 0.114381 0.544180 0.128193 0.134510 0.530324 0.089134 0.201334 0.537922 0.069965 0.310927 0.080556 0.139492 0.235601 0.700693 0.453952 2.114852 0.254745 0.063452 0.052500 5.848400 0.303445 0.241094 0.087904 0.189870 5.484236 0.113850 0.628608 0.201094 0.747889 2.924161 0.171995 0.164525 0.315261 0.621323 0.179771 0.465271 0.470140 0.121827 9.533943 1.761439 0.124066 3.038533 0.593478 0.211561 0.408532 1.143980 0.239697 0.165473 0.076862 0.051057 0.042546 0.051269 0.020279 0.041061 0.061820 0.074714 0.022983 0.052569 0.091111 0.059498 0.023414 0.040530 0.050532 0.068225 0.058518 0.014336 0.032303 0.066374 A R N D C Q E G H I L K M F P S T W Y V Ala Arg Asn Asp Cys Gln Glu Gly His Ile Leu Lys Met Phe Pro Ser Thr Trp Tyr Val #JTT rate matrix prepared using the DCMut method* #------------------------------------------------ # #The first part above indicates the symmetric 'exchangeability' parameters s_ij, #where s_ij = s_ji. #The second part gives the amino acid equilibrium frequencies pi_i. #The net replacement rate from i to j is q_ij = pi_j*s_ij. # #This model is usually scaled so that the mean rate of change at #equilibrium, Sum_i Sum_j!=i pi_i*q_ij, equals 1. You should check this #scaling before using the matrix above. The PAML package will perform #this scaling. # #// # #*Prepared by Carolin Kosiol and Nick Goldman, December 2003. # #See the following paper for more details: #Kosiol, C., and Goldman, N. 2005. Different versions of the Dayhoff rate matrix. #Molecular Biology and Evolution 22:193-199. # #See also http://www.ebi.ac.uk/goldman/dayhoff phangorn/inst/extdata/HIVw.dat0000644000175100001440000000317512507002037016024 0ustar hornikusers 0.0744808 0.617509 0.16024 4.43521 0.0674539 29.4087 0.167653 2.86364 0.0604932 0.005 0.005 10.6746 0.342068 0.005 0.005 5.56325 0.0251632 0.201526 12.1233 0.005 3.20656 1.8685 13.4379 0.0604932 10.3969 0.0489798 0.0604932 14.7801 0.005 6.84405 8.59876 2.31779 0.005 18.5465 0.005 0.005 0.005 1.34069 0.987028 0.145124 0.005 0.0342252 0.0390512 0.005 0.005 0.16024 0.586757 0.005 0.005 0.005 2.89048 0.129839 0.0489798 1.76382 9.10246 0.592784 39.8897 10.6655 0.894313 0.005 13.0705 23.9626 0.279425 0.22406 0.817481 0.005 0.005 3.28652 0.201526 0.005 0.005 0.005 0.005 0.0489798 0.005 17.3064 11.3839 4.09564 0.597923 0.005 0.005 0.005 0.362959 0.005 0.005 0.005 0.005 1.48288 7.48781 0.005 0.005 1.00981 0.404723 0.344848 0.005 0.005 3.04502 0.005 0.005 13.9444 0.005 9.83095 0.111928 0.005 0.0342252 8.5942 8.35024 14.5699 0.427881 1.12195 0.16024 0.005 6.27966 0.725157 0.740091 6.14396 0.005 0.392575 4.27939 14.249 24.1422 0.928203 4.54206 0.630395 0.005 0.203091 0.458743 0.0489798 0.95956 9.36345 0.005 4.04802 7.41313 0.114512 4.33701 6.34079 0.005 5.96564 0.005 0.005 5.49894 0.0443298 0.005 2.8258 0.005 0.005 1.37031 0.005 0.005 0.005 0.005 1.10156 0.005 0.005 0.005 5.06475 2.28154 8.34835 0.005 0.005 0.005 47.4889 0.114512 0.005 0.005 0.579198 4.12728 0.005 0.933142 0.490608 0.005 24.8094 0.279425 0.0744808 2.91786 0.005 0.005 2.19952 2.79622 0.827479 24.8231 2.95344 0.128065 14.7683 2.28 0.005 0.862637 0.005 0.005 1.35482 0.0377494 0.057321 0.0891129 0.0342034 0.0240105 0.0437824 0.0618606 0.0838496 0.0156076 0.0983641 0.0577867 0.0641682 0.0158419 0.0422741 0.0458601 0.0550846 0.0813774 0.019597 0.0205847 0.0515639 phangorn/inst/extdata/VT.dat0000644000175100001440000000353212507002037015535 0ustar hornikusers 0.233108 0.199097 0.210797 0.265145 0.105191 0.883422 0.227333 0.031726 0.027495 0.010313 0.310084 0.493763 0.2757 0.205842 0.004315 0.567957 0.25524 0.270417 1.599461 0.005321 0.960976 0.876213 0.156945 0.362028 0.311718 0.050876 0.12866 0.250447 0.078692 0.213164 0.290006 0.134252 0.016695 0.315521 0.104458 0.058131 0.222972 0.08151 0.087225 0.01172 0.046398 0.054602 0.046589 0.051089 0.020039 0.42463 0.192364 0.069245 0.060863 0.091709 0.24353 0.151924 0.087056 0.103552 2.08989 0.393245 1.755838 0.50306 0.261101 0.004067 0.738208 0.88863 0.193243 0.153323 0.093181 0.201204 0.21155 0.08793 0.05742 0.012182 0.02369 0.120801 0.058643 0.04656 0.021157 0.493845 1.105667 0.096474 0.116646 0.042569 0.039769 0.016577 0.051127 0.026235 0.028168 0.050143 0.079807 0.32102 0.946499 0.038261 0.173052 0.399143 0.12848 0.083956 0.160063 0.011137 0.15657 0.205134 0.124492 0.078892 0.054797 0.169784 0.212302 0.010363 0.042564 1.817198 0.292327 0.847049 0.461519 0.17527 0.358017 0.406035 0.612843 0.167406 0.081567 0.214977 0.400072 0.090515 0.138119 0.430431 0.877877 0.204109 0.471268 0.178197 0.079511 0.248992 0.321028 0.136266 0.101117 0.376588 0.243227 0.446646 0.184609 0.08587 0.207143 1.767766 0.030309 0.046417 0.010459 0.011393 0.007732 0.021248 0.018844 0.02399 0.020009 0.034954 0.083439 0.023321 0.022019 0.12805 0.014584 0.035933 0.020437 0.087061 0.09701 0.093268 0.051664 0.042823 0.062544 0.0552 0.037568 0.286027 0.086237 0.189842 0.068689 0.073223 0.898663 0.032043 0.121979 0.094617 0.124746 1.230985 0.113146 0.049824 0.048769 0.163831 0.112027 0.205868 0.082579 0.068575 3.65443 1.337571 0.144587 0.307309 0.247329 0.129315 0.1277 0.740372 0.022134 0.125733 0.078837 0.051238 0.042313 0.053066 0.015175 0.036713 0.061924 0.070852 0.023082 0.062056 0.096371 0.057324 0.023771 0.043296 0.043911 0.063403 0.055897 0.013272 0.034399 0.073101 phangorn/inst/extdata/mtArt.dat0000644000175100001440000001142412507002037016272 0ustar hornikusers 0.2 0.2 0.2 1 4 500 254 36 98 11 0.2 154 262 0.2 0.2 0.2 0.2 183 862 0.2 262 200 0.2 121 12 81 3 44 0.2 41 180 0.2 12 314 15 0.2 26 2 21 7 63 11 7 3 0.2 4 2 13 1 79 16 2 1 6 515 0.2 209 467 2 0.2 349 106 0.2 0.2 3 4 121 5 79 0.2 312 67 0.2 56 0.2 515 885 106 13 5 20 0.2 184 0.2 0.2 1 14 118 263 11 322 49 0.2 17 0.2 0.2 39 8 0.2 1 0.2 12 17 5 15 673 3 398 44 664 52 31 226 11 7 8 144 112 36 87 244 0.2 166 0.2 183 44 43 0.2 19 204 48 70 289 14 47 660 0.2 0.2 8 0.2 22 7 11 2 0.2 0.2 21 16 71 54 0.2 2 0.2 1 4 251 0.2 72 87 8 9 191 12 20 117 71 792 18 30 46 38 340 0.2 23 0.2 350 0.2 14 3 0.2 1855 85 26 281 52 32 61 544 0.2 2 0.054116 0.018227 0.039903 0.020160 0.009709 0.018781 0.024289 0.068183 0.024518 0.092638 0.148658 0.021718 0.061453 0.088668 0.041826 0.091030 0.049194 0.029786 0.039443 0.057700 // this is the end of the file. The rest are notes. Ala Arg Asn Asp Cys Gln Glu Gly His Ile Leu Lys Met Phe Pro Ser Thr Trp Tyr Val This model has been derived from 36 artropoda mitochondrial genomes. Each gene of the given species was aligned individually. Then, alignments of the whole set of 13 genes where concatenated and passed through GBlocks (Castresana, 2000, in JME) with parameters and output: Minimum Number Of Sequences For A Conserved Position: 20 Minimum Number Of Sequences For A Flanking Position: 32 Maximum Number Of Contiguous Nonconserved Positions: 8 Minimum Length Of A Block: 10 Allowed Gap Positions: With Half Use Similarity Matrices: Yes Flank positions of the 40 selected block(s) Flanks: [6 22] [26 44] [61 70] [77 143] [145 185] [208 236] [309 640] [644 802] [831 941] [956 966] [973 1062] [1085 1339] [1343 1702] [1754 1831] [1840 1911] [1916 1987] [2011 2038] [2097 2118] [2125 2143] [2179 2215] [2243 2268] [2277 2288] [2333 2347] [2476 2518] [2539 2558] [2600 2613] [2637 2672] [2738 2759] [2784 2839] [2882 2924] [2948 3097] [3113 3123] [3210 3235] [3239 3322] [3348 3392] [3406 3526] [3588 3617] [3660 3692] [3803 3830] [3909 3928] New number of positions in MtArt-strict.phy.fasta-gb: 2664 (67% of the original 3933 positions) The species included in the analysis were: Harpiosquilla harpax [NCBI_TaxID 287944] Ixodes uriae [NCBI_TaxID 59655] Heptathela hangzhouensis [NCBI_TaxID 216259] Triops longicaudatus [NCBI_TaxID 58777] Gryllotalpa orientalis [NCBI_TaxID 213494] lepidopsocid RS-2001 [NCBI_TaxID 159971] Locusta migratoria [NCBI_TaxID 7004] Drosophila yakuba [NCBI_TaxID 7245] Ostrinia furnacalis [NCBI_TaxID 93504] Megabalanus volcano [NCBI_TaxID 266495] Periplaneta fuliginosa [NCBI_TaxID 36977] Thermobia domestica [NCBI_TaxID 89055] Aleurochiton aceris [NCBI_TaxID 266942] Schizaphis graminum [NCBI_TaxID 13262] Pteronarcys princeps [NCBI_TaxID 285953] Aleurodicus dugesii [NCBI_TaxID 30099] Pollicipes polymerus [NCBI_TaxID 36137] Gomphiocephalus hodgsoni [NCBI_TaxID 221270] Habronattus oregonensis [NCBI_TaxID 130930] Speleonectes tulumensis [NCBI_TaxID 84346] Hutchinsoniella macracantha [NCBI_TaxID 84335] Haemaphysalis flava [NCBI_TaxID 181088] Scutigera coleoptrata [NCBI_TaxID 29022] Vargula hilgendorfii [NCBI_TaxID 6674] Tricholepidion gertschi [NCBI_TaxID 89825] Varroa destructor [NCBI_TaxID 109461] Bombyx mandarina [NCBI_TaxID 7092] Thyropygus sp. [NCBI_TaxID 174155] Tribolium castaneum [NCBI_TaxID 7070] Pagurus longicarpus [NCBI_TaxID 111067] Limulus polyphemus [NCBI_TaxID 6850] Tetrodontophora bielanensis [NCBI_TaxID 48717] Penaeus monodon [NCBI_TaxID 6687] Daphnia pulex [NCBI_TaxID 6669] Apis mellifera [NCBI_TaxID 7469] Anopheles gambiae [NCBI_TaxID 7165] The topology used for inferring the model was: (((Daph_pulex,Trio_longi),((((((Aleu_aceri,Aleu_duges),Schi_grami),lepi_RS_20), ((((Ostr_furna,Bomb_manda),(Dros_yakub,Anop_gambi)),Apis_melli),Trib_casta)), ((Gryl_orien,Locu_migra),(Pter_princ,Peri_fulig))),(Tric_gerts,Ther_domes)), (Scut_coleo,Thyr_sp),Varg_hilge,Hutc_macra,((((Ixod_uriae,Haem_flava),Varr_destr), (Habr_orego,Hept_hangz)),Limu_polyp),(Poll_polym,Mega_volca),(Gomp_hodgs,Tetr_biela), ((Pagu_longi,Pena_monod),Harp_harpa),Spel_tulum)); Note this is not the ML topology but the consensus one (based on morphological data, phylogenetic reconstruction using nuclear genes, etc). Where relationships are not clear, a polytomy was introduced (it contains quite a lot of polytomies!). The model was estimated using Ziheng Yang's Paml software package. A four-categorized gamma distribution was used to account for heterogeneity (alpha was estimated to be 0.47821). Sites with ambiguity data were taken into account. Reference Abascal, F., D. Posada, and R. Zardoya. 2007. MtArt: A new Model of amino acid replacement for Arthropoda. Mol. Biol. Evol. 24:1-5. phangorn/inst/extdata/HIVb.dat0000644000175100001440000000337412507002037016000 0ustar hornikusers 0.307507 0.005 0.295543 1.45504 0.005 17.6612 0.123758 0.351721 0.0860642 0.005 0.0551128 3.4215 0.672052 0.005 0.005 1.48135 0.0749218 0.0792633 10.5872 0.005 2.5602 2.13536 3.65345 0.323401 2.83806 0.897871 0.0619137 3.92775 0.0847613 9.04044 7.64585 1.9169 0.240073 7.05545 0.11974 0.005 0.005 0.677289 0.680565 0.0176792 0.005 0.005 0.00609079 0.005 0.103111 0.215256 0.701427 0.005 0.00876048 0.129777 1.49456 0.005 0.005 1.74171 5.95879 0.005 20.45 7.90443 0.005 0.005 6.54737 4.61482 0.521705 0.005 0.322319 0.0814995 0.0186643 2.51394 0.005 0.005 0.005 0.303676 0.175789 0.005 0.005 11.2065 5.31961 1.28246 0.0141269 0.005 0.005 0.005 9.29815 0.005 0.005 0.291561 0.145558 3.39836 8.52484 0.0342658 0.188025 2.12217 1.28355 0.00739578 0.0342658 0.005 4.47211 0.0120226 0.005 2.45318 0.0410593 2.07757 0.0313862 0.005 0.005 2.46633 3.4791 13.1447 0.52823 4.69314 0.116311 0.005 4.38041 0.382747 1.21803 0.927656 0.504111 0.005 0.956472 5.37762 15.9183 2.86868 6.88667 0.274724 0.739969 0.243589 0.289774 0.369615 0.711594 8.61217 0.0437673 4.67142 4.94026 0.0141269 2.01417 8.93107 0.005 0.991338 0.005 0.005 2.63277 0.026656 0.005 1.21674 0.0695179 0.005 0.748843 0.005 0.089078 0.829343 0.0444506 0.0248728 0.005 0.005 0.00991826 1.76417 0.674653 7.57932 0.113033 0.0792633 0.005 18.6943 0.148168 0.111986 0.005 0.005 15.34 0.0304381 0.648024 0.105652 1.28022 7.61428 0.0812454 0.026656 1.04793 0.420027 0.0209153 1.02847 0.953155 0.005 17.7389 1.41036 0.265829 6.8532 0.723274 0.005 0.0749218 0.709226 0.005 0.0410593 0.060490222 0.066039665 0.044127815 0.042109048 0.020075899 0.053606488 0.071567447 0.072308239 0.022293943 0.069730629 0.098851122 0.056968211 0.019768318 0.028809447 0.046025282 0.05060433 0.053636813 0.033011601 0.028350243 0.061625237 phangorn/inst/extdata/mtREV24.dat0000644000175100001440000000414112507002037016344 0ustar hornikusers 23.18 26.95 13.24 17.67 1.90 794.38 59.93 103.33 58.94 1.90 1.90 220.99 173.56 55.28 75.24 9.77 1.90 63.05 583.55 1.90 313.56 120.71 23.03 53.30 56.77 30.71 6.75 28.28 13.90 165.23 496.13 113.99 141.49 582.40 49.12 1.90 96.49 1.90 27.10 4.34 62.73 8.34 3.31 5.98 12.26 25.46 15.58 15.16 1.90 25.65 39.70 1.90 2.41 11.49 329.09 8.36 141.40 608.70 2.31 1.90 465.58 313.86 22.73 127.67 19.57 14.88 141.88 1.90 65.41 1.90 6.18 47.37 1.90 1.90 11.97 517.98 537.53 91.37 6.37 4.69 15.20 4.98 70.80 19.11 2.67 1.90 48.16 84.67 216.06 6.44 90.82 54.31 23.64 73.31 13.43 31.26 137.29 12.83 1.90 60.97 20.63 40.10 50.10 18.84 17.31 387.86 6.04 494.39 69.02 277.05 54.11 54.71 125.93 77.46 47.70 73.61 105.79 111.16 64.29 169.90 480.72 2.08 238.46 28.01 179.97 94.93 14.82 11.17 44.78 368.43 126.40 136.33 528.17 33.85 128.22 597.21 1.90 21.95 10.68 19.86 33.60 1.90 1.90 10.92 7.08 1.90 32.44 24.00 21.71 7.84 4.21 38.58 9.99 6.48 1.90 191.36 21.21 254.77 38.82 13.12 3.21 670.14 25.01 44.15 51.17 39.96 465.58 16.21 64.92 38.73 26.25 195.06 7.64 1.90 1.90 1.90 19.00 21.14 2.53 1.90 1222.94 91.67 1.90 387.54 6.35 8.23 1.90 204.54 5.37 1.90 0.072 0.019 0.039 0.019 0.006 0.025 0.024 0.056 0.028 0.088 0.169 0.023 0.054 0.061 0.054 0.072 0.086 0.029 0.033 0.043 Ala Arg Asn Asp Cys Gln Glu Gly His Ile Leu Lys Met Phe Pro Ser Thr Trp Tyr Val S_ij = S_ji and PI_i for the mtREV24 model (Adachi and Hasegawa 1996). The PI's used to sum to 0.999 and I changed one of the freq from 0.168 into 0.169 so that the sum is 1. Prepared by Z. Yang according to data sent by Dr M. Hasegawa. This matrix was obtained from the 12 mitochondrial proteins encoded by the same strand of the DNA from a diverse range of species including bird, fish, frog, lamprey, as well as mammals (see Adachi and Hasegawa 1996 for details). The other matrix (mtmam.dat) included in the package is based on the same proteins from mammals only. Adachi, J. and Hasegawa, M. (1996) MOLPHY version 2.3: programs for molecular phylogenetics based on maximum likelihood. Computer Science Monographs of Institute of Statistical Mathematics 28:1-150. phangorn/inst/extdata/FLU.dat0000644000175100001440000000721112507002037015630 0ustar hornikusers 0.138658764751059 0.0533665787145181 0.161000889039552 0.584852305649886 0.00677184253227681 7.73739287051356 0.0264470951166826 0.16720700818221 1.30249856764315e-005 0.014132062548787 0.353753981649393 3.29271694159791 0.530642655337477 0.145469388422239 0.00254733397966779 1.4842345032161 0.124897616909194 0.0616521921873234 5.37051127867923 3.91106992668137e-011 1.19562912226203 1.13231312248046 1.19062446519178 0.322524647863997 1.93483278448943 0.116941459124876 0.108051341246072 1.59309882471598 0.214757862168721 1.87956993845887 1.38709603234116 0.887570549414031 0.0218446166959521 5.33031341222104 0.256491863423002 0.0587745274250666 0.149926734229061 0.246117171830255 0.21857197541607 0.0140859174993809 0.00111215807314139 0.0288399502994541 0.0142107118685268 1.62662283098296e-005 0.243190142026506 0.0231169515264061 0.296045557460629 0.000835873174542931 0.00573068208525287 0.00561362724916376 1.02036695531654 0.016499535540562 0.00651622937676521 0.321611693603646 3.51207228207807 0.474333610192982 15.3000966197798 2.6468479652886 0.290042980143818 3.83228119049152e-006 2.559587177122 3.88148880863814 0.264148929349066 0.347302791211758 0.227707997165566 0.129223639195248 0.0587454231508643 0.890162345593224 0.00525168778853117 0.0417629637305017 0.111457310321926 0.190259181297527 0.313974351356074 0.00150046692269255 0.00127350890508147 9.01795420287895 6.74693648486614 1.33129161941264 0.0804909094320368 0.0160550314767596 0.000836445615590923 1.0600102849456e-006 0.10405366623526 0.0326806570137471 0.00100350082518749 0.00123664495412902 0.119028506158521 1.46335727834648 2.98680003596399 0.319895904499071 0.279910508981581 0.659311477863896 0.154027179890711 0.0364417719063219 0.188539456415654 1.59312060172652e-013 0.712769599068934 0.319558828428154 0.0386317614553493 0.924466914225534 0.0805433268150369 0.634308520867322 0.195750631825315 0.0568693216513547 0.0071324304661639 3.01134451903854 0.950138410087378 3.88131053061457 0.338372183381345 0.336263344504404 0.487822498528951 0.307140298031341 1.58564657669139 0.580704249811294 0.290381075260226 0.570766693213698 0.283807671568883 0.00702658828739369 0.996685669575839 2.08738534433198 5.4182981753166 0.183076905018197 2.14033231636063 0.135481232622983 0.011975265782196 0.60234096342392 0.2801248951174 0.0188080299490973 0.368713573381758 2.90405228596936 0.0449263566753846 1.52696419998775 2.03151132062208 0.000134906239484254 0.54225109402693 2.2068599339404 0.195966354027106 1.36942940801512 0.000536284040016542 1.4893873721753e-005 0.0941066800969967 0.0440205200833047 0.155245492137294 0.196486447133033 0.0223729191088972 0.0321321499585514 0.431277662888057 4.97641445484395e-005 0.0704600385245663 0.814753093809928 0.000431020702277328 0.0998357527014247 0.207066205546908 0.0182892882245349 0.0998554972524385 0.373101926513925 0.525398542949365 0.601692431136271 0.0722059354079545 0.104092870343653 0.0748149970972622 6.44895444648517 0.273934263183281 0.340058468374384 0.0124162215506117 0.874272174533394 5.39392424532822 0.000182294881489116 0.392552239890831 0.124898020409882 0.42775543040588 3.53200526987468 0.103964386383736 0.0102575172450253 0.297123975243582 0.0549045639492389 0.406697814049488 0.285047948309311 0.337229618868315 0.0986313546653266 14.3940521944257 0.890598579382591 0.0731279296372675 4.90484223478739 0.592587985458668 0.0589719751511691 0.0882564232979724 0.654109108255219 0.256900461407996 0.167581646770807 0.0470718 0.0509102 0.0742143 0.0478596 0.0250216 0.0333036 0.0545874 0.0763734 0.0199642 0.0671336 0.0714981 0.0567845 0.0181507 0.0304961 0.0506561 0.0884091 0.0743386 0.0185237 0.0314741 0.0632292 phangorn/inst/extdata/Dayhoff.dat0000644000175100001440000000250612507002037016564 0ustar hornikusers 27.00 98.00 32.00 120.00 0.00 905.00 36.00 23.00 0.00 0.00 89.00 246.00 103.00 134.00 0.00 198.00 1.00 148.00 1153.00 0.00 716.00 240.00 9.00 139.00 125.00 11.00 28.00 81.00 23.00 240.00 535.00 86.00 28.00 606.00 43.00 10.00 65.00 64.00 77.00 24.00 44.00 18.00 61.00 0.00 7.00 41.00 15.00 34.00 0.00 0.00 73.00 11.00 7.00 44.00 257.00 26.00 464.00 318.00 71.00 0.00 153.00 83.00 27.00 26.00 46.00 18.00 72.00 90.00 1.00 0.00 0.00 114.00 30.00 17.00 0.00 336.00 527.00 243.00 18.00 14.00 14.00 0.00 0.00 0.00 0.00 15.00 48.00 196.00 157.00 0.00 92.00 250.00 103.00 42.00 13.00 19.00 153.00 51.00 34.00 94.00 12.00 32.00 33.00 17.00 11.00 409.00 154.00 495.00 95.00 161.00 56.00 79.00 234.00 35.00 24.00 17.00 96.00 62.00 46.00 245.00 371.00 26.00 229.00 66.00 16.00 53.00 34.00 30.00 22.00 192.00 33.00 136.00 104.00 13.00 78.00 550.00 0.00 201.00 23.00 0.00 0.00 0.00 0.00 0.00 27.00 0.00 46.00 0.00 0.00 76.00 0.00 75.00 0.00 24.00 8.00 95.00 0.00 96.00 0.00 22.00 0.00 127.00 37.00 28.00 13.00 0.00 698.00 0.00 34.00 42.00 61.00 208.00 24.00 15.00 18.00 49.00 35.00 37.00 54.00 44.00 889.00 175.00 10.00 258.00 12.00 48.00 30.00 157.00 0.00 28.00 0.087127 0.040904 0.040432 0.046872 0.033474 0.038255 0.049530 0.088612 0.033618 0.036886 0.085357 0.080482 0.014753 0.039772 0.050680 0.069577 0.058542 0.010494 0.029916 0.064718 phangorn/inst/extdata/cpREV.dat0000644000175100001440000000352412507002037016164 0ustar hornikusers 105 227 357 175 43 4435 669 823 538 10 157 1745 768 400 10 499 152 1055 3691 10 3122 665 243 653 431 303 133 379 66 715 1405 331 441 1269 162 19 145 136 168 10 280 92 148 40 29 197 203 113 10 396 286 82 20 66 1745 236 4482 2430 412 48 3313 2629 263 305 345 218 185 125 61 47 159 202 113 21 10 1772 1351 193 68 53 97 22 726 10 145 25 127 454 1268 72 327 490 87 173 170 285 323 185 28 152 117 219 302 100 43 2440 385 2085 590 2331 396 568 691 303 216 516 868 93 487 1202 1340 314 1393 266 576 241 369 92 32 1040 156 918 645 148 260 2151 14 230 40 18 435 53 63 82 69 42 159 10 86 468 49 73 29 56 323 754 281 1466 391 142 10 1971 89 189 247 215 2370 97 522 71 346 968 92 83 75 592 54 200 91 25 4797 865 249 475 317 122 167 760 10 119 0.0755 0.0621 0.0410 0.0371 0.0091 0.0382 0.0495 0.0838 0.0246 0.0806 0.1011 0.0504 0.0220 0.0506 0.0431 0.0622 0.0543 0.0181 0.0307 0.0660 A R N D C Q E G H I L K M F P S T W Y V Ala Arg Asn Asp Cys Gln Glu Gly His Ile Leu Lys Met Phe Pro Ser Thr Trp Tyr Val Symmetrical part of the rate matrix and aa frequencies, estimated for plant chloroplast proteins, under the REVaa model. The first part is S_ij = S_ji, and the second part has the amino acid frequencies (\pi_i). The substitution rate from amino acid i to j is Q_ij = S_ij*PI_j. This is the cpREV model used in protml 2.3b6 (12/10/98), described by Adachi, J., P. J. Waddell, W. Martin, and M. Hasegawa. 2000. Plastid genome phylogeny and a model of amino acid substitution for proteins encoded by chloroplast DNA. Journal of Molecular Evolution 50:348-358. phangorn/inst/extdata/mtmam.dat0000644000175100001440000000726612507002037016327 0ustar hornikusers 32 2 4 11 0 864 0 186 0 0 0 246 8 49 0 0 0 0 569 0 274 78 18 47 79 0 0 22 8 232 458 11 305 550 22 0 75 0 19 0 41 0 0 0 0 21 6 0 0 27 20 0 0 26 232 0 50 408 0 0 242 215 0 0 6 4 76 0 21 0 0 22 0 0 0 378 609 59 0 0 6 5 7 0 0 0 0 57 246 0 11 53 9 33 2 0 51 0 0 53 5 43 18 0 17 342 3 446 16 347 30 21 112 20 0 74 65 47 90 202 681 0 110 0 114 0 4 0 1 360 34 50 691 8 78 614 5 16 6 0 65 0 0 0 0 0 12 0 13 0 7 17 0 0 0 156 0 530 54 0 1 1525 16 25 67 0 682 8 107 0 14 398 0 0 10 0 33 20 5 0 2220 100 0 832 6 0 0 237 0 0 0.0692 0.0184 0.0400 0.0186 0.0065 0.0238 0.0236 0.0557 0.0277 0.0905 0.1675 0.0221 0.0561 0.0611 0.0536 0.0725 0.0870 0.0293 0.0340 0.0428 A R N D C Q E G H I L K M F P S T W Y V Ala Arg Asn Asp Cys Gln Glu Gly His Ile Leu Lys Met Phe Pro Ser Thr Trp Tyr Val //End of File Symmetrical part of the rate matrix and aa frequencies, estimated from the 12 mt proteins (atp6 atp8 cox1 cox2 cox3 cytb nd1 nd2 nd3 nd4 nd4l nd5) on the same strand of the mitochondrial DNA (3331 sites). The data are from 20 species of mammals and three close outgroups (wallaroo, opossum, and platypus). The model used is REVaa+dGamma(K=8) with the estimated gamma parameter to be 0.37. The first part is S_ij = S_ji, and the second part has the amino acid frequencies (PI_i). The substitution rate from amino acid i to j is Q_ij=S_ij*PI_j. The data are from Cao, Y. et al. 1998 Conflict amongst individual mitochondrial proteins in resolving the phylogeny of eutherian orders. Journal of Molecular Evolution 15:1600-1611. The species are listed below 1 SB17F Homo sapiens (African) # D38112 2 CHIMP Pan troglodytes (chimpanzee) # D38113 3 PyGC Pan paniscus (bonobo) # D38116 4 GORIL Gorilla gorilla (gorilla) # D38114 5 ORANG Pongo pygmaeus (orangutan) # D38115 6 Ponpy Pongo pygmaeus abelii (Sumatran orangutan) # X97707 7 Hylla Hylobates lar (common gibbon) # X99256 (lar gibbon) 8 Phovi Phoca vitulina (harbor seal) # X63726 9 Halgr Halichoerus grypus (grey seal) # X72004 10 Felca Felis catus (cat) # U20753 11 Equca Equus caballus (horse) # X79547 12 Rhiun Rhinoceros unicornis (Indian rhinoceros) # X97336 13 Bosta Bos taurus (cow) # J01394 14 Balph Balaenoptera physalus (fin whale) # X61145 15 Balmu Balaenoptera musculus (blue whale) # X72204 16 Ratno Rattus norvegicus (rat) # X14848 17 Musmu Mus musculus (mouse) # J01420 18 Macro Macropus robustus (wallaroo) # Y10524 19 Didvi Didelphis virginiana (opossum) # Z29573 20 Ornan Ornithorhynchus anatinus (platypus) # X83427 The results and details of the model are published in Yang, Z., R. Nielsen, and M. Hasegawa. 1998. Models of amino acid substitution and applications to Mitochondrial protein evolution, Molecular Biology and Evolution 15:1600-1611. Prepared by Z. Yang, April 1998. phangorn/inst/extdata/lg.dat0000644000175100001440000000361512507002037015610 0ustar hornikusers 0.425093 0.276818 0.751878 0.395144 0.123954 5.076149 2.489084 0.534551 0.528768 0.062556 0.969894 2.807908 1.695752 0.523386 0.084808 1.038545 0.363970 0.541712 5.243870 0.003499 4.128591 2.066040 0.390192 1.437645 0.844926 0.569265 0.267959 0.348847 0.358858 2.426601 4.509238 0.927114 0.640543 4.813505 0.423881 0.311484 0.149830 0.126991 0.191503 0.010690 0.320627 0.072854 0.044265 0.008705 0.108882 0.395337 0.301848 0.068427 0.015076 0.594007 0.582457 0.069673 0.044261 0.366317 4.145067 0.536518 6.326067 2.145078 0.282959 0.013266 3.234294 1.807177 0.296636 0.697264 0.159069 0.137500 1.124035 0.484133 0.371004 0.025548 0.893680 1.672569 0.173735 0.139538 0.442472 4.273607 6.312358 0.656604 0.253701 0.052722 0.089525 0.017416 1.105251 0.035855 0.018811 0.089586 0.682139 1.112727 2.592692 0.023918 1.798853 1.177651 0.332533 0.161787 0.394456 0.075382 0.624294 0.419409 0.196961 0.508851 0.078281 0.249060 0.390322 0.099849 0.094464 4.727182 0.858151 4.008358 1.240275 2.784478 1.223828 0.611973 1.739990 0.990012 0.064105 0.182287 0.748683 0.346960 0.361819 1.338132 2.139501 0.578987 2.000679 0.425860 1.143480 1.080136 0.604545 0.129836 0.584262 1.033739 0.302936 1.136863 2.020366 0.165001 0.571468 6.472279 0.180717 0.593607 0.045376 0.029890 0.670128 0.236199 0.077852 0.268491 0.597054 0.111660 0.619632 0.049906 0.696175 2.457121 0.095131 0.248862 0.140825 0.218959 0.314440 0.612025 0.135107 1.165532 0.257336 0.120037 0.054679 5.306834 0.232523 0.299648 0.131932 0.481306 7.803902 0.089613 0.400547 0.245841 3.151815 2.547870 0.170887 0.083688 0.037967 1.959291 0.210332 0.245034 0.076701 0.119013 10.649107 1.702745 0.185202 1.898718 0.654683 0.296501 0.098369 2.188158 0.189510 0.249313 0.079066 0.055941 0.041977 0.053052 0.012937 0.040767 0.071586 0.057337 0.022355 0.062157 0.099081 0.064600 0.022951 0.042302 0.044040 0.061197 0.053287 0.012066 0.034155 0.069147 phangorn/inst/extdata/JTT.dat0000644000175100001440000000252712507002037015650 0ustar hornikusers 58.00 54.00 45.00 81.00 16.00 528.00 56.00 113.00 34.00 10.00 57.00 310.00 86.00 49.00 9.00 105.00 29.00 58.00 767.00 5.00 323.00 179.00 137.00 81.00 130.00 59.00 26.00 119.00 27.00 328.00 391.00 112.00 69.00 597.00 26.00 23.00 36.00 22.00 47.00 11.00 17.00 9.00 12.00 6.00 16.00 30.00 38.00 12.00 7.00 23.00 72.00 9.00 6.00 56.00 229.00 35.00 646.00 263.00 26.00 7.00 292.00 181.00 27.00 45.00 21.00 14.00 54.00 44.00 30.00 15.00 31.00 43.00 18.00 14.00 33.00 479.00 388.00 65.00 15.00 5.00 10.00 4.00 78.00 4.00 5.00 5.00 40.00 89.00 248.00 4.00 43.00 194.00 74.00 15.00 15.00 14.00 164.00 18.00 24.00 115.00 10.00 102.00 21.00 16.00 17.00 378.00 101.00 503.00 59.00 223.00 53.00 30.00 201.00 73.00 40.00 59.00 47.00 29.00 92.00 285.00 475.00 64.00 232.00 38.00 42.00 51.00 32.00 33.00 46.00 245.00 25.00 103.00 226.00 12.00 118.00 477.00 9.00 126.00 8.00 4.00 115.00 18.00 10.00 55.00 8.00 9.00 52.00 10.00 24.00 53.00 6.00 35.00 12.00 11.00 20.00 70.00 46.00 209.00 24.00 7.00 8.00 573.00 32.00 24.00 8.00 18.00 536.00 10.00 63.00 21.00 71.00 298.00 17.00 16.00 31.00 62.00 20.00 45.00 47.00 11.00 961.00 180.00 14.00 323.00 62.00 23.00 38.00 112.00 25.00 16.00 0.076748 0.051691 0.042645 0.051544 0.019803 0.040752 0.061830 0.073152 0.022944 0.053761 0.091904 0.058676 0.023826 0.040126 0.050901 0.068765 0.058565 0.014261 0.032102 0.066005 phangorn/inst/extdata/dayhoff-dcmut.dat0000644000175100001440000000565712507002037017750 0ustar hornikusers0.267828 0.984474 0.327059 1.199805 0.000000 8.931515 0.360016 0.232374 0.000000 0.000000 0.887753 2.439939 1.028509 1.348551 0.000000 1.961167 0.000000 1.493409 11.388659 0.000000 7.086022 2.386111 0.087791 1.385352 1.240981 0.107278 0.281581 0.811907 0.228116 2.383148 5.290024 0.868241 0.282729 6.011613 0.439469 0.106802 0.653416 0.632629 0.768024 0.239248 0.438074 0.180393 0.609526 0.000000 0.076981 0.406431 0.154924 0.341113 0.000000 0.000000 0.730772 0.112880 0.071514 0.443504 2.556685 0.258635 4.610124 3.148371 0.716913 0.000000 1.519078 0.830078 0.267683 0.270475 0.460857 0.180629 0.717840 0.896321 0.000000 0.000000 0.000000 1.127499 0.304803 0.170372 0.000000 3.332732 5.230115 2.411739 0.183641 0.136906 0.138503 0.000000 0.000000 0.000000 0.000000 0.153478 0.475927 1.951951 1.565160 0.000000 0.921860 2.485920 1.028313 0.419244 0.133940 0.187550 1.526188 0.507003 0.347153 0.933709 0.119152 0.316258 0.335419 0.170205 0.110506 4.051870 1.531590 4.885892 0.956097 1.598356 0.561828 0.793999 2.322243 0.353643 0.247955 0.171432 0.954557 0.619951 0.459901 2.427202 3.680365 0.265745 2.271697 0.660930 0.162366 0.525651 0.340156 0.306662 0.226333 1.900739 0.331090 1.350599 1.031534 0.136655 0.782857 5.436674 0.000000 2.001375 0.224968 0.000000 0.000000 0.000000 0.000000 0.000000 0.270564 0.000000 0.461776 0.000000 0.000000 0.762354 0.000000 0.740819 0.000000 0.244139 0.078012 0.946940 0.000000 0.953164 0.000000 0.214717 0.000000 1.265400 0.374834 0.286572 0.132142 0.000000 6.952629 0.000000 0.336289 0.417839 0.608070 2.059564 0.240368 0.158067 0.178316 0.484678 0.346983 0.367250 0.538165 0.438715 8.810038 1.745156 0.103850 2.565955 0.123606 0.485026 0.303836 1.561997 0.000000 0.279379 0.087127 0.040904 0.040432 0.046872 0.033474 0.038255 0.049530 0.088612 0.033619 0.036886 0.085357 0.080481 0.014753 0.039772 0.050680 0.069577 0.058542 0.010494 0.029916 0.064718 A R N D C Q E G H I L K M F P S T W Y V Ala Arg Asn Asp Cys Gln Glu Gly His Ile Leu Lys Met Phe Pro Ser Thr Trp Tyr Val # #Dayhoff rate matrix prepared using the DCMut method* #---------------------------------------------------- # #The first part above indicates the symmetric 'exchangeability' parameters s_ij, #where s_ij = s_ji. #The second part gives the amino acid equilibrium frequencies pi_i. #The net replacement rate from i to j is q_ij = pi_j*s_ij. # #This model is usually scaled so that the mean rate of change at #equilibrium, Sum_i Sum_j!=i pi_i*q_ij, equals 1. You should check this #scaling before using the matrix above. The PAML package will perform #this scaling. # # # #*Prepared by Carolin Kosiol and Nick Goldman, December 2003. # #See the following paper for more details: #Kosiol, C., and Goldman, N. 2005. Different versions of the Dayhoff rate matrix. #Molecular Biology and Evolution 22:193-199. # #See also http://www.ebi.ac.uk/goldman/dayhoff phangorn/inst/doc/0000755000175100001440000000000012547505677013650 5ustar hornikusersphangorn/inst/doc/Trees.pdf0000644000175100001440000041547012507002037015412 0ustar hornikusers%PDF-1.5 % 40 0 obj << /Length 1916 /Filter /FlateDecode >> stream xڝXIoFWHdr8mQE\H-]Si1r5{7NV+m]\ШvwBS\nwqe;j)oyM 7M=4~Ğ.;|)S|cua**oQ:jP 7=֗)-I"%/W(;]aUnZikZYZs¬[ Z;x0l5"k,Qej8*#717+hr{~$Qm]xX[u#i#Ø-G\4܋8(D~6Y ':$>!'!q8nD+f({Áo2^5WUU8(Xj@9~a(_wē.F> 숋{VsoYT佽Wct.Vu]vW߇eEնgTtc36u#$݋2A@ݝ{ ;S ,4m ͝H]IcG?'c]O]H;=7z%0 ymIa+8*4})QN715CЂ1=fDV 1#<7rPdp!F0(m3i(Ɔ1.X`A G9t'J-Jcȅ 2`%мM)!Ua1:;Tzsgs9}Pp0ھJ\Fcm$12AuSK_g4gr4E!p7*l3etVJ5d GS_;ԓ֏}uS~:NYvK/XIhejs $4 # (X;!!Enޜg&s2d4aT'^R5⚄mt 8bD4#/2u;JˮM6!92Ķяd:w+9{œF|$1a@=@k]X@ W uDKQMBNc@Mg_gg#s딃GÌ`F[INjp=ZlJ> ڒ8!vw󨓵RJ[;_n$`J׵Tk8BabjPP&$Ms}' f*`b4R q^Fr͂છ&>`*4u˔܋i`G*~y`7թHZ+)A 4́.[ md[*ch6"G901M;` 9a|z|dMLEUVՋG̅Ty X`a'@RZjݜ5N}]7NGK.@D'~yLU"`87\RvNa+Ϋw|uRK@yWSg|^9]'bH1HtYiAx .VY}p.0PD._hݡ0uiBx{+ U۸@ao鋲A-?kj_D~B#dgW%pQF=^ƇX[>B)7W̷c$ endstream endobj 64 0 obj << /Length 1681 /Filter /FlateDecode >> stream xڕ]oHdKkJ=SJ5N*]0&Ap-sN&yۏtZ3XlDx:Ȧh:[G8qajx->^w(oW`QfbDږBXAHg[G"&Ѕ!D#@t7I_#CR^rƍ5C.c2ē6ELQ:o866D\E8J&6X-Eb%^x_jfeƾ@&L6c& R-j8L=> %|NRuz*34ΗBbX'9#B~T*GM܊:6Gu\0WTY$Qf2D(`! g$*ɏ°b2DC&oUɋO} ֲBY樵$J4|ix]-Ew  JF;윁 rYU'tJ"[i`|pE*lߞ2pjY9z~e< )×ǬhIJFp> }Mˤ&c'Y-+3ߩ5!|=_yA*dUB@ĥWѪv;mEb`s E-iݮT& u "$$a .>G ~rUMjhWx6 ?_DWox>0̦!SD0RL0עwEʂϸo% и u/9;eTPЪ(/kg]^#[9wThҾ)˺a ~S+(pI*!U !z^kg?$XBÙ{@*C)N(1"'OjuA7X0W5~7&DsؗiOaR;uɿfQ%8 c\z3j+s1y ' ;u5d•/_uZ+!PvZn4Sp r.alJ}:z<⮍KqR8 3AEli$+NRD.\n~G4ZmQJӾX@IAvsQ۴# KnFaMx. x|+/_wB!o#"" 3PE&q G kn!y8@LV)>Gc _1OՐnΛBNGn;P2<]KqY055ǎaFXC!"{שf⧕^0=kέʔ9Ҥz8qV;6LbR7pUqJgeƖ\KQM[/Mf,擩̽7a"6*ZE$hpjtp W0"Ji(ۉ3RW1}k8n:>;y wnb`9 6M Fp{G 4aXA4rg,V46 v5)Puԉ9va]ۣy Z 7F$?`|<Qjr>t*0KS(A_L'6*ٻW:J)L(Mb򹉥ZڃZb*/ij,B"$2$&o>, ch endstream endobj 71 0 obj << /Length 204 /Filter /FlateDecode >> stream xMͪ1 },E뤵]EZŅo:SQ)9C*.B뼩,Y܄il[Z z3*V\oKJD{ ȴ!ڄ@c:{RY/GsrͳҶ僕f9a7.ow}̹KVgc1+)y%%34o]&b {Gz endstream endobj 60 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./Trees-figNJ.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 73 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F3 74 0 R/F4 75 0 R>> /ExtGState << >>/ColorSpace << /sRGB 76 0 R >>>> /Length 1157 /Filter /FlateDecode >> stream xWr[7 +a=;:mced!;j#זci~>$2"¾\#WĽx.J F#?~lW/fw/n`%O .$EY^Ye hQ?vyL,go Ɛ$]Gq"{pq3z+}$<qE3HN\KF#B(VAZJtޓhˁ2En WRh<,r@@VN_A>Ф~!  @6)H|KTN2# Olrp(- UNrB,Oٵ bQNJ76"<T$NIUNrlXaw%*'D>ёtZ? [* T)DYEnH/1T9! X~ldEV9 |h}u=5h`MԵ̠zgAu=5߾ZG93q(NeKɔCJqY&C 2C/j- V\?m>>Hdt׍^-7B_V9ފU)8ŧvłGrr}}}Lp'"7Hk *X]z"K HT/ǯG`"Sl @)FL(Ni(#jmMe(QL2 n R&ba2Ij'0~Ğ(Fn0SR??2>1. endstream endobj 78 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 83 0 obj << /Length 1645 /Filter /FlateDecode >> stream xڝXIoFWHM.u E4EJJd8y Gmͣܜ]\haefv͊*4,2b1YA{>O8`xg O5<7<~O(k~]I)'|8jT_^$#Y4i9q-Yy5`C"M;6ɟAX $lI*! ǐl BLxi5ㄩrk* Vd7o!6Cg)kMʷ';zdɽ@3gU';D!tڐ"UX%(ŭoξt endstream endobj 90 0 obj << /Length 1625 /Filter /FlateDecode >> stream xڝXKsH+\"z^Ted"EmmeMq#'?,w~FF&=y:'IyNfIYG館ʨmj1hịih*N4L,hlmCiZ0ט%D? :Lle`;7,MOOl폄w)6/[\҉=Mt7N7[M(.G@;>BruM&>̥یFbg81NlXqeQ,< E㠠 R6+dVŗD׮(1: >L+|=AUcL$BGwm_p8B)@-ssBQVdٍAW}ms'~cQP%7Nyb.0*FXd qABm#t#z\Ca)~N=?|$,`Nv5 b6UJfcS`{|(3BEXe垫V\-/Z0 iUuڳfΌPevi͇kE-VBS"đ4|#^[F'ť9FJNKe VlxѻDZBBf,F;LN8^kv5&qXrC,w]GsV#k^3v_)Ⱥ-{Y[i"G2,Er/z}H?wr{StI{XZ zMWk: 0W)9z)ZXLMl uAĔh4} C'"czwhWe@UBNxX򶮎v}9~r!8+'FMj :*QjO?/-qwV %צMPz7Nc&7l8CqI qL5ܛ'g?dvuYY2|) joRT;p }e1\_@DevgsX2{#堝>qϿm9EcW{/ho^Rg=NB^_I]DCFVt>y5{+b endstream endobj 97 0 obj << /Length 1715 /Filter /FlateDecode >> stream xڽYoH_)VTxXA^X`%fI*vVBڿ58qW{<ޣI>2FţrdtRѴ,vҳWkl!ges9 R@M}x{H3 A/us )!/}M&g7tnHdugk&w=.!.u^5W,nJzpW2; /NK8r"@i?9Mc7C~qjBNx6Fƣ$dJo_[qV-vdM?N[yp!>^t>Pt%gb 8k "6(r.WEzV0RXuEXRzEEVT$C!'0:/{@MEn3?j+1}O.IRtԎp THċ?*o ƌ瘦~@k0Huǵԙi`˝w@SK~Xo͵P;̋yzrIxy*]_8/Zpb0gih)ޏs9g6A& ` Yҡ\)RM͕--]f$3X^_!!!C]FR3 z=,u)Y)Mj%C15- 5)-t!|b_J5'" w#a?Wq=W nnSV*WٞVp46))iA!,A@8K,tiLƟx _OQ9cn9zOBiۗznMOl0ֲ| C$k 9olT+I#kLJ_LutFcғ[(t>d.:hx' YImz@KZY泞-|Psq/IoGBa`'2pv'R5C$?C/}F e8.أ TuSY!ŠŖ3ʏ%&ͮǛŏДk%00XBd!_SX> stream xڥmoDߧʧbwB4MJR*6o쎽/BUۻ3kZFl}q1ֆnR4yֈ^CC|/ى#֪fsH VTh\2\7Nz-36:Yw2=?hx#Eݫxde.7g6O^/E77Λ庋1gaSC:)h;8xA k܋%v|k(+`\BPպV%!R_r%O*tE#JV@UsЅ]Rp) dR(!C^HȎt!v(5F ;4V!TYϽ6KOg 숁o Rp$M.'R<{d1!sPTdmrPTs!G&I%ЌdP?D ,IJAYϪJQpNNLx2)cU Ag,5EJBylt0S[U96/I0ej9;1$7MM/cLPĹ\w'pxι  W`'.tJh xyS Rro?S(:=V eW=c0&ANA)HDJع@-bS?7`=Mub{ :}Qq}q@t ~^5˪P b8lF*X?7p%hm.8=;Fఒ!W#He6Be)ᙄG mXw~ h2-y^l\>Whqx" -} vY}3xk˴~ρh}nVygۏ44/w2H@oi[@{l_%}8$Uy.Cd:DayU?"mሊ4 endstream endobj 110 0 obj << /Length 1839 /Filter /FlateDecode >> stream xڕXY6~ϯ0>%RG-ICE }-Dz79u4yD37ɳ.Xkrbb$a6Id!L'68mq[0y߇% F|5ϙMy; '3s oV(k_1#m/B" SQf\C0RE9yoЋNyYkL|c6`IZa$!>xt3?a Dw+ M 3QqZT aEz!-U'kt892?ǚ8dŠ,wS{8:A\e8HvsgmkF-~(Q- '$,ֲ_q @^[PGqf$JThԛ­RBd[kDW(J=da֑B)0d@XW3^\ĀYDôpys9.dS F҉-ԪP>zG %F!Qy7@Ԟ*vjQ.;g4 \I g8nQbz8{7y;ZRA9F4k1ǀ誁4 *<͒N5b>kCotXBg&R,Ѹ}QK)gh8nSN9R ǥc#=9qmzvhk?iZ^'!a 2^-ĸv#j F*Ŝ FƎaAܞz TϩF ds8$gqGҁn,{GVynFsQbDJX uL |Èj\ b,hg!pdI4M6-TkiA̚u,Nk66b wܛ;ej[npA:ܺ8GhlBw5"ʙZWcAVZחޜ/6bekB5`~:1&$o"/|Bj endstream endobj 114 0 obj << /Length 213 /Filter /FlateDecode >> stream xMO! |"8x4&OƃFduvqv!)BdRY S'*י >OBq`FLZa ,})߬#ƺJ[r&JK?d5JMmϞ:e])m/}bͦt/kѿr.YV{ChT3NNy endstream endobj 107 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./Trees-figBS.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 117 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 118 0 R/F4 119 0 R>> /ExtGState << >>/ColorSpace << /sRGB 120 0 R >>>> /Length 769 /Filter /FlateDecode >> stream xVKo@W̑2ݙ}_Ai*TZ% )mH$ ڿ]Ī2|7 @UИr3-l!BOG_WoOss 7cJ465l@F!+`oЅ &1[T܏p)V 4JEdP0z`ѩ0z]K'KNg?]iCy(>DʃClPBRcxChm$Y SbH_5  ~שxXp+MqFH(#6kt}t)1ђOa!UPAPAD=z 1Q@ۯеYیwfI~N9ml(l _졹eR rmP¿ gR70,na6>MDt8Z  tYg&*2@~"9K7PJduz)60͟+D:,\/}ҩPђd9mKrFXE}\jg8-j대jQ|Zl7tRVz n&(NKOxui+J穪Wjth"c{ FaHԦIa=tP);IVS- p:62裪adev<ٖ J?t7lYJmړuӷym`Av+lˎwGFe㤵ϥL=}6td_5! endstream endobj 122 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 125 0 obj << /Length 1657 /Filter /FlateDecode >> stream xXYoF~ϯ

nm#Bp@I-XUvæpQr8;;7<yDZ p;IDZc+ NGVliܹ2]H]3p<X)C2~pk s:7;1m1~;vt|Jv2{Z[mVIH}J.H/@髀|&?1'.23uZaWה' ٗ?5YײA`hR;BWg]v9?yP>1Ŗu&<S٬m}]S҂ 8*7 "TCp Þ!bܧ!ԗk\n[9/F@wN㋗}Fqh t\-!$"Ⱦ.# b:U>U~ υB_K!7ⅷ'psb#97~ =Ў&"d1b,& ~#uq#xw~(r~׀F .q''NL$ג sj&*%;H*'8@*ZG$U]=Z7Nk˱.04V醴՚l>5َGXhVvoeƂ)$Ċ ,Osc30F>P O<4FڄS\Վ]a:ɃeQ-bA2` ]h34^B?F .Q AtYF+yJyWt.*+{K C4[ՃT>P>4duLuSv 2 ۸G?zmC-~XnʟK\DdxK ;p%?{nI o) ٕE[_e`_/pLZczIy|7g{i ma-(li#5 zƮ!Oz:ZjA`y3LP5]I"+rJ%+t;@ZbMY@zͺ;[TJmwUB*E($V ܍!kPhSېCZK|_AyՓ*ߖGV$kewZr&3vc{'Wկ|~FCfԽ2DEDz/hW?Y_ryZ~IF5kpn_M閻֚Qlt5 >L r{zJysZ{e/@o:O9~ba&K#2V rÄg^/M?N>3.¦>@*MV-17ZP6T, $e:_WhПqM|e!sԄ'(iٺT > =f^i!H~j ‡f_lw9(&`Oh3KLzZ9^B-1<nKo5Q;f[v8fmtoiAK endstream endobj 130 0 obj << /Length 2241 /Filter /FlateDecode >> stream xڵYMsFWV`qU"ڊ$bHHbB*W?=e[{~_on^}j#Upyr[R>'߲F:3p1[wk֏p ӑ7Y+<7pp;5k26pQxft[yyda/B${Yo;^Nm T%ýf_DpNDl é|BǦwluL: H,;!!XTfG©~ ɋlj} %r,) qZB,E_d.C0T-&q v=( Xݮ C$ nu#b{r]7!K8DeKG2!Ce~@Lv*rW޷m2ﭦpַweM^<ڝ˧fBO>-ht5Ar.ڋR+'5 &;J uIKtwm=V%iRO5C5֪CErsas&3nqexeқ<;Ա %!6PdmѴN]x[|&}/۲PnnJ&y{'<Veel$l! 6 4|W}`|!*XNΏ]Nq$K[ iDyמhA һ"#!LB. AQJY/k K B=(XPNX04K+8j+{ߏСxa%ӄP44IY\!vA*$W"7:kݫ>%&;9 uDukK(u4(T"!;kv] AѺ$,T b}pL*p2k9jHP3g|a\"H$,mSʍ'8cRHհ|XQt>MAa/ `P&8 M(tf\̞%sQ唀2SRPɖw{&=|vP O+5S\}î%xlPgǴ03EDc7zl\05>$n|# thgqwew_`o m)ȬpkQT?w#5l2F))6C]ݕPۮv[`czB[)>C\ٚutK_]{#g3)pmM'RtL2=^wҿ/i~趮KSFSKmU)z"^%Ċ86Elpuv# co #y=;cC5 PC}Kr|,zZl;s y\1.N Ts\?VNg }~8K![?I8xT &?5WVG vp8_:y_H< endstream endobj 136 0 obj << /Length 581 /Filter /FlateDecode >> stream xڭSn@}WіzEB"}"7 󙳗8.&񰣽̙9sf̕I`Vk7R'tLޥH~ S4{EK28=C~q28)6>Ի3VLU8dZ Zo.ɼiLHW#]Kk ϋd˚<'c"eUi~%Z2[$)U#u 0x;'ȑڎӾ\Rpn|+)to`{PЮB1U)ڝVmGQHA)0:]Ů O+kZ ^Qz=]C]QT-5pFQQ/U: %r ( ZG%-NJ",׀rzW{ÆԾ;ԃA@1+P,kZ.=8$?66h&;(X^qօsPlw}  Z`1tMxR9rr: !0ކt؀*ՓX endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 795 /Length 2160 /Filter /FlateDecode >> stream xY[SH~-;EM-%jg ڙxr#Sw$aU$>ۂ02˴a9Dʂb4<R&2HɤƥaaL)d`zҨ ShV91<) jDCAиjapI&,5ALH7{砟4HH|LFo$MBg 8Cڝ)5W&R8Sv88,(\Kͬazz?/=0,89i`ĽB){V$ZmFʹ`OH)B|fT0#$/lIaVFYh @|ObQqO$b@ Oj" Gp1 < ROtj,ы>ά!Xk)zL D+hA=1A )VvX`!KXx ZsK 9i| 5C}f {Ƽ+ꊋO7gUy`Ǯ+vYvy5ȟȮ6N,v>5m1o% sv_3V_cY][vlӬ6oeuêy^ƺ+.UͲomz7Lp쬂Yѱ}fi]W˷ȒOM$u `$c[ϛ~דhׯd_'.-~>)#Vy[ђuxaϪi &7MGL|$/|>.}4&,o@׮|99 GNu`$Gdev^d|j%M]ůI.rܻtd&- b3-DKNۺ-9 ~/zu6U4bV`}PKUN;O;Y"j{+B_':N Ԟ al辡 J3l {( <=ˑ"H^+|o;px~JO1?gҮfu3-ð0ahA34\PQac@#N'bSf R X46tv9 jePI^J 1Ć+leWcN˂p9^͚Dhk@'cPv-t\)Y+Y'"}l0Nь~b_]Pxb Ξmaϋw {iss^RDgܙ~/˒k0.L׸W4RE]c"IuCh#eyi|Dj+wrtaiIk\͒zIC4BR#dHm!~B1^R^pxIi̞ y >E6~\71|JĞ?f+ endstream endobj 139 0 obj << /Length 161 /Filter /FlateDecode >> stream x337U0P0U0S01CB.c I$r9yr\`W4K)YKE!P E? 00(?;h0a$>z A?$h LF N8\ù\=Y endstream endobj 152 0 obj << /Length1 1937 /Length2 12580 /Length3 0 /Length 13773 /Filter /FlateDecode >> stream xڍT Pݝ!-ZZܥ)ne̙]Y+ɳ/P`,l %q]v'  =r$m Q_ LfvȻ9<ll66@w  @rA;y:XYW9OwPZ2`svuu`e`:D6u d2@  @? xۘ]\-@΀ 9E?Ɗ1`; #@ss `icH+~te-0ڻ@{ٛbjÿ;80omr;8]]OdwOֿ_diha 7'V-Gn 9ɿlDHȬ@n666^~ܚN?8z;o4@6$o;;;`qD'dv6lo`7 ;{c*))J3Eo8#`gr|7/?@c'%o/&aoe<!7%uoEnc:{e6no~kB-N!bVE#B?CSx noRqm.Sz[M)hc8y@gg'ۀqpsߖ8]\o|`g?N*?*7e8r ^߈ 4Fo~[>?o3ۿ5濒?j/V_-?oi-ms9_ j/ߪ|+V~XC7۷'ſo9 *p':[nWkgпV_oox '3wsv~ަ'd6 i*F;!ځv-]4T=d> [U۫Q@~.aՊ1 ,3Qsuɝ*DtLEEϴ\iGzu$JRsNrAw$U< bP&/gzJA/i([TY"M= Z=j^/vz 7uY$g ϔHr;7sbΉ^ڛ`)6ݕ#wyZjxn.t5w#uUJ(f]743$9ڣ:m\KL=\:ngl~׮0|98K4rwODAXBBQBX<>@o^:ӷ<ӕLtL1EIz_տ-^M0b<hd 940wUC-\S1PrܘvWtr\ǎXIH̢* އ9\gne-ז7:J8g׏lξ w_!at=:%pWbA=c!0eca"ıc:\%P@SW8so\E%Sҟ&"G5҅eU"K{ة\|^ (-FyB;LB!&Yj!H-?Lu?~4fɹpO 6{!ѯ8[RՇt8HrI^OgF'< [Kux&)ߧ[p/röqcSğJd}"l0\3!hM#z^<7F,G,B4{ڬT?eP¯n2 "p\5`E3Ա6xϩ LU_8nhB兠$Wq:#_/v ~g<5OrQI$fO-d+A~ĥ*am/i#`^.Ut@*;KU-h"א`\ko7TyA͍D+Wm&iDfJF:"taj{w:PR50&)fWei }"Oם]?(,Y\̂cgsK?uC 3: M>|#Ď[p䧄SFJty<ͅ׫}U!$6fE-~e0x]NX[PؿGo.̈K9MȇtyB#7$m6 ڡ6]K_Xq~MHC-ŏwn*f~&k/ArBEȚ(^.%'niJK坔_:gO.w dY$HH8RS q 3Li3k.%~ΪF&}Dm 3_+1&SPS_v\-}L!7wx*;Ad=>ŽF1IcKFm/uTdcWV%.>Jf5oeqPv 60hE?i9&^5I,ާ K!M\Uwt 8G?|5_qIR}:p'^y^+s醢^ig'JVde:9R#}WaWKx2޽<ls^N}Vԯʰ6gWs%c)`18E*эWa~lz:k3W1ciL M܏4iYz)[ IOM5d,?@˜ *}顤P#">FZ ءtQMX1tI#bsdiJ$g/ |iRd z.cBTkN}Y`e9Z}4mNj=ip7u%FAK&UVN4|Vޞ*Q0:M@O4yF{{{XlMYu4ULa'ՋE+ѳ0  ,ChC} %Pt{u;4ww[&g Z<~rLve۵b}ϸ կ?l@AgX++6?zDsX-` tje/_i] j/;zǼܩ c?}#]"ҐZҕDSGGbwd=}7Vڱb$n|\A %)y8Kvj"ɾ`< B[*28 Yjck*6OźJD^*g½+G¦c ?&)WSH诧Lh<+>Zec{&u$Qomݠ&}Ur;4!^(f~7.~1ScWW(g>|݃mDgtg=oKkќ\T\E{Udw̏ACz:(7u=s J2wSiEI[vS .l tۀum5(+qIqrלFiB+!"-]Z%ǟs:ߌW ѼdjN6ʹ3//&"O,VD<2H/CdC 87q-R߲OBC@:Xm&9jeEH9~+Y5 e6v^= Y:?;$"m6o.i++%,0F{(q>Ya?G 6½Yp%gz/%miLW]<"|23h%xu rQ0!-txJdnYϐ$H(|sQ`Śns ;{P8cjy1xMx{+-/Z6u|+g$crHRCQKC3)sѩLOGeBG֓ެ^ VAwzs#uB,Mj.uW2^Rart_<%Xa/9COR?]p$ݍ8y&﬿wRkTl.z bF/a02vw䎼@z>u̙Q:&$c8)5-;A>0S9`<) CW˺C~~R<>Qu/X[̡KS}fTl:p֘dk䠘KRYQ4pdZ`ëEY")\&ڟhtsVZugčN~r`Ɍ$n16jtQP9n.MRe!k&ARջ:8P7@<9(x_/ ,"J8a .=xӜr3! p1 @jh.3Y5'2h~v! fp~Jfј?Q(92cĘ\b!g}&#^If@wE`I]bî B2]\)NT4Ef`!O-kծ\ o"<"Ƚ'?-Vm+K=X=tdD2 C'~vN)RY .(PCvaoH`XF|EJ(F=sRp1c]4*lcIiunjݴ2C"IC#])!r%ҔF1 Â}I8Afoʢ;͑"/IqbhG^f?FQ+f}7[49S"VO濭 ~'?J FvCA}'z@zߤ[d+Y[*wC\Vh&w\gU0-bmFnʥ\`"S vK'|m%#fh >@C ]c);mkÉiBmSH4ߣ|cAWFgUlhN̜RMevId<%vD FwīG]y9%r-QPJ_ہ~N%t$S`yC򯞋 %ƒ"dVHg/-6d$b8Zg_f?CY_~U |54)=6fϡޜ[{Qx XNrwB|XJgx)]6,!1COu_w%l+ykϨ : (Q&_i E#)"7&|@ hpD^brlsLѦ*I j.@gfDO!Zgߝ`Gm(Ru  WK#<(]ZwvQjǕwwz> h  ^>:pN &jg!to DoL|3ޓR=&rgilDSSvO>+92V?e~'̣UgzAQB%2_.y8:hq S>f7C/Ku{: *Na )rihSt,P4iY,-Hx=kEԑUƕԉT%Z$f\4b\߫ʆ$KSu >1QtU>ru?]}S6tŠOE&qg^ԡҋFH?gk?[ulIc>0F/Δd8*{>W2I@(xb ,*,Ń n?#fN.|I8؏BmbLL&e}ZSן7+ d =N@l6]=E M-r!o`vcY9jvخ K}a{$ y`FaJ 8eAChei $C zK>W+f5/g0[b-VEՎ }>𠥳gH.DaKΧ_Z?5$?r!LiZB{1SF!͌vlp:㸉XWKgNK:=v/y '}jNBVza17F ˹^WV<Y0q2S;Tx]y&xPTŠ3&2B6M\,I֭5Kc7R+n[U|9T 'Jgy/ˆ}HhA6w}M_ay8I0>}7)g =L>T:3=n(!樘dhZZ<ԋ麟9{ M#B36g@69&X{/OfR"6ť>V&/v;$LA(6 oz ܩJWP賂iL (,=: S1w͆.-oJV ք 8[>/`_\*)/, Zcm.0CD{f6&.؜@¨ϖϖ]:vɃQJhQh7([}g)_:l`M + {%QOi?~S_lM]*7l*'h&Y-%Vsw6rSrxD=$!hX~?IgINiYV1M 0]&7\3rºF3w%}uչTJzT.ws2]d'# -;}ܬOW$)/0Fw8 n*qԷ/Y= #G8-&,oomH>BxpL6}C>XRCBӐi|qҐZ=2sԂ`vOrՊ<2/dF3ھm } ry6~h#D*XE^{͙vHΕ00o+<-KQX5iIr7݌+JR$y|FHQ<69\p||GjLMQ AQ9UƂsꌮ<'4LGX&w'C$CKǗV^20Gwf[H<2uZٷ!w-~=.x[=AYϸ,nTT6G!Ж(v ,U#^ V ɶ5cEqU@ʹ+pr@>@ఛneόf m{b&\ܓ_k 耸u,fcz-BU5"FǢP]Yqـ?ܜmŚ֌'x_ g1"ɟ"/~ ɚʣIL~ 8܇Z@k=\?ȣ ݺQ.[Ƨ8xvEi9Wݢb jw3b2u<pFՠpm[8Їtsf5Am G13/EC" vǝ۾}u 3vL Ǽ-M0xN:E;b ~YM~Mض`ÐS!k,nVGhxik;+;#ElsK]-KbCwA.^ɿDW4u\ )6@<{t8Ej )r`9LAȨL|G]a :c,Z2KeRE r\!fTz{jV[ׂ!Ɋ 5M,XeOd w(r26B?*׾yI^N ,/1f5.c"6&/ṳ,R0;7H-, )'+.C1R}3d?d' u`gQ2>wnM+:t Ѕ55C?W5 Nh(w=-4gۘPNskfUl-=dȘ`fuH6RW 'l֊9>u z;>7+L!.7v@754db͗#(JrDގyR7@&$Y,:@yrc|65Cvɴ]ȕ\63w%Px X 2zn|#>aNYq4'af3o'Gܦ[Xk|OO~װl%(YvPiz^1eeٳst9DOV= D7iL݃ ,kdd?ѩW>  a(ތ.:wGAJݳ9+Pɗ~cQzI0 YU#!&!@'y(wr'mu( 6;]na & ƥC]04$h,Nc]윇gnN()v1n+{ ځ=)S" ?^?&N}C xV[WvgVW-O<`WSo- }e=wwde˅n,s/ ,ɾ~/;k{'+J\P,f_PA+?cT fxU/k#pg] 8^ QdƕU"^DC }܃K8dWWa x0ra'0)~bv@`QuH"\Tg®LMMpdv; h6~X*R7-A6pY#Pֿ4Ml?*Åg"ϪEϭ]D`,]Uy22ޕNM-A4JXǹؠKzbj+uSg]]gWY|{{9dL{ ?HNwOՕpDjKj'wr䟣)eQJ:/7 ‹w^hpՏzW{S`E-DZ^ i9c\)/ĞTgR({ (XoΔ)7߸:vM!^ @PҺWaMiy?K;=2mŔ԰_g:rbw^B~QǼGJ튖l  Kg`-u$:)ҳuɎ:FrٞCǖfeQ^ 2gJ_Oa,g%5kY0(3!X|,PpUoD5Hf Ǹ<VéxKA@"_ km@OBx(\Z56)ۯ 8>@՘J} U.(wev߾2xeɝb8 / S m cdFgBJPtq |@I}M/VxnYg}Vr(-[ mSOlNڴ.0 D$ w}±51\}k#>#.Oxɞlj OxJT١ aS-Jf/ȓk0G@_8UnM߹LF# qF<0ϧ,0i ܊$@MqW6i䲉& n od~ϰ??LE*fL %`͆#"OMtW>vBIɦW&wKOLzmkv #W~%93?zq!4H[|uөwS06Xc.3P]~0r-!;cK޹IqE=ʄ#3W#vFgN1%҇:YcG Ȅ8_ 6Lʠé:2Q7]תf#ηF0%;$*-L=G=)$O?^jP}SNru./ b,Eo}{\dY&W:-쓪65aP P  y&4vɃ-Q>7,f4 aDZ)z}{1_Ѳr$oX)hM b ]\.@VfRu򉷱qJ.+\D2OAbt5+gK+P}Y7l ]T)4FƷVЕ #EQ{DֺuA (EM#ZRE&׌ hyS&H^JH[}YȖzC*ayc-}}ܤy i;[ǙYE.1̐ (?1}Z/)γrZG :҄;%TI2$TO%CEvZ^t endstream endobj 154 0 obj << /Length1 1631 /Length2 11000 /Length3 0 /Length 12053 /Filter /FlateDecode >> stream xڍPk. u!0; ='K 8] n#{vޚi}鷾bZ76 ;@Z ɅJO vs-FH,^d2n/vP@B.NNB]2`k*;@ KC]vn/i`bYtH:\V%@ jyW&;77'!OOOv GWv3+fxrx PpU;*=@\ jiV 닇;xIRT; e 7 ;#򧳅 l +b+`ab-r. vD?¼tYb- utA\Q8 dvo& lk?vwЁA2P#x999 gʎN??/:A6/E6T_W O#T ` rXlDl/w{8_p 9_7J :,Uo ` ˃wUR ߇GDE  W /Wӂaw5 APߘ (7T3-Pe-T/_S=_ ;Ve=$!n#UYšM%Ҁll/Y}P\_f ORbcx..ި/A_ˆZ6u{q1QA~? r7pX I% |f d~%"q@N<|/JPX$s|1q|'fZ2^i  uij%j_vS#Ic\t^3K&R suf˕dP7,ӥ2գz-I~f o~.NOGBΦ-}g^y/}e+?4wʦbtg,i(_za^^L4ڜy=o&aCMa1C3F`V3oX|]3[2`.V6TM+61[ήfm( 9 5ݐ۸SγOK u`rZYn/K1|Ռ n96]M}v̀`$t!#U͓d✖E~. PRST?1$I.ڒmBa+ɩ7(1V+)I<}3^Ízƥq! 9O$`Ҵ;e6i4@B\7,7QW֚Pҽ, Ir݈'_k3 VZp"%#[CDMn\ɸӋ`KtWjlu?Q/y-kQd]Y1lM&lMxo6W5)ע֢WKaàeޑ3ȿv0zoq9XχOѧ3!sX ьu bXKn;ϩF% v,Z+_{]f?q@ )pJ*yhLu{#騕 jr +o3,wCT X6>Dzl~I L sq|>vM8ý*Zz=zy MGC%Bf 0zxBIA۰t uHc2`Pqۄ倇.^`}7+wGզYO\mȈ..ZS 8'\FBE!b e,,է[ϊ$,jH`Ru ` /@\$zyy|l<n߼K7 43F7OGVj7eNb\JR pǑ_m~zhbUm %ɻ5 Q4gsb7Dz +R}#eJF//f YBu+'HxX d%a}Ky͓0k7!*a)T α/I,B]R~BV1:$T0 Q̾'6&1<*Qzk: U,yᛦSB8iY 1HZ$͗B;nJ^_Bd8凅[V4_Ŗ$fl>w&,9H{cQz w&}Z,wWZ\chJá)Lg3 tȔ-!NjzH?枕 3<1:zz~ GR R`ngag ~([V7RgJ-*j!3-8vF*vel?iNccg۔xcD*ƛ>PM{+(q 6G|Bk j|Dۦ72.=qǴeZG?\Ks`ZޝL>a Xt=3uX 0wBdٵ)+58Q5_4nW-G, |"Ym#nv^9o:95pI!sy%lMn $醃,yŢ`nkBhYkXP9$W[Bnv(z+(2灐|oxE6{l^2N?;N-cl{s<ܢAHHlQnO.C J2<]E(pސ}~/H~@޻ƦqB^cbV;\D F5 Q9L1 Ý(KS?}r-oi75~:`QsxD&e{h6%fXgvb'6޽^.wHZSY䫻mmyLyJ>g,vM:ui:GЯ ' .>)@_TJ #7GQ[AE߉6Sp[,xKEũ؃ԝ=4V1; (NW0($Yw#5".^"6@B\gxO<f6@ZW^eeЕB`ÔԹ~ .֐'TM(!f,gg!y&hHWFicK>TK Q> 㫴d aH6FL;=k$8 R84O(~o2ƽ |Ϛ}iY܃^MTTZBe8G+MnJ HbyǙ.߃ILjĘNrLnxF{yrجj %xHZ5.sٱߓTBGr'D{jhHZ]k"̭vzA<6r2vq+__1j!LQA<Y" ՚d &aW_żA5t^rM~]t;zz25#{gŨ0>T^KgO͘S؃А!"׊3 4':>gC;r6pKa%̲X:wUx#γBիvHhmP fDTe8ymJ?v~ }\‚{U" mۊ%OOиzEI捾X7.&=(e~!$?':\&|CqNgHdthOĊ}f0S|5jBp"’֊dAlX>sLecAl$ kzZ?4ƪ$Cz {WLNʞp-N*hwUS ʪ&,J}ʡÅ19lz ggIs& vy׺s*|>" $B|FL.D5̶>4h44 G^C ح7+I%>KV)UJ7 ӻ·r j4[~zG먷a%`]R>AeWp2O(@j:Q6t`%/H;p)>+xp\u`rTK4~o|zT49~Nq$̪2Ag$ epFCї՘L5)],*x:dp!daրj~H8Gg R^&Y!Ț_Sp#KsDc|:e$RJsxh N9}͕vKST"-@j&&e8dD!/ߊ'x E+Lte]3CU.ݞÅݵz{(~k `َDG̝1$$nB8reսʝIRL bx:/H6B0.hE,0޳~PBIO}Ko'rVc)5؝>IalI?+hgSVgFGcWj}\ !důQbYg>%eB=LC\U2ub y.$Ƞ"U콥m 6TћgLCAFrb1asW~:gZ`j=4nv1)j}!!\q([(ܟ8z˺hxpGګ8Q8Ya`{&Y[*f@X _ܵAu BUMBMfaT~Z~Pd1)}Z BF-BZhc,@*˻.VGMNʦدJuj]NCaDt_o=$G>'ko#]Nz".qODkv6nb-<+i~jDS{lSuk 漹2oI%_41<-1cwSel͛ y21vnu{!jǒq "F#dd@M q…q!]; j%s<7<I8hs7Mpc2QHKGuUv~ɝ82N8MeN΢NRޥPr_R%dDwGV)84*wX矀ќ1|~V׍5zz^46׷u%SI2쇵*U"˖]9VZEh| 4 wbF=yM.wk`-_Da?n}$nB K.e[3.溝#-[ʢ[Sr!ib|ғa-H`[&C;ϨW! 0W"D2w]LܺNCQ%_"8.ay%)ӄ;儓} 2̫B-LpHNwr6xjx$W$C_-8F ]1㨣#9䄶&iY$}tJ;UwyRlYC-b!״3wiJTeU8A]wΥ/@zRZl{E[ lŷdb]FzN1.m?OEsWy/ɇeeH6S7_`hȰcP8icb^8mk<|7"iZ4)/: wn3fV<ج|R5<!ODLOֆjp$"*WTqfLt2 ^2#.b8?l(U&(  XvĴ)WF @U4B:'qt葐olk/2Ho,KP Ox4><\}1䙺4QL3i$Fz=6]p<];vAZ\O3-IN/N983V .n\0`-υmSE]; Uԣʲw9贆ՋL_ ڜ< 2%,IB6m:SX'1]p 'B3ݹ{c:*/ Ezl1 c133z J90mw&׎^m;oN?uF4i+;qY_RkILgM%eG1(`u 'l# .\9Xλw ZyJrl8L,v1g$t! |Đ#KKb)wl Ƅu;S[Ú Zi4Ow?&XLZ^}n#<0}1O$<0Ze$y ,qҀ|ӻզ#/XE/zgkRuRLZ5:4 @P<5W. 2)Bd+G}QT1wKo?E90P 4l2&Q7{?^̮RVDauUo7;sV̼弒< .N=b׊Y)/uj_a填!n~kG13Nmc~W[U0˽ͺ rpL&pXPWbO'jzL@*=1kylՋB4sG|Z ;m ]p endstream endobj 156 0 obj << /Length1 2587 /Length2 19578 /Length3 0 /Length 21053 /Filter /FlateDecode >> stream xڌP\$=k.!Cp@p!w=3Lr-ק볽rbEzaS{cG{;zf&23 \1:ގQ' H&fHY<̜Sd`Ki; _포]21 4 O  Ts? Or5r]zPqɀG *y1Gdv=χ W?$BchjlA?Z 0!-d;I@l~=],L TVA]vJH 5w@N'.@K_ hhoby_'N|O#{٩ 66'hV8uǎ8Ս ыI[lx{RǓϳA^S%'CU}^}!{ ]%<*V'k9d+fcbt sI`\ Ѡ{ ΡOI'e-d{XZReq!&A9LZ\4kr6kO^R| C*:f]2ɶ8 -%g3B囂 g#2<^c~!,f&Mfj#{8x~#RDs,ֺFn$Cqm5UR^nG;46&=Φ8Aubxs \oqcISs XG Nੳk;#w0**ބk rPKK=BoM~[G ߒ{ +Ҩ:+gc0WAFIASH=+cnx)i.({ P(N %eŤq֠4J9pti0Ƌ=xj[́*u#dA jSF* Rssl})2ڣˁ!!d*@{u޷p0UYj/Оg7)_\S0uFOL.oBOqz(&"aN -_ɫܧvSSr 9*F g2cT?`d軍4uc Nmi*D8+X O%>Ij%o&5EHcm9f-8u޳,o4O'io]gmt*S|A=o_%@C4;p-7b@P<ѐ 翌T1ؔ7.i%u 0h\F!/yF 0Id7kAP5C6 =*Ȋ*F\8@Cvi#yIXom-tb0G$j3B->|[/T '].){Cj7Ϛ7sD1-]yEz.fqOs#$͏H(#=H$`yibjh!2;[rծ)뺭wGNuZBrvQ4 q%X ^y;MKa?򂐬uu˱!M;zC|3k5 oL Wa+O ṿ8ax'|0? 9%R)D!zbRhNp9)+u^'7Sy]!XGͰx)j:*Bk}N_&npJZp"Rwiiz}(Y6Wi8'Ӭ? iTZj9ؕQW&fu(@~wnm2``X}@P hK;h@\gAiK@pkne]DhMebٓc&;߭#i]G9$o-,a&GAAt-o;Cd?=юI pTwSn±)*Qùr%#{'IQJ=}ōgZھIJ1ȿͼYgB<Tj/Cv˟Ku2Wc*OzT";oQ0@lJܥ LsQس˽_R3$fn}7ɘQb$B%ׂ.)4(Y-UJ AY5jSH &pBa~\A5}U+tsvz^K?Z0O#d %̓j ʂP'kɓ=U=i/&'CSEZkT!4BQ.pu"fY)4Rޫׁ/XXL oh2ڲb$FũfR̟\(Ǹxb$ W`aƛ9Fp3i ʝn9y߭G4vpy HuC}nqBJh;G9'1bVL8}O{̳30r9kޛzA!.(bx >@o8LU[-{Lp1y0B &9TN;nHUr\=]A{#}r R=p]:dbڋ(VAɖ> *C"^ [YMY,%Q6W'aM2.W5pI64&.;BeD? oscj{LNPA{6 pa_/Jʼn$eDTf&`AC|M\WEgU{߉1v!tGJ:"X ̪b`Y3cz \ sw|DFIɬ=}YvXeۇ%.4obf+ύUBujIJpt٪(~^*! 4 |J,ơǰ}O|LPF FƝYC0z]IS! t9~G$[)g)Ӑ"vk׮\1wJ^:a Uu[f7^D<+]%I9nRX漇Lrfߓ>O Vqsg:}<52+ #*(~Ǡ/m2pMi9<2.p"nsq\߉]{9R%lp]Nyzw؜h&Ӽ&WR/lՉu)Z3~L }eI7z=9WiAE,wEB prO?AZzJ6YSuqu/-vMbS~ /X]dx0QhJyIR|rĆ$As3nb{ ֿY[E9MR]ONf`3w?[k3Ϣ\k#!aܪBÐe!,-AJ %L,WtlCIz3A {5^fx'*/"L<kH]3Xcq|9uJyԻ뼜1s uPD]cpW 2 &|w"M3 ׷B m3^)?m"r= ]i\+tm.;`q3mđ'~[ w6]iԴt%(ʓo#4fV#E7,W5=ڄTRu1 a <綐!3񬦞U˜j[T}g\265T!pg_ccc?~nb4ֽ9lpZh,TB[G?zwN+h2 M7-W"W 2:& ,a*8#|j-/P< %&(v1DWDdah9l'XoF, W(~L~:-In/ےQI7+8ͱ+wQZȝG c *10} rI9c@.6-/$G@dSCv.s >N%9'@ L s:7nZdᗎїΔUϨ1)ĥe>7rNMPb*kձT .pyMv{d;Urf݃.ƺBr{+=5ITnz|wd#WX*Eѷ%`@,Q,! 䮨D\cB"ReL_LIf6kvspbMN<uW{?Pw1'r5 ?py&ڊ}omUryթި@CjтTb#N}e(|>%Y 5.w-~v^p viuQ:uO*8/.ȓ 5cp7J38Z ^2 }T(lzB4{2DגA^IcKS\_7[^[:9Q2"(##e82e1G"RI*ӃeԿ5Mf>%4C׹t'?H9Qu+wIﴶcm}?d %ƨpx Ba$oU/<  't:>7>Bƻ\UNY* jHxFr+wgJOr`vut`UϨahN!N>#0i2E 'Lt5Z?@4 N-7\,a^7jsf¾K`=A2|L0D)"NxF8/1"86W3(dk/V„ evSl614閄dR4DuZM ή~N6Sxa5~=f~ jQĻ2W k:#"#zQyd`IN^$3_߳Qu4_ DY2$p/$QZJT4]2S 5T.birqq/㟏q<"Ǹi1 %6o.v"W!Աw⾑D縘nn֭2RwJDYeTQ Dgc4l2~ψ ;jCT z'C>~I yL6iڑ`.Ed MyffߧB/6{IA2~Y #W$9sBi\X=?GІ6|(W%1( \"v{.l M\)!BhMcbVą#Nspr4Bs2<,L92oM(ZO7Q\ Q Oڮ-FDqMk`70:իW_nqIwÔT5+s/‚Y/ÞJ=8)VS](qE7ܯ0gQDNa纎& I/)r~[0v}zGuUӪ+R-R| Z}9]_ǜ)󖧋0>,V0w,*qgj_=T#n>v1 |#=ĮB+uG ҺdK99Z(<҄˱HOZ?V =O7Ho1BuPJ5%t U oAMngHki6w'e\K,w֜y݆}jYOO}Q`F'nBgv~ ܱm^եk!B" }T3"VfқOjbYٖ AOx|0T||ec,Xoω!.#C>5 s5tNiWP)Ǟ͗_p \TxMe塟; nVX t`@M8u(|I>A&~˽ɞKUjBN 7XSuAglVbJ4kc̅ EuLM6e7t/טI L Zh[lȟԊ֓T4B󭛕?S;m&.er)`Zon婚q՚zK 50nA"7N!'1pFVvDI|iQ cx/t8gJ[stJSumFh},}*{+T^#%p$aLgW#WHxhq{++g<$=Yx/P#>AbvH9B YmqLќ~sMc5iޔ?̭w_oEգi$Ni~hOlN'l1qQ^i"+"g=hQnP4)Z^w*1E}ްtXyG/P m% ߰^Q $?=FE3yD}JVe ٞoM&Ybϧ=ޯYGm.g[ !BfFI91WW?[RZ6%4ٯ\lc7* q껶q]9yX%mF`SSDhB:+2IЄ^q594a'*k_:͒ݚ3+m8OV G7(@ф-=vޏ?mW~O#hA[n~d{FMxg*ΉXΎ 68 !RTZ#`FPul.tR 5VdT~TdΒ5|ל.iv:4qf!^?"a?c o8:w&֣ 5 寲^%G]O_;ˎ$! ^m,HU71;rc/.E \B J\`haN ZwUVfDGM:l/.FXxFv^@ϧ:ՏN`آه9#6oVጭHRfiJ(8Ef'w(!=l[zd[]8/WY@E?UQxlpf,5hiա ) Kw[7* }q2F[BE3Ǹjv9 P3.RqۃΌ{2;u؁ 5hxܢ| ͇5vA2,gď<";jMTn?-Ic3bӲw-F76ٹ$:'CC{DAo'Jl~_Ք'Kf*| -->T'o{kæ>R[(ER|%>AKۛKGŜu⫳y2)GTjýIQS{ӆDnV\dN^D--.a-'d+Q] h:`1vI\ 뿒xI{vZ1'$SVXsaKrV0vtκdl]Ma;) 6Dz AĺE[R!f٥}VJKf}X JoiE+td2~gRLGHS)/gܳBU7x|ǬXH[{P@YpnB)WЕڎ4 ;*CsƮlmS 7R}E4=!uF3W'QM:Zz:tPm6)td19)4|ssU^SbOn ԌPZ[ѥm\z!;SŝfmJdG'qͰGH|7Y}E=YH<*1{O*;yk еi n^#KLgnk$b=LpjZ*3~aёez15ɤ0X&w $^ԡA|s)".]pϼAA`ԹLC9azd&8mɾ*h-3:s kQmLZOxjE/"|B!823`e+7'],<1sCYHAH>{sc8nJӲqH릊jpg74aP˾ܤɪZO1>7fm<Uy'#<Le, m9JAKo &ypSr#1 ;vlyI^4ݧ|Hgavsu\Ŗ$jCJ{q(۶UMVAKy<B}d`(.ɡm?~#ܛUOh]{(ip'}̵b}EUBcciu7Gq|rOeߜ4exGe4.mK ܔ2AF^:`ÎK' oщS8`#RL>K@k*3+{?h؃33Tbw<:~QR6F?`9w"QXѝbnbAa|)<ϻ;@5kH -wǥIs9`!y|s#퇕<0W~)afӱ8vw8l XT8%CwDu9ۄudܬbU=AȤm(g|eYBu!T$&S`be³]/1w@J3*o$̥oAΝKi0SO!V"HOU Uz8A$LҾ@"@V6W{hTTq(wH> g.& \y?+d+JOY6{Zr#Kp_*N/&a1g6yG抿cY.`hv߱@UQ:0;C~6|5U-/8ReWZ{>μC0X2q2jU0Vښi`žI{k zsJw*˶ye ˀS7Lԏt~[>7MaC([ig@O0(RtWC y]e=#j[SFiuw$;"]F"9G>J.ccm zgDifmFfZfn~*L=GAmkghlF}+LWǬnu6-%iuP} ms!-۴*ff 9. ;06yϾEs,typ!"auH a(,Wp6\r@4>C 9t&m,,BCR2\QΡL')"pu*A־zRd YD*[Apx@1Va#>CvNlZl鹑zJu}t&_C>6K=YJMJg`N]h#;A\`EfI\ij!X5ɗl`%%wzNʌ,-1Aq23+,[:,Uj_"TGqP (5gT8+1螟L,5-Qs^.ֹD B\ 9<4d]؀{^3uѻ{1-n¢SE OZX;ESH"=g/sT$!Olv{KEȩT=NE0н\zlxdVV "TX9^F;Zbil7 &7eLb|/ zGm|f+wcYSŹԮ*><"1i)RK:8P!/Lzt跅 x!7km* NxW"R7X-ܾhr>:`D~O](AQk/hG/ O) a4yRЄU6]lxԐ}X 7kT/Pk g`|d`fVM↩뮁CLET5"Łş^L Zd*WhbpҶA'U3J*y&W$\=ڌf>kO}?ȒndjnO#!7DNtV=2Xy#V b-_!mv9EI)YRJ!)/ '4-Y %䴄U0.˰b$ ksoE E(e3UɫMڟsT f2+d(~LuGXYdg Kj6v(5Pi9gP\2J7))gтDhN%9*<"yr~~ҌJbF*|oL 3&] h챂^ݏ2}nHGuw I"( ̖'ϋ=<AG b, 7;?ܚ>ircC:5/zF#2L.,wsQ$ c}P#QF2I}t*ls0M'7^b=G]:(uO{k~pu8(ภ:EnJ7\h<tq@3fϕʢEYe l DMNFQ]y%yw;YsSز%Ju}2cXg咞u:IAYd[sgb&jrnbpk䅶w [1fLcO`Wm5jz1nCI kI*3 N'. \UW{MsWd/_+ӏuH^|#n3)~k[Nt]NC84}w.Zy$wѩԭ:3U)<e+$)ysǢ΀Jhv؜ ٻc8IeF#j bgL9e=R1cCwh΃LpmJSYXSQϴ\G'WG} 7{*M[NU쪋vtA$LW 0K`&W7)Uu\e`sWל_ߗL(Uo/v=R0˽_A1+v(Ma@Bn$}ZJƂYA4ӜAe4bs}N`06Z2蹼Dht_+r^iU>\)on&;_h'7ҏB&I[y;8ҳL:MÐ30|3gFK8AtTi4!rEx5}/ _o[BgpBG|f 8hW߈ĴR*QI֠q^D7fc)SCZ OH~òCOM9?;!cm;-Sl4mrNUT$Ke8Kݹ,=h4 e (eΑ[/'uD|iHC}>ډtJ2G`s?=f[qv=E qK71BS}ZdIY )t`A,#- EA:ݪgǷΑyg7h\V"40meFJ |L8f0t3 KSTg5͆4TtgxقW>O2.}P+ئzBg o̞|~y0\0KiyNZKoUMU1RC%5{D_Yz4Lhl4 좓2nb]9epFm@|;hǀG 'B\?M edj{W# kaa HSq ,jYY4%Qin!hjAݍ4[.-8{Ďn+o? 8Ohå˛Dن`"jk0aYnb|"wz m$=ǽ\C.c]ᖮ-üTIs6X&vȆ]֨Xt/%>v{t*xqiڀLf#3d=dv֩6ƏctUJ )@K9%\oy{~4)ݹG"{Ж 5=wσP A&ԏ[Pv6zVBC<.Ym6Yv&OxPP3R^ocdÝ:Gɷ)l("83ƧWhc1ohq[ɰĔRy 1|$y/K,t $`9r|δ:v͘o;>3^`c܅?%lٴLNe *27.I@_FH)Ľ9gPc3=)sGeB( 7qtuf}VI-d-i3{| &l+97 S (_ҝvyk$V,9]jǤݒgސ12Td^ϼW:!y)m vqsI_eJEKKK%;(F|"j޷&.lc&|]`O0?H|1@Sxw 뱼'Ju* 6Y;ۚDP56+faT́DžcanE[S Q[1iU͊B>#~%zby dH+ə+ChlN%@DI҇D9d+0,iG'`p政Dd¬:&hW)5ˮ޺8Ɉ[EȎ2J`1^[Aa4j\XHVa?&L`sVPӛq,wԲP;be3=;XUճgR[* }HŲ-Lhv3-ļo@[&#i Y5  CpА9EGݻp˳G@ O h']}O9a"-U B3֚\Т:pwC(Bk=xm (G+0 QH8|tU,9ɯ)j4n\%E[~-Y'vn p/5g]DS](VOO20QABrmF]BcosϞdrL>sc6qVZ wЋsג3)+jG zY LV\$C&ް5Xjc3X9 [Y+G*p9t{bz,uwDkS›tlWFX5\,iL- Q r_w_sn\)I)sfj2uoƭ2cod W5[.Oa_}?3y"s/Z_cxRT4 F*&]sme%P\Ƣn4j)yptH:ÈD%,,H.%˵D`bܽ1u/q*Rɍ/:| @%H%[KPZYl6SG>%m67xn4"JhO̦Vj, !7ywbdu]Su(d:Ven5E{$n?wzΚc_A)g&vGGW&ZcŽؚBq.L6û5TƢFuÁF|[iW-~=b<<}A8oA?܃F*'zDf^3izM+}F4n(m/g71\/,EB:uy$´8$_ qYt%yb!{tQg{:"ߒS!462o': 0? P)6,ާYʼGȮ̆.ė'M^ L#2a3n[ _&:b\|26*(SSC$kCJ?.MzU.1 0ׂ DH9b0 SUW^e cK#csu7PWnhQ~q1@<֎zk;LOp?0duQ tuĕg} s `%8Z] Pwrr .p?ҝ`F&xvzBsY:As4]x=&ht鐤d·D VF;: {27;h4Iz!l:G4{9 ?15)]5bU~8T46J2y40ڟ9 &(G/ }j?Z9UxTY)1^( sH嘻!4['T *3Ի=3/R75~$Ӆ Cb&!ӛ [.w 2U`Kp=Ϙ4,jV^794K~2 ~^d2H -f%MD⑑o$|kܛj JJ1JUg2b`@d '*bH@)Zs-Lf 97lW](sX;ѝ?4-vo#tvD#cPHorTi<O*C/SxG'uwpIN7#iSc[+d0~~O$k.>of^pSU*Dj(.ql/v<T%BFe3&xj:m+/\j.EsS1wJ򏴜)9{\/MPP[mcoQU#vZJ`7:IDg$>jQRj gց Wɞ# endstream endobj 158 0 obj << /Length1 1622 /Length2 9057 /Length3 0 /Length 10105 /Filter /FlateDecode >> stream xڍP[-Lp4H7 ݂![pINx$̝[})T5,!@iؕ `e`feeG6#Sk]@0?$f/6I3ח8% f`qYYqH,JyL-qrY۸#ւ' tYJf6@f _%hm\]YX<<<\!t @tvZ~(9bƌL дe׀Xz9/{:^4*@_0 ]lfaqp4{+="0[4w䛹_@ZL `Boz. GWfo,˼LY l)qp]]$h2v/N @`K$,Y '7!/&ج.VVV>. a]^z!Y_~}\܁Wg7? W9FO3/r O?~2z%l?".!&;+ */fߍ?V_^f/weȋ(ߐYRdMBnܴ%le7k 7ʹlcH< W $Sx)oU!.w |/fareb{عff^Ȭ/b,%,`K  D,RM?goI? b`X_*;X/ F/\,/<_*{5D 7g_&/&=K PۺЎ1bq]4:&%N{tduk̕m)+e'j& SȋxEb}H$L}|`Z_}srEW-+6>[|VaP,uyxW&RDzSO٫܉grdw}7yVjtR\aNK_)-laa/x6:B^5 c;Ѝ yx9&[C1NgP $iSۑTI<mZkΩȴ9~nEݟO 6aﯫΈ$,a}SM=U4񼣝Cm켴ÄR%YMʝ)/}$X ?k;'lYlC4+'1[p;ܔ:sWA{[6r)hÉ9z{SȘ!ZuFJ_t>dž1jϑ 1kZscZޓȩA ҕ?b %҈pkm6~੃L`6]f=QeNgԐY|GpꎬeO).*xQVe"zY1Q'REa=N%W;N÷h!2#*9~|eo0ܗpE[b,0Ӎƌ Fw6!q"-zNdJ2#̮,N"b \$q0'|pH0=eХ6P;}W^_I{y /Z>| zLө4 #ƚwH%VS~].{oSΪ$lg9%\O HǑHuu#S{PV@`\ۇ7ՌzDdC PR h]o$]{z_ˢ|I b'!Vn@ga) ){d3G晨l4ɤ]hN1"]0Fy-Á,(0 ʅ&Qm4kr#<BwLœX1:FBǡR=͞cWsqAzƩE> ]/ X6Gk<*3W+in-˟%\i}s/E LO.{n_;L+'=Wu"",;fc+0ܼB2+F> 2ŖՐWH ިr/VA`n|ܥ/bU L@_Xќ 9IݱY:˔_ WU8]-֔/s=րlqXR#xMX8:#M*<-/JKZks1cG}KӪsj_oNkTgqEe֎H5J >m}VvVlޮ}32 R@f_m1LpP^V>B 𛶱JPq(y-|lI(îd1-k)*Py*oH.ݛ[kv \NdCB (m(/[yW4?`ߩ`?+(gY"wvվjq墩h#W@fd# j*.FWau[:bִZ'9T8,MKd(G*n.K[͇a6!(ypM;%uY@׾ٚOOV3"'J ,ҠYb==]x ^fu R=jg/ԓż:,FۏVIp)ݥgB,䎖.L;QK@Խce7F2i&Ӕr=1X&,?0Dc!Bjd0vg)0m;#?yݼiuUi57`0W;77;6TϚf&-UN)loc_$VzggD6>4֔zQfs'RԕIT2UBЈǂdKqqytUZ3zO'}DG#YL6a7Fu:vRID짪&KD޹Td!|qJ]mW?BeqSqdT8m-:-y$Iv U7A[M<7}Uu\N)DmW'"s >M_+o&?Q8t[2"F?G0Ⓨi_ W`iHx }}^:a# 5i)fhc7g}a50+,XKb7UP?~bDSmaN^ų/LQkegUҎxDR!¤]h|Ju9Xeyx1 g 4T[Iix }@ 8{t ꂑr.ZQ}$6y$~kfg;qۣs6^a#["fS*Ƙ]RRbP죚Vjbw͢#WGɮi*9,;T}Rʣq6en Sl޽XEBU*7vka4f$ώoh6>A@̫ sӓ|7۷)c\4x pڌ]饭K1k<"u7pc,Ivц5*ze!ϾDӣBDm3. PLAd אm2M8*A)i:s+B:ܘfkdW+6 p_43w堞YRڍ͜LSȞ*Hf']x&=I $B7Oul JO!3~Iv89GnW0yU Ue"{WWʯDS%X ~ 77`6oCsV&A8½>p%D2F :֝H>Q뗄7@cC NjV)Z)i߉MQ>~zRa8G]`F5ԁ'?s>8,W5ApDIdV{ƈkPO5#jdm'֝KG3h?1d$u e@_ Ef6ߚ:l 9\HԃjDmyTG1pJ8b71̷o,D)3)Wąk/o-?-D$ qg13>kf4~:Q]tҰ+R 3똮gr{?~&b!+j5P +"Ro>+h ?rFgzūu&~^#w=סb~RtZ<)62/?6/4'};F^A{jכ'g)H{Ze^.{MLyݦ6NR({N324/B+e#j' 'N]ng(W^cՉ`G(Y4|0ګO^pcgT;p(6mn(AZ<!JkFKTN5I(9ncww͎ EQ ZmhRQI{W[iuh>AFIcئ|Mb䊢㡇fmY%柲/Pz&e9^<&*9zѐq"8wHҩIZL歊+Voni8y;8fcl€q0X {g<79M.nTbE!+z"?eL gXΏ~}p˿u"[_~M $h<%o$ąx8mEoA9;W'*W?өd <@"d)6{5o%Q6RLkɷ%ҠWÑ.7z5rұ7!e[ =J:1j%3:!2L[uYCߕ Ffi402O`QNR\N[xQ]0g3?bۺֽ1:dSqMЙ덍e{~f|n8j)@.[#M]]Fs\/a:}XX FעHӄ syϢg4$.}d[/ہ gA豜5'ZWkU9ƜG㰕nH}; ȭYӌ*}> )%c0$tRA%† 2ٱklti"4bBZ 6e+tD=Y4<߻Lp_/t̏-0?ŜC8%DdkDKIBqRD&D2ȞȀ],FLu|LPݎשʵ]$ѵvڗFQ "sdO{s3=g*ﺺ1VJvܴ3{]o|O4&uu]c j/PZ~aB /ym1X+ F|=3Pbn^&_iz,)r/Z'U!D Di:BJj~Jhy!IJ_)-Wn@eϝ@JOXhnw6"L8*So{1/:TC#O#AÛ0;A͟Gɜg]br]9;EjD )]w2Y}Q!vygZsKZM_h}7wxɀ}P<f}BV;:kg? ?^R.IYO]+)?49+H{P->8T"Zf'e\=1.YM#z =b]XőNڀPN>ޫW?m!Eeae!fK.UT~oOn ǐzv\\ +<y묟A^w֭(.<-pGbrV>12 od]XL~R^-GH( QOD1.Smރ*IG$v t.J&(n.ВT"`Ֆ%c%`['Na qzK1[=0gfV|Zl%xV'%:5U<ʀw ~%Gh-SƂAmm7^vryq告sY]ȱ~>Zi$eId?K6R1G߿1LKywJh}OreTH 3uL̑oFC[c:tk3IrG'X+%qՉv3( F|k}8h`ϣQ sD?71;w w(K0_t3Fɘa#oM@N Nq& *_,*Nf. 3} g>)BxV>MשX2] ݙRK{aekԧZtD.fKzUF_Mtf':MDXaYl4&L\lEa%=21JRBҺY&~xnű@)DtImfi.E1"<^ڟ0$TG =:Xr~={mtydUIxam9BthCQk6!"n+uqwZeC6ۘ|`/]({>k'W6-G}Bb/M ݵ>Lo' no^ DJC1ǚlC]&p_zڛ@;%yK6ZƸ_0{nAhkIRݰwrd۠D./:n3~qp2\'1T;Sl')?E -Z%2y֩n#Hw7?~Y߿SNuE6O1'77;Pi1ւ6>q8i+Zkݮt\,Ap~E y"ŇN,uȁ%[qB˽!Yc/u)sa0qFL"mkru.t (voV*W^48<FC)\[ӂ4jCu=6YDj+ L#Ǩ51=u.&ύ;]ZRqqނPݬ7ͳ ];H5!'`ZװwvhWG<*W4/w.Ì)K.jvd?|- q` Ii"`к9ACbC戨֜KVh? q=S'\Q'lr떜 h^mJ?aNXN$A:n(.]e Bn]4>~ p[UQJ1HŨ9 V6!.U<|bFw?q9X48"`eV}.Tg*u9~S훌ffٴ{݇rt] hL%1gR܊9 I/iO.D/ endstream endobj 160 0 obj << /Length1 1392 /Length2 5960 /Length3 0 /Length 6904 /Filter /FlateDecode >> stream xڍwTk-H&]JH"B EHtT.7M"E@?߽kݻVgf̳gfYag3䗇 l*8_H(P64"@0; Nn E`B(" 4ƦBc8@ $@@R A "bWDz#ahL!IIqy( S r"0(_)dhW)AAOOO JP~Q\ `;' ` 00„!P$S`uki@H@t%`+ `P ! gA遲*~(0F `ο8 Ji2pq(_S!`L߽ }!vh@]anPu??6{( %P7 +S Ѐ젘"_ @#ݡ~P{?1f_g0/9~B?,1A=bA%:Z(TP@x|ń¢BIq ii[@?':y\T wflPƼ kwmenH/ 0HCY W HDnO#a(CڢI C(د'_/Ft`'SoT_H7a¢_!J!P #И$5S a/ѿ҂ݑH~SoC^P0,XpV!Oɿ6k&uкMRJӗ7U:2glˢ%-KZKcEa?zO _{Hfckxxzܫ&ԺBΜHOoںi̶5 A4Ov7R4tu#T!{EJ|wZgGaf[Xi(-sz_\i5(,ذO%HK3gێ7I\ߣ7#,K25(iTD55 H&_Q{/X⤸*E}? moS%ǽVD-)0&O1 C`ɴ#AM\Ouo`?S?Kefs&PnRQj\!+t1+D({.q/w+ޭ~^څ^.*TF}_fz/VF{99w^al%߲Wn Htӊ> }-V$l'}_`=ZR17.Cbއ;,ϣ[ LlNUtPVN QZ7τ@׫/&5,mӗ"^%InD[Wf_S9I_rob;ykU B&Ur %)*㔷Ompng$h01&I 1! V|^b,Q 74d|3yxG%6lT ^mJDh 6Yf [b 3PʘKj"9yZr`@6TI?AcX+OJ/ϛ+7 kRi;.㯞e7C%:Z5e,Gm|[2?H ;*ˑʙN_7/Q>ʃY^R2/JJ:rF`ܣ), z|'4X|qoLA!e!qO^q?p^C01'Yi2݊ŇIM6UOLu?Iw<^+ukETDOHA+_L{ Q#Nt*SylWvhO@T#ΟLX :mo;+c}޿gLI['PH~NG^u@CF`;օ/f{-?(J.Zz͝ f\(u1A\ N l@C`f߯]Ia&yV f"O' $b 6 }\b9jcO{dn?Slܴ ~ץ#"P7l*3qI;8,o(;.or3 ٴ`KfL.|QZ${;4Vd͙G19Xn*X\ zI>'eVr&g/9*ϗeԸ&]<ͫpyt8uT^}Xw A_3||%]id\^|)z5&muMKU"Gjd14ѻ}wNE;X,؇0fu=B`S/lSIQ%?s*⧡R+t:99}pL^PQzT)Fl:,0v"~eS KF8$dK%g .oa5=Fj׫.:fT?5;6 nf<n\|'.ɯCgu)~Un|;Aŭ;Y[tB9 V4?OTg?D9=lT,?ON8F@Af،Θ8^1//&tS=kHڷr,eMhLȿ۽Ϲ龚}ANU{dSȍV* E Adq]o+Vёz˖ECukWT=Bu0_$?.7VD|_ #g)5"&Ffʔ,%5[qhoq$ل3e`j>Fj`՛n-HhQc\)`7k.d^CnIJ!Bxfn8NL6% ."$Tf]%b|:FSCPT mY:䨩;bj-&)H7^>lLv82;{iIQ\Sgn4Cga!W"%[*sdŊ2EMe(/7.׍yX_,8 q9&-YL,I-ngpK/%)ViN\d*1XZ\4 ~1;IhlNyiE֪o汑 r9Ux^朘́gKT:qrt 9ǵ =Nqwa gIS&m@K' <: ~j~hb]V]w/!@Z17A IvtȃѥYEFsϤ-8MCtdR48<]-;%}1q$=ϦyF񱱙ڱs%%U3hF[4I' Fu;`jrG9 :T>͂Tؼ'lAZ]Vg?;3D]m6G}9#FNt}i[il#iͧSk݌ag6u]ؽK9:;cڝ'ȅXoU k<?)8Nk]{HC i J+8e¿#SĥlI 0=_ t}<Ǒ,>0"1" i;롑+{9Jw:sxoXIbUGvӒ-)fYj{gZ)8?[cGny=5]I˹*J&J xâBx}U9d]i#e#:2vsw׵AUyҶBSe.ﰄ>MWs~3.0En]C(_`CΘ} J"$ke(e(D)=6' &R6t:Œ)HvFDos?z;Ӆ-֗C7ky:Fo5[0U铯CI7Wzo^4~Rout*T}|_?V^A %o4‹ ޛq(Оki)CX|g,C ~;ر0Bh(^IPG\Y+xN*VA.lYrQSxz6:\ХKT). (j[gh{*y/iRz6Fg]6Iy7G/mmdTť?_F{ \Y{xL'?B)r~U8a|.gf Cђ/5mibT'=]]ю9:NK9z a&)̉|E'XGUEm HLַ[cȻv=:/d~-+H7QJb c[èy#IIYxAJcnop^-[]цNqBvgZz$̂i&8>mzj[c ^vx# 5;4Il_Qf^^j?܈Sy^ DwlX"2\Ř}1cN; 6=}vm-6 FM{F3R}o>-|/}=%"VɇQ@j?lsBS T vrņӻ6l0uA!yFu6&dZjp[ O rGoгl.L#Ɣ<)Ѝs !ОE~ҼX3b9H8|V>vt{4yŏgKnzF'ޑ*)em@϶+<Y6~gy)(dú$W=q06 ~w BЅ<7ZS37x,TO5 OaUk1$?D˹,PmApŖ:V|}*<;)\7XQk«W꺽r*t"Dq7y2fp{%&nȝXn~ *&v$VJZ?sul4!zaZ+CWa*hOO1D4ȸ ;[]M3uo{8I׺5x΄U]Moz ßSS]Y-NI,mvr16n`/ i,ˢu]s=2rB>HtN}b:u!hwt;-=^)}B-mȞ%[ KM$UGR[$[*L3 dg!ڍ)?yYĩ~0%+B CJl=20*t>=?(7%8Z\9y@7ʃ0jJNGY(=6Vv묭 |x,d!K<*?{0ϊRZ ?տn~X*כMEJl(0Z]NdMaѭ7~Lf˜c4gՇ ?;Z R:7?kߊ7$m{e+> stream xڍxTS6Ҥ#H7 & wAjHB$t^7J](]zQA{oed3̼;W8 (:  *Ɩ EH89Mo;  G!c6U0 E!<($. "@@4@tPHSwr`} @RRJn08107lE0FA0?R:c0B`7IW 8`h Ev&D 0qr1`k@!0$≄<c-; X/@B+; H_8 G:Bh6#XףּJ0~hB8 J=f5$TCb$ A+H7# uE.l?i`M$901{@0uv6c9X@# C{OX:"P8p9$Ύ5ZcX>* B"| baS5(˩ Hā$3ϿNo`GF-#  M2x /PX=<5P ~C;_YW=~GA`Ά. ;!h]^- ;#JH'Awwp8#a(4};zWmo ;YFPDL`]AY|~K ,Da!,@#ʃWcE`43/'? @<=<3[ < Ϣ 2./;k?,-w$YGa=w!֘zlyl0W99|UnbfGUy_p+'+4.8fj/ِ ߊ;|"BGtg]R7@)%[&^)k%2fҚ2*DtiY*ى$5x1Td)DP^+ڶxKU]}#M[A?^q/-_*>^1Jmyw(2qMھΥȪHrf? ͡-Ovws,Fji%YӸ?V3կ謃tpAYJd*6=ZZe^)=֤u/#b\CUgiE;A\NWjxGĺֹ-nE}|6M TkHϕr&#5v(dx@_{|AuԲpWxUUa9NB,ͰTjE{OGy% p4;*o+,͆Kx%\ՠHU|"f/c^ұ-kX֪@V2IAA{S#M [*UDzkEYY+#[_EU|WjO?WJ!%p1|}qU_JYS@JGڣ[_\qfK=Z`#9<61mj}ІJ֌n %b˛f/Lv\u~~.ӘP&q#8DI0K\Y}}*QuVbx{Y90`Pbt#l8rx9~aӌ^y(Ξ3'[~>ݲ3еUf kcal RCL!"5әR8- =*|ŧ ;s3o|>'XZphgafVdtqގ7Fp CM)`:7& 5q6äg}ij/Rt Wmc".4aّ* ^z_5IKvȾ4 n%KXYk59X(BHj;2[(ە]qw$BPMߛ^'ioJ~x@k5ցߖjM) .GUE׿^fkQZKk}ՉAtՍi^ZᘄtX" b`%%]8ޮ Q ^ D8{D^(egHCe:h]r?Xzkh62Ã7N* G{s/۲I]ol$܇yؖܟy·X*nc|FQ!ʥtWǥMX`T;‴W+gxO4@:8䖝\"  $B~'w`ZWr."bT*C9'3){5)6˘ZGEX\!vfo3#C7Aڬ{Qں+- CneVRjEmtI.r$lyk(Dϊտ:MwSXQ*^|b|ɻQϒ&8ҿ%:5/?^YUW^H;~:9*` / ,l&և.Ѭ4Hm]vr}+G[ntV{I(?#t*qi=Tނ[:`Xq AGn~>eq'LuY\=O2pVqYgP.F/!UI&9EPqї+ˌyd#ch<AV Wm`2Dby(@vi.IZꫭ 4yuplC_nlf;]naw^FLyrї.6 #Q {~ rz:d,n9XȳKm<u-=GĞ|h%z< &dJ݆>WK.}2ϰE%Ak̈=spu尹]Cql)^Cٮox8rC4ma͓T/Y1eG0>Rķ9Dҍܦ1|KxU䦝'#;ӝOvjx3Nװ􀛏E5!Fi&PH\č7df7}yj=e)[!k0 z츮\_5hOmi 3यo; B*lAE!6[338|̽Y2*Ч˙ׇ<;jA7]. ԩ)!hLيuF;/~5)\TEu3SY,Ӥs]mbLh=7/W]^hq{Xd$eǔeLFXɓ~J21e48JLC??*c?CEiHSeKMPjJwؠd6f [o,r˵ (GΟjh8?kjۊV!7[r$^'HfTV\ahDL@Jd]L'X>Byޓ j8Z>~o;(.1\更9M*I-Vd+N!)I2X֒Q(`3y ь;5Y{"7ieX``]\M$j ^C[NL?G]!鼿$\NvXA*C{'twh2Uٓ}^Α څSMj Á ӕr!0=wlo/? >lQWQ7WU`7Ef?-]<ܗJhR"vbJG)#1qW@mbcw,ks kt>/”.Ƌ96c6o#ȅ&TYuݚDɺB;tTM3GR&6~nPdGzXpJs?.vS~yƳu Ÿ\4 7s@;P;SCO#>I)uF/eZ7XI4Bآ@~tL.ЃIK"06 Yԗq5Z\Tމ;bQ+K ].miwz%uPPw䢔QYw2&1PZ)~5}5,ha[kpÍw PF/G?o{i7ز $P}.R+9Rc &(&ꗧ~S!Zlh^ ߺ*'Kr;}hp_gzXpܫk;kx6%ė[v[";枊Zܺh{?q&k.naJ"g[V'{uibWcZE̥3˛}MǢʫBȒ҆/_fI hub p,iyPbK?SpjXTk>ŚTkQsGwKoqXt64OH7vlXl탷z0B:\_l`-ܻn"F ˦(31nyӃR:GwvÎwB9XboD)-KeZT2/UknV~6~뤊qQr O7Ŝ\dRG#d)I~p^1څpc52/Uc|f=t}n0V TuF1HiǞ?B?I|~u_/W߉~Ы)3ؗUv(Gq$_W,zN$-鹶e3=3p-{[Omgd 7'~4*iyMt;ڰ[i"y=?]"aO.SwZW#[1e͊=0OD31/},!F/+E=I2`)b}܌D7ZKO2?;D`<ޯ5FPp(Wr hY, _X=S"XLQB 4Lzt^dE~u*;Eyۓ0˓|~?ڄ -G.JKss4;[riY ĐZK¹ oblh=&mI&9)OnK*kO<*|0}k<y97{z6HF}i37PPM\8+z]Ώ>9 _;ĺKN"hj}~f~'=7pf ќBRK}w:-*WUҪu}}-f]Aj335],Xh()~{Vd{΋5b#CrcJdQer:o> stream xڍtTk.(1( !!!ݍH C0tw#!%%*(% -(9kz}|M׀Oa UFQ| I88 a('_f"#( K$B(tPwwD%$A $w ) P{lZuFġpFQ6  rP$ ({3#0@@`PJpI٣P.@'?ٍP7(j vAO0 lQ`$68 P:nEj(O柀fO'!  laNP&? u ;!`0 l}s0@YNF  sA~A*F ܈~OBc٬# ` a|C AAQ8 zA쁿z@;~}].[4?#u{@(;;}" (5': sF/ ~M/()A< ' b۪ u9? /Zp%n;h#\9HA?;_U_ );9vsn34QhYh!wc)kAm`UCۡ)' c)ü60^ E~}qY Ъ8*nvAѢw_%8aK}"0 &I&("@ ?B$ѯ `74f#z DjqG"tϿzA!Dȃ0r|xщ&Q"(ΉUF\luc>e);x.M5Թ,`7$L| ^bmBo M%΀324FT\n6V "Ĝ,inh +p.Gl;;ۓՙ.tRhy%=:[n_r7=uRzș«;EsUcLL  g@ C, 3s[}q_G7 [HT0G V.Mj^k>VYH tq)ǺֹYX |ªVDqt`ZOOtWx\)C㵉*^gLۏpPZ7[ԲT:k} \rɝ7UBg^}ARa19RfdxG<d|_ەn֏ê[}YEl@_#AH; p2,pv3h6)ua>^jQm_T;kBL ڪO)hShz)% ͈ מݞOx[Dx@>ͼL.ttZO!p:DrӇ$Wq|3CȮ~4\sSz[#^FbIK(Zu0~Na0Ҝdu*yQ{^+39IzLR^/)JA}> @/=KA:zKs_GEdTwL oR}+']`~̓Ne5 :\yݛ>:&%Fx'+*B\HSTJ ֑fš{q$YES?UFI蔨lcIBdXP8a s~0YMgl+M(Ұ&ˎ-ݪy؋ƍIH/&p߫V >2:B5 6"qΙo3:_"jWќ 0*tkT?h7ϻyg븨sƛ-;lJ6YRڜ 8ԛ 2YȭH7RO[uܴ=l,Kk=a\.fSv~=ʕVO3rF&"ư| 5 ~Hs.;6Jӵ>a K wd顨JSxGWiv'ݵZƢJlI'"Ln\*%HtMK 墈qT#}T=Y+!)kƋф Yr< {+SN0l=:zyMzV A2J/b>ƂOQ}a!|4c=;]0~oF\z?ÉW&B&F.<ʼEZ8v1Qy#pʆu#Lm>i2o6إ[Y<.uSOM6[л4cPw]Q Qj!ʚYq1L!v0ZeDEM@h U^LRqޭ灂`<}#Fm6}ϵq$8 _Kqcn}M_#FК&;p(&I#xU2ƹ7.-6KRS~ޘhLAYh5V /Jۇ0Ws|%ց}ܳEf]νΨ;.y+>l/F1Idڙ6gPsG xD3SY[瘸.ߑ,3U=9ͨ;n=J\)"]JiHJ\m繀U!/Cw^=!)3 mqlPDmFs|1)6\e"nOfGo0 e xs-⨊ |dcy{ t;$} P[4 mb%ul JZQd=4 RI@mktj}[8Y/RNoo (7b$s<:-q L8jE>/EZ4ۦbE"] Tfy ޽ (l=/ߠvzC]BǢxG3" Ӻ7GbjL_*d$<#[L$)äc ,e7L$vL :WZ[Ս9Kv,}R~u|XZk,wv-f% }k`Q?=9u1"Ԃ"?y(aCOܬ2v@6nwD$%#Jjs,HP}ц-]1Z?t 1˂J#tqSބĪbZ?'Q169_}14o[(J.x6)‡L VO-z%YpU"|p)i6G7OL樿M=x\%ǩֈuƷB1]LVZ;6A3aϾ{;|:dWobt%Uid޺qH00s96_X!Gv̀L $UGػZ .0ʾS>cso>nyM)xu2<%?eבRߩH;%5i OAͩ?7XW|[6ތ M<̬kX~Our6H]>}g NCT1%xa G6'}*JUc_s'jLU~aJ5Xin1D5E҈H"g\ 2)-j^myE^~[NInٟgN0V6\7z})nXa.aVIGMĶZcV ^Ӝ)L'Qӂ 96{ @%DVZSkk 7?]AcNLiSOdMrT=ì򍗋iZv5s>F˔R,dM/ou 7VbDB8?֗գm\|Ku!R42NZ=f%i6:3b组{[ ҷD;kIREP驓GPL^/'I7]mb*m \LJe圦Ԗ@ݎ+Ne?S'd{?8#b٦/{ߢʳO͐5-k';G} RXpQӆMe,? f lZ/%>h2Yؐ dSP?7kqJ첕NCQҒNg٣ly,]8t:? oF^31eXpHucx+"D_H5i،LIi?WW:5X1(*xZRӞ|VAUjr?s U9'QI<}X::Dh'V_5 |fD(ܲa57;bA$0M^v^VWz,g{i<:e|irFgV'Xbu!7Lg:HR2\$3A& >[mHjm8R\!s"Oc۝ol2C`!fwsduK֝Q_rV8Uu|>*Ͽ~AMu-5ͧR2Їq"}!7=Fn~ڰN.Y.-+kag]?QQ0"QRxEU@0PxjUɡG^6ʔt33#gpH#<Ƹ1|J Bd{cA>!f{PHU<]g"c˟vM|J{)#+BԼdo KƾQg'Bef G?#īy:jI!&їC~@ƺk'ǞELڮ9*s'n\&tUJ卑W3n^3ƥeyO1/pSFG0#EdW{[ar/rC!s'?NBܥ~gDR&%Ǭ#>z#OVyb<[EFzz1x8m'ΗhE=WњF[9R{ Jpte(tk2RNBߐA|ůl2' ÿS*S]'ERĔK &}Q>TPD7 I;sWS}əS[Yl 8,JLCIxDL4$FV.fӝMnwz&4oc(n߶o>/_ Xp)c ؒ[x&IdfKfxp[ɂ7CeR"J|8,K> stream xڍP ]C RX)/[oLgZ_BK,n@n,lIe-yv' 2-92 Bh*2w{5T vN;;? Pȴ'ok|d2w,es7[kFKs&tolܜXY===Y]Y .6" LO-@ tZhb5dZ-/&x8,`Ww)Pu2Vˀ p, @?--!N`o` rTeXܼܘ`? \! sW?K7Ȉ_;?WK++Y:fi$vsE>) uެ= h݉U rvKm*BGftpq- *qXY_?}]=7wV K7F'h~=~?^f0+?UU]USR-W)!2s9l^n6R5sձQl ӈx07 @ofy t?V$_?zsG|vw{ e놀.VZVuG6sM8SdLyrmsUPo zzT(Sv˪Ҿ!u.QR}-Rn _'\"_R5y"d`.z sÀ~0Ȁ_r`*ǐw.ڋ/P,_9#j6:#.vxEYKLA+fwQlX!DO!#%x }pFl:5<ve%GeRg3 ~4d^Ĕq^o;k4Nd#^%'V !cSm}\S@H+|d%I;v9)[^f'}ٶZLѫg@≿m&jSݚ.7skVVq֚vv#vŗEݹRdQhoW["TA4ЙAPR 2)2^ԢSK9NzҞ5䆥F*-f^p$q,М+tmjOtG< cS.AF${ݖԚ|Y')xv|:Q` ֜y Ae"g:ʏ6kpAFsu=A.?GIٍS2q#Zm'M 磯ej&v>4S#! G'LXSk2>ⵎ=+hc>6bia$_LM1c'*,@\"iG_WQo|}Ht/hZWQ-~J=W9,lIDR3i4ALg;v!"$=("sU&)` ؁w!ʢE4my&N<4R@IaᬹV,?k8OH\&' KzΫ75lC[TÞI>%ï 7f Q|V"4ZKwkӪtsoaruc Ek%vN,ҿ:2.9 )u6xi~p"AaҟP|ۆ"Z4h\x$Cˏ*L0| 2mHއ^slѾi\V(c ͪ~"ԅFk eu(VMVdz\a1UÛKIh+咡釫i7MgN7C(}Uq#76r68Mn]F嬑v$\'N-}=7xk3N_ #hQE%~'E_="= DkgY|ZB5F_źғx/ ;TJQmt lV4sڌS"$C'?7v5N@{f7=G 枆 M_$&SwC!;/hDzyϧspEzm 8\64aHڬ(}bt<0B_R,@[lS ٜ[G/:e99bEllV7 AׁK E`24T}V=w=w&#C[ol_0`D`s3']+H,?5֒?g{/5q@S7 Ion8:pT9g4e1Ii,# %ǫ0A1i7Nz4FI BʿqȔ=;K23ޝi7"9REj'P!֊9/:/⻾Z"M@_;l5>_>]8jgڟ 58 {%3|}AM 9 vμ_ENڲtp?=3ۚ8?*.lt+M_uO@q7aDE-Z;BE#LU,4nv2KDSNP;>.!k6aX&4o%F]N , nF"l K5I wj`~ 3ni3g(hڠG8&0?&,`!+#z4cX':ޔ"=t@*Lڒ*6طcƝJ|>}^;=wbAÀ,+TN$evXﳓ~P)n8'tcxfkq;mK V<ۘxA& u(Jȁ[i.'~+-@Bwi,AG/ULraլ.yT1/V5F|iznHq%=L!:aKG\mD9 wD%~z7㾮q7!|]k*)B8閠& s>ʹO_<,橱V/װU>4q> /F] _"ّDM"wxx}ݮb.>P^H`{h%ząZcـB_}A2u,ilI6Q J qdRt[6zdҊYW]x2"7P/K_֚zCGX-ŽUhAYw%Ӳ K@T xm}=d/x,{Ϝ{F܄Yx]nSaxP.Zu)Lzrcz|v6H04 s/7 k[jyNsfW64[z>ݟʙj[m&z3"n>iY&.ՃyvWĈkFQQ0W=zQo`g)6-V?UX>)ˏb/"oh#x$ꔯ)({~Q3o~FZ9UܹF 2޳Nuj/Vg#vBi['δY 6r>3^ qA H"pL+gď_ZpO{<>cqfT%ϾLBJ3c+n4 9218|w)i?m2(\j4r|\\Ew=bqŁ rPOZjNVn(."À28t/V)0wC"7={iҏl`9QW{5՚EI3V$\}ڌF;ff:v~w8V16ʻh!MĩL%=I>'nXR2nWx#oql{8o I1>Vq\V.]:#z8;`Pǀ;!9ń2*C.{s7?uڋN:|K,bP\n1 @2X]RNZ=~1K Gw[IPdn)]-UY_Ҥ&`M˔m:DE٧LXo/I"sMQH :4<ۉP'{ \`PE7FK_f5Ql7 &J@SQ _J.ϵ%@I ZX$djbqԌ&ERdK%J]R9̎@֭Qq17lH6+ du5%^~Qȼ21Xln8xs1NYF zCƅӋa515uek: } SI*NzlKl=aܓqPymwI]Z`m;[X!+9y5s*&>~ wuLx Ƅ"c(i5@=3UJLil(^ڏ_2d ?,/qEO=V K2Sqd~ٝFN C=i]1)َ}`vwݜk?j F' PP9L.we %p SO~\3Q5<`h5ւ&Fltӛ?*c,4Okv}MYe0Eu6,6)0-Z2]k"L٨iy V|1Mm\~ R:;3Arv둺Ω=a\#g#cJNVubl+4[bsBSb]!ǔn:octQ;=N\` SiCH Ov]u tG乛/az?[4쒽ݶP8">>kpP_jKjסApC^$7v"aQO0Vٮݜb>3nX>*̴H{9؅a.ð r$zܟ9Y;YR9gawSMtt{iEx[f#Q.tAnޑNyHW3?.T2krBaB52<{@oڋt.`{'mz8T e$_ )xȜރ6yqs=X sp5o}j9[ތ1s/>"MDaۑFeFֳ];,2A id<~kJ4&.S6ipUP9ˬukIHH>zL[>z*Hf(?4ƿTS7+0Ez̽ݮ=MS)yyÁ yֶX8 ~φ_BQ?:-`XT~+),@E0sZZ^"2󉨥j#d >mF&X~Lm>ΩFEcw_4}-"SE;q\}7!+$ aբcTm߫ffJMl "f?;>M.X Y853e/v; $87IeL ;efv5MK#ڲd/&Kipx/6TǪ0^§ ĭ MO̧4@Tވ$դgmpu@?Zn>.KWEuU3={Q?*zaIR}>LS;3g :E?`Gc _pyL(NN_je˷a3I;y0…ĺDgnhrSe,]/a8Bw1#ʛ>|,G i߼0I)L !\Of 7:d&d"r#:ZѶejM~VE Wn|&QwrcpjQ {^YM7&GKbFryӷ$X^"UQb&Q?8c>SKMz-*\dGU}g?{*hTKPNj3Г{־?Ǹ +rv&5Q_߀xRjw~/>37lH`|!W  '4v;7N39[7lp_hAFJTkEI6ml-<6?9E-wP@v3-1 ĝ3O[0 lȇin?ٸhZjTOmƊ܊,TKJv*b~J^hECb ޟ$DVZCU=4F!6 K3/sYj;t,U"0[2%%QH. }E ?:5M>jޔm*̏q&a${|FIߗ┶a7sGkvd}U:|1O匐p'QILhZ,Vco^[(85 wf!!ňՔ5KwfIX|Zw? O8=3 g '?*>"E=48L*{\V;~YlӂLx'{U<"T^֖ߤ:zȈ-uvqG1a9Bonsf LG/}2/]YYwy8x=s*}hR7u*ow؉[E8Ҍ SB D\ML1~֛ἻkLC^o_j;@P (|ݕ52v#m >6eW,IlFy_'( 6҄dH|b+KQ*S>V$}[E7kAjztB^ބ>Ň)1(}ELiݤn >st ^)$t)FD]l)5LΪSv89]>~d8۸@-0'Q>xw wT !|/w\}/WLˤǚтC]r|J*|Gq g"5(@Ejck@-s^`ג IJar!5)H:,f엻F3TˑN'#/u5♵+6S ܟDT?}B`ݕV7"xVYX1UbetI\f,StH$&G[TXw`i!&9eQ7,(e=,NNbmi/g,q!Ą>ou ݛUZ1GV? 'Mǂ3K(˸=zE7nuWfe+d|yb=ŢejA~Ai UYF`+1xK]ephzWr饓 81?3;QV #z/]\$PI\ČT)ˬCznrԍ TtM RM^0h﹧,yf3A4&&=sZ\5L.nVߍv`ƈ_%Oh;d~Kn ~zXPc0gx- ;6Oߙ# ~~<kqe-HVZ)-ذW}my Jj B]-c\Lrk鍙QL^}7 FQ!LiXy'R()"a=>Նv`]d.MK" TSyS|V!8-c$h}ԒKc+|%,d깐}P4HA*83Y5wEv0I!Ә)u' sh3P⁅,{}=ͼxzuPvU$[)""Ƥe^RO{:8mMzByUY#,6_(;Zxƨ㇚^c$% ɗ!q)F#Qn(MuܠuF^ dq|8ŸCGvwUoUyguQC~gGQ| ei{#gxhN8XS#_.YONwm+u'T3K/g*d ݓXX wl䵣 Qk[ڑ̦(OAJq%^y+@狮1bkoyHxYX" QS z@O`BXjlݶQ[RM!sε(ʒZgmy6Gs_mĹjqb5 _:kc+W4,rymyS󘑼|Qb-&^aZF' Q}Y,COD3j 7~!v0ÉL a Ζ+YH`NBQ!e>)vJWo%X?m|gETxR1b2-c@)"o>[;a8|i|NnOZ_z 9rl%ƣn˳nه%c85R#v>+±|FYog$jNE?.8)Og۲?]0~-e@WҲOYKzj,%U6D1|&۔(T#5bxb#P36QuqC͓ShtS}#ȕ?'znX@0;u"[!ʺ"\3q%6$MV.$;Kф }>C= Kumzbo6tqdMvLHmt*>?R nM(› `LS[6R=$4p^~/⋔)N`yI8F.?p Qlw{V11AyN\o SWZJm"KvEOqU,K$O=}U, M"!喆 %)`2ꥐM:gh:YJipֲ(|ܟťeæ4t˔b%|^B [gxW@hJ6]0H~vL_Gi&fA4BK9oߞNj=FT vGDV7ס?R{g(kqL 2 FC[l(`8"DGaLD?f]'Z&3X " 3Z D^Apχ^ͦ; `K儸03Wb^C7Y XT KgZkD#Mlv8h΄Q|272q%$s7RD7I䲇*l^Ng-`>樲:_oJ#>*1I0urb?J-["PH/@'?L̰I[ki^3y\idk*ozx<ӧyVc̮2%b\#б"i]C8h$(ҏ0vǘ VkT!ƹVB{wѽK/ 1!Z3~3%i0,(Jo٪N9I1WcMTқ%G o3'va,X t]ZBG\e.AIp endstream endobj 168 0 obj << /Length1 2671 /Length2 12039 /Length3 0 /Length 13566 /Filter /FlateDecode >> stream xڍT #% Hw Cwwt 5]-%"҈tHKwH#%-o{k ~aᐲYAap'0@FMW bb҅!ʱAܡ0g?,d pL0T9= _$ & Z80g; jkG+ rA5K lЁ`]@///NK'wN8; hC!nkouK'?8vP:08Bgw5 QRh@6VۀOs N% srt:l*'tmhC[zZB-n X"usCsh w], F:8üE6Pgk4=\zPW?6ֽqqq 7; /%!AЀ@m X~+->:B # 0Bo 9;ܛu@Y#u#uPO)- q<>n^ _I5-uOwg.XY6fP!`~.>.0yr7H/=?zK'?i#6C k{ PU["6DFBkM(l{ Pg&pr`ĝ8TFoF9g0q,,}!vh08`a>R~>PoJ#P " r!.P@{ *#PQ=BԢz#D-QHQ=Bd׾G:]!#D>{`Bd0GKai FϽ n`ܿA;#YCl0^謕%xlr/ܿ  (C_Y%NNPB%7;nWʃ8-kł>1b<).ܻ h@(g}D |\ X d? ѣpzDGBCrFl}=~ߡԀx**1ax<^xϝg xAHwxwA y]sq HD\=`pBH+>o?#O۽nt^?\D~anq>@DVD?j>}@BN?* H_O񆀱f&a`pj)J/n^S 59rMPi%]w $\fY$3u-h6VbW*F<ֶ$^_H]ֿVenYaw~y$>! 6rxԫJmJǒ#ۗY|+}@(wvp\TN_gnuSX2uɑ]'Zi&R7{hЇ5׮)~)+^8bkΉ;*Qqō#IEԐC.j4PڶrX]2_ϠfdrJo'B簯 L-L9:QP||5E2GY} q?>;fXο^`^A29M4YP0hzAQo2=f봜PWY7'^bq1UDG^]KiZ'ߟ\N(#xśq;y(x U +ltΒTxsMxïӒgngyB!嬘 n !u",8{`!`)0OɓFn[[gUxe])c_>f E3 20ajM.3zJ r]ĠU|ۍ%ù ABebh]''`/  3{9ن?+-gyGROhs.eМdNd'S si9h\_w [L@] %FE1_o:*!uHtkDx )^C߭#S|ynYhV˩LrLb0ZCl(v={.cgRu3$2+u%%Hql1h#_eKpkHtK'A[0`KNva˭s<@WU!=MfwLMT%_=> jiktV`<_紐~T]Ñr{Ot +mMQOJn8id='U{s]4JR$85{󩏉|F;9z &1I>f ȋgZȟj.s Ew{^s&e&ɝÍ|E_51.[7|ʃ?nj7Um~婪_6`k%ҾEO[Þk0Q=Dēp9]Aԉkvԭ^C-Y'H Ȥ<5%E dѿi°?{ҳc}=X. Aow<3t@3*,"D!ɫ~m$GV| r!tѐ~ umRQ*;m Bw6.j*Qe|hSL~HE7; Tpγw}'͘9S8'*J}Rk~R9HIZՊR|m4~ʴ[/e\MJEI-l:s |S8BgvYdCyl%XxqsqC"z R:U[<{-?X0H4zaō`Z lYKARO [:CO-gGimLiZ U])&hz.Rze팝 4̗YX>7 ?к3Ƿom:&~\,a<>v䧯hot;KI1wЫ^ w}Еwo _, l ~J=i0&"$|gc0ӔfY^KEZ1ҋ*YbEƒ*K yIztGЄͭ.=g[_~K5殪?pB~N2aVaɄ;RNnaBب"8׏l?UlJQPx<uu3? ErDb^e/z:Y\nK[ Wv!X\3NVNg486='=6*@&.EB-(tYile(,W%uɛP) _Bh վ*2I;n6$7{ D"A&xrS݂ dmĽ`P9j3{YtbQde%lJ엺:J7u), HZeLg_-oӼ', 76q.$UXv*|zc#9Ç׎7MCroE5ٞH_Q`K.to?yvm y-6Dx;H]Q_LٶťZͮ7[Cx(ORު/ݦDز\*{$`O_ VD"+x VyV)}DRTZxdsjJ\ <:)^@p!yuD|vHӖTj!4Sq1R.%Q }ɿ&kHTU,Yރ͕Z 7'x>6P^{!nLcym(SI&&l]aL,*K@3{WB B:z ,vEȻ!OYu̧u#^$Ko[}k6jjM09XYgmu:1U񥇁o5w;x.!v/g}(r}t]z!:ֵ[.Fm 9&j噺%Va GRի|V-Ǫ"(TBUu]8tV-Xb>{bkc\ΣԦNcn6@kuԱnš'D\*?s`baY%NmL^)&h5|TAnyCO: )wbzަ,/F2XNRL(}8*S@;:x\J[lGkYw/mcJW{?m|ч=>TE&'i|9į6vp|]r1F/mWl,@j=5l+phyx^Fς+thRZ;.ڍ)L!kv@( PV˸k)& ;Ic7DhyDq(R=G[}Yn)צXe"$_ 8JJ܃'֟ӱ#?:fGg7z~Cj 14P7\ C)؆x-BS|-'>I$T gch5G<~?4{z=p:amKgmբP vݩ~\yuƲ8z,Rol~"u3%գ0F]Yi˔zFߴ+_nMl˃sߞrpQ7 ׀hXΣwDmSvoÚ`}Q%i4(u;j^b*yƐI[ǯR*' ,q |[Xw|{2nOgos"* EMj[= މ(+ԭ% m}l5j[t {܋BڮTk6 ,Zf`U"t ]kfB †HMOuBu ĂaUZ;ȖUtMS5Rlܻ3磷.u:WToSu|tzᆮT|i粦[UK{IU\4jÚעM]֟_ht)A`ۦ(3/Q X\.uD岲ģUE'ǔ>ricOq|/~WozUp-Gn`//$ҟ29L_j!g_\!+%1Yz,p2?{8TL' SGނ̾rMt!+367<{eNYߨܾǵ$T}(acx^bWy܆$;`@+ l*K &?KM8Kpf6h# L&a8Ӯ}S#'̸_&eq邶/Kz4+S~dzVX&9p%b;.to{!Ȉ3[LuPv,>1X"@EWx9Rsg/ZZ%hftl,xY0}K(&֩RC`i ξ;~ߧ$nd)Y҂rhhFVϭ+ $~S4!\~yz^H=_yς,"ʜؾHzA";I?6_9T8I20{pGƥX "cI;g}5U2/̻N<6|iˍRwDeLJQRdƲ b? ޝ %[꣟uxrd*Nu}wNCXceZ7BN>6Tj|O=,N+-\8*֔htOsh ړy'F,|RLĿ<۶-Nx\ٝ%ɚ2:/O ;͸TCDxED~(8vbppzxpKN{wl|= uS2gbZ~/&[|g[zAՌl!A!T0,g.B_Śmpz;0mkW k!ksEߐK#\Ag50}\HEܾǎ )>"G!O8W:bu7n\o,rŴ\袒٧tďd_3^ x^ַs0f_9!40J6*(X">^f1H :Hyf3{c}x/ ociA;vK-2j._@ݐOa&2j%D5eB#G&#"UivSVJM!*=f`b@ޝWov(X غ7CzV&}X-uk!GOV%(ѐHEvvs_1E7).GiG'$ocp'_&nIGT Sz:šVCCC7CsIu^>6uwz ̍K9n2}X%GIjñh*+'`D.BBt+W2 7oܜaA\CvA5d8+"Eo_\=Rю>2ؼ^beYS`6~uegܤehusdhaZ5 Vn=)\ATy+2џb)9$kHzz憾,؈x XBB]ojPʅ5pd<@ȤDeosbRA>XGI#r~eg{h^pu'mu?ZAYƘR.$F Վ+]G+e0IɃ)zG|4}6 9݌T=L1%JG9F\^2oT꾻МTVf1WH.bӵğt\ 5B!ؐA;o|A扲n@oz= U{Nws0 d2->qQa(%V3\:8L^nGi&$׆\׎ T CŚ d4D>bh;瀲s7Lf*`2 qPETred@ko,g WoU2Guu~юn![}>}C5zˤUoKm6La7xlMlL?[駤Wb T~iY瘕,n;k݈AUV`A@؅ӯ+!'o7F D+r p+08Lo2EK Rx#ETUE4Ȍ2.T *f;c7sk7 B'C*> ˯J.b+_$i4שdtvm;Lɓ]l@ݰAM^z^ICrY F=jQ)8۝׊yBVkR>eE A?q.9q{ zr.wؾ+a!ar&G.ss+=UqLxyU$؈,o.e#Y:>3-9s3v_,kN{4ݏRœ-^kfσuZ-IN9)Lrнr$x,N`A]f?laYÛ bwbPE3 km3Xx N(SI}%ei-)HP;9+/V4,6By($hYzIOJ acI*,1J4{s@:G,•&qh#U|3U`ozK^G "LM Ʊ? x#0FvvcTp&MEʙdcmE\nIaSe3KYBE,fp'Pʖ\ۿiB KXbU _ttc8<1V=D*K"u煴lG(3=LVV`ɿP<#teb,-&ךM(Cݽ2`>*KؘeCI8b./^6I.lZ ̊t#zus%-xY*tL}0ҽ\N~\M,k7Y8cRyfE1Ct.ѐ 4&2DuR?Y>:P5 ą](Dw/3lA%I[{ԂW;`އ o}L^YhS(谡4(cvSGU6=`+%].!㐮HydB|1Y>$!@^oۑ :1-- 2U гE$jqR7:%/2_?vk&6ɪJbw[l…35ɇe p1Uג__5(r¨^J`KoުgEL绡E'b6¢%ER/_5t9*| V6n+F5TX] ;iV^$2%RǕXwRv;ϖ;!ߍ N珼}*0"KYvc)^Ԣ"Ww(”GXdJDW>31i4B>""jm^L+qu[,zy(n&4J-Ɵ 6'< G&S#noᚦ Uz &)"p7mBGeX:ɴ=9\5!2wB.D4T=_Hhk*޼5skfqu9PɈJ-2l顈r@.WFG,={jŹЌm*@kӑIWBd|R>u^`rGwvGNaMDܴ5yp鮜T}8*̐.3ewPgޡ > endobj 138 0 obj << /Type /ObjStm /N 52 /First 438 /Length 2789 /Filter /FlateDecode >> stream xZ[s۶~ׯc|X L3MĹi.?cT]j~ P$EYNvtb7,v,aB)R&t”x $Z2e-ފ)OoT6y³x:Gsf$g¥4JD$&Qb"5cҡrReV0]XŴz$a[XL :)3 !Nl`2m% %U1HmM)Vxf=%P+II9:gN%I7,#9F$#!BO`9 -5f^/h%eސ[-{F()ǏGcO ?' 2&m, ~a_-Y^ _0~SD]?[^aH@5mE/zQ|f8duˈuxX$&bWA@n]iOEUd `Gy+MڍBD NL ~ {_^ӧ|I p<4%eU2 o~~B˦rN1FUcO, xʊ F\ g| k cȖ=*A;E 1ܱ^뫄F\@eG+e#N1T* jYlf-4a[#%'C`G:{+x8҆q* }gqxQKVNT8I.;&Jt&>J ƔT}8靮acd|D3xj:pvmZb$NSjqz ۆv7{4NFnKRҦJCvLeot9QdMTRfoҰJŕ mIپMX*Ķ5{݈zm$hc2}XbŹ&59dDEh* 3TS8uy3O0hug:d ;K#flS ŔlnGvFE5n$ǝƦ< ?}AlVL׳%/I\O7Pv;/~ gl >2e)}wTQݽRr/Jl?U 7~uvgǿ0PB;)l|'ulkܴJeΞ^V}%t> 2V:u16a*}Ϣ)}^c}]u;!w}6%ΖޝrwCɚcnݙy:dnވ⾖Ǟ܇t}Ty:ݝ Yoemvg=LHCvg? C.']:B|/-F/(7ЯŴb*x[), /:q"m|f,un|(+ι岞!WX Clgu-t)LFcv*5q-.5R4˥+:?@G>{#t{訖N##&ְUM"D5Royt\NlQ[*{4)||Ϫ|ԋ=2I٧*U?->fӢj(5~˟E=qr: ,X-lAtc41!7su>nپ>gY߁ c;Ta HhSe+!_CF ~?E>j!*D#b_Wr ("Ƽ q;-q+# 5cNu{c  Z/3})*E9 )d H0ww\Cڐl5:Ib C XDd˕uv5 -nZlAK|7șm{nPGF6>p+G1uyrz,j trU%w T|BP endstream endobj 182 0 obj << /Type /XRef /Index [0 183] /Size 183 /W [1 3 1] /Root 180 0 R /Info 181 0 R /ID [<91C7DCDF68AC5BFC6DF16471E849EF25> <91C7DCDF68AC5BFC6DF16471E849EF25>] /Length 464 /Filter /FlateDecode >> stream x%rLa9 zH@H1&CBLQR{.UT;KKvJr\?6z{s<(B Kv̆I`9 0FZ+a3& V^fCհ&m%ZxlT2T  5CA"*~ŭ~DBl犻07>\V)*?` (~z=;aPQ%SwV4>xnR܄Y aL1KA8P^{8܆;pNQ/9Ɩ (&?Tp.i[.E8ga yTfbep5ܢO\ g NTjKe}äI'N&ML/_ҺuIגeIoPVo:U>:USizީSzũ&^e]z©!}uIz [@s|䫦*ڿ'O endstream endobj startxref 137320 %%EOF phangorn/inst/doc/Networx.R0000644000175100001440000000262312547505677015444 0ustar hornikusers## ---- eval=TRUE---------------------------------------------------------- library(phangorn) data(Laurasiatherian) data(yeast) ## ---- eval=TRUE---------------------------------------------------------- set.seed(1) bs <- bootstrap.phyDat(yeast, FUN = function(x)nj(dist.hamming(x)), bs=100) tree <- nj(dist.hamming(yeast)) par("mar" = rep(2, 4)) tree <- plotBS(tree, bs, "phylogram") cnet <- consensusNet(bs, .3) plot(cnet, "2D", show.edge.label=TRUE) ## ---- eval=FALSE--------------------------------------------------------- # plot(cnet) # # rotate 3d plot # play3d(spin3d(axis=c(0,1,0), rpm=6), duration=10) # # create animated gif file # movie3d(spin3d(axis=c(0,1,0), rpm=6), duration=10) ## ---- eval=TRUE---------------------------------------------------------- dm <- dist.hamming(yeast) nnet <- neighborNet(dm) par("mar" = rep(2, 4)) plot(nnet, "2D") ## ---- eval=TRUE---------------------------------------------------------- nnet <- addConfidences(nnet, tree) par("mar" = rep(2, 4)) plot(nnet, "2D", show.edge.label=TRUE) ## ---- eval=TRUE---------------------------------------------------------- tree2 <- rNNI(tree, 2) tree2 <- addConfidences(tree2, tree) # several support values are missing plot(tree2, show.node.label=TRUE) ## ---- eval=TRUE---------------------------------------------------------- cnet <- nnls.networx(cnet, dm) par("mar" = rep(2, 4)) plot(cnet, "2D", show.edge.label=TRUE) phangorn/inst/doc/Trees.Rnw0000644000175100001440000002626412547505677015434 0ustar hornikusers%\VignetteIndexEntry{Constructing phylogenetic trees} %\VignetteKeywords{Documentation} %\VignettePackage{phangorn} %\VignetteEngine{Sweave} \documentclass[12pt]{article} \usepackage{times} \usepackage{hyperref} \begin{document} \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rfunarg}[1]{{\texttt{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\R}{\textsf{R}} \newcommand{\pml}{\Robject{pml}} \newcommand{\phangorn}{\Rpackage{phangorn}} \newcommand{\ape}{\Rpackage{ape}} \newcommand{\multicore}{\Rpackage{multicore}} \newcommand{\term}[1]{\emph{#1}} \newcommand{\mref}[2]{\htmladdnormallinkfoot{#2}{#1}} % leave comments in the text \SweaveOpts{keep.source=TRUE} % Ross Ihakas extenstion for nicer representation \DefineVerbatimEnvironment{Sinput}{Verbatim} {xleftmargin=2em} \DefineVerbatimEnvironment{Soutput}{Verbatim}{xleftmargin=2em} \DefineVerbatimEnvironment{Scode}{Verbatim}{xleftmargin=2em} \fvset{listparameters={\setlength{\topsep}{0pt}}} \renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} <>= options(width=70) foo <- packageDescription("phangorn") @ \title{Estimating phylogenetic trees with phangorn} %$ (Version \Sexpr{foo$Version})} \author{\mref{mailto:klaus.schliep@gmail.com}{Klaus P. Schliep}} \maketitle \nocite{Paradis2012} \section{Introduction} These notes should enable the user to estimate phylogenetic trees from alignment data with different methods using the \phangorn{} package \cite{Schliep2011}. Several functions of \phangorn{} are also described in more detail in \cite{Paradis2012}. For more theoretical background on all the methods see e.g. \cite{Felsenstein2004, Yang2006}. This document illustrates some of the \phangorn{} features to estimate phylogenetic trees using different reconstruction methods. Small adaptations to the scripts in section \ref{sec:Appendix} should enable the user to perform phylogenetic analyses. \section{Getting started} The first thing we have to do is to read in an alignment. Unfortunately there exists many different file formats that alignments can be stored in. The function \Rfunction{read.phyDat} is used to read in an alignment. There are several functions to read in alignments depending on the format of the data set (nexus, phylip, fasta) and the kind of data (amino acid or nucleotides) in the \ape{} package \cite{Paradis2004} and \phangorn{}. The function \Rfunction{read.phyDat} calls these other functions. For the specific parameter settings available look in the help files of the function \Rfunction{read.dna} (for phylip, fasta, clustal format), \Rfunction{read.nexus.data} for nexus files. For amino acid data additional \Rfunction{read.aa} is called. %When using the \Rfunction{read.dna} from \ape{} the parameter the we have to use as.character=TRUE. We start our analysis loading the \phangorn{} package and then reading in an alignment. <>= library(phangorn) primates = read.phyDat("primates.dna", format="phylip", type="DNA") @ %require("multicore") \section{Distance based methods} After reading in the alignment we can build a first tree with distance based methods. The function dist.dna from the ape package computes distances for many DNA substitution models. To use the function dist.dna we have to transform the data to class DNAbin. For amino acids the function dist.ml offers common substitution models ("WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa" and "mtREV24"). After constructing a distance matrix we reconstruct a rooted tree with UPGMA and alternatively an unrooted tree using Neighbor Joining \cite{Saitou1987,Studier1988}. <>= dm = dist.ml(primates) treeUPGMA = upgma(dm) treeNJ = NJ(dm) @ We can plot the trees treeUPGMA and treeNJ (figure \ref{fig:NJ}) with the commands: <>= layout(matrix(c(1,2), 2, 1), height=c(1,2)) par(mar = c(.1,.1,.1,.1)) plot(treeUPGMA, main="UPGMA") plot(treeNJ, "unrooted", main="NJ") @ \begin{figure} \begin{center} <>= <> @ \end{center} \caption{Rooted UPGMA tree and unrooted NJ tree} \label{fig:NJ} \end{figure} Distance based methods are very fast and we will use the UPGMA and NJ tree as starting trees for the maximum parsimony and maximum likelihood analyses. \section{Parsimony} The function parsimony returns the parsimony score, that is the number of changes which are at least necessary to describe the data for a given tree. We can compare the parsimony score or the two trees we computed so far: <>= parsimony(treeUPGMA, primates) parsimony(treeNJ, primates) @ The function optim.parsimony performs tree rearrangements to find trees with a lower parsimony score. So far the only tree rearrangement implemented is nearest-neighbor interchanges (NNI). However is also a version of the parsimony ratchet \cite{Nixon1999} implemented, which is likely to find better trees than just doing NNI rearrangements. <>= treePars = optim.parsimony(treeUPGMA, primates) treeRatchet = pratchet(primates, trace = 0) parsimony(c(treePars, treeRatchet), primates) @ For small data sets it is also possible to find all most parsimonious trees using a branch and bound algorithm \cite{Hendy1982}. For data sets with more than 10 taxa this can take a long time and depends strongly on how tree like the data are. <>= (trees <- bab(subset(primates,1:10))) @ \section{Maximum likelihood} The last method we will describe in this vignette is Maximum Likelihood (ML) as introduced by Felsenstein \cite{Felsenstein1981}. We can easily compute the likelihood for a tree given the data <>= fit = pml(treeNJ, data=primates) fit @ The function pml returns an object of class pml. This object contains the data, the tree and many different parameters of the model like the likelihood etc. There are many generic functions for the class pml available, which allow the handling of these objects. <>= methods(class="pml") @ The object fit just estimated the likelihood for the tree it got supplied, but the branch length are not optimized for the Jukes-Cantor model yet, which can be done with the function optim.pml. <>= fitJC = optim.pml(fit, TRUE) logLik(fitJC) @ With the default values \Rfunction{pml} will estimate a Jukes-Cantor model. The function \Rfunction{update.pml} allows to change parameters. We will change the model to the GTR + $\Gamma(4)$ + I model and then optimize all the parameters. <>= fitGTR = update(fit, k=4, inv=0.2) fitGTR = optim.pml(fitGTR, TRUE,TRUE, TRUE, TRUE, TRUE, control = pml.control(trace = 0)) fitGTR @ We can compare the objects for the JC and GTR + $\Gamma(4)$ + I model using likelihood ratio statistic <>= anova(fitJC, fitGTR) @ with the AIC <>= AIC(fitGTR) AIC(fitJC) @ or the Shimodaira-Hasegawa test. <>= SH.test(fitGTR, fitJC) @ An alternative is to use the function \Rfunction{modelTest} to compare different models the AIC or BIC, similar to popular program of \cite{Posada1998, Posada2008}. <>= load("Trees.RData") @ <>= mt = modelTest(primates) @ The results of is illustrated in table \ref{tab:modelTest} \begin{center} <>= library(xtable) xtable(mt, caption="Summary table of modelTest", label="tab:modelTest") @ \end{center} The thresholds for the optimization in \Rfunction{modelTest} are not as strict as for \Rfunction{optim.pml} and no tree rearrangements are performed. As \Rfunction{modelTest} computes and optimizes a lot of models it would be a waste of computer time not to save these results. The results are saved as call together with the optimized trees in an environment and this call can be evaluated to get a "pml" object back to use for further optimization or analysis. <>= env <- attr(mt, "env") ls(envir=env) (fit <- eval(get("HKY+G+I", env), env)) @ At last we may want to apply bootstrap to test how well the edges of the tree are supported: %, results=hide <>= bs = bootstrap.pml(fitJC, bs=100, optNni=TRUE, control = pml.control(trace = 0)) @ %$ Now we can plot the tree with the bootstrap support values on the edges <>= par(mar=c(.1,.1,.1,.1)) plotBS(fitJC$tree, bs) @ %$ \begin{figure} \begin{center} <>= <> @ \end{center} \caption{Unrooted tree with bootstrap support values} \label{fig:BS} \end{figure} Several analyses, e.g. \Rfunction{bootstrap} and \Rfunction{modelTest}, can be computationally demanding, but as nowadays most computers have several cores one can distribute the computations using the \multicore{} package. However it is only possible to use this approach if R is running from command line ("X11"), but not using a GUI (for example "Aqua" on Macs) and unfortunately the \multicore{} package does not work at all under Windows. \section{Appendix: Standard scripts for nucleotide or amino acid analysis}\label{sec:Appendix} Here we provide two standard scripts which can be adapted for the most common tasks. Most likely the arguments for \Rfunction{read.phyDat} have to be adapted to accommodate your file format. Both scripts assume that the \multicore{} package, see comments above. <>= options(prompt=" ") options(continue=" ") @ <>= library(parallel) # supports parallel computing library(phangorn) file="myfile" dat = read.phyDat(file) dm = dist.ml(dat) tree = NJ(dm) # as alternative for a starting tree: tree <- pratchet(dat) # 1. alternative: estimate an GTR model fitStart = pml(tree, dat, k=4, inv=.2) fit = optim.pml(fitStart, TRUE, TRUE, TRUE, TRUE, TRUE) # 2. alternative: modelTest (mt <- modelTest(dat, multicore=TRUE)) mt$Model[which.min(mt$BIC)] # choose best model from the table, assume now GTR+G+I env = attr(mt, "env") fitStart = eval(get("GTR+G+I", env), env) fitStart = eval(get(mt$Model[which.min(mt$BIC)], env), env) fit = optim.pml(fitStart, optNni=TRUE, optGamma=TRUE, optInv=TRUE, model="GTR") bs = bootstrap.pml(fit, bs=100, optNni=TRUE, multicore=TRUE) @ You can specify different several models build in which you can specify, e.g. "WAG", "JTT", "Dayhoff", "LG". Optimizing the rate matrix for amino acids is possible, but would take a long, a very long time. So make sure to set optBf=FALSE and optQ=FALSE in the function \Rfunction{optim.pml}, which is also the default. <>= library(parallel) # supports parallel computing library(phangorn) file="myfile" dat = read.phyDat(file, type = "AA") dm = dist.ml(dat, model="JTT") tree = NJ(dm) (mt <- modelTest(dat, model=c("JTT", "LG", "WAG"), multicore=TRUE)) fitStart = eval(get(mt$Model[which.min(mt$BIC)], env), env) fitNJ = pml(tree, dat, model="JTT", k=4, inv=.2) fit = optim.pml(fitNJ, optNni=TRUE, optInv=TRUE, optGamma=TRUE) fit bs = bootstrap.pml(fit, bs=100, optNni=TRUE, multicore=TRUE) @ \bibliographystyle{plain} \bibliography{phangorn} \section{Session Information} The version number of \R{} and packages loaded for generating the vignette were: <>= toLatex(sessionInfo()) @ \end{document} phangorn/inst/doc/phangorn-specials.R0000644000175100001440000000675312547505677017423 0ustar hornikusers### R code from vignette source 'phangorn-specials.Rnw' ################################################### ### code chunk number 1: phangorn-specials.Rnw:46-48 ################################################### options(width=70) foo <- packageDescription("phangorn") ################################################### ### code chunk number 2: phangorn-specials.Rnw:70-76 ################################################### library(phangorn) data = matrix(c("r","a","y","g","g","a","c","-","c","t","c","g", "a","a","t","g","g","a","t","-","c","t","c","a", "a","a","t","-","g","a","c","c","c","t","?","g"), dimnames = list(c("t1", "t2", "t3"),NULL), nrow=3, byrow=TRUE) data ################################################### ### code chunk number 3: phangorn-specials.Rnw:79-81 ################################################### gapsdata1 = phyDat(data) gapsdata1 ################################################### ### code chunk number 4: phangorn-specials.Rnw:84-87 ################################################### gapsdata2 = phyDat(data, type="USER", levels=c("a","c","g","t","-"), ambiguity = c("?", "n")) gapsdata2 ################################################### ### code chunk number 5: phangorn-specials.Rnw:91-106 ################################################### contrast = matrix(data = c(1,0,0,0,0, 0,1,0,0,0, 0,0,1,0,0, 0,0,0,1,0, 1,0,1,0,0, 0,1,0,1,0, 0,0,0,0,1, 1,1,1,1,0, 1,1,1,1,1), ncol = 5, byrow = TRUE) dimnames(contrast) = list(c("a","c","g","t","r","y","-","n","?"), c("a", "c", "g", "t", "-")) contrast gapsdata3 = phyDat(data, type="USER", contrast=contrast) gapsdata3 ################################################### ### code chunk number 6: phangorn-specials.Rnw:137-142 ################################################### tree = unroot(rtree(3)) fit = pml(tree, gapsdata3) fit = optim.pml(fit, optQ=TRUE, subs=c(1,0,1,2,1,0,2,1,2,2), control=pml.control(trace=0)) fit ################################################### ### code chunk number 7: phangorn-specials.Rnw:205-215 ################################################### library(phangorn) primates = read.phyDat("primates.dna", format="phylip", type="DNA") tree <- NJ(dist.ml(primates)) dat <- phyDat(as.character(primates), "CODON") fit <- pml(tree, dat) fit0 <- optim.pml(fit, control = pml.control(trace = 0)) fit1 <- optim.pml(fit, model="codon1", control=pml.control(trace=0)) fit2 <- optim.pml(fit, model="codon2", control=pml.control(trace=0)) fit3 <- optim.pml(fit, model="codon3", control=pml.control(trace=0)) anova(fit0, fit2, fit3, fit1) ################################################### ### code chunk number 8: plotAll ################################################### trees = allTrees(5) par(mfrow=c(3,5), mar=rep(0,4)) for(i in 1:15)plot(trees[[i]], cex=1, type="u") ################################################### ### code chunk number 9: figAll ################################################### getOption("SweaveHooks")[["fig"]]() trees = allTrees(5) par(mfrow=c(3,5), mar=rep(0,4)) for(i in 1:15)plot(trees[[i]], cex=1, type="u") ################################################### ### code chunk number 10: phangorn-specials.Rnw:242-243 ################################################### trees = nni(trees[[1]]) ################################################### ### code chunk number 11: phangorn-specials.Rnw:254-255 ################################################### toLatex(sessionInfo()) phangorn/inst/doc/Networx.html0000644000175100001440000123543612545270274016210 0ustar hornikusers Splits and Networx

This tutorial gives a basic introduction on constructing phylogenetic networks and to add parameter to trees or networx using phangorn (Schliep 2011) in R. Splits graph or phylogenetic networks are a nice way to display conflict data or summarize different trees. Here we present to popular networks, consensus networks (Holland et al. 2004) and neighborNet (Bryant and Moulton 2004).
Often trees or networks are missing either edge weights or support values about the edges. We show how to improve a tree/networx by adding support values or estimating edge weights using non-negative Least-Squares (nnls).

We first load the phangorn package and a few data sets we use in this vignette.

library(phangorn)
## Loading required package: ape
data(Laurasiatherian)
data(yeast)

consensusNet

A consensusNet (Holland et al. 2004) is a generalization of a consensus tree. Instead only representing splits with at least 50% in a bootstrap or MCMC sample one can use a lower threshold. However of important competing splits are left out.

The input for consensusNet is a list of trees i.e. an object of class multiPhylo.

set.seed(1)
bs <- bootstrap.phyDat(yeast, FUN = function(x)nj(dist.hamming(x)), 
    bs=100)
tree <- nj(dist.hamming(yeast))
par("mar" = rep(2, 4))
tree <- plotBS(tree, bs, "phylogram")

cnet <- consensusNet(bs, .3)
plot(cnet, "2D", show.edge.label=TRUE)

Often consensusNet will return incompatible splits, which cannot plotted as a planar graph. A nice way to get still a good impression of the network is to plot it in 3 dimensions.

plot(cnet)
# rotate 3d plot
play3d(spin3d(axis=c(0,1,0), rpm=6), duration=10)
# create animated gif file 
movie3d(spin3d(axis=c(0,1,0), rpm=6), duration=10)

which will result in a spinning graph similar to this

rotatingNetworx

neighborNet

The function neighborNet implements the popular method of Bryant and Moulton (2004). The Neighbor-Net algorithm extends the Neighbor joining allowing again algorithm is computed in 2 parts, the first computes a circular ordering. The second step involves estimation of edge weights using non-negative Least-Squares (nnls).

dm <- dist.hamming(yeast)
nnet <- neighborNet(dm)
par("mar" = rep(2, 4))
plot(nnet, "2D")

The advantage of Neighbor-Net is that it returns a circular split system which can be always displayed in a planar (2D) graph. The plots displayed in phangorn may not planar, but re-plotting may gives you a planar graph. This unwanted behavior will be improved in future version. The rendering of the networx is done using the the fantastic igraph package (Csardi and Nepusz 2006).

Adding support values

We can use the generic function addConfidences to add support values from a tree, i.e. an object of class phylo to a networx, splits or phylo object. The Neighbor-Net object we computed above contains no support values. We can add the support values fro the tree we computed to the splits these two objects share.

nnet <- addConfidences(nnet, tree)
par("mar" = rep(2, 4))
plot(nnet, "2D", show.edge.label=TRUE)

We can also add support values to a tree:

tree2 <- rNNI(tree, 2)
tree2 <- addConfidences(tree2, tree)
# several support values are missing
plot(tree2, show.node.label=TRUE)

Estimating edge weights (nnls)

Consensus networks on the other hand have information about support values corresponding to a split, but are generally without edge weights. Given a distance matrix we can estimate edge weights using non-negative Least-Squares.

cnet <- nnls.networx(cnet, dm)
par("mar" = rep(2, 4))
plot(cnet, "2D", show.edge.label=TRUE)

References

Bryant, David, and Vincent Moulton. 2004. “Neighbor-Net: An Agglomerative Method for the Construction of Phylogenetic Networks.” Molecular Biology and Evolution 21 (2): 255–65. doi:10.1093/molbev/msh018. http://mbe.oxfordjournals.org/content/21/2/255.abstract.

Csardi, Gabor, and Tamas Nepusz. 2006. “The Igraph Software Package for Complex Network Research.” InterJournal Complex Systems: 1695. http://igraph.org.

Holland, Barbara R., Katharina T. Huber, Vincent Moulton, and Peter J. Lockhart. 2004. “Using Consensus Networks to Visualize Contradictory Evidence for Species Phylogeny.” Molecular Biology and Evolution 21 (7): 1459–61. doi:10.1093/molbev/msh145. http://mbe.oxfordjournals.org/content/21/7/1459.abstract.

Schliep, Klaus Peter. 2011. “phangorn: Phylogenetic Analysis in R.” Bioinformatics 27 (4): 592–93. doi:10.1093/bioinformatics/btq706. http://bioinformatics.oxfordjournals.org/content/27/4/592.abstract.

phangorn/inst/doc/Ancestral.pdf0000644000175100001440000071674512507002037016255 0ustar hornikusers%PDF-1.5 % 25 0 obj << /Length 1819 /Filter /FlateDecode >> stream xڍXIoFW>I@8,h4M^HCqe9A6g[ΞYb2U&ORIak2Z'KXF7ejl1z#O7Vc'-o{x܎^bo姫m+:ISuVVQV:=|l9g7DєXy`J mu+ T)o}阰(?s9xDȘ:%ZuFRri #:xe:hH FOɳ)m`?VĎUmTQlK^\Q*R).c0͝xԐ{epUY?TID.}!)ZR*UԦ\&(Lsm;~]GU߫8r-QN-^2gkE] 7}'.C"|j-X4n$wdA"<3>BHCd/Gwlo>wdg"IfX $ Vc\d5  N12xJ~ǧ$tXD|j7+1Sr8w2 ]V;SMRzii$8|ezwatX|evhIgG(Z7k&;Ld<̫6O^vPa=-C,gvFE4>l}2CDg#f<1Da9 ~wr}i4.BK<*yaш"jY$݈kXIy~UeOe1!vO[)^Ǡ*CY9Wm#HT?ڕt'"#Knh!updz>i];_Չ #fo L46@WQ="%pgr2,hl+GR"Kёl)҅'nDs'/l 3T2''IǙSO7Ɇ)w:.MDj؀YDqmL4G$)HGAm)Bd2(ub'~,󹾙ZOׇ;0 ~1З^!u*R.N)n$4+xࡷ)f@cmpzj_o@Ae֝`h}6?Y(i7lj"sƯg\}=ӀLPIY+TjSPIJnoqLa?5~6)T]ڊ> VߏCS9{XUh'f+Uze  +h>aaa*IJ?5:N+S9I=y endstream endobj 45 0 obj << /Length 1269 /Filter /FlateDecode >> stream xڵWKoFW9Q.|u7N:%>) Hw^KRRK-9;7c=m"^h$WO $%iG-L~kß#"0Hu1@*xKse8JZ{6jDyk l;V᦯AۆjwG#+-<X=R;TYA$:za\Pb O& ãE'֕\YV<$udA`?U'fI˛8DG xQG~rѥ IyІ\`n zsCb.X^z;yA>wю^BZVcd IMܵNLIԛn0IѶTt\SL*kyd{L*jzvߑ^J P w8uл#n2ṕ#G:մ,;lDSR(HCbU `nw. `{.mB8 {ѐ̠'UIaiCPȄw,Cf3 m):OGqaOOhFn l T:b ZO`ݢH 6AxB/WJ RHƴb_ɄH?j=|OK~zCJ{ |1=s D3S,t WxR(q@8H ל Ÿ|7wF.Ja'D5'`2(t7\"0穁~@g)Jʌ1U8X ZZJ_cFDuS wG`%ʤX4k2&FkĠE)F2|=ԄtO3vcgp2O|b~M `?/_=ε èI'fei-d݌J8[J=l^ w$84ٗ6 > /ExtGState << >>/ColorSpace << /sRGB 50 0 R >>>> /Length 43426 /Filter /FlateDecode >> stream xIe;ҥ׏Q\: 'M!A mrK5"-ξ스q>߿?_wJW+{_9s~_7^w'sz_m8es_s9{}??C{w}]HWqڌ?93>kr_ɸ}ן31}:/NƟd yc|ߟG1/>g?N7e">79/<8_wESg{x&~vq~ccޘs鋻W-}s3Cww'7.鏿8+[-?[cD|WIK9m|5G|s|#xɌ+?+.?Eg?_p1>|@g|O<Ϭџ}=vnW7OWj8ti2>3tm},g<<wR'i_{>ϯ-B߿1|@_x?~?|Iw󜦎?̘D^8aft Ӎ]Ľ&'^It>|1>ouG~;]I:/o>`|n7_B|n/#3-~kM$O~?q_7/!~ŧ}}w=}_?{g>zO>'{b|5|2{?(l/'~4'otHΜc~`剿NTkCw=r|T~Ρf??Cs*ƚ/~s}\wKj>ܯՙ~.kqKO}ؕg} +㼏{wO\s>g=ZrKw:,xXjq>ўK>[N^I5gf{oɟ՟~|CRӟCWNHJ|e9rm)r9aXן>3n>ƓrN?SNGiǫ{<:sg_GX;ļ?w<-П|Cߋ{|!Xy9>N뉧/'NnGNO|JiIO{m/SZQ>rЈ4?G>v|O&6Ԟob~ws䉗ѫI =|۠|[<3ٟ >1/wLӥ%}~gO\X߷ 47"Fhr_T~78?s=p4LS|m|w'w}L=쉻>x3>1}\|i'=;>4]}0'oY3|qSh=aG81LJC?97=:z_3>֭~_ )wOnbu_8%YWZ_}U?:M^n\v_ͧ_Wv9Y厇]OP~"=Mz3xzxc~y3|Fϖ/tOLW_ϞևOA/> "|%g7ߩy}A4BoV|P%K?3:?' N>g|O9~/9/™O~|qV{71[>ϙ_6S_j_̿4i$J'vOV{:mRq?7?EsW>O^qucsғOKiQG>r;???oHF|r^+}X?㋻`xA[:Yo ]m#ƃsݾ9>eu-g<7x8nRuɟϺә{|1ޞ)ܯ*>əѺ [;Cʹ?Fs򁓦+_:󕓖xǖ|iܸX7zM)o~(8^+wӸq?'zGd^O?pɏ+bGWʏOubo}wO׵0{~'5>7:ΟK{kk44קt]bzFM>[ Qp=oJx=M:^+ GESglo)z_* _'FW}~ƃO~z{mށlzL |czʙd*)}Y퟇Oϊ i:|J8׼|xg`<38Y_g4G*ӢƎ;#m=b?*::?k=^B'mIqs?TOד/y}f"Dt@~6g|x=zCyFץ~bX/:]>IwϩGEM1;ygIM>'ze;^Gf{E}|򺱯'w~4wgc=ѷWoMʡ=|%?S?1W?t~xz-'߫޸}|3I;v?1!ܯ?9f/~c֍zhq~y׏}%޿dGcK~}vxs>yǣ7^6&}^ַ؞{?hg={B;'%G'v{VݨOm%_>zߞf}~MWPV~zpoM1/17Nu>n?N=']ߩοxxbߏVVy㎷g{>_P7Q]r; U 'Wv^~o];ňw_ ;ͳ_nUR_n+ oFx/Fɛ?fGo>uٛf{= 鯊PS\?pi.# YO 񽞦\G=ם`?HoN7q?gscͧ*jS{~-s ~z{_z(pohB= kj|+P5f=hB6qҷ1߾?5^M\ź֧&IWmWo2azƕ}^sm\QKOdu~x۟I|%'bLs\BK_uB1>m'^ ꉤz^~SnYg|K>wM?0Go㥎/_C7>zFP4ݟjghcOU|OA@:/MГO~sxXN7?*n7^:GUȷoKu/WO%Iߙ]&F֌‰(0 5f8Bx&bH3 'n1r0 'nF0 g}?Bxjɹ(4fN\F31ČYЮBșT0fQh5j~O8q{vw0 5fZ㠚`3 _<(+8Q8aN\-v`s#p0 sQh(0Ji̩(4\f8 3 X0 5f-FFS0 5f<3 '.p&#aNxvoL0 9f3 _|r3 ( FU QlFL(+*j(0 s 3  jUc).0'2PlFaeM (>Bόf\ǧ0 3Qh Qc/MeԐd"/nafZVͽ?χQhL(40>fj(| 5bxQhq6m0 -|44I8q|p0 u|u~d3 '٘Po}0 gFn1!\Gͩz'(ԥM.p0 u|+1 ua{4 jÀū>Bx9ÛQ8~að}gaF$a@FbcFŅ(TfoQ(ԁHBB3cF1P1~QB[0 _|3 _<(55'O0 .6P=My?BUy^Cg0 _(`dlU4dϹf*k3 'nPQ ZQ(@ FBS45G,ZCXL3c_^^3 _fx?(~Q0eFӌfQdFfQ`Q@{ F) kf^Q@{F=(FI0 oQ@`П.( Fi0 oq0 诃Q@`0"'(` FQ0 Qxƻ`02(` Fq0 Qx`|!( F_`|'C(TրQ@>`|-ʚo1 Q@>`*k{(  Fj0 5b|8( Fv0 ǃQ@`@0 /D0oqF`0 F8?̧Q|+ǂQ|-Q|/Q|1'Q|3GQ|5gQ|7̇Q|97̧Q|;ǃQ|=Q|?(@/FzB0 Q`ɡ0 CQhd(@O F =1(@ FzN0 {Q`')Q(@ FzV0 лQ`-q(@ Fz^0 QBxg5](@ FqS `k(@ Fzi0 SQ`=7Q =8j=9(@Fzu0 гQ`==(@Fz}QQzA0 XOF]0 \0 3 \09(4aaFa~mF`NFᴷ0 `C3 8Qhg(F!5ЮPBCMׇQh 5ik`$(4fnb;3 'p0 !W3 ,PjFa>dFU7[{3~QhU)aZEub>׷?`f>B+`<?( q FVT#o0fZ-F aN\oQh`(@ FF֌BeF aBCM?f13 LSfZvMfe7^?xϥQh1ީe~2i?‰(|t<U3 9F%\x0 -40fG3 ̿=08?I59Q80 uzF}Q|nj‰(T0Of!Fށ#<'Q L޷\wnF`*_3 uIpaQ Q8~L܃Q L:4ai>4gc>‰(D=BI0  :џ沂92@=eQSt\F92@=ŒBsdFa]אָ0 g0F:os?(ԁBQ8M &GP™Q8qy:?Q8q}7p0 '3 Ip0 GPQhF^ŒB(ԎzY?2PQOaF (1P;\1 Gp0 \2Po1S0 .|Pot0 '^,3 'PQ߱}f1(+p0 Wߩ0L7{cxӏXGb1 3 ^3 fxƳxo3 |f(yQ63 |(}3ьW3 |(}7`FŌS73 lY?]a؞(Q@`П&G( FY0 Q@`П6(Fy0 \_7 ǛQx_+FQ0 Q`=w(`< Fe0 OQ`=(`Fy0 Q@>`O|##( _ FL0 wQ@>`O|+c( _ F\0 Q@>g=U3|3( _ Fl0 wQ@>u( Fv#Fz0 Q@ (`#&0bXd&/Z~_(`C(`F{̷Q|,=,(4q1F`0_ F`0 F`0_ F`0 F`0_ `XOgF`0_FyYa  (@oFzD0 +Q􎨿`XhFzK0 cQ`9(@ FzP0 ЋQhd\OXXG޳Tz^QLfL9`=-FL`Ȕ=)c=`Zx+?`G2Q`=5(@ Fzm0 sQ`=9(@Fzu0 гQp3 (PO7@݌QLWحc7 =+UMxINvҩ*%]?:Lt vAQNޯ?{㚾o?VÿiJ~]7i~wy!pM@ )L{?敵+"y5Jx]} J?O ׼6{F|{P{r9DP^1sύsP(\q gxق#(SQ<7NAxxxx=xxxx?L~4m)>OS<|ަx>b)ox>jsPxŃ|%(3A PPKM/oŃXP<Ń\PA`>A@g=!( A@0C S<;LP1CS<[LP1CS<{LP2C$S<ԛLP2C,S<ԻLP3C4S*Q<7NA=q ;(xXj/+(xnG(^)wxnc9(gP<7.AxsWP[S<-xN)32(1?rq>C8=@^r2Xʧvy(xy;G}R*I,7b9~(=Ix6v4ų`gJφ)]@ɈsP<`)r=]|?U]be}%g쪕CN&x6v4ţxz S<1qu*d~Ģxt>x05GoS<|xLy6S<|L}3WS<|M}7`SRAx~zګ)gSxųE/R]'e<.آxŃ|.({A  bP<'@ѠxŃ|6(M7uC vP);6|=(A JfQ>οw('a,w"YDOgx~aWܯ)gHQLgez(7|4(,^ݠx0}[7z:S<ŃzP<+E<_^xXgzBP<&&zFP!8=B[(|GQXaN\F~<]9vbps0 '9sQb‰ F}p]L(`Ng0 'N3Q3nFcPpfNV0 w1|pb99Q(8(̩(x֌]|o(‰ F;f .Q81w`А[h‰S FI59`l(8ijPQq FĽp6Q(8(`X`F5֌s0 xepY`o}~ (bk0 ';`nQ((pŌB@aFpK0 'Fu|NUYk1 [Q F#`n܂Qq FqQgk7h0Cs`f{n(|(z(z(~\FAsA!FAK=o1 z(}ٮ$FA۞> FAfQ`{0bFɌSְPMXS Vr(wĘ!&[ 3 O(1Ȍ+3 (3ЌK3 O(u of؟Q`oFf8QxcFWf8QxgF>H3 O(p5،k3 (p7|3 '(00͌3 gJhN)U!3 ̗(02|ˌ13 (7|όA3 (0t8M3 G(0_5|֌]3 ̇(0_6|ڌm3 (0_7|ތ}3Q|f80Wq+?9w(p>dFΗzL4*&=53 ϙQ|όf8_47(p>jFU3 ϚQ`GjFa3 /η(p>nFu3 ϛQ|ߌ3 (PO0@`W=#(@ FzI0 ڏ`='=(@ FzQ0 ГQ`W=+](@ FzY0 Yzj(@ Fz]0 Q`ǻoQB'Fzf0 ;Q`5̝(@ Fzn0 {Q5ЋQZkЛQ`2w;(@/Fzz0 ۃQ?`nd0 \0 3 \0U(dD53 Q`{3fFӌBchFٌBFͩ FьBFkF!w0b2G3 kjzdF!YP '3 'NbFa dpA}eft&ں:Ut6b{r>xV0 o(xpG0  fl(|`? '/1 (8p}p;+G~#]cK(ܸ|Js0 Q3<~ONXZ3EtQqF=`n\QP*F)`nÚ(8p+`n>ރQ`q3R~/oG;?(F%w(Fvd+͟(U F|YV0 7N h=*m(dF7W0 7N(܎p`n\Q(<5;..9x~?S0 w~ނQS0  %f@QqF=/`n\Q!F9_`8Qq F`Qq F`>3QqF&3`3Qq F`!ˌ،S0 W(Hp[0 7N(fpB³`n܂QqFm+`n\Qq F{0 7(8pg0 7(ܸps0 7N(qpg0 (xG>t3qxS~[(|c'\btƳxBf/)d=Bl}s8=.>Q2}MG1 z_WbQP{ҽSg`~f0 jb(?0`1 O(1Ȍ+3 (3ЌK3 O(5،k3 (h}]3 (p<ɯ~~]ZoWfT Ff8^QxjFf8^QxnFf/Q`>aF#fQ`>cFCf/Q`>eFcf8pQ`>gFf/>{ sC*d@CS|׌a3 |ڌm37|݌y3 p>`F1ƾIvYQ|ȌK?Ώ"J"QPWܯ"$kH(H2G(pc~S|棬^413C?g0 Q|݌ʌ:XH3 d^3 +(P0@#oQ^bFz-fǘQP9fQPEf'QdFzS 3 гe?Q`-q(@ Fz^0 5=0LL`7[g#G3(@/ Fzj0 Q`7(@/FYaXlFzu0 6;fQnFzs3C T <[Bx23+0q)jHNqG_~1Vv=3ْ81MZsf :^u֪#n-x`9tP?~9Ӎ]4cj%Z~?G|ty4rzLV_vn1hv=]:n:@tQj[]9;6jnKsıyMk <[V@-v[0ÝZ,a5:8ַ1^`9B;ZZ+\AI1& e.z Bϣ_% o-֞N\o\yF7Ï):*'e+|F k;\ ׎T;1J+;b(9BSK'}_ 2{X۰;斘2Ʀ>/1>ЯAmGy{`'1&<JZyu:,WܦO%~[(<-R?PBj:x*`t9`nAǪ>(};d}rl}ntVIV>wO`nڑm#+>:>rwm-u|#:ֺ;rSۊG8G #8rd!Ɠ12Zp';Z#NNx2^u?x0#ٌuqKÏ\_fy?} 񡓍Rp~I2$w7c[_O/;\#]>όߢ١θ=5dbYl'JZ_vyCZGSX\E??iSH{ZNICO8?w i.74V'͝Om? |1LJ/k^.HT+ƛ8^ q-yT{bgg yv"\ZiK{g<ʷPzN}~Gx(r=ޏFjd$^BM֣MK̑Z-]xŸ˟OŤO=})։=5hEkslڧ1^m*+65u%?Q P|כvt |45`Ef-Yk} k֮j[R:͈1AXۯ㽞m=e=o\oshy*/&VϣimϫxGSE}hҖ5|O7 ?}?x3ǮN^9=K+gp(ʏ<>b_uϺjugVtփig|dG`<%缟2x2>1 Ej9^ %s<1wC7rֈvxjχ֊8ޏ|a,'j o L,_6)!^ʏ2V|j:F5f|̑ߝ|nJ[d7՞x),?Gs櫮`>;>J?/8fU|{VV|}VWOiʯ1kE/LՆq>a󍿏1_yX5j=W鿦V|o-|pVͷYc95q>թ8E|w֘N_[߿MSOOgOp>?U{̡=`Vzר'LS'>b){UKB=d&G30~ ˡZ51c3_^3v=Gg8sjzѓzMC{PSj5vIkz:3H/}qzZPyCl~|Sj?;׏N, FQ%/%G ɦ7}~VP/5N=uzkWI=k/]kSs %8߅Z$M'zs~H=45ux!ߒ^^_zyWmz{Z,^C)U;O sޞ8tS\O)~mzEѴV}yc~_+cS_Q˕>3ғ &7wOt&wƯB'v{u6޷ x+菓sB'O&S&n=7s>6_u*n9FmjR|GdFQ5x&+7zD+XZh#C^1q[m(Z/h>F}Xs玽bF-ωP?k+lq~؛m]UȞozu;ڋW=ߩOx~SWKF{xm) u@A7_u_ +oͿ4)Ew% b>T}TS<%?`U6y+W\QR7 |= '_Cu_h/oQZNԧ|'jߋ~WEgEP~?,%ϋOԫmS,;sj]9|aS{8w+~c&{]OXO'֛=?u1^߽GE}o z}Gz_t|cadcwU٭k_oyoc1\~^a{FxOfU 3̞ %z7Y(̇7ȗY{0֏gϧ |n_B#b>Y7>|GyߏPRSY{qK_5\_wGzl<>_>?}N_Y>ߥ0kzQ/4{Y8fkso~߷^ רc{7zFSg{~!+zMAn=%-ޒ{oܻ]ܣrpwCOos5CBzPI{ۿ뗇ꁚχc|gO{}%c|g=;Yzn}x^S)}c뗷^В`|ן&o/Y?ݨwoûsRE{%S/.53zR;VYK8/>*YFU^jH&{ yC~%~ +Xc_lXóoD9}_ɼhL)+Lr¯db_̆9~+Ly+~%aN'=lb~Ԩa't`>j&=T4yg~9&#W2a~%D~%(S ~3o~%OʄJ&^L+~$/5+9s1L5>5Ҭ&sx3V~%3#ǐ_Ʉ߄J&j~W29&b+5Z#Мk&[~%J&rLOȯ W21_ĚJ&g&0}³~%_|TLq??O!S,_bFp?3 iЯB5cy_`xTS3fS|O? 䔃jW2jf0W~%c|~qst|cc\} YH3EGp/̼ 2FZI)'4S+_)&=CNhQW2?# f~%c/ȯds~%9JFs5/G~%_|G1: ?% ?r6c6iSS~_Kܠ_4GC+R3iNl~%5o+bf~%s` @5G_گdd#DW+5? +~%#k+;f j·5][S52OyۯJدJٯJگs}+A{ +A{ï5JОï=J_ -I GW*JП_ +A~%/ïdp?Zx_ +A~%ïA`z"ƛ+x~%¯Y` W2J0_ +x~%ïy`W|!JO_ + X~+A>~%w¯P _ SW|+J_ +A>~%¯` _ |3J_ +A>~%wïp _W|;J_ +A>~%+|!J07?2_WN`>~%/=pa~%_ɠ?S¯+|0J0_ 'ïdЯF5󘏆_ Wl`~%5bl1_ +|;J0ï+|?J_ɤP'_ +~%~7+~%;¯zH@/ )W%JDŽ_ +~%{¯zP@/ IW)JG_ +~%л¯zX@/ iW-JDž_ +~%¯z`Lw?_y̵)+T =3Jw_ +^~%Sïzk@ W=7J?3^~%Гïzs@I1O ~%ïzy@OW=>JG~=?J_ ¯W+zCp=~%\_ 3WgW21_D͂J& WfW=Z& ',|Fo1Jf߈J] [~%2W2o~%ڏ_ɼp_|`\+ OyzfRzJf~'f~g~Cd&g}J8گdҏ!}<~%C_LPLs<74? 9R+ ~b f#Igǯd~%ck>_  A?~ȯ0wG|?~%yl}~,=RzJƂ|LUa|?~%cɟ*??G+{`+Wr;1XW2 QaW2&WJƔǯd~%c? گ^1p=ox=jM^_#C?=>~%gAUBי϶ǯ_/zݼ&J_ɸB {ٯd}+ïd܅+_ɠ#˯dtGs~%#W2kq7a.=Qǯd __h7v^+_h/T#;GWr|B&rW2izy߽6 -?~%+eQ'zx<~%n~%n'z O~%+9q}J)WXf=)W2Paq7Bq +¯d>~%qzA&qJF?LW~%bWxz-'$W_bi_ JxƳ(~ۯ~%|^+_ J>x/+do+hJ>ۯJ̌د?Cƺ_WjgۯAp={J? 7W(J__ +A~%ïe? W8B~%ïdM#ƃ+x~%OsGW*JX=0ޅ_ `0^_ +x~%ïu~%¯` _=|3J_^R Wz =>|~ K35o0RCTz]?%E\+Ğ5S{-[8?_ 8{~7QOz_ "+|0JX?f'ï+,[{J.oôzЬY/q?W2{+|=J0&oq1_;Y: 0?zBL2mӍ+^~%3¯zGLC6+~%[¯zL^~%s¯zO@ EW=)J7 =GFJg=`WzR@/ iW-JDž_ +W0J'_ +a׋'rܓW=4J_ +~%cïzm@ =8J_ +~%_ +aJw_ pD~%WB~%_B!&߇لwb[>z>k&OkOZP>awaL%f'j '%Ng[KO_NR5kk*u9.O˜e߇.ƾ(n njfsg|u} 'ȣ )n }š)[)߇O>k7ŝ\> b6`߇5Q#>wо &vMmKq 5sr.>,z&wsbM|@ |:>,(}ˇ?}}} acaÂ'}VaY9d>,x.au\+[pנeℚ|I!,̉j||$>gm<5 s<>,p}X _k }3|,pMXE> VV,:ߢ*:߿g~d, \Oƫd>lɸ9>ds ky>sWF{> +ysKwâ8} |B_!gJz}1bhG¾DanF0'>}fhƋ95/5G[>19!o>Lxab<61O}/s*23}df4df\AFk l^}'\> C59a־sb_LwSqu|1|sÄ'}Μab\>Lrޮi`\e>́}0l߇I.kͨ q[>Lr;>s)?wq<.NѾ}f. ` s.3D`<Ę/}1gnc_}0;g/̑}&Ixm߇ E>Lj|f\X 5Ũj~|ä}kx#4͈}2VMO~y>p}k>~Y#}O>y}}}5z}`{ۋ}؞}}jg3n}`a'}`cG}`eg}`g}`i}`}M}؟}8}8}8}8}8}8}8xs.3|(57}}}O}}}}O}\}}O}}7}8 }|>oS8>p>dΗ=̷}׼o5=A>ph'}8[;}|ؾ/i>pm}8}`}` }a}a}b%}b-}c5}z}z}'z}Gz}gz}z}z}z}z}ayk>K>5#@"SϴN>PR3S@վc@־+|}Wd_7`]T}eBj>P϶n>Pr>PO@=޾RϷ~>p=k\/>p=¾\3}A>[\k~iϗ5W֛/|r^P֟/p{[O9}j p:$_<ϻ~a}G:}}=Omw&7zx {zgh}~Xh;xϛ{7c|Q>}WGܧ{KzFPSgxU{}XS̾+ ߇c{G'_`:&n+c^Eu+MW߷}|o9G9^Yo_0>:~p3b}Xžg| |6jӓ Y;^c6,'?8Kߧ=͟x}|_e_&y;}XYw}:t| | P2;ED/ɾ(.߇Twџt_FQ7?޾'>X}[/&OO{aҾsb` ߇ M>Lpan34މ}0a.w?WpC1-e`3-N\\Q^0Qg߇}=0|80{Ub=ޯ{A4~L\XOJ̷{)=ab_U>Lj߇9Ǭ>8=}}f߇}&ü}S{r?ab=/yO9سsBOV>7t}zx<>}{ab_^>D5Ȯt}k~Qb>z}x5}}<{}>}7>},Oj{ZϾV+b'טѾl}`{v,ۻ}}؟}}؟Z}`i}`kǮ_cL0`Y=[~a}o\Ⱦ3^f^^<4>}ͼcc>px}=^O\m}c}[Ǿz=i~Q_J+)X˯}`dS}`eF}gg޳b!>7|ԾW|־w.a>0_i0߶q>0_y>0߷}|!1oG~~?<__xuӇjGϪoϳsPtGSGsN}7XoUY(;I`=~߷^ ?{F@=¾+@=þ;@={ZP/>Po>Ps@Ǿԃ@Ⱦԓ@L6a_Nҟe]}fe}fm}=>C@ϾͰS/D>PoH>PL>PP>P/T>Poc@־s@׾ԃ@ؾԓ@پԣ@ھԳ@{SrA={fPo ߇;^p4?⠙W8O}jڷ>n9+6hCņ}q ߇}8]>7npŦ}q ߇9{>8Cņ}(ƶC}q ߇7np-|NvԨUw:q]PQ횸}8qPQ n߇{by_ᅒo(7gYQl߇bq>a2y{Wx5}A/`b>oεu 5'}8y?p 'ƠkVch cH靶W 2c59h߇>l9Imp}k;jo`N}Y=ުy:>a &hh5}خ'l߇9}6[>lxac ۾gC0#KH_&@s=Q}7 ߇5|>lh}5}89c߇ /)>lp}v|xig7 lx ؊ 7qeb}?/z4S|.0Gw}Z&3}7rB>l}#߇} Gچ}6|Sd߇ܾCf6 >l#a߇\ܘs1 6÷11c+뾱}6|̸mcb߇9WL$yE/5 [Lf&J !{N‚a`l 02Wս-^̌8'qVGN5܇܇Fqi:Ŋ9b ,6 a#:QԾ \s|އj5ϰƴs5K5V >(A_<_s}}5^/sx=}6}iosx?O>~3_}p<%y˾x}p >`< M}xƳp0ޅ0܇}V/p0f_S>`y}|p0&G>` Y}|o}|p0>܇}õF|!> HW}@>p|)S> X}@>p|1هfG}@p|8> v}@p0z  >F_{m;> v~Η7u5X}@=pPz1ԓ> hW}@=pPzyߪv}@pP= >,r1z^߯=">@zGC}^s@=5>P1zԃ}^d$s7@=U>P2z}^f4s@=u>P3z}^hDL>P3}iPs@=>P5zs}}ީ{_x>PO6zԣ}^mlsw@=>PO7z}^z}z\/0 >pG q!;7kC#܇pyZ>T|PC=+='c|aq*} ˜P C/wpjT<}%Cow}pP#܇Op*n>{PqWG~pp-<_g&s¾W7ê }X!m}X܇"Q}|k;ύ }EzVy}`>pVy}Xz\1 a=wsP-?>J}xqO ܇uk_[盥|96ú5_Znww;z.}X78 Z^8 Ηr17Û.pgƺYߒo.p}Xظopo܇ula]j\7}uo܇Uyk~0r=` )9܇5Q[7[͍}XQSl܇5]~ p܇nz}Xz<k@P/]s>ܸol܇ I̬΂z|8>,r\kiê}Ց~}Xsê:܇աw|~q&z7êpV|ڸ$s)>3afNy]?{%*5܇Uh> qes9W>+q!}XBϥ >,p}X0aՍ*n_~p)}X7܇-kYz}Xؓ܇ sV5g}X_ ޚq go >@aՃ*sc ՞ Oъ1}+I||=oظ}1^sx}4>2}=xo>~}n{>o>y4ϫ|}nƃp0^dO}}xƣp0^,w>`< eO}x:>p}>` IG>` YH|x0_4#8 y}@>pO|##> _ > Pȗ}@>p|-s> `}@>}o|4܇=ge&8^0ϲ8 ':lz}@p{G0pؿdïoϵ;ٓq]Py~zQ\ߑC~\ qPz1ԓ>,s7+.^Nj?/o7hc?}@[':ޯ3zB6="܇=ճ=##{k%>$>@ >@ zO4zQГ}'pW=+{lB zX}pDž~Vs}=8}hBs'@>P4A>P4A>P/5z[}kZs@>P/6zԛ}PnԳ}mp$\>HoAz} =(ȣ0٣CGa̳G.B=QG(4{iQBqvmvc(4Qh7<(4!(ڰ!RQh`=٣sGmnGeB0Gڣ Qa+vaG'F_TzQh)ɣjG$B>(pBc"BXim٣'4ƣа/= mu$BcN%(4lBYŘ԰= m BN6= XG xQ(BCNkBCkB[=C= oLNrxy*>Q`7}ۗG8?V< (ְ| < o|xޘ܋f#t7ۦS?r r"r{<3(ģq!QxkţPBDžG{Gi >SC7|w+&W=CpGLjGB5=7fM3u>R#(MQGƷGbBiB@[< oճӵ{*b5ߌ/yxo{~~ˣGAG}ߧoGAK]d\oy{ȣK(GA< _{p?ɣmy>+ݯ(~G= |Qb'{m=h<ڣ>(yG= /Qxb{8٣g(pG= /Qxj[pG= Q|gC{8_ڣη(p>G= Q|o{/أ|(0G= ghN7z4zO=O<ʇo٣|k(0G= Q`hI3ߴG= WQ`>k]{ۣ|(0߶G= Q`>o}{Xأzް'ף[;(Gv~MK=#k(G= Q`hI{Xoڣz֫(G= Q` = Q`=nu{Xۣz(P/Gz= Qa {gأ@!(P/GzJ< [Qxģ'A(@/GzR< ЛQxgţ+a(@/GzZ< QxPţ/(4wͣ=2O(@Gzh< KQxƣ6(@Gzp< ЋQxGǣ:(@Gzx< QxEQpz~< Qz@< X/G (`!Gأ {a;Ih6QhQ@sb< x٣jx|ڣ1Gϳ= Qh(ڣ%6GhBQzzTQv(ZGb~< QxgBs=ǵy@6W< =(4x@Q,B+G< B= ڣPÊGB/+G< 5$O׷S}g>F< 5߭x*(tlhBg< 5(TQG#g< 5x*(T>lQ;޶|GA< x:~H{=ϛȣ1٣PόGcL{*>QP>%B(T53^Bg< x*[(TQ|G7zgBO< ((_G{< ^(tQ|PB-G< B=߿3=8yw#yi (tQeţPqGAi}azsǣI7x(T=vǣPc3RBW< Ux*n(tQzGc G3_g< U>(TQx4$,oB=x_(TQGB=x*>Q(`ģPBg< #QGc!{< (T|ƣPBª= \(T|ģP̌GBGb`B-x:(^tǣPqGB3Q(^uǣPqGBW< (>QGBG< (Tz*>||cz>}/a`duy[w#緞xt?ȣ岞N5o(~GAY(yGAϋ< zgyˣˣ7(pc{٣|S(0߲G= Q`>g={ڣ|qcxG=\ Gj>^xxۣ~yOۣ|=Q`ny{z [?!=K$j|~xXأzK5[s=k(+׫_djCr*F< 'Q`iQ{Xڣzֻ(Gr7(N(^G= Q`'yz= Gz= 3Qޑ!(P/Gz= [Qc{أ@A(P/Gz= ԛQ#BY[2Qf2{٣@q(PGz^S詛^y6BL(@oG^/nGj~96xƣ4(@oGzl< kQxǣ83ۣ9?ۣ:Kۣ;(P/Gz= Q{vByhJ0$#;UBm1zнp{u;bʹRLكN/^kާ{ժs"׿qǎF?RDz'1~5]yԪ3]Gkh4-9xw).YUq 07P-莩]`/}ޛ/A߸vUKsݜq5KKՀ .다kϛP};b-)֣R7>t~ i+\'Gh%oA60b]H#RƭbS#CrzG]￡z]{`}ΰc`a9t.Go|o# o7+G(] Gp|1=0c@.VBs3~37~ǀG#@FL >OEigRU|j!6@} 1w8Z!4Z=ߌ֌UVȷ+C<1иU dķ:,oGco}߆'ߌV7][#{MrV4UὩ]OKaWOt"Dj\_1fW +~3[($D+M'wo3[]o)[+d/T`ܹk>_/^||ș`|GVqpazz_|QԹG-I#[~l]cnW<|}9V`~8 Ы#C񻕡v(UKVңƏob7x4]Zʭsy~pz|)ɍo|`}dG+çB`k(" "y`U}`>PG[ڍ/'V  d7 9VY1V0zNJIcoc#uء8+ :t?pRu8* {÷c[rVh:  ?K+Dꐢ h('jQ߱ۑ_@: +quP=auY+r~ c7w9+M{zpg0~}: *V::bi?с0CkYs?kGcۉ}}:|Ov==z+vގ]vk#HD)2~lzOJx v :{t( 5qDGG ?}kLOQn y|[_>_ƏUƿ=r-?a{kp`xy;qQagq}glw7׿H^!|[ ~k>/G^_0D>ƜHu&r 8"x7b? Rtrq3<]\Hx/ݤSC ?68 'k'8AY|"%CM>oW9.78B'*ʧF`> rl|IEꇃ#o./׏_|<7GK_=->דҁZŪxAWEQ:TҡP([=Z>kg~PLJGW}:z97>Twߏ_zߍqQF>;::8>S>7Go|J(VwLqQFF 9ΤLPsMo)ΧJr|BJ`zuzO?1^ x| 5}t0]'^5Yz;94zډ>wV8?j)ᕏY?j|$;xpLu ]'%#xdzb\88zǹ=oOz1v)z~uzHTX/KĮK<6袮qvڇ>_[@o$RoTSTX5@`<ƠAlNuPvMNM:cuj<~p>Ը߸ Ͽpzs~ 9ȾơwRܟoԣrp|h\IPx>~p|mQYìa:t];< P:> ^81}^C4ԥ?tyKz{Q.?OKVrCɥϟp:|t+_p?:꿥;A<~q`~st7}|v!{*}0_v^ocu>=qC? :(1]|~A=x|G߷k}jkG~׎=q>s}D뿅v|n[[J…>xqy{Tv!=uW4zƔ;>._C_D//g05޹^7^z|/85Sr ө}XO*ݔ>]]>{#z+p;sqMhc#vܷkpic oH)@@|CH)@)֗W 0ψr\>-F>ץo笯[/}YϿz۬'e.o:OG%=nz1>E}'_-Ǡvt88oA<#vnǽ?؟wrNPΏXQߋ[~OG,ǃ8cGw@zdy8 {Ro|ؑJw`}ɿτԭqf=Ͽ́8G_HfG?ǣ+6|H~l)>o݃w&@?ڥ;ϰxПf=a}ѯו?_O-]`ۚY~7Xw\]?otj#PQP??CL__v/~`'sr ]!O?;zvb>ObG:vL?+<}~[q7vS7ߥ;7#-}`?PJ}}!|/R~yU/DZxŽ"??oOSs?+R.r]3{Ϭzbգ ~_ԫ:+p O:TV-}{o(~p6-㪟H|tH0_y=n8~_ݲވƚ/^~W~~&Խ!=d}٥w;,<:ؚ?`e#x4C&!IL.(tE=8j$C?8eB)(0S6.TLٸ0晲qbH(zlMٸ4ec֗ e㍯1)c)s]&\l<QS6 J9$FIzlV=Uks,+klL`R6&ZS۳Q6&zݓ37xlklL1 e+1l~׵Q6&v7ec$W$yIkxfS6&zM٘|66ec"2ec>bp"'3ecޠbhH(̡l|ooq̘mljecrzՀ9)9)=̦lLM٘1+r )9)S6f51Amq >QSC٘D cĮlLDlLxL٘ˬ%C٘ؕޔϔ ҝ).?S6&\l|dzQ6w|2ech(hЉ]M٘C hjss'%5dHcy6ecQ=T] ^.*&zM٘5=JϾQ6&<;l.S6&zMـ=3 ),S6&r,S6&ȣlLRQyp1G=WS6^{Q6&)(L並lJC٘Ԙ1A2eceDolLļD a<@.ecf<0>iȔ=lX_g=S6<3l xfLـ8(C^c_x`W S6v0ec<:'xDjz}bn%kOռeml]kl`P6<w-f34oQP64S6ec5;l)CH{>F<ƸOcl 4s1@E3ecf7l94Qˡl`P6SS6v1eF@^(Nk)RS67el OMe۱1a2ec`7ecjƀhʆbO)+vo^gzAomqu|M1eza)lzÔ ^l4ew<͸Lb'S6xє ޯl~e{(杹(xB]<5 <ϡlyϚƃP60^d I(oBƫP60. l ]16b<eu(Cx惭G.?365pB|P60߅0 ̗l`> ecD ǡl`eyz&0߇| =-B@>dOv C>P6τ|' Cl _ eAzo|, klL||/ 䃡lLRB>P6|5ɞn|7=ȇC٘|0Iievz摏|=myvy"z"z"ꅏS~%< wB٘]U|{Q:Vz- sl e`<C@=P6Pz5 Գl ep( =,lex(C@=P6 l ecc$P6g# !l@/ ec5M-l@ ezM(=[ha>z2m뱄P6W=+ ]l@ ec'N7NԵsC]ׅ=/ }lL,|?O_=9ij虡l@ ezh(KCـP6dž6 蹡l@ͮЃ8 ɡl@oezt((Bـx< l@oez|(Bez(Xel`=! 7S6^a3LzڞWq_֏m g6ecyciy>1o Zj&&꿡=/}~GigҔ Jf@3e)szlv|?1A1ecvP@#?RϤK=:qi=b*ߋ?u~RCT,zTv|I<^@*zGϦ9[[07 QM{V<:Ξ < zR.z}~2!ʁ'Fxcl`;P6f51Ai4ecsdƄȔ O)#S6&~^ez)+dzQ6f cl xM%섲1kZ~bƀ=|S6(/lcQ6KS6M(1Q6eS6(1ie5Ɣ~,$@)kzg zEz }97߮=^z={֖AAu. :?g1Y}ꙛS).l Z|ЃgO=-マEQ6g{(>9?GG9Ͼ~hYX (E5eÔ ^k[|)ަl0e)=MmS6xɔ ol~4e)MnS6ingє >ly6eϻ)Bz)OBxƣP60^, wl`< ee(OCxP60^< {!l`eI Gl` el` ea(/C|P60: l`e?|(B@>P6|% 3l ec`=˦l eV(B@$SI6e`(s eh(WC`)7V>uL@>P#1I1 |(C@=ꅭڠ=ٿdƯ|([P6P/}36P6Pz- {zUP6P/z2 ԛl ej(gC@L@o6L@=P6؟gP6~?S6'! l@ezF(;=$ %l@O ezK(cB`)sBـ/Mـ^P67=jGF)гe?=, el@O ez[(Bـ^P6jP6=1 荡l6Gj~lI(CCـ^P6=6 赡l@ ezoXЃCـ^Ƕ^=elP6/mP6Aܔ lPo7ezNS/^…ȴ|-"KBIWJu%/E&>97({P_ 9(5N_Yet3;<'yLkyMs Mv Jr kz|_OSOߎooOEO (xe/c6unaqqL>p;~O%F>p;x)F3܎Cqq'}v#܎_U18S#܎sx4gnaNqq$>p;n8~_ܷ7G^QXOgD{{kh{*W;wy];݀vo?foo|j?V?;&.vkYd{ ~䂝o}ß~ƀU ?s@8ڰ3܎jqUm>088NytUkxhsXV?pSݳĻ仟-w %ۃ}]뽄?o~D* endstream endobj 52 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 56 0 obj << /Length 336 /Filter /FlateDecode >> stream xڍPAn0nNol'"R"P)H@D }wmpDZLv5LC*ôU옩 \+:0z{9P^9>4hjU[ YVٕf͊}|uB%pSO4kӷAFmjt"P YAS͠ "ȅW13%":mxOrռޤ67q,+!MQ4FadDO:+Hp>͵ Ar"vӓ{FEvHN}dIO$waceɤu )ʞ֞ endstream endobj 41 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./Ancestral-figMPR.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 58 0 R /BBox [0 0 432 648] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 59 0 R/F2 60 0 R/F3 61 0 R/F4 62 0 R>> /ExtGState << >>/ColorSpace << /sRGB 63 0 R >>>> /Length 10474 /Filter /FlateDecode >> stream x]˒%qWZoÒCaɶ4^8 eڦ&iyaLsǙ# H>????!RzZzÿ<|uKv+ZPFOͯ>*/=:{H&?vo2wofP!?WN|M1=v~rDK?om*n増%۪ oW'/yNHO2K1?!Ҫ4vuj`~B\Aen0=anjZ` O=ֲj4 K͍,BpQګT26Wm,\ˮ Nv!)U-`&V]Ū8>}l Ƿ^/XәnmsYG Z׭TqYq‘x GpuîQ];>juNg8޵ZaO,ɻq]_8,#}~k'~VHO!9m؝y?࿀K4^c\o>w?|/߽?\@k%g>߯+lﻤmq>K JWݶ- z)/}W/*66q>_I4 tq)˷O_E˺̅῾臭Temem?p|ŗٞ+Ǧu|aʵTfr ouo_PO"Y߸}/)[!gD%o%eB67XkۈF-Rf Jy/U2;JA{r)b2v#[ }܋5s6'y-StkT[ nə[4Ϙl/ [sP]o|%1NxnhIzC4^!\Pաa|am6\aL%cU,uU7\`qpNgWչ`rfM; j"^HĊB!Y5b8k "5Q;GvVXuP$jIL-z@AԂh 5$QjfCEQ-G_ԑj'qUVVT*T&Nu=qvUB(TI Q*UJЗ[!7UB}U9 mRU-<t}!,Åܛ뾰'3O dܩ3 ԯI4_7ܞq+WfLC)x8E^#_m,^UyIXyW])2۳J oܮ.~Q~p x8<hq.;kz!zg]niq7֯E'ظqa*:]tم9fWD']2ev-:^t8l~&g~h~):VtP{ѩ c7D6l$:xKtp=Ƌ7EqsϏ]Mؓ10%2N;c^d\}Оc^}fy7NNI+aƵ2y{CwwfF"q/RL~ep~PyOV Ѹ)~=x Ov{ 0t3}wߎ~ڗ\;ۘ۳u1n{ Bxï7nR.~֡l\íƽs qj7gwwW.~vvyzcS{"#t3?3<>ܯ\~OV6ox*x>[=>kS.{)}yp J_zftۄ#΁;7zBw\yo~zegk3ԭ],R,hQׄ/sIX%ɸ%+kS}㑂]l/<_]'HS;Y]6C-}Tl\/~~C&S/i'(!.xeJ}~<ݣ9/qߋ8Bz#z݈/oޯl\DGظΰqb.:Btٍ+Afw.EG݊2fv/:6Ra~g;щ既#oEg_5j :xCt`KTg+WS:^ySuwumg(辍K=qyP^-$7_oO}\ލ{/؋>[GY3oP 㕗Wu֍jZgq}=fV{Nk<`/y`|$7Z7^%+ ^3rϬ2O`/2;U:Qnp> |s)_fΧwA887Wu^g=e=d~GD߼wdWܬYQꕽ_ەu}Pڝtܤ_~ǖ~K/ߓ t_h6;<ø˿घf_î-n.Xe~^~ x>şgo6n|ߋҿoIk?W佥^xq]k|#Htf3wU+_nW>U]|_X:oP>y;4qƫ/"{7e2x2~>Y2y>ȸ0f(/".z{>'t,˜0}7b+u7Lޅ.|0ͧi´ND4Oa)x*sa>Nf]Э=hO'+aZ/( _,}4 n|uS20+i=i3xɼl+[]6YJKCYq.Mp'^"'<^1\/ c=P?]8w_B{ =_iBM}BXɁBV(o}a=g`|a$g~'O`X.ǃp>^:'awom=.0w=FCpn[v{ΘPud|؋Ƌ`|ğF'i{yaJG0;ᔝ2|Ax%3;0C3u91.·pdO |˸:N39|ϸy<08s7~{|V9w}7=ֿycVtLu$W/d|/U`질T*^~-:brYmYˇbwYΣ(?IKNm?%gmǛҥX ~|?ӥ&9ƣt3;?ߓ/OrHGdGKD8ƯK#yyKۗ5^E >{{?ߵ4k>VBKo/ڋ'GjoU_R{V}MA?'ՇoM_Y|ѧE#Uߢ'X'o{}/|i_Mm~]>gf:qU|Nay^WO0f0KdLe{' {/Kr#=wWe!<`:[8/b볒*:aƛ/wt*NnV^%Bygv K_i,) R/,þ64Wtu~&w^w'p# (8*֓Sμ%ބ)Rza̷  < N/Lcf X30^_2Vx0aW-.Į_Mi2Iϥo q UmхT>О>Q`/_zf> Ma<2ƋQO7i^3u{Jh/{L?Wج`Xv{!_?O-/؏#M|z׍}4J߱|@+EMv~p*FHwh| Η|J_+3: ƙ{w*n9_}kgy?d7tY6M6>Oή]Ac`?lZo6bS_wwSo:Og)fy:YS΢7|A? +?̢|_fL]~EdywETu ά|~g~YY[̲-c&ѧ_g4$~EL->X⣿E >{{?߽?|S}޽/t@99Mt`:?"+)$Wνv^'5ϽJfu S[WȢ|7.L̺8AtK,7_;yE%I{ENN=DEj=H "G|V礭R^+9m?!VA.HO-`LO^n1cw}7y_ŗ> 1Cw&/i]pH8/Np}ԝr 8n/ o帼@plC  Kye<\^ 8$4ቒqygmCE G\zՇzuèQ]#>*uǺg 5aL4Ȼq =78|vKy͋ ʼ>WgƵڭeW SڦO?q|҂sY@^ʂ~  vc xISn,( pcAn縱d (֋/,~apapa-ԩaO|/,s~a   dj"Y:., ., ., ., .,/,~a%   _X@ÅÅ|/,C~apa4|b>hapa _X>,YMGMT_X9r@S=zMM0\X/,` 0rPTBxaW#aW`+^X`G*o$CpX$ nG q$!3^X`Íf HlnfHHnffHn& gdfHnƏDHn$VHoNH/oHMoΎFHkoDF#Ho$FAHo5ĭj ߈qxa*.0Fȸ\amXp.,i>)^X@0\X@0\Xg>:T/,w{8k|t/\X@0\X@0\XG[2̙/,~a3kmby $W9gڲGpG`uVм>xa(m 8js=^XYSɺXV/,~aC son>ȑ^c EM({"Uq*(fM@"Zs$zjIlՎȫ.qYEtP:ܢD-PCf&:DPTh5`Q8jޢEkvRen%KNTh6uXQt΢E *VT%4":SIFTRhT%(QJ_oD*6NM)^X`<\X`t}! Y y‚gK3rgL7R{_H=1t91(oF 4*>Gb<,S`,hƪfڶ}-112_, gU>]3-]S3--K39b˻8sŸ,m2nj3JKa_>Ԫ jw)EيlԪ>DI3g-YOi56mO#l`5WT<𾥸  Gbqrf=Ag| elo:oys>i#U-sg`|G)zC|I>EM[dt>FN;ϑ>= Oƫg<{̡E$^=̡ /\V,,#ѱq)CFq\K 2([EwI3r{?n!4Ϡ|ߓ_`MBįJwi@tuAymxN CN˹ jf \"Jf oEO ,'`we/,' +o/|,'%. v%{&щg;y-/q߇A\"nz{W_?%[Kܷ]`%St%f/[̞Dט1{]d*Ytٻ.e/̟Dי3]h*YtNѥ[OD߈5>]l|%LtnCƗۍOU+ߪW>y<2:b#ƃ|0# 0H:֑ t\G2q@i)ב t\G"Й<3i@tt"$r|:t#GOZT ?g9rH9ˑsØLJi?i)dH9s#'2~NM[>i|H9ۑs#lGَT>g;}vHI0dH9ۑbh4!甕7IF0apәxQIZs{z5xU 8d D9k>Y {uY"u;>٠ s ـ" 7q1 !!矙R"c( #ߠ7#[ סR!!S$)"Ϣ30#KQ8Q ǣR@ CQNA!ܰlԇFmiԗFPkęFȫit͹9uZ2瑪s#S瘷s#OG1,cI:8rtq9s#?'}7 9G?s~$9ڑs#3hGbюfɣY9G=rzH9ꑑs#!1(G:Ρ٩ף8G9rqr$2qr$IZ20GΑ$#98G>Rp|d5vȿ94]yhG͑ܛCDpsE|xPTŴ^ S^Ibq@D@k>uubu,"u; b (" 7Ԃ t!T(407?ԑ9t9T$49,39;ԠQt TQ4їq$4mGHB5# Cf5! $m:3tip?9@|)G 9@T~#uO@@6<>3ɇ9KN/ve>.~SY_ endstream endobj 65 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 72 0 obj << /Length 2014 /Filter /FlateDecode >> stream xYmo6_! Ԭ"jغ-k3[-'^d+eGJr8ú`' c)Ee*9]&2U"OmBY&dIf5]B˺˻4K;oWpy.mKعq9}M&3i1ZhHĞN<pЍ:G NJk p9vbyBiꠐK|BCgJ ϔ;"23ɼ"9w;DoΧ, ?E  ;78J.2^L#A| ՠf>ibon d4 !te"U)@e:![ YH(",LRH% "E66G'qQYl + Z"`6>\%|Z6qD~l=?=p HJriEiT2_}& *5a`p/[s>N9cePzdW#d*2 wK'wr@Έ\RH`E0xt&ON#+6,iz-c>W{yW\aU{Ppg.w9lqk9r %sfeA"F/N.lW4Mn">N]qNx # ge|-s,S׿0rT"쳸YH3J/^R %2&C\;Ũ~(cA3;|i6; kQ;R }yR-v |BJ/'ZaD>ϩw8XR ѹ[NıxRMڥεa=6qC]U|~{,Ż jݶ mS? 2̨Bdg {7/gl)0)T!Bp>ر\a*px+,]"Ό֓cBsͩ{קv g@>OdY 7ǩ祆\tE{J[طbo1|VB(0҅Yra:1M(/=W2\~.xQIˑO;g(,\xRu~vZ >qM_` ,C?""`cAqW"ޥRw .[U BƝnԆJ<@!GäAF]YCU)*_rBuw5Ӽs͓T:dmh/IVw.{nQ03wZ-[VY L#L& G{% ÍACA3>>^]9/I|slm9y1dnD̹'F+rq !*yS57))MNtrVon5jponn;wObS4Drp;W"Dۇne\00Rg,_FCHrey޲06;2kt2֎VKObI ^Z^ʬt]h<-> stream xmPN0+|tvk;nTP nHQQH]qfvf :+PSJD XMN el ۄݨHk[7^zԫ3Ŗ8Ɓ*7K}} Og(=y̞(Ǥp8D,by \҅bŎB*{q9%t&,'#M9֢"O o']*CLZɟ{Zo/^1}..@J ]rg9VS_FxD9s{ UL(mH`*m/9A endstream endobj 67 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./Ancestral-figMLB.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 85 0 R /BBox [0 0 432 648] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 86 0 R/F2 87 0 R/F3 88 0 R/F4 89 0 R>> /ExtGState << >>/ColorSpace << /sRGB 90 0 R >>>> /Length 27830 /Filter /FlateDecode >> stream xI.qǯ8Kr- BHe\P>|~sHy񜷻*+3+-oxKRz?o훿?V{TZ4[S/~Eޞ믳/_"|_~1Yg?++?˧げ?f/ڼ(|DKSox"jH_S|Pф˧}~ZO/9xis~ru2ҧ'66K1Xa~Oi?G0"~_i,c\WAxB)UV,̱/@be_]'.EWz欗~tOmj?)hO>ƧT8p~bvzwwW1+{G.»BOQ+MK/k./P ?RB7߽#$%CKOG\R緟?}?/n k[ O~^~7鿾}r~ZȷwO|5~oLCi|Ջ6. DC_^͔wQmt%Щݷo7/X i_7o7_G4W[/hhtRQ~w)sqՙ>.1Ч}ʾT/?ӯ͏N|CK݃~LC|*MvWKtǴu5rɆ\1G?}dٴ@ wf6{1o\RzDw A$/f/fL-fkTB{ ]/!߰6!*Z^T~_l?Rd}Te-͐?l6R 2>4P.9XBz\*U \2L_E.U_I墯#7#z-UXN/oz-DJM_CiveI74sN=>p^*k 5 l] f`U]ª X;5e65U `Msj9 ^..8 [#ڧVk"Dv(`c&>0^S*E`-D p n WZ_Lnr6zh ؋p·`eK^pc* .kڵWH0vz1Xnl5Du_S,hev‘ aeW O{^Mϖ޽LgLs9C3 1Lҽ`&  A6ull lջd!\"3%¶AkV7a"7y+ MJ(܃sXQg>:xW؟L0&'@"z l/3`[&BkU 'G%X(0q:)N9u->TAޔ :H@J>_`/hiDP swQ$܀砜 {,vk& M1uxb`G7.e!r'Z|8CQVJ3  wf0c 83ËW2?XcV ((.0i0< %' tk0lpK^ X:D.E06˙ljCw(k/߳_ dDqhpLv ]j PR]7\ xC Pt 9w!TΡn&BuSząN!b9 a#UP7IN5肅 -B>L6F+`D.d_6a%a7@7Ԥ *{۪>KJm]dASdIt3ișP!+l=[ض ˓ljp fI0Yi[mcUlFR>F~ި(o>ن/~wא-%|B%K)ZXr )xYG+\F\+q7.xwUrqk48rC`o]M|~TᶀWx}w'ANp>{0HV×}{EgX:10֫Ӹj?\9 |*\q&,<>pOaoxP5/gpn(^ -\a,IAt]k,l\M }7sb<+Z ntx'Ot0Wl%yE j!( X|hvXub 1Rr|k\PDOYD3ll9ֈYoH0+(CNqwi9u9r8]bM߁-+G:`χ ܵ5o3g~}~z/P`SwubF.lZ7}m{"XO.hxWciܿD궇 z>lt"]n%"P|%iP>0ބ~<&A8ة/㱾;=QħO{+Q^vccc>netąA W#2>t%{Sه{HFcl#ca~C>ɠGz7I+0{ "&Sֽ/-#?zwq_p>d7EA7>텼CvkD{c.Em}`~0!ӧ Sr!{"Zؤ%9taâ6p聾.z”Ĵd_]xOi_X?(\cg`# x [K8fOt4/htum Vڛ?^OVg\`O1g}{>;oi?Dz}ذ^SX0;q7V{]|x,nIv~ϦSc@~ީ:(A{|y⻎4[pƒk |e| Z*qr8: _p} q?]zg[۫^j?ytQoӱ,:ȔSg~/Auv?IO"qrW }Vx%ݿ,g 8^$H$}k\^r {}|xXb>@~hKz^75NN%/~?Yw8 צǩU`=.o_*;|]_azà;x"p_ڐ]i:"pߥm+G.=v#0b/,ؿO-&À۟!_/z}={{{~kqݺ3ƕ?>iM:>f{ۿ>mw5nMXNЅֽkH4u=r_ya۴Y:ﶯcʝGW`W0Ƕ+A'Ǟ;Q)W#Y LvƙrhAe钃v`?v{=v?.X`Ƌ/6"P@c_R+W`SV(z'<1}T`ʣ}W`ʯ}YЁ-]@>+Oq:c!7cD`S<,C=Lm[@'9)W X ~70@&8OozNr`yiёA|P`}b \{"&>p$=Q?0{y ay~J0(k}`//ޅ1-9}a#h-^p׸px)3ށHd[>SRw?94GyUlŁ!_ϯ2 |~Ǒ M8[a׈Eݽ8?,NYzi|on=W#zWsOU~]n)kx/lb);^L~u~ ~Q89׿ynHZ':v)6Zn9'A @!p=zt\tz?]V#'.\l_fʉfPN?~}y3pwlsw&I)3 <Ͳ-vfh&O^Egx}Hݨ}`/O8~#w-:g+wdr(N!ĥ}so~?{ڇqqNp΋4p"ؐKLjW8pqraYրa?RJy\cd⼧8'pJ!+LJS8'.ʄ1Cل}HLK9\I{GG|HQ&J "p`E{Sl[8Hnl8Po( *\?fru?=}?p쓁px;{Jg~_|n'w=hKn#.9,;d\9"p7͸Ȓwatt?č}Jpv 3!7\Ɛ7y Y^7ss0?pEi gc{v{| _ mwyv3'\=0NOl7io3tvF EC^fYmeUmj9[:a]NXz8͚$q;ȑcʎoܔ߹ o}ύ m͍. 'lvhln<qsFgpjD_Xq ǘBXOd:q/9` Gx>3 m;9~S?=Ƨq0h_nZ߆?>_>O^…i[Xxp}^?%/aޚ![UIwwPg7Ǿb>Ua/)o{s۟< ҄!߂=,%ߺ0|tUzEȹQ_6ϝ}E&/5}دx^ 9L7^N8'/Rsk]*3}yy3p$l9~GağQq$-7mY+~pu1 s^FRG"]`8 Kk߻|_!0 #y)$p$AF>D7H‘~T`?!Kq;?ocOxWOYૉ LU:緉?J6 #s5wx6~9O+0QN+N!|8 7o 'Qb. `^~m™-/OIxwb}}3ċ|s0G2AO[ =>J> z~˛X"AGDs`B~:o-5&Vv8 L\LzogJ9B*rxߖ(2O+ M¾% z~.ya{4l⇚ME(֯&Wm+S}~'%1krV3c>>_=> $θ,q]S Gp}`a27<7a7WsA068LLX@c16>F:8a؞ps{7` -{]>(:4ކσ`tP_1PB1}F" ɻs$u L})?380?uKG-o(0 ^t.8Ә&<~~p1M%?{WӮe:pqExh~pOIc)@Y±L LGŋr!HԿmto!5CSu`:gmx?r^~`gQ=08(|1 tNøSBr|l|Y]`:^OI1/(p2F82iRߖ>fxsp<ܯ3mOW qB)y<8M~gcԛn>fiևB-̨x0k=~@nUIǂ2p_?6e~ @'?}zxT$p /;v o1GVo=ӿQ?KCg࿮:C~vĶ3PwUڭ7^,j-?___>LlY߬ۧmo3u_ۜ}LL{[G6O0'+򙂭uޱ7rAu `GDۏ?＼v߮b6 C)>_}nˠ “/ۋ~p?U/P. q])FwN(_>㩨h!>h,ۺ,n"ڗtH}ݷnw3nlk&9q2SxJ(0'=mC8슦TLig80pG, G%Y,ΗTLrsOmƃe]17W6f:`HT%_3"0q'Unx?gv/wb%yy>ʶ1O/b5m!PT&>b be_/Cybuȗ_G/w-U"N0sG-Kc^[0DA{@' oӞYU*#.|^q+GbF*|ed=x0sʌ`pNU_և/%wQWU V@?pg?u)7 W;=Ty,/%z?{Ֆ1̰Q z΁|ȅj.rVua3Tz _߹9* )dz0*83=30k>nwU~K,bcNT!6 mwiղ UP,uM߷+G{RA;^c;!r}B{](_CL$E m#&8v-bO묳Ż#Xqb/wI~lv2yw}^S;?DA~>/ﱝ:q/ y.p&JӘS82m̺O'O 9@tWQ[:SjO.,eLOMu_m)<0;'עgu¸̩VXpe}TI Yd)7/x ~b{֧g}hW'/"|Eb/ -CW\ 7lGG=tQH4l|9ފ [xW+j loz|}pN;G菱ʺC_k|\o?^SXec g'ҟƇSV}@ceR~u^?8y_YMu7>rB,~>N3UO(p)_Yo~ԩƕuSg\(1 Q._Mu_>G/źsKu@om/֡[}/ۿ;>s|eV/:twꍟQq`|fG:uX/թ;qg b~GKOs1wT5U_/7*{|5O֭k>õ~2k!?X:k+HU7bϳA>}Soe}㇭x,'bԯ]gpzeG?{`yRmX_g|{>nؖ-= )tИTzS+l,ѣzl2>gF~V\>{[;ٖðzlo]7[ҏ}iI'v*ܬYl&ʯvrwc?_Toq^ S~/7zg]t֝~>(O} vkMS ~{8p< 7+0#P'p=Znq*\Nx|Í]Ϫ;zU&zzL;8·Η3݃POOW(&W =a'/0_u.݈: +~Z˸oL3x΋+ pﯼ%σTyG`buPt ~/|_Ojg|XUBe} g Wߺpx(܅ awOS<0Ϥ!~I|X.܉EO2?QDUEIo K~?un;|zιy^P7m~a},k/ҧS"=TnG:ez->wgw,_kHS0|x|a3 a>5bW\,dzoM}4HN~>K?e46 +L.V_7<&T+!o o,"X=ƭJ!%q_<> x-:ۗ~\zz1ߧTU/ϯއX*>h|ma'w7ž`7; c=p諢|:;f IX/[lO co_AXW &R]q[3SZQ-W>۶?U6k%u|=ײ󴢺v#}x":pO+;_y}ޯm;W^{igOu7*?v{k;OO/ｴC.W^{0IcU9<緑*L t}k'WZ2b`#fī$W}qM+q]v=5*GEI`?6| }z`o?6sGkU%oLe|9|?wy?9|TM?dٿ=xOo=q῕}Qh ԇ+ \֛M ܛ l>iy>sfxbwsuZz|Qot֨G6F%x?3 '^]78a?Xq:E<'駟|:ҏƗyoKu~ 밝x1&?eMK⟓V,yVs}O6,/ؼ7?7?aU8OCl|ӝ~Þ'׼^Ly|~Q|%ת".O'J{>Cu=?E<߭E|8N/n=y Wuba~;t7p2~r=^G">) ߧ~}2 ;WS,pu{+e xx=bt ?pq~K*_C~?[v ~pw>o_To<'0X?? +[_w3q:OOAҝ_}>0X_;u|`_O6/Y:kz}~g{}7p~tgp}1x#ǣ{6M5t@kv~Ӣ=xk|;=;F^(yL5Myz?c6?Eoϻg"'Á1:Sջ}Ч&qo&i_Xhĸ۟/N*>wnxղ?Puwn}K^^ߔe{?O(Iu|Οfl9?10턽RE>yfq>}9g8Cl,_yT>$_7o/ƺw]qI߼0m'/>߬O^|dF2fGѽHE^˲?߷޺{cQ|^yu|b}r#rB},->'loz|i>3Ay{ g)?{|䓥|"{= zNz.{O^띖ȟz[azd~M, y35nz_;n~B/ 񛟘~s~Y,/xu1>GaޑK-/ё'pE穁#ȣ)Ɲo4}#ds=DSa^~g,W|jn}wW}ɟsoW<=>G|#O%Z8(켦ʮ%Q_EO(_K%H>w?@=;/\?ùE|>OsGt_{<ԏx?|Hډ}C|[Y/?}p=DЋi0=>OOzϔG~Mϲ~: 훟d~vQ}9wyۗ'^׷<}jyc|߰?(yhW<}nykl[^<_O}g%u,B,o/~[/1MȼOۗ?|M;˚el7/MQ 8&/lrH"xEaa偮owǟ/3_Ձ^4?={%OQ7YqN7Ӈ HwF/<}KoEG} 5xp̛g! 7$wHV»yd>#_рB[zw7 xq0 ~ #'5RX %KMfx={ zTā?u5#URώ ~gc$ ? eWj<FK '#BK݃~LCscKZ}W?Yo+IG!p ?~7𾹍f3x7^y= r@мFي_Y\Qo׍0#vբJQgKflM.0\ y5& DW5(ނZfD`bq7mHfXIꯡTtŮo\[05Tġ'NW ʋL'vkl\-hYv'b s&R_px!Spᭇ1" 8O c w[@"LD/DD2H@wu+1 "Lyf\6B-*65˖}2;WA֤!ꃕ-N! Zz7rbE%&R9px#lMkJovCD["Y_D&"l<M/nˁ'nV<\w Ls3 8 '62;kAk#]s^0%OtX?|p)o 'PGX) q3N/#Ҕ  iMI?<ဗpPOzʏ)އ;>8ʣ\{"neb,17/N C ߫g3c8@Dž$$4ƺ6JL>d|JStՄ;uKát]O`Щ x}pDVɿT.p&N rg.p>dFxфcZHI ˈ%^{gCp3閻 r9!+p}uru&Q^qM=>߽z%\qqOyL\(/Oe+)OƙwuW^{]fyuZS8&{wxH)W2CygvM/+Y+xc}s2}N`XT|ON~>/Y^l]f]; @~6b:ǐ \C45?=)_| oAO;zoփ!_|ۅ'6}>me}ml}wQw{e/LapݏHM7훞lo￿x}3&~gc7AO }e;y.(/ߔvs# CjRN \;o~N=e:v.7syp̀g}k }㹏y> 8Ĝǁ;v@|hq~Oࠛ5AUhP9'.ZhrcY@,~fɕLEL;gDfM…oh@/e@ov kNÁP}lϿ8;G漘(L2KOIm 倉#63=By`ALɂuO{us=u3 oOUh~:{\pCU ^s,rZI\GW\^FοI ,\>M\Oۃ!<=3uo Go_q]LAVq%=4wz%b&o wh\}R+3ǂýg^!y?ً^뽘i?@.ʁ VpⰟk>YPp3_anzϔnok ܿwї>'0+M!WK9@`8"nn˃@U W>_{gl?OcR(PL8Fx<b>=b;/~lv^ǡgluٹ,oq \>Xw>S^O`ڷ}.Af3!]P&; y\~|:- G61{637[ۿ/K׺$\.KX}SX!gGe:@WKXtmτXWL 웢O~1q|2mǩmTutgJ>h4oLGtS) }㺎s7p5Ě/t$ sYٔQMj\s.z{)ϾS7gPoK>_qN`C쪆.PP`{1g|xgTpJ? aʡL7ȑ:C,L HeX;Y3g(`Lq,SpXp%T=Wʽ"4&X0\{ .pOo^>އ> 7B)fnԀqzϑQb*1`{L6`d|[0ӛf UzUN&CyCo/D> s;:\g^s􇈝 {_ 2oޜAGӶ/]Θ>Yʈn0!|O/}7uՙN'9!)2xgc"2^ =G !{ad"qcy KyZn)VPd,)XV|tLrBġLf (!h(Gx`bP@یn;šFW2K3n_c"ǏhD'C׀7~k\Fg-̙FѲjh—w9S#QnEw<JG; PNrQ[a՘q1)G#{qB0Hv[daoAqt:uDcFWzwE#"H3Z#îVt (0p!ߥ0/o;q0@~dCSrxQE;B.c7,6Fۅ($YCYv45ĻҀpȋ>``}2 aPp9*jF{(WUgo\=rP}LzW`|3-ObsrTp26V:%Yoi  ݑ1m`0tㅍvo4dOڦ=xaHu300$1A2EYE;X YD8E[6gy+8S~\\=+YXCF`^W?#7N̬*Νj1q*7pDnwL6[:2pD"n]8bQP c,#0'Vo1=,~`Nfq^6ř=Y܄{f^$81E8N4o'NƝkRb{.V[Rɂ\(0ޤ#oyJ`ս9^Q?Tx7O5͎ȸ|~rO{qp 0;/+3_18 :{=k|tRltg=G̲;p+7=d98}^2ap7?m"^=5!"Ay}ɏS#~,~iyyr[ s8"-Gnw{XȤ';ޑj֗>By|nN{fg΃͎{Gbz̤"櫟wPf6¶չpN2=d~ͤt?=_/l~}pb}_ڲ6Z7ƛr-m8Qۍ⁧ڃoZn:0a,8?#k P`vvy$5dR?*-|ODnʜ˨W+q|T{47vy{Ûۉ̈́Dlq<J'ߧt#/Fˇn{r}Da=0|)w8$kZ->-⽹J؈t~/> 'OA<"fD~^: \6ndEb)ު#wXqg9+ߟ~e{*,{?K)aυ_'v:Jq?'ۋOE^]oޥ<:vy<ƵR~[>{d2okԯ.폤{JoϺ5 pIy N\o#-? (ݞI#cݗDzڟg$ T}*p#~/pY<b/Na }LyP^%?AWvL< / 9Vb:tMrV㧽e:)穿z 9>)׻/+H8Cn|>ܞޓ^n{ Hr>`ªĊzo?%>.Y__ĠpҽЇ"$GL33.Obd,Z$ӷD@?ږ0g?ۖOk.x߶?M<@Kn:ʳ|iU4_QoMwʷ6eK5o)nZ~v րfqlF#N!-Y%|YMoj.]g~Ԟ]6,'$GZb?i[XxZ?syqQَ}@m_T>/942O|ٶ웦U?/Gf}ﶿSߦcϡmAu'E,ۇNFBQ>m_& .>x2DyV|Y)Zc?MI,ŋp'\^Yѱ) ؛x ު/#eV5C4_ll. \乂BI׃h}Y w=q<:N '{|җJb. VNƒ+ƝI~46K&=&u' TYe_^Zݾ#;sqkFegsY5>/ܢT_1_(ɾ<`8rXCQ|.Ϟt91>KL </F]**o;\Όڃ?y}1f7;)/C־_}㫼o˾y2[պb8}.+~KHG+w'waKh8o(*ݟŠ0P/pXf,Eq“UqWTƲϺtš?qWfIh]6x|X<8,0izډiXV&]V5?Ql,줳Uu0_Q΢?2HU.w]\GLy&zI}yfq]x啙o\IOgғ.h.$ݗ~u.l%ubrv3BăNw{̕X߻O#qYTD+bmdR|Y$*k_a)rWY$s{6S(Guy:7'yƋۻN[Lܬ;e?߸qpgY|g}N"7b|I ,.g|O:k`U6x¬' r2=ݦzG&քĚU9\4V/>[/,*`\oe5uYl[-c*bet?Wej\_ ܈%?*Z?0.|q16+GIدbj y5!\U[n~|Y~cE.8|g"ĺlwq|8>"TE:[aGS~__+c׾{yt}j 69xݼ|1%y2ݳi_~uJگޘ|z{jӨi~y|vQ~΢^YFc1檢+^n*B#Ut:x(005bm7;W˷"=ΫjQTj z_ j*VSťs[EӦwE4~(S+p} E]A"b7|i*.Q)Q_{+mo@cjR^"]_Zr{-=7G|yK__f^728H:,@1`hy^1r"w{&Jwnl"?hE/w@?ux|\Xb 'âYDOW;Z^3.Ok,h{Ku(}jFlN| }GNT^Zq}g LZ9IEj)i}p9tƱ~|()6ps%cWv&ԄDXC~~YKVpZ}Yq>*#;% i$h6{Iv7ӰyѻJl[)xaOYzE2|`ط2|?ƓBQ`؃3~#.7Fb؃J`سѾflPK& <{bC2PJ{]1]xׯi8{}8W׹`>?평o4?gkoVX}4Z9K< ~՚O6b Gw,JYW) {_5K{]5ڇǴ?ꕸ\cIEX|b9W<3N{ɞG?1DT!?\CPHӀYd2H`~d~=ܑB4pN{ճ?:/2|b+x3=];)y??IS3L9D{Kז8'S/“!7%fc.QYbKRK]#ȹJX$rR~QdCFҘ_KR |KyғF`'Lj8M!t  @:hލt zF(ySE”UE 5s|<'=3v,MhHҏ,'ggogvH ZwEnOtEvвX"?h,LZ.2M("gXޡ(ʄ'EM(rs-L&na(tL߻ tf4quUU*s4OU#}}aB@\e?0\O>L+\(SU°'KxpOeLeG\zmZhb _R#i=i51-ZYb WfLgY8*ҟ|uN:K=/gbwiy޿Dy\xX3Ҳ,bnzS#Y/HkG;SLE<'ϵu?9?)~" `"E# ăw*~L\k,QD'21}X.,}Tw="&唫b2䉘N|2SYLY2_-'f`\V$<6ocdp3w}=~ڽ=Y?\0X.St?r>f>X>&rLz-?yr~i<2װuO%ƿsKc[62M]<G妱??cY6YHa9 雕 7!%|Q~Ɣ_uǃNy,bKNֿș ;%S^K_wc>'|?P路M!'?~B*2&~z7/#'l\we*tz*Mn )puz:m[;sBYɲx@eJ_$\;6t;=e*3)#p=2x~,'%ܰ&K)y"ʽ< c r3{a>'"W{Ą!c-p·MZrFucxi։mloHiK,&Q=xPX4ez_,Ub9;KX5E&2(fcF{{SkyY{>gϗMC|}]mxj=;.^y) U50%m-qrȽWxW<*Gi,0Hqb5Qk#d1͔ dGZ,b͖w+c9L;˕bCS[/[^s }p՟q;#a_u2IJ+3y09yr? Yd~|g}3A^d~+|n' b.]̌ߵGfW`lĴ)+~\b2<<(0p;H 򺯒ĄN&Nf&LsWJҿֵ3 wz_H.AB'׍Yae; Xߪʤ?%++L1D_\x?矞;n{FI6f?ef3F2~_oyl<[b&_1췛rW?d {{f!3B'gQ;9qWwGP<'!yC#G^Q=,3oyy7S++ mVf<~~U$G^S?|/~(>FАWJ/|݇7>ɾc/~|)?mc'_yw-qu-B-~ki_5?`;_yu'1bOw/zgozT#6G8wc_雿|GG9 endstream endobj 92 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 95 0 obj << /Length 1021 /Filter /FlateDecode >> stream xڥVr6+xfDL+خǦu,y*[HPvžݷK`?GNt\(iҨB(ʻS/R*ӻex z:71͟ĄF*;QI$(QHXeBe^.HsFTW7[70CZyGL (5{l IDp.|i2qxw>#i_Ƹչ9NG5wsMj0טMX}4،ҔNE0LĞ'84(; h ">'&7!i1RtZ*rSoa ,l)&WX3%-8|#៺r))rwJm$'3 Q !-l0IZ.$0~FctIb| օkr@>v7 LF  )Tir 70g-э+m7 s}k;ve`CY-2*n65u2SdT7t\"ݫEpw#7Ѝnnl!q8ɿ)N̞42D^HDoW!8 J#5sg)Drb/<8%x;'!'G\_ܮbTk5H7݅¬7b5ڽ5,n)cuW dUw—`gڕVr@ wHoh+ ڞ 'K⮒[ɛ W)W:I6?4v!:>1A.UC}Nf|RVKʚܶ)Zs"/ӖtsYg}!SGy-Nݔ4o6> stream x337U0P0U0S01CB.c I$r9yr\`W4K)YKE!P E? 00(?;h0a$>z A?$h LF N8\ù\=Y endstream endobj 116 0 obj << /Length1 1767 /Length2 10288 /Length3 0 /Length 11401 /Filter /FlateDecode >> stream xڍP. ťݡxC"8wwעC/ݳ̽$+-:$ sbfgaH(s8Y8Pii5N6Qi@PG0N_PY& tz6Tmvv^66 !P$lPbC@{w(9LLlAP)t>g4!`tr`euuue:@LW%@ )4,*!N@(,]@Psv"@dL`ga;_޿pBlv`; 9PVdqrsb~m!@ hlG@;_M`{'GGot>7_+vCOG۸eNϷy5y9/D6n 3UK)<ہT!t7gj8>;)qpP(y8Gjrc,vg39o9{Vߢ?Uo`UqXA~#~^+`5fj/` >5rFg\VAn+_9 _ s!vυ@\϶ωUsbN9Ss('K(y:B\?_4uB?y u~b6Ȫ:Rĕy$v=<)"-`z)?؍)Ew!@T(Vm|uno4w_ YCtK C6C5ڵGƭxq8dfv}GH}),WTNd 8nS8O򱌨޿>ryqDL{,jp8v")3Apֳ0?Z>$"ߜpA UE1/X<4>j_ss<$஍zF+ނvTw;eSi@>kU䯟lȃ.DL#xSW4v$I訌sc0o얔ohVa=՘ߙ>Ruc R:C(lY501 }>Ku*°UC#Bg #䜥;>y[^L"P`̬|7uk.&qyXLL#+3­8R;q-ӖK }_.0[7h K (WNkaf+S)Ue]n*)!$(*0@N6D&.e&>у"z*~n>_yay *-lݷ7 ]U/YL% `ݪc5͆H?ƍ"[:㯉Tz-0{_i!%C!FcngX\ǣ%\U<`_W~X|w<_Î[JyOL}˕4ы$8T%MhY9Dg݋fѦG9fUprC8@/f$L` l?l qxZ}&GMZYڣi&ά1JZ.9^7tne0vn|}2W\+&2"kl"tAa&YrÒXM lzx~ f< ѩPDtvhU|ѯ^aݒѨ U]X۟1Զ I<$o],:tcB v͸gWtZq)u$R+/J t^5'ז04N 'c&佌oTl/SosqsQb̞;" dGm[;1?'=G}0o)^;0oG@DvbM/꒩bsU0}pp'EZfJ&Qq~v4KyaWÿ!ӓ Pcվ`Fi/!lZOߴ696 H9jf_j{]$6LUC'<є$D]U`~*Vo4,̈́{NhΙYqehBLuDtAQf#\~z߼JY$~fa:q'̂cyF}[DwC@@p,=vV4NP+n>wxr#d]yzbLO"BJʙ5@O%[05]emR),.[e߰iR ǯ@Z{wI}Zlu~ٹw[ӡ2ܡԛ.zGkw~5%)13yL\G3tbsyU|VN~^h&X[LB [M'10EU?)>D{^R#Pt(|PPZ0 1~?%TS0W\.X)OjT0ׂڠj%M6o֪e&W?t9Wv:3Ԛ]m(2Ut #֐G@(uN|)|R|th~f.=Z 3}8BrC|#@0tk2+w>ma4LꬴMonll}>Bd@54]1 3I/)>vqw,ΛhNC3o2SV]T4b*$哆ޑ4vz"i7skŖ+;NDݝbӊ.XF.Ґ2 glAvdG+003%ű 5GxW-Ǭ_d(TEe?l0,[QbUhj7gZbx{wU&4aQ ^K 'ۆ}cSИA~tL+0tnA|tdչT>G6FVDcu}yZp j Ldв+=Qxk3|{4T 1!ik24󠬄Ȍ!rZtUW:Q喠§TV:-:pJP=_ӊT?)1bL IsӍ7ᄇ Hy.azm0~90$5nUf z_ol9Ms ja'LkbdrmT$^iQn&sf./uHJ eo XѺ,wTC׬":ޭwݙp~0Kyz=tEm'Utv=i@u*u h]Z ڔɘ,Z-ЗeSz9.<nr.ݚԾ7,+ht,rxalQ[~Av~s䚊P#b)[aP\bT]$Eh+^`#Dj'S ~BƄ)*T"ff$nE4b%c8\js*rr3Ha΄8~Z*~rʑ{omQc>jdL@Bw0l0T+/#o%ubgG +pQa>*Dh}2>rl^%}מNSaSJv/ě9uh;(ZegH i2$ПS3`atS` l&abT/Z-`M/52+5txXYMC "5?0]Y)esxYz\GQlvڲitՒ?'ͽ$8.|s\M|ĉwٷNKMh.eWCxEKjCi S!뢶 kxްN|ڸcHt+B•TEO1} KeuyewR+/=?Oh)‰ߪ!D ʫ oҵaDNýC"d <Tƚ.Ȏ1Ⱦd"S/{KOxV|eEV؆7n)Ktf;=FpOMhGvLVJvRrhj2de1*S sH zr){ EÏv̊\Zwz t'lѰdoҚ۵R3ndS,)c:i殺ףS>d@*.p b|a+B@1#TG:.+)tP%;>*G9GƆ| K+7(]#F@Z >-1&?J53=BNa/#)d_2@`6;e릛9!6>xpWۙhiڦ-10Hn-&3?X}NjxJ|]|3{IRs]Jz6a}x32 >n 8I~d$M>cq(%EՑ/7XK;לg!WoDpX<ҫXNiϹb&˴<~T7L69a$"*0xN5~Vqy^7om{Ր?/Mz^'EҒTfpLZJ6]Ҽ,3x(q%-44Y+8[ x drTMYCO|`lϧNR\*LR܊6$AI :Rp JD0m'Qq2\1{^K2＊qn2 d~ Z92ltXS9۵)U c`1&TLul"惑Ú0-pDNJE5~"/Vx's!zF#AEYr^IMAW2el,o\]֊@z$A\:p ,_ɫZër_[K1RVO7꩎X}'_#. @ H_##b iE}B6/l&ȱkES\rKpv*S3%I3.k~t R29מb^4V*L=RT؋ C ; EjZrXM;.rEmIF/of2f4乚NY+јOplTg ZydP9~]˄$xXLzE%C=FO_?)szYu]ol6Yʽ>׫8mǟjnіT413(Ǽ混j`c ~ ŶkP{5EN4o൯pr>L}6}IYEBoBۚʜkmd|ø&8FNͰK\:-1 ÓnJC-]/ZfjnSϏOlVʹ&ns0&k9@N$G)mx$q>Mlg6u~Lż!;jqlSb??o/ݛD*$o܉IqaeMrݙKN~;JbE%_)0tiX'ןi)e*YoO>qTBMF;^v5?rI96P4B✎JjAr8FKy8KJҢrDF M%KXPb=H*ǥq/ @}d'>#}rr"|njr*nI`l~4O#alf{dlz˶ ^yV 1r @uƢG(w@Bfz"eәd莻X3Jz1\u$OThLmM.^]c5ʎlmďzUG͹jKUF}jFK/鸀8"+Paju;>U+@cHv-ǎJ]&]?O6 d"A:ݨ+#Ծ" d-Հxs|f`ڲyѠϵ\3F  eoʻ!^@>\߅\("\¶삑oIҺ}ښAh Ώtj ?`HKe~|ejOsNW?_3'@dڴ8v\ nϘTe 2zc‡&VO1֤Ld{t+=]~q/1(Ȼf $JV= Wf;f{-1T-]^TORwXwE Þ}qQA*•Ǩ l9FEr!M7/Ni&gܱfd`leR'HC;6=- & p*QRCݣ cm@uD_D'F':c@G K`UYĽm6JBoUD7ȖAƀ,ň)ޏ#8r9lvm w5:nҵ"Q,4΍O m׺ڏؕ{gwx Ls,ߑE|iYH׹sc\D&ή6tKz_YAXڂd}S_㳫Ȉ.MӒǕ ]fCI4ɬ>2vCFāoG> mL&uH*fK^8Qi'b^3qLM:5"V Ƴ) 0_J- bK}OF/vI<F{2yz";~sE}>Ő*nV]YRRJ.Z޺Q׺si޻^Cw`,E&]=>,E㲎+Z 0;<% 4e[7^!TTdx/2:vmDBqWE6v ^%Dw4qErtJ-:ܴ/-[S[Uq=&x ;@ pY$i#LYs.ߪcޕT_ctxXnvʋҧީny?aOcZ\0fBq¿ P_ǀ2zgt'1-ɶm;bΥ…CR`;꾏~ǿ^z/CY^h$'OZv.mٌ) _!1ÍRĂ̾4DaZH9=}-S8ϫ(l%̜6Bۓ=uhx}̋Xb>o*Gs*ivxPGugGp^+ [B,%g o#aӭFC tfSꭋ eoiQ;!NHS-Q%}o- d8'ΧMάϵ{~ ""E8٨Z"vZ$v7";./4GYC!$QMRK/R"P}ו5ELAE{؉,>WdH#Ct/RpǣM1qC6惘K쒘K-5ӛo T¿5J WDg "~(_e3)4¯$x6pcyS"n[Hyi=.A'OVƐ2ZzoF$7?,trR|QyGO] E3>5^L.xϻR q*F,|[e}ON(E(.z:xlBd9)!ZTݳ.Be(_i[hmGWTi~|B-P+Jf3qA;LyJČBDUy{ 1x~7m3zr-)[$uRrQ$[?rM%QA@Vul_DHSkɒ/R]P8 p;|gd-jѴfǷuRO'L1"1q gH%&ЉZ4kL`&f2(<~GbV1Mhc?TO9c ީX}I4J=ߞ*"nF/7@~hC^ŖME(i_ˏC-c>l`rѴ @DǕiD׊ǷJ!bXn?>j(.)F~OS 'ڧjmꖒCvZEs"/Uӱ hD_>;gA?Hl"![,9]oԣT(Fo_|WMoN|5~`>RU֐ө{B͘oJbFHXjtѳz1g[EƳ~Qw=1 k,Wh5''h J- ZX6fy/tZ4_Hf@xL;صjֵ̋O^< iytJeBrVsdFѿѺy%gߌ9ʒ"~+/G c:n-+RTe\u,o+ ^Ɉ(*qgo棚rj Hw:ӓ6ڗ^)YZ0>OeϦȧ{Pi0mgZ>/ D=jl,)>s : T㻮|od$. .M18z> stream xڍuT6U:ҋ {/"!%j轋HQt邂T))s>ֽ+k%;XPi@"Ђ ! @UWB@) NeCy@`4֦AcH$ IȀ$e@(7A|]!=$EʥG:?xp; B]掭P8  }u@C2 {n8 Jm:ACHO A}3\WG88!l{zô`&ۜ`h8PZDRB¿ {~;AXAKwaH1^a)pC{AX33v(]?'0v7XXG\E͜9UT~@PDZ$%EALMsHpDbmL|YA]hoB_ ~WuFnn<?]ho4VHD 5h]ZhV$'59P9`ӻ0; ˇ^N U?K#H_@P(?)vؓ8{B$ 8"Qf*{y~a~_nzPX^lϿ3SHlK]dIM_\y13vD cneu#OlGgV[IGm)4QZ 4 soǕ-EiPH{۫WW]ԪZ6yٸ`iMXW}$5 1͞4y=' N-X-$NUxflĂDnFe=GLi dG+MEc0w68>}ZJeP%}[ Lxg$Ӕ {7oQ6-;6&N A@5uqrpQ⨧}9 2w *+$`dE#>g<4_b$hQj Z=w {POi/EbLӝ ]:~JsŅzI?g\`TR".Uru&Qzbj{b[Rӧ4 “//9+n>20sIjܺ!wgzĕ nrOD;o|g,o,I)GS@ C3_pkя)V;oZ9} EtX}uīcP]%ʾv 0VDݺz(T{a`SuRc`[XfoW<-鷤5!6eJkSo~܍zQ;6挐p˰h%kץe~lKNP^筚/>*8f jO!3%d~2y!fHQB%sɎ/)b3 ˾7HM{Q}SQ}XAəc\Dam\^t-'ؤѼAocDu`t/p.kQ:5jôc Xrg#+_bl>Ib-~\!=N*n\Y(*|-vmz̸Ņ߫ۆZ+> 9 O}[t\]lx-R뎭Λo60d(*)Nվ JS SJ]'-tEdQTsN_{ӏ` 7OR>T[&ިdc|kXfP?h#rOW{.%vW2gҩo;? *UP8L_wQp4@7]!Di.*75ەb)*|8;=łe%Qx?Z|M/߷Y9-?޻ύI<75{\"ZYLΒ&UE`J$?%H&YgԩrURPHEEkKh3 w`@r6{x &ܐ:ՖSCIk 6iUY)2O OdBW|+stUe!˫ʘcN2<ԋ$74)Y~Q{fUl$᯸>&PNÄDjI'1ɮ)hmկ=_ujb.P5O1q|SMөSnwCv<Y&]r"f=nN dDbQJiiCZvXnnǝj46+)8fSH+` '& -z$eɓdfORFWH$\aTiHNd5.' r՚ώٷ81K I1%*қȚvdm3QN,kO:\H:yiwpqš3Z{;krz|*uuU 8J' ]Y{Lb\x/h߲xxKw@,ё9b&)ζHʀfcq6oحi.|jƃ,Hc f$ŠD\A{+N)[<Ӻ磰:f a,,w%o(vgg7hXJ kR\ꣀSԁKjR0pc)uHd }Lտ[S^*!8ᤒq]%m$+~-xF>, EF)qPs9#W k'9lT㫇vVFv&NwĖr>r(f\s_3/SQ.5K"[\K4zMlܽo6G4>rS]FLtc9z- v7,ud4YUq'x1jz=}5}G*ZOOqeAж9Qoj| D3ʒiF7hp%f顭Jkʛ[yF%g4f÷VT 0Uژ+&';lc]'q[#VdW.'MBJR:Dd5P2*a[,QMLnH6()%(D?E4GA; 23l~fO3NIH\t'&9~˴̛SVGpWCw-L0RZ3 W,i]?QǨ 砅We.}aʠZCy󊪪BXv"f@L f7r͙G@4gʪBWPlؗ~'ƕGD )խ̦-ya4,R7oUS 22FWʜݞ @mTfWwfۀK}{u\uEUExa)CDO)_"{5\Q=]?,1x]{=~0L[ycB *`%NGe^ ܯ'2U,[}hߊQ>y$D3`6 r .S{vlTuslr;6HҖd3BCJ5,6G>Q̌=_kPj)p_ab1N>)dNM]? Y}:1&d`Wg9M a nOFCvXNXث,338^Dh, ?iY|jĕXr4&'"E GxF̭{К4F<ꩤ.2Q+dJ٪pB ~E9&m6|{xV֪]!CM'|Btv "`WK8Zfv-^~sOȈw 5 *'{y77gH|diA#/%hF6I$嫗%I3jOžÃw e2rbZS16 =bD6W5PzrWd!x$6"Ou=[g7*~C(u qBFFLX\5&L|$!!/ z%ev\2x"ev^ fÕih@^[ -NZZS/fLc` ^?v%%͋>\-k8gOK\~\d)i6ޥ!̂+77Wx*8 Tf:H}4W=$=Lc8ǔB2#"(WXՋWE!\lfŏq$֒+D1^V6ͮ^_(n.I3xg aO NsQ,eNGrtvњ9B98ZG%^j̼U1.REfd ԜL-j/ʰT*Oj cUv%neNȱ'4-/ȧ.F0CsFW,*4_?2#(iqQMP(b@3p:_Χ}7f+_=zB*deɹKyPIwYL3)sqWSP-G'+嗭q`@d/u/>d_Y@4j zP8㨵Av:ZG'ɭ}el>+V#N3 1;7/+oI0sk9pʊKm]cpZViqL9CIqG~&oMP} endstream endobj 120 0 obj << /Length1 1521 /Length2 8489 /Length3 0 /Length 9511 /Filter /FlateDecode >> stream xڍP6[qZ\wZ @HCEKR@K)Nqkgo2}vy>{fH!m )@!pNnQ2/Q wb| rBȺGTB*n>((77[o U t[9*P( ur{ `bv:nrz ЅZAp`ÝE<<<8N0N ; ` Ww57e 5N,Fg@jG{LqX\t ȟ`?쀿.OCHZYA/0`v48pvbtA@#сim_`V`g8v͑wkXB@8 {o M͙Kvq)ytag  ʎz^Π?<ݏ|G _ tn _XK-n͟c]GY=* qs˱E p  SQb}'_`knXB(h?7z?RU{"7G??q/ģá}B @N:Qe8qH!B)=AZ`ݟb{8! -( yY9<>.ǞG{۠Q9!VP3+ %h y\(1`uhAo KK% z|xxe 1y}/Vn P#?^d5; oiXG=L4-2ǀOXLΚSPQ0!r4}H΋–-e/tSx RdEK]0%mt|zf=?-SR m+R#yo[8#e]q ^}kA*yQ<04@K)*P=h! N /6H)Ǐ^r6}7RHXW=VkP >+.k cz',.N@gt,К㓮6,z/ҺQi5Vy)^BV+'-<9}E'iD1u=[kX3Muq@BGT,[u)7Bm0$$X.fX;̜'0ˍ!w8>揵M1gOB^S:zFbLv/Ӆ[ Υ#mj7ZrF&ȆHsOUL^0c<߹M\ y.$}ӵso0 {m =\$dVN叐ګgc>gK5W|f~Rb/m͚3JϢJj^gez :ƻm֝x,R,4F 6@Bi;._OeRL{F1 D^oSOE!6}=rHksN"9O8uQqVBƮьC\vC7 :_E'|xt4_O(MQ>DL>/a' ^[2K68!JGuo`"ZƠXIs?ݜ-f`\NFOtReGb J4.YzZ[P6ag!@RaЩLY!PBc+b#,c'/H3E@3.?MXZȽMn>np|A6!ڳO$îllJw.S*ٞwֲ #E4!jŜLSE$9+Z!~BT*5J&]/2s1q 3KDg>;V!c5J¢{m|Dpv֬-]PFjc 7uOF1}+aN;l7̫,Uxܵ1/& 7hFҬWR[. N%-548ezθnʾc9#&U^؍v|U+h]՝`A:a/|!WPb93F"dVVBf:1dIzi,|PBkdC=RZ)z|.Vd7^#_@D Ƕ*,TsjL,E]Ϯ{Bl86 I=xh)򊖶8X MQ=d-v-+ux3MCqQ!8>]LDo5~Ѵ\ k@Q̒J{g  )J}z|rIV# _>Fّj +RyWϻ %u>g>f٢9~%Q8cvA P*jb ߔ\dK4b䰄ax`Tj4&u~e8-bPox\s}~=Qa쭬Ώي*Ly ރYR }rVW]K2q sDXw<,Xek3Kh6̎^Qg*r'Nmss܃[]0W5T65 CD:J R&ff<_ tӅ ^=V Y4giTVPBG D%'HjEgj]B3/ &rC^5E8Ш8s*C$MW.̪FFd@OP([_7? 9YTR\{M%f2kY({dFBPwu͒B:&,*Jvc<e_qW7fey{``Z QSH33h S~iJeK\ pý>0?-F\՟h@KqyX e\*814\Zz$xT>ϳHδF-wAj%oGoG9%d:i0.uU76^eB0ׅMRl>Υ{Å!{ŋB5 GhW`֮X"?W98M~'~& lkhӻih'Ϛ3;O7~wtZO5}^ǩܤh3,{='X,Twe={)$C?C97 :U1Dq#(+ _w ܜkkYC^>iCyE q"%(Y_!2IcvyA;1yXNDh'F#‰d*~嶍hZ$fUirhW`ˬ`XU.4e{<~t=~<펰՜OV@꤬iJ>@4ۧ7[\7'u lmMIJm+ i ?Xw>wӏ<3K|+8]cXុuU%d`&C=AoOZ?1եBzp;ŏ ~"{]콞*G|A͖6ψ]Q̒?OZ@tLT/ӫ%aP(p{f=:'yO% 5U?{ngt&4V"ՈF}uXnYFk;5?=\MEǮز-[XŻ#tN7VO<.DO7O';8wǰ0W 9L/56&~~;ջUlN"q\tG/#.oG?2#\h"ȑ-=ʢK1A$PTs(MW·MdF6 ޸n jCWh'\[OsR&'Kw װ[:ik}Y,Ar ?#ݿW= {Rue^xP#v72SѶu|5 rKwgK`^^C:(qU q wkFnކw\Z"4LkEQ ҩx< ъS;=]4A5eX֯K*Go}FYC>W(-ޖXwlɫgMPXXuCư_Ppذ۹2)kVuG _U 9_]8!ߎWm 5(v1^~%xi:>&?VTGTy)l`j(60N8^&>^C#r.WI.rFv! { ڞt.n ^QPt˦"Ë4yt:@< &4iQz/CXCi>3 B!ݼUY~>=U ~:dᯡTA/BhNPّ| n x Еq=R/#blV[(IVIz=:c3j2RB{`Pm-Z<6Aeu*n ϥjitr҈j 2)IE5(?[V%KHhe7DŦO4IedQY.[t6k G{q\І7Sctt}Ph~Bzgb1Wln?&%2'A]--T@1LuM5*^^ Nc+ 9Y?&3texr&1Ҫ= #1C}w7Fz! Eie3Wѥ^y+ RWjպH.y[1Z݆DMt\S ba#WYQ!E\M˾ޗW(8[B+Wx߻z$W;YNf&G+Q4+!' ӑPDؓ:5SKM+Kɂ򿳢%vf[BAǟg%vb$!y~_K6/^m|BJaIBop]&Z 6qe::ZVREܗ"Il&hH/8 NgPp5K|W9KV :rhlg.nL]Yq* bmp7hf.ȚB&mZX3/F%rz[+Qm Qw~QAodS͗ 7|g}# P d3]sonwZF[)VXӈ+s!NHė- 9[Ř;& ǥK铸hS~hZPr vCaU>|Wژ -/x6 ],XRZsE&\M]N,Y%e@xԞl>Xca['H(5ⵂ{f @@KAfJ1&>'(k(EJJ<k,Z E5u J(VM=-L?UczIƹ"|mZeŬe[ɡ}NPܼ> zδ+ vl%R%l|lSuh TCJ?y]O_"O;ֻ#1nP O $*K`m f3c_yO8ՉIZFM_YwBZ|w˰ΞJ_w{xwke[_i ʊ_g㍁̌r+pW[JsߤT]JsjL/Pv٪CY5O)[\P,n ;IPҺ}grY@+ h-0I!#GZ?RK*q:w HfXxڻ1%yoM\Pyy~ I`YYA5D+hd'_rWm@H) L"V 63~0p|b$ۦ>Ȳ@|SO.Y/%\QӡcWr0dx\՛mLhP88L'|Bߤ2$h_7fd&0mR4p^7ɝ"B~aJ[+B*8G[%#jk~$b(2z::e8Mލ΂CEC@Kc2)5}t$Bef Yb ~Q!9̙5*n _#\}"HRp I7 Bx_և5~ qDKK#ը'f?|TSj|l {Uáq|O\ŋ-L_"jgR $Ld&Vq_%}K,@yWz]^H=Ŀ=s޻a6@޹_\ҕ-vB9 endstream endobj 122 0 obj << /Length1 1512 /Length2 7544 /Length3 0 /Length 8560 /Filter /FlateDecode >> stream xڍtT. 50t%ҝC3 tw H#- 9u~~NCS fA`.@FUUQr@<8:vGfF= _2.s&k@Ʃ %WG @H_0@ B820gO;[r-, ǟt P5GB;Z;av`E Eݹ̝\0qVC\ V߄jNq0tlٵawsip@ WPw@ V+\O%iX9B*\j;C曻9[  / 0G9 V20''}>Y;%=XAruօڽr(4fAABB+ҖwyOg' FYC8ps7 ߎD8`0Aq]iXw!~Y e:z;O4tUbOZp`0D.|?/vPkY ߺ`{fX )f7,I w@򮎎,]ȹP!ߡfYbe^E9r>6Hs@|v+ ;_JW/{8A!0'9vg_.s8rCS球Z¬~#)$xsk#x7@}0mpK62 A0[$ o?0YAd-C02[ ܿX,Ek?_HQsn_pb!&Vmjү.sgOh=9imh-gL%y_P|DO)uFѠ"lǖf$x\e.ɝL^P)Zk{MY*akZ&> ̹kNqAߣ#2Zpݫ Wz;7BDr}T|zn{ ehi$71 "lp Z 2maiWABiSa6VbKZMad+뎸c,Y׶e'~RQUF\y]l ܋&pGNwIzk-B捀JډKw28NJWEM")܎a|2*,=(*a?ˉi"fS02H -yWE&v?<{GC"L <NJŚ$wbC\! d%I+ :Yy΅ ,W ގ306SZS{)?=#w[2D?vϯ,˧ Ԓ͘z9ZBB{7gy^2T3L?vzAix{}5]o%pzivbrVt~7<_^&&qȘY-rg'K\M-:& Zl+pXg2|miߴm(E _gfD`cjgYfnz0 >">ML~J$P ePp9ѧD5t1Ħ  T' %Ew3~:;ǩODxa)[x3]xNH_]ϽW1BUʆ "&U{%a2Wd8īn/5> ANK^\6t1R濞uN=|u>)U횂p-@k>j󮦨gBo)yQ^ rLVqjEʮ] e~flS޺29{?.*V;T(#uA;7⻪ZdY^\sjLtJ͛צ56M]E ^GQ6b/)YnF4(^&y?57ի.EbW(naP5( K'SaUԲvU :/l]d> Uc@ɐ󼛓Y싍M0E6H/32 ^Lt̽UwX;Ʊ7t,Ou}T{nKӾ.u/0UkAr((dc%gDY?8QFVӹMe"2N`VZtf p1Rplkn  fxWty$bp][GWqk5p";\>^tT[mL޶X`DEI7$x=!Պ<»qB[ݧS['7@e~&zj[[ukX}'f(= zTbc}TY_w;*]מrtp{?5)q$j&/% &71Bc+9߉C(|5yK:|je9lzWhhʪʐ5sPUPOC'rEbR k;Ս]J+<\y-Z9ٞwZ%^K:קaq@AP@ @NzY/@cУ枭v@EK~4Ig: Q0[l[м%6+48 gEu0*N_3~2JYpHe _CpD}Ѿȝ9:˪>#&IAdSoZ/HH}'5G";BG uɆϝwksf-߲Bi^c[=Ppxl6ߡ+Gҕ=F>3~I5ZMf̃|QkMu'6r,ލ6{@/`/fz8 +7s1d 8P4J5eQ-ЁNMs?j4kݡgO`Xbա͕usw4׏ \eS9#8 /s{I.Ց%'6Se;/VE)*=p"Z_cdDyl&Tϱ l1`ey*ۋһ SA O^$c=4ǜl`2jѡ[wxQ%vY n1h8RaD1T{2ذZk(y{(1'#0FNCQQȿqN=ΤM`l[ uk.a_ /Q-ՃGqÚkb^gf%QMGWz c}lIlV՜vCnzu.y)WVxZv:Q:6^#zA uwP5͵T ؝K^#mȂHdPn<ϻOZbͰ9|C,@j_?.L̃8K.OtbKOH'VD ut_+qeUMEwmzVDmWl[S& 28Vg+ܧ˪c[D}zV{mw|u{23XQ.WQH2vb(4)-娢_l>*/%[)=se4T~`հkǵPQtɏb!&Ł`KOTɝE ٛc=l FXT>2I1I(gwdځBz o3"o2Ï d\NQaRhGz愌2x$%%Cte^IvG3|a==7&Q(s")|L(hm#WG/ǫ( "eV'ހ8@)"ws^G **XXʦ3jc)+mqۚ鰔ڟu7J)u]bw(vJȦˠP%}SpG*1(+/Vx.ʛC͔;/ޕn$J͝NXZR!3Ѧ\Ҽ>A )NMf2\uSKRWHrhl-R4GeT\1?$+2@>#4f2?b X?%R(0N,yԻӵNZFJBE A\;8_x8Yխil|s0oшz-l;(ʦOQ%M[&*ʕja?"M':5ZĜ1%PӖrP`$:닓1gv*#?nUC75]-s@" ]nM:XS$ KE 3.3V(41'C_\o%pEe-}WD*'^2wYQ7kўe2r̍yTLTg(/2JOoYƨSl&#B/E31=Cyq)֡6$;)NS@-Ehtk&v/MM&2R ѯ pS47CɼS ~7 /.3U RIFnQqQ; =#t 1QA}lngLOlU} Ktnpyt,jg/pZh]W84g$ I4Jo_MFO+ɇ(o5U]k|;Gfb ^}Q? .{.:wǘX#Uff YO/=ƥ}3+# ;?;#fL#S.?S 6]g)" bg$+9K߫O6FZGCJO )%/m)"lǥ)A4eOskeȯOCNUm55r'_Ka~$(bX3ʚ4X/Nx Yq&Ł~/>KvNhOj~6a1WǹAR߮Ψ(qxF0+MJ4AfAk.OSkykU]::W-kOFJ\7jpVy=Kܘ_DZܺP*i'JOzloAr+y7`$ûI3Cm\҈4P8r{=5Q:MMrIV 8$$bPG\,j C1ƲN\ՍЄ.ώl/1B|ƏOp=y(S4!}h[;\.ܢWڗ G<g G@PՂP$Π<+6|Kz1xϚTA 3Y6D(kMf^A99ny]|CޘAQTȐ;#db'Ш!cxi8!ⓑp⤮Hrk"0chaK˹T'f[`&^_))6OMF7Oife dG/xC80XdXVzd{ YwA;t)w`"L[ݽW~.TdN-fyqQ~&]i5gĮLgIkYVĊ:O,i,h]w*$EMrCOI:ȾBZa؋Jb&"V8u>&W"^8G(i3N|Ұx G[ӤHF> stream xڍPk. u!0; ='K 8] n#{vޚi}鷾bZ76 ;@Z ɅJO vs-FH,^d2n/vP@B.NNB]2`k*;@ KC]vn/i`bYtH:\V%@ jyW&;77'!OOOv GWv3+fxrx PpU;*=@\ jiV 닇;xIRT; e 7 ;#򧳅 l +b+`ab-r. vD?¼tYb- utA\Q8 dvo& lk?vwЁA2P#x999 gʎN??/:A6/E6T_W O#T ` rXlDl/w{8_p 9_7J :,Uo ` ˃wUR ߇GDE  W /Wӂaw5 APߘ (7T3-Pe-T/_S=_ ;Ve=$!n#UYšM%Ҁll/Y}P\_f ORbcx..ި/A_ˆZ6u{q1QA~? r7pX I% |f d~%"q@N<|/JPX$s|1q|'fZ2^i  uij%j_vS#Ic\t^3K&R suf˕dP7,ӥ2գz-I~f o~.NOGBΦ-}g^y/}e+?4wʦbtg,i(_za^^L4ڜy=o&aCMa1C3F`V3oX|]3[2`.V6TM+61[ήfm( 9 5ݐ۸SγOK u`rZYn/K1|Ռ n96]M}v̀`$t!#U͓d✖E~. PRST?1$I.ڒmBa+ɩ7(1V+)I<}3^Ízƥq! 9O$`Ҵ;e6i4@B\7,7QW֚Pҽ, Ir݈'_k3 VZp"%#[CDMn\ɸӋ`KtWjlu?Q/y-kQd]Y1lM&lMxo6W5)ע֢WKaàeޑ3ȿv0zoq9XχOѧ3!sX ьu bXKn;ϩF% v,Z+_{]f?q@ )pJ*yhLu{#騕 jr +o3,wCT X6>Dzl~I L sq|>vM8ý*Zz=zy MGC%Bf 0zxBIA۰t uHc2`Pqۄ倇.^`}7+wGզYO\mȈ..ZS 8'\FBE!b e,,է[ϊ$,jH`Ru ` /@\$zyy|l<n߼K7 43F7OGVj7eNb\JR pǑ_m~zhbUm %ɻ5 Q4gsb7Dz +R}#eJF//f YBu+'HxX d%a}Ky͓0k7!*a)T α/I,B]R~BV1:$T0 Q̾'6&1<*Qzk: U,yᛦSB8iY 1HZ$͗B;nJ^_Bd8凅[V4_Ŗ$fl>w&,9H{cQz w&}Z,wWZ\chJá)Lg3 tȔ-!NjzH?枕 3<1:zz~ GR R`ngag ~([V7RgJ-*j!3-8vF*vel?iNccg۔xcD*ƛ>PM{+(q 6G|Bk j|Dۦ72.=qǴeZG?\Ks`ZޝL>a Xt=3uX 0wBdٵ)+58Q5_4nW-G, |"Ym#nv^9o:95pI!sy%lMn $醃,yŢ`nkBhYkXP9$W[Bnv(z+(2灐|oxE6{l^2N?;N-cl{s<ܢAHHlQnO.C J2<]E(pސ}~/H~@޻ƦqB^cbV;\D F5 Q9L1 Ý(KS?}r-oi75~:`QsxD&e{h6%fXgvb'6޽^.wHZSY䫻mmyLyJ>g,vM:ui:GЯ ' .>)@_TJ #7GQ[AE߉6Sp[,xKEũ؃ԝ=4V1; (NW0($Yw#5".^"6@B\gxO<f6@ZW^eeЕB`ÔԹ~ .֐'TM(!f,gg!y&hHWFicK>TK Q> 㫴d aH6FL;=k$8 R84O(~o2ƽ |Ϛ}iY܃^MTTZBe8G+MnJ HbyǙ.߃ILjĘNrLnxF{yrجj %xHZ5.sٱߓTBGr'D{jhHZ]k"̭vzA<6r2vq+__1j!LQA<Y" ՚d &aW_żA5t^rM~]t;zz25#{gŨ0>T^KgO͘S؃А!"׊3 4':>gC;r6pKa%̲X:wUx#γBիvHhmP fDTe8ymJ?v~ }\‚{U" mۊ%OOиzEI捾X7.&=(e~!$?':\&|CqNgHdthOĊ}f0S|5jBp"’֊dAlX>sLecAl$ kzZ?4ƪ$Cz {WLNʞp-N*hwUS ʪ&,J}ʡÅ19lz ggIs& vy׺s*|>" $B|FL.D5̶>4h44 G^C ح7+I%>KV)UJ7 ӻ·r j4[~zG먷a%`]R>AeWp2O(@j:Q6t`%/H;p)>+xp\u`rTK4~o|zT49~Nq$̪2Ag$ epFCї՘L5)],*x:dp!daրj~H8Gg R^&Y!Ț_Sp#KsDc|:e$RJsxh N9}͕vKST"-@j&&e8dD!/ߊ'x E+Lte]3CU.ݞÅݵz{(~k `َDG̝1$$nB8reսʝIRL bx:/H6B0.hE,0޳~PBIO}Ko'rVc)5؝>IalI?+hgSVgFGcWj}\ !důQbYg>%eB=LC\U2ub y.$Ƞ"U콥m 6TћgLCAFrb1asW~:gZ`j=4nv1)j}!!\q([(ܟ8z˺hxpGګ8Q8Ya`{&Y[*f@X _ܵAu BUMBMfaT~Z~Pd1)}Z BF-BZhc,@*˻.VGMNʦدJuj]NCaDt_o=$G>'ko#]Nz".qODkv6nb-<+i~jDS{lSuk 漹2oI%_41<-1cwSel͛ y21vnu{!jǒq "F#dd@M q…q!]; j%s<7<I8hs7Mpc2QHKGuUv~ɝ82N8MeN΢NRޥPr_R%dDwGV)84*wX矀ќ1|~V׍5zz^46׷u%SI2쇵*U"˖]9VZEh| 4 wbF=yM.wk`-_Da?n}$nB K.e[3.溝#-[ʢ[Sr!ib|ғa-H`[&C;ϨW! 0W"D2w]LܺNCQ%_"8.ay%)ӄ;儓} 2̫B-LpHNwr6xjx$W$C_-8F ]1㨣#9䄶&iY$}tJ;UwyRlYC-b!״3wiJTeU8A]wΥ/@zRZl{E[ lŷdb]FzN1.m?OEsWy/ɇeeH6S7_`hȰcP8icb^8mk<|7"iZ4)/: wn3fV<ج|R5<!ODLOֆjp$"*WTqfLt2 ^2#.b8?l(U&(  XvĴ)WF @U4B:'qt葐olk/2Ho,KP Ox4><\}1䙺4QL3i$Fz=6]p<];vAZ\O3-IN/N983V .n\0`-υmSE]; Uԣʲw9贆ՋL_ ڜ< 2%,IB6m:SX'1]p 'B3ݹ{c:*/ Ezl1 c133z J90mw&׎^m;oN?uF4i+;qY_RkILgM%eG1(`u 'l# .\9Xλw ZyJrl8L,v1g$t! |Đ#KKb)wl Ƅu;S[Ú Zi4Ow?&XLZ^}n#<0}1O$<0Ze$y ,qҀ|ӻզ#/XE/zgkRuRLZ5:4 @P<5W. 2)Bd+G}QT1wKo?E90P 4l2&Q7{?^̮RVDauUo7;sV̼弒< .N=b׊Y)/uj_a填!n~kG13Nmc~W[U0˽ͺ rpL&pXPWbO'jzL@*=1kylՋB4sG|Z ;m ]p endstream endobj 126 0 obj << /Length1 2487 /Length2 18205 /Length3 0 /Length 19643 /Filter /FlateDecode >> stream xڌP\ qwwwwBph5Cpwwwww  8J꽢1m1\{79*P֙ *`bbe`bb#'Wp GttG#&f'og q09x9y,LL sZ2v@'8rQ;{G 3s|PS9N- m@FcCkJP;;021819 P,*@'+` _jNڙ::k cG AP(m,:{`f`ogUdCcc;{C[ [35(!L05+##$-ى/貸 Y8?ZڹzZؚ%ŞQ(-:Wd`!ca d 8;}_ 00v,lT0M?h{McLl==_F)MYi E)ODEgagpsq8ٙ>[oſ_>z j2(}2@guؙ?>?)*o$bmoq+> &M,\lWvۚYN@% gcQdd׳@|y1]v&;vz?. 029>L(;Q/ӿQ0A\F?(_`X>b0JA|'})A|E\|Jv?O`_}DA'3?b_DEŌ? _?-?%O&cU   _Aֆ6J?#/^ֿ?>B?90=́Y~H?G?)=S#F!a>!Fo6ß4hbdt!NTGOr\FgsG? qh?G_ c(GG'_)e%#{O h lgղkc04f*5ךc3tuMfpX?8՝:ѫi[#th{roxYS!X|z5#Wo+6\.$|GAIɐCYyh(EYwYb<*Xzqp?ߡMQx'`x8N,auM|c>d8nhG4)=)G /!垻 74)3=I ~D_:c 1l>FzpMU.W&j!tlS Xޔ 6ZLXUHfUTͅn=C27tl8v<=7vHs ^Peq`]Lz)CoZ'g~'8c8cJwέ`Xu?T5jA}bGx{ oLWlX&sC0؇}G/@%|gnXU>!T ,c:DQ2:)4Ged2H6vk_&`y.dfRL%k:w}UZ0'c&U?t*x0s?2ڵܠu y|OLȻcTANKe`ol0mjvE _1ӡ]ytEX'^:><7Ƴ(EKC>ITN`\Ny+ QD[7:#!b*oM9c+r1(8`Vb|!\\?wRn{ǍpbD-^Wp9sGnj!o3'q.eoASG︥9|[ɾ!T[ _czPLvTputjEAXJtWHOw.[UrZ)F:K)w3Г朥߅i& 7͈T?IWi$._c1CW<`VL6G-^$ a*#NN Z$~oqwFazTN1X^"Ǽy:Xٜ8B"]W֝J#H6+Yhhp?*nebRL'Azz{Gs 6frZJ?B`6b# q `dJd=LdϛSWӺ'Ni FNJ.56-P]ٯ:~w~c#gX ]OZAM7;p ߷a:ފs[##1w0:kx9G ZRT֥>uwW-C-7aI{OlE}G0$:G0 =p{L@kƪv%mD˴ .2$o'ITn+B͝K/THrܡjw*Q# 9v>ro m)0A*":h"T ! ??+ehwP4hw{hvxl 04=a"&5;IT90:( D96Q"OtTIu]~5>JolE'. ,?_XYkTma|I3D.iSQ4 8و}FQ=N]gڵOig^4#}vU>vs]Fd}ARwzj.TC' a25mcb P#tj~RRO賭t~Ϋm2Y3ֈFcv}@ǡrmQ,Dhv SzhaHmk]5\.oE[&g?>8ܔEK \4q*z1AHاK֥]m@lE8aR^#{OG~GT;\y0,'R[1F*sPt{6pJ`̈́9 ACԖ#1,H5=f.\taΖYo ME ͫ/sB㦀B6uDkWmȱ+1~%1_QX"p(98_ \c4QCg#z g⯎GKktKnDŽ'(.\d Oi/㼾>ȭ&_#FqaƑ&ڻ!A_\^#rhQH=JA@]Z0e8T$S7'C]m:r1t+D}ll,ZaS$9W Ma#~\ddU{$JF/bIZƅ>PZ%OS Gl<놘ȉRQ$eh/U1E݇z,eRN1RLkXk -8 C#؊8#ϸ&Zξׅ[.ueٓTZ^ C;04- /faPAA݁< H4QV.mS' kt_ Ƴ{mn0T@Ǹx.=z,"mTob<ƴ(5%@5ٵP靡6ٸ!-_cJSzG_J +[5͡ؼsT*}Fy?TD\oKvڴS {rN^OPLK;dٍ&ŏRjHҧߴydcq,Gie"Y'#ƴsQ_!iƟ:CVtFߠ솉6nbnl5Ծt@-~rY^ke8qo/W^-vY@c _!˅W"j.  ǻD:(Nz;쇛BmM/ dWyn7ۭA(80 p)Rg}Me׹`f--o+z5F F~$|< 0c&|"n"g9B)ıyVW{p΅)sWS>Bm\"-nмUS`4 p18zpH`Y"kժHnUzh v~$7xAJ 5O\TB]v!kBjPV i>"g0`FtM3t5}|k|h@d>`l+ւ|rwStQyDq7J{(X㮔we+Aeʟ^[ʸbPM@2#W._48gJ0ݲXFh>u乪!@=\_p}2K ˋ0FT}E o?KuN9pzgpe6#Q>Lm9X2TsĸTqeV4ˋ*{e~wT`~qq$,wlS+7x]CK7WYk؈QHD4SFdתծg/\SquoNQDTY@d.Jgp9&N49Lok$})rӍ=Si4 kRutI4czxO@k1cTHڿҁLII~<\oyP -cL[H`ljKR1]5J O @N~![DV֊$o\ <}vZǏd1,U0;w 4`{?hعIpfWj>N0ڬA3M.w&Ο\sf L!h}4D+ެNxA<'1p2m/`IGdĪ5!*3]S%ˠbc+ EM֎m5{sU'7\&;(wsčxQ,eJ6NmNN5mR9Wf#.0/^/Sk>w&7䈅#Khu=T"UAܓ`#Do'Gj:Vq*? SQqxK94*h΍O@SWub _Ƶ^Gox%%q6Bs1E#S_\z*Ӹ򆾮'chMC'!džoID^;J$z$lOG%fߵ𦔦|F?VN6$z/w~uJHTOvk# cOjTM.FYH9c76O 2ё74s%`\(J\3rVNMf1eK-i {pbd# 9 ͯ›G&u{w-eJ|󶵑_@f0=B]Y*1UZd 6nE5HcԆl=KT$Nq>z|&E~!Uw9CLs@kb 6}s7H4vkO?(EGR8^y̪TB78XCb@D~&I/iI<O9 gBM|7RxI{G9+X:&%PF)rJU-c`i.Rͅtnk,X A;BҩvkQ"~a~Ɔ W 8Q|[5||—ϛlvEJ1`N6:SSf\x`hӱd+J { Hk)Uh)N`3/;r10Xke߭|r'-2Ylcwm+Boh?s4ML,œe]8}?҄blj5 ńI @^934dZF tLbY2L7_Cۙ{:- rd#VأzWv tN΍Վpb3"QZ;xcfu[Eܻz4?˂p2eXa*` J_A#-}A{h0> ӰWnZTJcgT6РXWr:'lV=_Tyۢdh-2$zOҊ1pc:0ViCZJxlKU\5z`vWE7x2ޟ_PPЏVTgW쨼ޮmLŘNFDԋ$=1\;"Ф4 KN;7拀0ɋ]7N4UlAdHG8φt-5+DY&)KP\4&Ԑf!qN,aJx)^لUL-[ aV9sgڒnJ#}"[LTYѣ{#"8JI@Hq43 U/GO*l-~E~+JΘ&RRtы;4@7L [O?ͭ.u\ ٺ+^"#ݡ|@)`'1c9_6ia' K~r>RXK88Y"{Z ; >/*7h/󗋙v{5QGZ ƢP,.;o*M-9xçg,8c0ゥf#\1sφ,ښzҝ$@\:aի޽OY:'+۾-Pgu-DFWRC'-[*Ux FdkCXS^)Ot"cefZnڿM&l  $F8,7=,IVXs(6mٴb\sSYRb04ro0;ʿcǹBuu,_HF#*F"tB]C0p?9Bn24lnzӶjLyX:d/(3 \5o 6}U4?S_ml2a *˷2T0ӓDDo:5G,dI6_7c}˥+Â$wsYzrnXѵd,z\kMվDGo/ 3 %|گ_+b:3)417E-1l]YcLrv^$ϲ* Fe?ݵ%NTizn IhXpO6Zlڤ'`'鿗XMy]XfUeDry~&3]J }+0UG/^R8/CxrEx1oY9AJF(#L^ yHTYCp=цi\Zb!T 7Qi5#nK"Űnλ#~V\:i p!K^Oa0we9!C\'8ϿBt0%'La2{|(F]8XߺJ"Ga2Sr1d["$/s O?OCeF lYy zJTF8= ',=P4#umy"^/QAS6$]}}-;q9 :"4.2DLC3(l+̩9Oä 4a6'ܬ7>x,p]KR"Co Ơ y݂Z&)QiMAnz:mǩLo:pn9uڛo'jqjGJq:'#3 )k.`^34"bNXunptyK1};~܉|E#Ь` MyBl#_k|K(A'S& ZQU=$VXS$nfy֛RXoW^)]$izOuL9c =m:!y__ZgΘ9˪IE#L:I%WYakyg& ̑HRNхaG :bKYYQԜyrХ,@~y $0ˣ |N GT0t65L!m S~Uu^"R}|#K5ehxڕmĵ tIJϘP)7Uerhv6s[Rt1-$!R,z{{0i8vs)F=5:&oWzŃxa0}$IP3"aF ` eW޾@t8  oM*3"]del)Gۊc9r h--"f,T gD~z`.\}'_E!^]nUD)R&4T.xxDVY}RM" UF$z4 nWJ8k^*uIl$Yts{Ĭ3"ȿ:N)ZxYO3po lT O3.r&=ܥ2|{x|Ѫ$]ҕNH#8Q3[$ˮh1{Rʮ%wiǽ.0e 9CM44]>) jJV([fA~ Y]}m9uܤ3pl\eXkn`aY޻PY35 >9EԢ(^h8MCѠ$j;kHEpb;7JuԮ*w25sG y: PߣlBDbzv/yjO]{ \X(g& 2})dO׽u[4Gr;~CcȑKO˛J &By0Pѓ i5 !iq&~xrQӌTas#^̶_GվzvB3ߧm"Bs"]l Zj;=5K=R !gұ]Kh,#/kX&]/i#b+Ş/tz01sTSwTc3 l2Uu&okYju9Lcۂf`V5rgoćqkനRGA液};աz26 V/0urgx0nALۻ`ȋ$gQI<۩K{ (x LksF.?PYɬ΃477flQx"ʪ\icJC6ZșVdȖ@='*S)Y5L o!uW0G7~E#XE%/9X<ޟ_o+!a8gUO*I^mx>HPNV"W$:uߑҤ!y=Z.zi'Z(ZҴevƼ/bT/edȵީn<gQM,dm/]s>976Y]$vsۋJ:=+6l=WGQ#uW+{i,qUrTDFDiV $## Gce_L./gPzVʥI&gߐhb2AU\+TVmi'8ۏ~qnMuY)uYDhVŷjcjkѶK1N*˰(q ~hW[POoY[XQAtP鎋6åTm脋U*]Q璇SU8ԒXB1Ա }؅sHʅʇmbOn^XjCP$_Fi}!_ pYΎl\J-8s2qq0 a3N vrrצtEGцD{=b㺟7M:ԍmCYICS\}ZhA΄[I hwc5?:4@n)(h<fM>6ۘҩH1R,B: v0ģ|b&mk3;H,3v|&AE{bN^*SH٣:?BT{'є̴ou@=73CQN-pgG,y*~m鋁9op|T,N&~3fh`6`'oS,[ֶܐsP̣4[6= h[I[YO lRCCqCb3\'N~}mWrp5by| jN jPR Lo2j9MVp )PʟYܜ\p 5嶠 " tnYz.v.8ϒ])aLrrX!^Hڿs~ f[F: #*-O&\TGQopp29Jc;C%[ ;!׍X+dB]_2OU:0gq\N2 1b_Lq\md #tΟ4Ia<$S0 sed r ffw"_x;X?O^إ[^13']vV<{a\0Cw.Z!IQmx)|1_鋚0fwhRγ rWC>) b]ab֧!RsJ1li/x DQr6Vx,Z˲T1oQpQrtSS(§r&,WI1\{bFr Tqr913B8.!Tci2H-TE b juON[>m׼ f6@Kae]4stJ׈􎯠LܦSd@Mx+  Xؿhu-:b cV_U]`59fJ+s~fmY=blKtӅ8"eKH _v (Kܷ2 '!Q~bc|1f^eoz .Nlh JN;ah(cjءSt-M;=e%3?U>lەv 6Ucdxyi_Osue.V0aʶYpl$c¢v|ƺGmJ^UOJ]I۞6`J^W : p٘M 5&xVxJ}7mB4Q"WaqHb\=q5Ԅ$QnZ<[)**Q:/? 8 ؕ--"hތ18Ĉl[vd`^P {%TP+) i&]HvWoh ։k4ԯPLf:J_ą>qa$2 k \6lټ}oO!S.ȳ`&'ʼn\EK$*VsK| 5 ҂g{iי>5j zMEͳ%>٣0S SO语Y/kjBZuuMiqSY$6XbPjZk;1CgU Cs(K)_c|Zh.KQdDzaڒ.L-^ hRk橌<2",LI3m=2^ZZ@zg-#5Uv ]ݠ>FEb|/݌b|0hH'!J\MUu!e4t#r죯 yHR#WQM~;h _PÎ m>h x3w顼Di~Y|Q/hDVp6 wV>U)'z1N3uG X+C~b/ЮkyiL¼կM$KC[҈>U>6V)]ȼViL8(*UߙPzd$2?`f< ܎+LEó6+17r/G )>q>r{vd6^G"of'I ~EF`M7uܬ}MvbdžcOA[ѧ  >Gk&3o l :?" "@dʃ:! ؃H`8.lqjZh钛HȈEǛqVLp(m׏$D:$׌f؉]+|*JPy,#KFb(tA[Yx~QkI mG(1><rN>pn~6ܧ;49L=q3A#y.2 a7zoh$.ro'02Vdsu¥4P[to9fnhc=$T!_HRĝFMް)Da>]4ߩ \`FI;jfs1<MiE89cP?əi. /Ӝ ,+_rWE~"!p/ފuR]HX^;˗%w,nh6I(ݮ`$y{~3{+E>+dKax^Z\ fKvdY=cN}S>>6R+ւ-9aj)Y]"PQ ́ 9ORWuyژ;O; k]Sïg5S𚦒H !DJr0g9UUERfaňrz|hע4Me^uҎyҝo '7!灐 #lK\[6d?BISM:K2NS6Jhu-qc$ Y7~rM6J1>ri硽w^r,k7C l n6I*J#Os nd~'}:-Q7n{[pg?xDAۏD% P[|,q)CR4$ ?"F3 -K`R ^&'Ue!O YԣEfo19rMJB찈 Plז8`,Gq0ZiY7耏|UqƢQ01+ń WV]T?TRgU\@5 RpXA@8Ja+߭ Z8{BPztgv =oVЧe*A 1T0;9(|yb?en!/ʗJ,zЧt #R/o8L泟:-@!ɒ$N~TNTkC ͭA,]`"¿Ѳׄ"JQ Kԓ0Z9O.Ŵ9ߜ4 KstQee_wSIHO^FLUO|2j֬޶R 瑘2H|x: :e{ϙ6| {mrfc鬺6eMfpTba0Q#1v endstream endobj 128 0 obj << /Length1 1770 /Length2 10034 /Length3 0 /Length 11157 /Filter /FlateDecode >> stream xڍP.ww4 0!\Kpw ! NxlvUT1u_קTdp0:@\Y8XR@ >;;+;;'2-Vv+@db6u}:@nv.  ;;]?΂iSw Pt\iV֮/'ޜ! 8@ 67 M`vuudc`5waupe`x] ;a=Ofȴ-k˟vMKWSg`6A\^NA,@΀ UG`?wN }X,v 2+3bGySwSKMs1w;G.@,AW?;_dm!%ba 7G6m Wȋ '9@lrvra~a|![^}\LAWg7Ͽ98`sW A'd'~3`=bOi(+h1o' q ;UWm$TX:һpKm oPqx2@߰󰛿##M[o7omj+En/[tx d f^Wӗ퐀XF,dv5SBKz;0pem_Yv^鿯;Xw<SggS/dyq|8^[6V =?3Iayl:#>?Hf7xQ(or7۟' f/ `('9lyiп/8Xrsq$s|y !v J_L_9(_^9 s|a/_yX6R=~K%We_Wd8`.jSv[%A;.2Cv2#xZPʶ œAsBDGǷS }dH,Z{ON:AНrqn=zĘΞxPgB;|Ucw7ZEDCd@H{=:E##IOqa fgba"%nWqnh:OPxM<⩷lTb̞ngH:C9 uۑTQ>,mc9:9^P B~wǩUL_WzI},}uOrK1R:0VӻEMb"aBn=La6wMyȵ'RjUm&Y: dc_?IDފކk&m_qfܲn[玨'SHrDNΒ?!60U@0]c?ТrƬU;Ga6h:e O{EoqO!%.P:9K3M`S1GS{LҙZ ⲞP8}2`72VuӇ\ [UWe/yhOM˥ n٬Y@O2-$43dp:TAѶw(lU~֮`ͅiݳNޮvH2t-]bDQ:gwcOp".#xB9fј":H\{77ry4N|+ ˓\95D /O-e6Pd" v]zU<`(PH+^R(\jⲏk*fŃr"Q[Q8@JWu#",ڜXfc˖0ܼBF>2+TW h/ɗx>ׁ] vp/(Kr#+Zs!';|߾βUj.P =%e)Z5 7[xG&z,LGȑںu }sKzU'zW[:z-\ ci}GV3>f ް_F$.ǭgЍNL5%Z^ ʠ*6A>-СTqVj-جU vdyR?odt6V5 ƒ,%xE/UVް|#'gXYr7Lj0[ jf= TZaÆE6Iy!4ueWDC)oclGYOv ً WD[WkFvmznd?xx4=z61~JJsnީ`?+k3,FSۻ>Fh?Z+mۇYWrbO^^|֬7.p1kR}-BnMԻo1w"x(֥Q|q*_h/˜EdJԒ D5W.<2ug@ t(NG2əÛv)%UԖòsj&*$^a1rJ?K@MFlWTy6EK s;wzdl· zRiM=m.ђX6Y`ЃTS~b;ŝZgYT/T~F(B=4_/rze~,qi՝ю(VK~]=WSziQ~oc17r/q~yL2N6kQ{]Ddt Hs[/NOզaAΫ*6$"ZS)bCw~|39o<@E.<>ojorἚ TNti|$ V}*͎8#-'PDN)wkֱcQ jW~,S0#Nc'bH <;7lwz?S?bgbh(J-#,̋5R̰êvr U9`5n|['e\ȼD~7Y YibtQ :K/fz vU1#VϺInɘ/0F&IP]dp٦ ]`7/It+ /^s,06SBD辬&|B| ŋus֒X'oi6(8wv<[71ۇbF<*NO=OERnLuۍ/zوv-^b#G\"w%JP4 lPcX;/rTcRB4]9p < kZ_.,'.G#Z_I"I`P;WvraeU/=OIڕk9d`%D03&|'ѧ%lb,`L#ZDP.}"@$wwQrm\l&þ,mleٕ'bdoa =Ƽm"Vr!x? 1-r:q WDΖJFYxWSJۛM x`^q|/.^Uu(x2%ۚRe,P%W2 %Q<*}cLg=b#H_ D2a;Fd;("UEy%,Dh\2^nH@p)V`Wuw%ppɸSr6mCҤo6ݍ_Uro`8kT9%P^Ş~݄q$(ؼbA6_FV,]/i& `@0rlL7RT<HS&c=XdyM5ׯi9vmLr<G[o_A?UDǠ=2|b9f.M Ce-aK3h 羠袣C4&ٛU9Ͻvy|v@G(r,LoO).ǔlШ[]!pߤYbeoVu2ifD uϾDӣ<ɒ-qi](&`rɥkmr-4N2Y fB3ck; #11-C?׈ȯVS;m5XwDZMMГȟx?'HwIg"ѨB'hH*/3NʆWpy=r+@+ZAFtդWU3\% Uߋ%C`)E,\0zT@[emU5ܩ;ken |OcO~< H]lɔ'~I揷Qz.6sR,vLj-]n+W|'oGX(9H=&"8 U0ct\+t&*H*rk7F_})PS_06|/o3<>N6GVq/)~ 䵉PMdz㭉fc@ J-ZHD$Q}8jdfM,!?j,X8u:e|E#opr:iĭG`NxZVL=WIК>UQkcejTnc]Di LXVw`ϜbfhlCu N :ZYGgIe53~5 j}s_j'-.Jn (ZRXtKcËB|Rc$5ukxbew#Ir2z0ZR%#ϜKRl,*(N\ZPW+̩%Ǐ`ӯ3Q"hLs9~u ~/53 8~kY\L;ZѢf~'D,)\Pf1X;i;iFG| FPTvzl1¨*ɤ!̽Vi&OQk`%8jCD s"W9h=3S/TGO8NU)S ¼p%J_g5zDNb.T>5,d0o 3F} 0*?rQx][Ν̬ەR//(#=`KQi6U:}l=NbmnUAS+?Q7 ڳa"8*ۗ^FH2V؂b},Օrm$X rW3K)[PtRR+nV4{O+KѰ?%ʾ>Kߧ^{K+r5rM3d=ҵ Έ$O"XWuZG=QS. ? vɷ>|iWK Uj^K2UmHƵCCEyj;MY`*2޸AOFze+Ξ9kri"N4] Wq9Uɒ,V%mGa)xȶ^btU65qTb yH7qJuGD !l z|%"Zg}eP*O&b(KݙN^jp1)E}[ "?q5k | ?)=7h${Hk;^Qf~ W;BSS̓2b.ŝEgd F0g z48"CJrN_jym&lS0`7=*!p e'a|X'xjZD͕U %EUݎZvEQ )JsjPs_&Q}. I個IGݶq̎9TI %vb_юlZԫ`OХcԕ܎<| {҅`n/]s.&._JsGHr|ޭoJ}~|MJܽ;|Jzp֧[;n|!4RD*c?_ؾx?**F$ɰCF//N;iAEȆ>VA䓪·BX_/bԖm\F(?Os+z?ȣ R _ /=JQgexEfǙh9lVq^,=.G^ۮz8$"?T GF\J>8Di{v r(7O# 9:-`u.bξ̌ '(ґ:5C:)s $%Ӳ0T7٧slCcm HM"kw땕2+xc?`tR(I?|SH s!z XO鞆OeZmېBߞ{&p綿 ̹}x](sY^PJhAX{*fw).b%ed~hʭ&A.좫#iӱVn8_.ROa`gQyx7HNĢ|^ }TT?b\B'*ALItgoz\oV+(, HM(yr=`왩+LV+mU$r'55&'l/w&<?q }.MǭQwěYm,[6Wfl'7ZN1/%!+gi!Msk0_:XI:vJL8$:]CjxvI֟g錵љUufSI߼<#wVfNND8D}>!i eWLkJgcrORT)[@\urmP2 ^B{Z61=5Tق!sNg^) , P6#bpML,3~#eu䦑(ȿJ]|yIΑZ3  ZqnBVFxԂ).#;e4CU̾6m㰉!$X~` w%%-g.MCcj d 'mz4*8T?Lzs%Fk:u/fηF~U7M0ªWN|ȔE;וE"(~+ctij4U)'3 Qfc"Jw^kRe3|u>^{>n[͌>xCj<ljI ȻE[vu<*Kh6f+Cbb(#ɬ^̃Ve"u%"X9G!S3}֍ygg+  NT|c.6堻L^00eV.ڃb>Ubp"AJњC+7zb^vixk5!VJ? u\,A ˨;u$+%{Nz W\z_9{1<>B%F[(-=2k# ^լ)T)ˁ}Lht w}'ZpR-+|Ufjts)W q"Nl\hy*E,T&8jkȣt-Nڏ-w] /I*Iu'mFl;_ULPw6vmޖmj, 1l+A0IM ">̣:֏r-{}Ӕ;'ξ֖cs X +A섊V 5;BdžY5g:LG͈=Ⱦ+&=/f1ILGQi\NSvaNgMɠijfoBX7:x狣rVٱDm:է Ak1YQM!dhJ*M9ȥ0F DA@Ѣ?E6ODu$uZjq1Z5̦͢Y$rrc+r^\$4+pၥ9LVnH?tt~^P3Cäl/7 l$ELaY]+,vbŔtã;nw9cUN5\_;<@LΞzHP!d)ɠ\6 WF>#9+qp,|m-D<;&<+q'w%3.hbɤ@&n;%t=ߌT~i4.GSWqۥ>eD-q\|Gͮ2Cc_K^prԃ&=BS~K`ފ~2}8!={#%{Tahǧ)}g T6Ҏ{JD /FHGN `H HvF8-(dg pbx1~_}Pfb&͘t0&o «&+yޡ˔˃GE4c4k:F5WHW5F[kڗc*RjC6q-%#UР>X, K鏸{Df[ bnϊvn;F<ځ5xTBXwZ7ni@<1i!\!%.U.:8~E_mCl u#ݰ&I5YpBV>]!Ѳf;rn_*} 1}e8Gܔ {VZ*9JhW'0Lw;O[;D\Mniυ~YvLiA78F]ؖjU XoMϨ`ӈjw0 a"?({SU$aN dUIl+OKH>(pPNwgFYŬf_A7Ǵ*;UQ]L$\"}zLӲRۺc5s1|.K8U kՌdٗNG^ۙ$s;])eHjLIO~;jk2Ԡ1B\G &9 9cDJH!vxw#^UDd ![DD5 sq eKH{J5JBYisNc]׎\lk_>-PƁ!~h2EFt۬SX!f8fPWxj(g мv endstream endobj 130 0 obj << /Length1 1392 /Length2 5960 /Length3 0 /Length 6904 /Filter /FlateDecode >> stream xڍwTk-H&]JH"B EHtT.7M"E@?߽kݻVgf̳gfYag3䗇 l*8_H(P64"@0; Nn E`B(" 4ƦBc8@ $@@R A "bWDz#ahL!IIqy( S r"0(_)dhW)AAOOO JP~Q\ `;' ` 00„!P$S`uki@H@t%`+ `P ! gA遲*~(0F `ο8 Ji2pq(_S!`L߽ }!vh@]anPu??6{( %P7 +S Ѐ젘"_ @#ݡ~P{?1f_g0/9~B?,1A=bA%:Z(TP@x|ń¢BIq ii[@?':y\T wflPƼ kwmenH/ 0HCY W HDnO#a(CڢI C(د'_/Ft`'SoT_H7a¢_!J!P #И$5S a/ѿ҂ݑH~SoC^P0,XpV!Oɿ6k&uкMRJӗ7U:2glˢ%-KZKcEa?zO _{Hfckxxzܫ&ԺBΜHOoںi̶5 A4Ov7R4tu#T!{EJ|wZgGaf[Xi(-sz_\i5(,ذO%HK3gێ7I\ߣ7#,K25(iTD55 H&_Q{/X⤸*E}? moS%ǽVD-)0&O1 C`ɴ#AM\Ouo`?S?Kefs&PnRQj\!+t1+D({.q/w+ޭ~^څ^.*TF}_fz/VF{99w^al%߲Wn Htӊ> }-V$l'}_`=ZR17.Cbއ;,ϣ[ LlNUtPVN QZ7τ@׫/&5,mӗ"^%InD[Wf_S9I_rob;ykU B&Ur %)*㔷Ompng$h01&I 1! V|^b,Q 74d|3yxG%6lT ^mJDh 6Yf [b 3PʘKj"9yZr`@6TI?AcX+OJ/ϛ+7 kRi;.㯞e7C%:Z5e,Gm|[2?H ;*ˑʙN_7/Q>ʃY^R2/JJ:rF`ܣ), z|'4X|qoLA!e!qO^q?p^C01'Yi2݊ŇIM6UOLu?Iw<^+ukETDOHA+_L{ Q#Nt*SylWvhO@T#ΟLX :mo;+c}޿gLI['PH~NG^u@CF`;օ/f{-?(J.Zz͝ f\(u1A\ N l@C`f߯]Ia&yV f"O' $b 6 }\b9jcO{dn?Slܴ ~ץ#"P7l*3qI;8,o(;.or3 ٴ`KfL.|QZ${;4Vd͙G19Xn*X\ zI>'eVr&g/9*ϗeԸ&]<ͫpyt8uT^}Xw A_3||%]id\^|)z5&muMKU"Gjd14ѻ}wNE;X,؇0fu=B`S/lSIQ%?s*⧡R+t:99}pL^PQzT)Fl:,0v"~eS KF8$dK%g .oa5=Fj׫.:fT?5;6 nf<n\|'.ɯCgu)~Un|;Aŭ;Y[tB9 V4?OTg?D9=lT,?ON8F@Af،Θ8^1//&tS=kHڷr,eMhLȿ۽Ϲ龚}ANU{dSȍV* E Adq]o+Vёz˖ECukWT=Bu0_$?.7VD|_ #g)5"&Ffʔ,%5[qhoq$ل3e`j>Fj`՛n-HhQc\)`7k.d^CnIJ!Bxfn8NL6% ."$Tf]%b|:FSCPT mY:䨩;bj-&)H7^>lLv82;{iIQ\Sgn4Cga!W"%[*sdŊ2EMe(/7.׍yX_,8 q9&-YL,I-ngpK/%)ViN\d*1XZ\4 ~1;IhlNyiE֪o汑 r9Ux^朘́gKT:qrt 9ǵ =Nqwa gIS&m@K' <: ~j~hb]V]w/!@Z17A IvtȃѥYEFsϤ-8MCtdR48<]-;%}1q$=ϦyF񱱙ڱs%%U3hF[4I' Fu;`jrG9 :T>͂Tؼ'lAZ]Vg?;3D]m6G}9#FNt}i[il#iͧSk݌ag6u]ؽK9:;cڝ'ȅXoU k<?)8Nk]{HC i J+8e¿#SĥlI 0=_ t}<Ǒ,>0"1" i;롑+{9Jw:sxoXIbUGvӒ-)fYj{gZ)8?[cGny=5]I˹*J&J xâBx}U9d]i#e#:2vsw׵AUyҶBSe.ﰄ>MWs~3.0En]C(_`CΘ} J"$ke(e(D)=6' &R6t:Œ)HvFDos?z;Ӆ-֗C7ky:Fo5[0U铯CI7Wzo^4~Rout*T}|_?V^A %o4‹ ޛq(Оki)CX|g,C ~;ر0Bh(^IPG\Y+xN*VA.lYrQSxz6:\ХKT). (j[gh{*y/iRz6Fg]6Iy7G/mmdTť?_F{ \Y{xL'?B)r~U8a|.gf Cђ/5mibT'=]]ю9:NK9z a&)̉|E'XGUEm HLַ[cȻv=:/d~-+H7QJb c[èy#IIYxAJcnop^-[]цNqBvgZz$̂i&8>mzj[c ^vx# 5;4Il_Qf^^j?܈Sy^ DwlX"2\Ř}1cN; 6=}vm-6 FM{F3R}o>-|/}=%"VɇQ@j?lsBS T vrņӻ6l0uA!yFu6&dZjp[ O rGoгl.L#Ɣ<)Ѝs !ОE~ҼX3b9H8|V>vt{4yŏgKnzF'ޑ*)em@϶+<Y6~gy)(dú$W=q06 ~w BЅ<7ZS37x,TO5 OaUk1$?D˹,PmApŖ:V|}*<;)\7XQk«W꺽r*t"Dq7y2fp{%&nȝXn~ *&v$VJZ?sul4!zaZ+CWa*hOO1D4ȸ ;[]M3uo{8I׺5x΄U]Moz ßSS]Y-NI,mvr16n`/ i,ˢu]s=2rB>HtN}b:u!hwt;-=^)}B-mȞ%[ KM$UGR[$[*L3 dg!ڍ)?yYĩ~0%+B CJl=20*t>=?(7%8Z\9y@7ʃ0jJNGY(=6Vv묭 |x,d!K<*?{0ϊRZ ?տn~X*כMEJl(0Z]NdMaѭ7~Lf˜c4gՇ ?;Z R:7?kߊ7$m{e+> stream xڍxTS6Ҥ#H7 & wAjHB$t^7J](]zQA{oed3̼;W8 (:  *Ɩ EH89Mo;  G!c6U0 E!<($. "@@4@tPHSwr`} @RRJn08107lE0FA0?R:c0B`7IW 8`h Ev&D 0qr1`k@!0$≄<c-; X/@B+; H_8 G:Bh6#XףּJ0~hB8 J=f5$TCb$ A+H7# uE.l?i`M$901{@0uv6c9X@# C{OX:"P8p9$Ύ5ZcX>* B"| baS5(˩ Hā$3ϿNo`GF-#  M2x /PX=<5P ~C;_YW=~GA`Ά. ;!h]^- ;#JH'Awwp8#a(4};zWmo ;YFPDL`]AY|~K ,Da!,@#ʃWcE`43/'? @<=<3[ < Ϣ 2./;k?,-w$YGa=w!֘zlyl0W99|UnbfGUy_p+'+4.8fj/ِ ߊ;|"BGtg]R7@)%[&^)k%2fҚ2*DtiY*ى$5x1Td)DP^+ڶxKU]}#M[A?^q/-_*>^1Jmyw(2qMھΥȪHrf? ͡-Ovws,Fji%YӸ?V3կ謃tpAYJd*6=ZZe^)=֤u/#b\CUgiE;A\NWjxGĺֹ-nE}|6M TkHϕr&#5v(dx@_{|AuԲpWxUUa9NB,ͰTjE{OGy% p4;*o+,͆Kx%\ՠHU|"f/c^ұ-kX֪@V2IAA{S#M [*UDzkEYY+#[_EU|WjO?WJ!%p1|}qU_JYS@JGڣ[_\qfK=Z`#9<61mj}ІJ֌n %b˛f/Lv\u~~.ӘP&q#8DI0K\Y}}*QuVbx{Y90`Pbt#l8rx9~aӌ^y(Ξ3'[~>ݲ3еUf kcal RCL!"5әR8- =*|ŧ ;s3o|>'XZphgafVdtqގ7Fp CM)`:7& 5q6äg}ij/Rt Wmc".4aّ* ^z_5IKvȾ4 n%KXYk59X(BHj;2[(ە]qw$BPMߛ^'ioJ~x@k5ցߖjM) .GUE׿^fkQZKk}ՉAtՍi^ZᘄtX" b`%%]8ޮ Q ^ D8{D^(egHCe:h]r?Xzkh62Ã7N* G{s/۲I]ol$܇yؖܟy·X*nc|FQ!ʥtWǥMX`T;‴W+gxO4@:8䖝\"  $B~'w`ZWr."bT*C9'3){5)6˘ZGEX\!vfo3#C7Aڬ{Qں+- CneVRjEmtI.r$lyk(Dϊտ:MwSXQ*^|b|ɻQϒ&8ҿ%:5/?^YUW^H;~:9*` / ,l&և.Ѭ4Hm]vr}+G[ntV{I(?#t*qi=Tނ[:`Xq AGn~>eq'LuY\=O2pVqYgP.F/!UI&9EPqї+ˌyd#ch<AV Wm`2Dby(@vi.IZꫭ 4yuplC_nlf;]naw^FLyrї.6 #Q {~ rz:d,n9XȳKm<u-=GĞ|h%z< &dJ݆>WK.}2ϰE%Ak̈=spu尹]Cql)^Cٮox8rC4ma͓T/Y1eG0>Rķ9Dҍܦ1|KxU䦝'#;ӝOvjx3Nװ􀛏E5!Fi&PH\č7df7}yj=e)[!k0 z츮\_5hOmi 3यo; B*lAE!6[338|̽Y2*Ч˙ׇ<;jA7]. ԩ)!hLيuF;/~5)\TEu3SY,Ӥs]mbLh=7/W]^hq{Xd$eǔeLFXɓ~J21e48JLC??*c?CEiHSeKMPjJwؠd6f [o,r˵ (GΟjh8?kjۊV!7[r$^'HfTV\ahDL@Jd]L'X>Byޓ j8Z>~o;(.1\更9M*I-Vd+N!)I2X֒Q(`3y ь;5Y{"7ieX``]\M$j ^C[NL?G]!鼿$\NvXA*C{'twh2Uٓ}^Α څSMj Á ӕr!0=wlo/? >lQWQ7WU`7Ef?-]<ܗJhR"vbJG)#1qW@mbcw,ks kt>/”.Ƌ96c6o#ȅ&TYuݚDɺB;tTM3GR&6~nPdGzXpJs?.vS~yƳu Ÿ\4 7s@;P;SCO#>I)uF/eZ7XI4Bآ@~tL.ЃIK"06 Yԗq5Z\Tމ;bQ+K ].miwz%uPPw䢔QYw2&1PZ)~5}5,ha[kpÍw PF/G?o{i7ز $P}.R+9Rc &(&ꗧ~S!Zlh^ ߺ*'Kr;}hp_gzXpܫk;kx6%ė[v[";枊Zܺh{?q&k.naJ"g[V'{uibWcZE̥3˛}MǢʫBȒ҆/_fI hub p,iyPbK?SpjXTk>ŚTkQsGwKoqXt64OH7vlXl탷z0B:\_l`-ܻn"F ˦(31nyӃR:GwvÎwB9XboD)-KeZT2/UknV~6~뤊qQr O7Ŝ\dRG#d)I~p^1څpc52/Uc|f=t}n0V TuF1HiǞ?B?I|~u_/W߉~Ы)3ؗUv(Gq$_W,zN$-鹶e3=3p-{[Omgd 7'~4*iyMt;ڰ[i"y=?]"aO.SwZW#[1e͊=0OD31/},!F/+E=I2`)b}܌D7ZKO2?;D`<ޯ5FPp(Wr hY, _X=S"XLQB 4Lzt^dE~u*;Eyۓ0˓|~?ڄ -G.JKss4;[riY ĐZK¹ oblh=&mI&9)OnK*kO<*|0}k<y97{z6HF}i37PPM\8+z]Ώ>9 _;ĺKN"hj}~f~'=7pf ќBRK}w:-*WUҪu}}-f]Aj335],Xh()~{Vd{΋5b#CrcJdQer:o> stream xڍtTk.(1( !!!ݍH C0tw#!%%*(% -(9kz}|M׀Oa UFQ| I88 a('_f"#( K$B(tPwwD%$A $w ) P{lZuFġpFQ6  rP$ ({3#0@@`PJpI٣P.@'?ٍP7(j vAO0 lQ`$68 P:nEj(O柀fO'!  laNP&? u ;!`0 l}s0@YNF  sA~A*F ܈~OBc٬# ` a|C AAQ8 zA쁿z@;~}].[4?#u{@(;;}" (5': sF/ ~M/()A< ' b۪ u9? /Zp%n;h#\9HA?;_U_ );9vsn34QhYh!wc)kAm`UCۡ)' c)ü60^ E~}qY Ъ8*nvAѢw_%8aK}"0 &I&("@ ?B$ѯ `74f#z DjqG"tϿzA!Dȃ0r|xщ&Q"(ΉUF\luc>e);x.M5Թ,`7$L| ^bmBo M%΀324FT\n6V "Ĝ,inh +p.Gl;;ۓՙ.tRhy%=:[n_r7=uRzș«;EsUcLL  g@ C, 3s[}q_G7 [HT0G V.Mj^k>VYH tq)ǺֹYX |ªVDqt`ZOOtWx\)C㵉*^gLۏpPZ7[ԲT:k} \rɝ7UBg^}ARa19RfdxG<d|_ەn֏ê[}YEl@_#AH; p2,pv3h6)ua>^jQm_T;kBL ڪO)hShz)% ͈ מݞOx[Dx@>ͼL.ttZO!p:DrӇ$Wq|3CȮ~4\sSz[#^FbIK(Zu0~Na0Ҝdu*yQ{^+39IzLR^/)JA}> @/=KA:zKs_GEdTwL oR}+']`~̓Ne5 :\yݛ>:&%Fx'+*B\HSTJ ֑fš{q$YES?UFI蔨lcIBdXP8a s~0YMgl+M(Ұ&ˎ-ݪy؋ƍIH/&p߫V >2:B5 6"qΙo3:_"jWќ 0*tkT?h7ϻyg븨sƛ-;lJ6YRڜ 8ԛ 2YȭH7RO[uܴ=l,Kk=a\.fSv~=ʕVO3rF&"ư| 5 ~Hs.;6Jӵ>a K wd顨JSxGWiv'ݵZƢJlI'"Ln\*%HtMK 墈qT#}T=Y+!)kƋф Yr< {+SN0l=:zyMzV A2J/b>ƂOQ}a!|4c=;]0~oF\z?ÉW&B&F.<ʼEZ8v1Qy#pʆu#Lm>i2o6إ[Y<.uSOM6[л4cPw]Q Qj!ʚYq1L!v0ZeDEM@h U^LRqޭ灂`<}#Fm6}ϵq$8 _Kqcn}M_#FК&;p(&I#xU2ƹ7.-6KRS~ޘhLAYh5V /Jۇ0Ws|%ց}ܳEf]νΨ;.y+>l/F1Idڙ6gPsG xD3SY[瘸.ߑ,3U=9ͨ;n=J\)"]JiHJ\m繀U!/Cw^=!)3 mqlPDmFs|1)6\e"nOfGo0 e xs-⨊ |dcy{ t;$} P[4 mb%ul JZQd=4 RI@mktj}[8Y/RNoo (7b$s<:-q L8jE>/EZ4ۦbE"] Tfy ޽ (l=/ߠvzC]BǢxG3" Ӻ7GbjL_*d$<#[L$)äc ,e7L$vL :WZ[Ս9Kv,}R~u|XZk,wv-f% }k`Q?=9u1"Ԃ"?y(aCOܬ2v@6nwD$%#Jjs,HP}ц-]1Z?t 1˂J#tqSބĪbZ?'Q169_}14o[(J.x6)‡L VO-z%YpU"|p)i6G7OL樿M=x\%ǩֈuƷB1]LVZ;6A3aϾ{;|:dWobt%Uid޺qH00s96_X!Gv̀L $UGػZ .0ʾS>cso>nyM)xu2<%?eבRߩH;%5i OAͩ?7XW|[6ތ M<̬kX~Our6H]>}g NCT1%xa G6'}*JUc_s'jLU~aJ5Xin1D5E҈H"g\ 2)-j^myE^~[NInٟgN0V6\7z})nXa.aVIGMĶZcV ^Ӝ)L'Qӂ 96{ @%DVZSkk 7?]AcNLiSOdMrT=ì򍗋iZv5s>F˔R,dM/ou 7VbDB8?֗գm\|Ku!R42NZ=f%i6:3b组{[ ҷD;kIREP驓GPL^/'I7]mb*m \LJe圦Ԗ@ݎ+Ne?S'd{?8#b٦/{ߢʳO͐5-k';G} RXpQӆMe,? f lZ/%>h2Yؐ dSP?7kqJ첕NCQҒNg٣ly,]8t:? oF^31eXpHucx+"D_H5i،LIi?WW:5X1(*xZRӞ|VAUjr?s U9'QI<}X::Dh'V_5 |fD(ܲa57;bA$0M^v^VWz,g{i<:e|irFgV'Xbu!7Lg:HR2\$3A& >[mHjm8R\!s"Oc۝ol2C`!fwsduK֝Q_rV8Uu|>*Ͽ~AMu-5ͧR2Їq"}!7=Fn~ڰN.Y.-+kag]?QQ0"QRxEU@0PxjUɡG^6ʔt33#gpH#<Ƹ1|J Bd{cA>!f{PHU<]g"c˟vM|J{)#+BԼdo KƾQg'Bef G?#īy:jI!&їC~@ƺk'ǞELڮ9*s'n\&tUJ卑W3n^3ƥeyO1/pSFG0#EdW{[ar/rC!s'?NBܥ~gDR&%Ǭ#>z#OVyb<[EFzz1x8m'ΗhE=WњF[9R{ Jpte(tk2RNBߐA|ůl2' ÿS*S]'ERĔK &}Q>TPD7 I;sWS}əS[Yl 8,JLCIxDL4$FV.fӝMnwz&4oc(n߶o>/_ Xp)c ؒ[x&IdfKfxp[ɂ7CeR"J|8,K> stream xڍuT6 etIۀl;AN)i%D =y=;g~;}q (B6HF@$$T14 DFp/ 4p$B9(`` Sc~:HP (,  IDUp(PD"`h2 `%a(810glE haH#g zxxhe'c04 >;08Fpi`@,hl CŁ@]⏳~߻ oDp`0tv#;- Խ xb`# ƃp' w`}E} K/=4wAh/`oYUF:;4W*p v/?uD =>p 1P낅`4 yB7r6 |\.@[, 0 ߆<P8g0?gQpOV{@_=YaE"{z*a/# * K%%~_ߨ9g@"8`/ewexYeҷ`wM wsrmm?`g_0صAb߮?ݜ۪cCaHHG߇{ zp C8(!a}ma?" HQ(@+2 |k y7P@b!@,G?-5Va! 9l1laѿ!czZqCߒ6kA3HlЖE&.E%Dcke*=VHכ. e< ڳ-a E2 KG-Rn%"lot˂'`7 .uRq`9,H]mzCo&9;Pǩ lt?u[O{k$.ʻz}#AAȬY//b?@4܍70k<}~eO*fpǑw] 2V,IZ'8(}޽F]r|^tVJy<Jns0op̒ '-./LX(u%̗ۑ~%;xϺUbrt`=jy ,V583/UAK ]t2E['6f߽3}-*\m}a}+$ɈXV-5uϞ-.%|N wVE /cZGRHP7C*NZR/ usܲn+0{1 , /4@]S\/Y{gBJbG7\32&=iJGc:*"gK^52aCl*@YjgݽNnLSeֈ㠟yYb }瓠KA,Uۯ^Z(B,j!vq5v2Uux&Tt4=Zk󌊣w*wWNc,G=P⦃eԳgsF]aa̭X% E6R^.᷹b QϪ^Tt>t[*Y~ڻ>l3 QQ.pãv̑K:`+喇|o٭2k=,q ۘ. xgPuZȼ6(fMuC*uhᙰfUv.;t*ۂwpwі‡ؼs?ĺÆ`B ߎ1$?YQ'V?ʩW$ST|MУ\9@^'Ř?lځoK}lF禬 4W8I,}F[p7,v%]f(_2X}R,D#v> ٧V?H̝U[݈LvgFƼHN؊1_0{7S94Q -Q=ȗ\aexOṞAB`Qije] ~daʜd-?&GX4H!B;.[l"ksɨi/?{ʟ UoO*<@>i3ß,G+2jO[ju?yn5СnNGa>aĻ;(>*g~rT6u1bWIvҐ'=mbD ;\VEŊ3n#f\WΏv*B8a_*j^fw]#KJjE[൞)=YaB/%~Gj%GB:R½l[mqr$M]qF=g¦G-G@\PLD>Yw?vdqt"9`l૪цր]g}T7|YO͗̅{s{zVE6ٯZ o;ulHe'@$2gP=ҕ:б򩧍?J^N)FT͘=(S`Gi>Px';BhrHNB3 V=Z\m .ҩ/?kTt>y]G,͋xK_F-AƐdԳ,Iڇ=?}:͋S2ߨJEzx/;J\Dށ 7 8m=f~D?p7SPv\GR0فBWt2|g#?VïkF/j5q5ᅍy)8xqo؜z|O[ޣvt]zjAÜ ^^H˜7}k+=j꓃%7k"iM!) IgkV lJ,Rםݙ34- fi}ڜmZّ1{RJOj0);'/)@"j`Ai3 %Xp-J2T{jZ/ AA6A?j7JRAw󒓧}LtjE&5<1<x oΟ )tuD288DY @I[_Ud'O~@`]< SX wɺ(l}giKʕ!>Nܼ[sy>`p y2?@@\Q mѣ)n?>9hqGSD6kuU- ~W,J)lwØps\4EӱOG[1Jf=ahmK^cޚs_y(h\.Q1 TXMZ|wtB+6x;Uπ-ʧ}և߱7LK~KDTb-"n*%Aj]h<9~<Knjnj4+wN&|ď@noi獩ѕl n$=,Y:Go4 S2t|h!qx^R/S5x74uC R8GLG[t+藲St^Nm)x@@cL <)6\h7_yt~{z-1iӄ:7<+LvL*{A0GOvFhT]ˑ-qoNqյzGi{l~-L5kՇҊ`1c`?gw+Ο<d[əjw{.1@G&tĉx 7!F +g_ =V(23dܝ^͹o,Wo3CXH%Iס-˚1P.xN.sۆ m#ډVFzWQzz~M5  bh=[rhPO5Ǧ)6oPq.] #.6:ya5Mq㫻sVV-O*Hʙ YWʐ=ڿt0DH'c̓'FAc1?7hXuHB1YHlʓ4t?[=)=覴X2=>f {5q] N1uLwboQfjf*w;“۝xM*7s0NT2=ItHްR5A+RNI‰]םd:8kӤdLc8pX3/SڣE}XIspH$4}#NYpt#!7@v 8!U <:ݢs'3E_x9y綉r}[C`f|`ҭ庒6)酢O%P2_CF]WXcwwQzRMWN?ݨtq].:,5"5pz|<9wk?z|HnnH'Y+WxyQn$GKd#sdW^-b2u{K,kyqM E'F9= endstream endobj 138 0 obj << /Length1 1799 /Length2 11524 /Length3 0 /Length 12654 /Filter /FlateDecode >> stream xڍP Z<w+ŝA]Z\(8w)w圽f$ozRi[B́2+ + @RYKΉBKrGBe! 4s}I*C7{WO.C @d Pf(@@ZI35 >?@gljtxhafЄX^AQÃl- 4.@gw%*f[cEhـ\RhB\=̜W=vyuq[JUG /c # [@@+3 l dofjgfqukb rtuau#a^Yl) qp]]PO x=w// @`K?ڰtsd܀RۼPY]<iaG-/GJ?į=8BVm@V3w o d 0Z(Dwy _ǏOFf {c))Ɉk*%$ .^ ' 8=tT wuD[A5zzi`{mA:@?ony t7D[z f {-^u7!:Zh rsZyW[9 7+;_r hrks9A`{Ջ^Wzey?V`l:g<<]z96V0ڣ E6& ؤK|:?;Mi^-(?:fr؀@VB.f/|/ _:y׼k^"8,_rvvz _O_Z2?UB. @YXօֈxlsrG^"lIK ]pG-wDݭ,yi%`3%Hoe;bg)ҚƠǥ #!}YaU76'Mh01Qo`B3۫$jgf;i\ƏdF8y~/1C6I/3DzxM'3[=o/B]F5jhı*%Xxo;qM=K5Y65Xx)1}CT7Lypa} U8Wc>ss!P޲65583Փf}͈F<YײgƔq*YߊĶKD̗ԜIsK/OI ڳ_BkВk?TE|3 FYFs @لكF*J iB© y@ QP&udRVclA"'+$sCdh =͓'%FP;#׋+})Kjg|Aq.)L&Ս q[ fAɗj*chv$7m1Ew.6T*p!C[:ǵwv W,Z\w,!CShMJVFPP4rͰI[?LQjޱ7F /F{'"j9#kvY0Vn-,³J.•-Mjg,. Ag \+ox;-$nE뢓+򩇵Rf܉t#4m` 8}D: ӁSL@bY^v{K!i#hR!DTܩ69]+˚qv`EPߒYlZ`lRj4>7>)h#`=a?Y HiiWڰa&ƃ#樂)RoQyBH K6 B*c Ӛ Vw|g HN樬,^L3*Qv2_f;EnJm}DA6'kJ%Hȏ}9 }[&̼md`ۀ~&`[Mk"W"{LNg:1ʥTm Gﻂ!rq}!Rp雋IQFMo{H3!q_Z;lD+seKu**/IlNt┗ys]u (EC-oexmRAk~( G]D X3O ݿoݾxT*kF8(|/~fmPxtje3Lu3(%{]7:^a~ؿ %-i\]c(*[>Jpp:|e>zn"Fm;WGNTJ.ލY۵kYby"_bv Ḭ?7ȕpR :@&\dzM lhR|Yߺ['?uͭt! ۍ"7`<i$Y cA7$ #z:[?dElOx$^7vI[ -) xB!F@\3{eL% @aAi窯jxnG-6v{q'M($6}-[lpFSKfV;uQcbCl(6¤L$MX"o6>{C!"N%/ .W$֨zWOPēFSh!cI. ʵo^& 8Ыtuﵯ)ƋhsE㋆cDuç0qWͺ3?V|x k6W/(J+^|xZF&*99zF,-;bcHW>V_עJw3g?񃵞JUje{D(Dn Tkyv)(':s12gC 1 ʯr)O7=1y쒸WSΐp>tɔ"t2e7DOR ,F'G_8X'ʖj?R⃄{Rd̍ ֬x`2e/ON ±5=u>xӅ ȕ#"8:%]Oqen4=N0DB ȝfh19b6nT=cՇ^S4S0LG&X#E$ƞ KF\nvuA8O^kҖ*xm<^fsEg9dG0cc>:u>JeCivV*s{o o #,)[%0N),7Nn>03@ $k%-, fK^p9.1dpe01qv3=fa 5%Ω+jeH[nOQvnx@#tOw[aV~Y;FaT~xMg>bwj9m^zj^-\CGW sER 5`3/ 0~V&af}]w l8Rf'G _37+1#&{J\5Mps)$SeEƛ}w*ng=  ԫ-_NOcI 0ܳ8sPrl}] Hb@AS5j}F6!}&ˤ"i }o0n\P Kh;r#b!tKx*Geb Œ"d[l̈xˑaqsނʋ7,kLVMnWt_t4y"fK)^ ɺ"C$b3+ IQT&vX&Z-%H T>~Rx''02vX OI2Fد3{S$wM`*hͨ-R\L`*mE$QX=(nj2쭜W=c\5 zw oЖHyI"}醿G:WxhQH C5M-.$? Iېqtu/kqX+Oݩw%m6c jAe̊ƣi&\ Sf܃q'g駹Y3L:vn.Sux :H$MeJǽ;U]ԣ }L=-}{Cҏߞp2jEȑ:lA2o/{WX|rT6O R\-̨O1l9͔U2"H(Qw}EAXЊ%Ў]ͦSWr~S>q^ H-"@d7SϚcr*MuTk&ჟ_cqT3$O@H!0 (^j@2e#q 95?]I L[MbU8={Ú_&勉Ƈ 6(S=9}:Am.: X|XJ+衵8ۅ3__;N:#-.LhVJ$0F\Q"axlt"M>sի l‹O;p47+^axs8o/?'Nc.Hiwqz '&awqN?D[m;i[dM0&hսF~KOdy'ȻX6ܥteP!6Q.F nT^YQ{=w'F4ex B(~N8 JE:48`I 7hkn`6eAn)A/Eƪ޺pfFM3xuقMB.7U0ɗKL2Ʈ[)d8cK!%*l+>DY\#t[yImG_붕'.} /^Gʽj3g|̏{ֶ=9(!nst!'q[eC3bsO*+;r$.:0ZeR[,NtߞZ"\0Y6 Ҭ6(<098^uf{{ 3j͌UӔQ2^ͫ{ƦNiqW`FL5im^n"YeD9XcQ2q~63µݍcJ̌X/KP77ibk(2n}%HLjN 5ǡؕ%a^ 7ؽĄsӸ'[jF:=HN/ጝ=浛d/7M{СOMwjClHM)F^{E3,Ozk@<7pE!lz:_9^#ѣ dϏi@Đד"ҞT9w~Wё%釦w2Ȭ{4:S9\gҫ:{ϧ3[!$ &}E8/W2??kxt ۃI`[ޟ}(RP"|6OG}6C;FC!Gk =j(/ñw=S ڷ]O%T=KYHJ0Trye5r:O0%I4VMl15oJlw_n)V*"kh@XSܹ>HLj'82tD?1|Y1p揙uiB~/,1<ɱ0U+* a(VLaKGuy^+AE*{U^_JQ2;CFG15OiRK Zʰˏ]&C DK86׈2ll=<r$XrT͎l4M)QSci"O4\rkSTO䵨2:+sWhMų|;6J˧!;ٗ>qĔ8[(ꕵRci{5yTPS4Qngz; qjlpƵ#[>5'e;p 3rgDTq{쨟хkЕ0ө gȽʎ-e9PheVn.R\wK,m|uUOsqwU~wB]"`>gb$chZe{_~Ӟ;դZu )pKaw{492{W %;1㴲ůׇv0$HK(%¥ґGS؍}<Xݳ[5qAGA d^cQ gV/b ~k@؇jĕGp21m`x0BMIBC߀).O;֖8>OB=[_qϕ P䗢0?^q8 R<}k^DUSA7gg ϊc~*jee&ԛ|]gxr3تՐ7ч:"l-mQU}٤4aglҽH3F1;6`c&'e%OTkvUY}PKy)a4}MPG*ZN,Fێ,bH`ӀtPT"X;<ʈ lΦ}S!xX0Psg9-%;|W%>ڎҔm̘+(0X%PpJ"++O!nz:[UE!qTnc;Nhڠ{N} +\KFܬot[8,k躿S!? IaG\QlVY,~¶ܔK>;0,}:k RgEbO|dgF4*t|yX'v`zJ|;g@x#Ju ::& K<}Xu(~y,b:mCh-Ks }̔O.*ѹҡ5tLatp-V叆\?YpV蓬!Jb zJ5 -ׅJ K|bM[冈EۿnCjj["8F!츓 ͨyn%5Tzp0J>&5d=b_"3LiۜuI*1"𮨲kf5qb!g#j@>aRK,5HMZab1\ԩ.y,Zpةx uR԰9/{Q B'6Op ߏ D0煓׾/4IMiέ/US|O tzR|KV g.eVj;Kڢ0V,G"z$lbxjxʁvr4,L Z1B=iGHO={?0%h| ;<4[[/b3pVG0J*}(ԇZ5ܠH^bfQ:.s3!(IHsHc}!@Q8b\b LZ8/Ae%ZGx *oduȳA=nTyؾxI>H)St42Ӑd;W#1c:I9D\&0k_=a*08us1|mPKLDfb2Πyє֍6>b~riyDL3iHDi(%k#A*~di#bv.zQY.]@֭mdJˀ 4lM"ר̷ݺߦEurHs5P5)L MIO-"zif 9zo LC5_JSzM[ Z},W 5Nukf"k`7jX{d^8H e>-pXy^?1L홿\4}9v:^HM[_]asbX4\s'b>XN}.|Decg }3%}/ =񌂽Yɀ"p`c<-ELA \{( (EcVþQx*թ6j۳_h?Vږo桗 [Tnv^BiΙe [A(Mr#V3wĢ)B"~Ww;#uEWSҌsi!҄ 9a/װ;>OK"zɆ(9X[esu HdvޥS8p~U?iyCT-Æ7 Lj-ؠn%'wPHnEޗEO.G[ YgMyX sꬠ8D⬵v0f~ qŵٍxWJO!s+؎~bAy6f-w'%R\+v0tbWYEܨ ֨핍f~w$(~,nUch)gƼkJ;:*d;1 ?+b  $8Ʒ0ou3K1WK<~ޫÒ]аǰ#ŤY[U7jxաlVM5m*kߢ ,V3;x+tN(5A< vZ>\.ndIrS';3L,1}+6 ;O,Wx,:9쉩 `-ᾣv*tTy]R_}EQ|iS):w{T`)i`] i:>5}剟X R7xWYL3Ȗ; _j) C). Ϛ++w<֬&ak 1hr'0 {[K}뫈0Ke<9vY߀ͨe)=> stream xڍTZ6LHwH ݝ 50tw# -Hw "-*-)75k̳gsi4uإ`y;;70@FMWŃIO qw-Ǥ PgY wL7T:=ܼnanAa..oC(L X8Pg& s/Ɋ  r V ghr@ `w`sww9q@al/@y)AN࿨q`t n*t6^ 8Bnpgk0 QRh4VӀ Wsw  ++ l 8loCAAp?J䥴 8ÿY .nn9YZvvw],݇upz9l 6iX{p9C\=JE2[;Kv8'q-ssl40 <~Vars!VK-!:\ pǏ?3YC}8bN=iyEֿ(zع<|~>(RMڸ)9@?){7 Ͽ鯥a7:>`rsYW:[z? ?z/ 4{7C 55j`kjA ru7y7Zne} g& ssqrV; ~XoF9g+`0&|x~{1Ng;g0?SO$~@N$}@@?H )xT<S@| !x>ϠtS= xLk= x-r9??pzpߖЇtp[{/5D59 s6s%lmrå7vD ? ?r-7VsP+pZ) /q>3tM9roZ2קozfW x I'LЁbc?I(vmllmKrآLrxk6绂(CKe!c>6842!!^lNj:.gn'O_z?ÿ> bwE,gW_k?0}^G49N4,,\yiR_b`:}!JM&?N`;* e7&R<[Nzr'tG-QLOV_l@lsKi*Vߕ3w=v0.zӜus`/=kU=>DQ%h]6 [pzijl_LoNƣIcp#* i-d&)Z:g*ܚ%ӈppWyB/ty^bJ=%>=0IHWn WaUҙ2}3݈\Ylq~*J؝;pa@NnKȼv~RghNTiUX=عG4ez/5+&|Itn[xc2/OT^J!ʊ|CK&F4z.Q,{N!++¨'PB!lmY+ @.W(4^0\l9iz=]Ǩ{1EE!8ŒVH1^)¤|Z`e\vB,?ngktw)I?l'W^]wJikr "ua'*6')8e}:"x}ͦ-D^Z#J97I \ȓ>7>.f[mVtd.Hݒ@os7bf_!0y+<#&MmruvM*@ZD0Cq[Fr)#gw18lPD,앧?lXr#l'Yvg%cv %9hnl. NܷWGy*Qߚsb8#K%ϩl`m@:9\ņʋF2\Z*N{DOsLH[9 _̞c$ҕvz#ݕcm$BD^4"mW< Iz*}zwO^ޗ;+KC6)<~Yfp9e S;.B{VM`n^?U._w];%S%S)z?{m3${+yU>AǫDg ;iӨscT ߽>U8tE3p>~ZdT:ˣYc1wmqBn `(i S`]L?[!o'^~E$_f{to0w:UXv@# ;*WR1%Hwx}Fz:4\m?6sr hlDu" ت:;Y8j񝃨n q)c*Zӽҭl&-Ţ\̢-<[尪++>Zڭ*ٔNIMøM-;8ztRs gژ%JoPҼEhkw;ցq")m{YOi|҈SʤlHo|6 dE,VE~{4i (޿Y];2>5јrzyѳ!3][)g_j!vMޫ:CFxM)\~<]qey3a=)Vͦ[(a!CZWA>$^T;+tE$,r|j2 wT'.2|>6x^VUC~)J[%JS4X;_ R9)fgz 5v1J~U@;E2|S/4C*N[V\夞2;0˟Ӂn*tР SX$']1JH0] 쵚 4S&>K+u፾/@"jN8d4F{kҊF9LsJ '.][5CHuARpՆPe@d^!b5xJ7kuFl׌0>9Μd{KNuy9$yDVفW 6)ȩ< V%XwO1/;xW=`OfwM3nƧ5RҢXgήzM|X{߂?'XXk9 /l8g":W>tm= (A7~q{F~=OOZgl԰^PEuiO%A@T9J[G,+HeچNӖ6`5Io筲;K<6F!?R6}&"ѵStǪx%d s><<gdު.D@rb5#`iH[kY|,){ގL']Yr-yO[lOʾC'PXEjaK\F|9)dH;HĹN`U%ƶ̀FaKluɛ)>ށ7K59Y-}Ȍ{B}:=Oq2Y$::.zl|,Ia}FnR,|\Io"xE))~F=2)x;X*~S(%kԊ}rQ"cRzbB%PfV*qTqpv\fٶѓp12iuyloפBإʋ1晘|Cs%Y9pV+~ٺZ*ˮ|aXXB>G2ե[q I #iViAIZ~;+D ,.ѮtuYLA^nˆkH#hp+obam#kfh~2/ZuxvEa+3c|E{Sp=# - ^1;#i#)I5_/ %SQ}~mV(8Jєt2q/&n(G޺q5="gѱz- ~1_'Zi|̅Ww/v(|$ Z_1̝#O4-B*gNfyaN 1fٍEfz}oIզH0ASK~f<BRUJc{/M 8Y1dIs3K[59&o[}D,tj@bGF5_u?5'I1崳 :5uDm'oZhad5~4_'6-g%,oo.}i V/(xn-5F`҈!3ƊvH9i|tlxLJ%Х2YD׽'ФCv}6"6?pB,#*<"W)cwRfJOxfQّCtk4b"%tM??Ss˔rGWaNvqǃ |?1DX\Ӽ2JH.hNi(fgH?kߜF}YD#ZifJu8Tn۩A@:l:n[Oz3(`:Mʍbfw M#;;љ}:[G^LSC>^謨ug2aqwx]ZuuwYQUa9H<#`}OrRV03vAt;ch >7!@n1nAkiJUʈ%#_/2 xZmjk\-x[h#;O]])l`̣_ij$ܤk;pElk!^}5T-a>t*ZV&9TG7e >[I߻3!Ң氧i(g}}TJL]jiL,m$6Ҳ:£ol| #ot9?|r@7бta]o)twu،-QUCѴ#\$&o9P)_ʐsIH補^{lT6&aj+D.~ x%1ez}N N$\=EB.~^rHSq4BSWWmNwo 2L9qEWNwUϾVQӾ#7[OsnCb'\ACRP0 Ge.I^~P]O~b7Or_5mMWXkXq| 9+hC EZcI*R<: t6=e3XrOh 0`݉*3u=)ޅ6B,*KCƛaK sQO3] m3^ٴ6b;!ӌ {r굈G=%09\1G""ETQK<5~Ԩh_Z,<.V%(֡&t!_'*/܆L9XȫӪ^_*a޾:E 0lW{#e9,p҄mRV|/sTc7L+ש+tͫs\1=_H.Cޑah.X dǨi= X8uۤX~bD]7#%agtB5L\0[t aD)[6J-m:XmNJzW".-h[ړ܀HץdD.&z5E56$pLɏZv$I:SewoKƔ̮ӭ\c}Ize֮KnMxFr"칞5 `mN/L~jmac{.F2\ԝ]yVUXQ!TK y& kilFT)d-Ύa]%g3da8O1nZ_ͩe 79'!IJZ X|(8I%̳M>F 55先5Þ1SF=Bq1\ ao2!Wm>NJcjFB'Du(8yh]?>P] 2'Sb=%q6{CNDǪ# %Weոs'¸ D"酒L":@AܦnF (̒Mc|N*cmx䮕@,#7}0_ߢ4v@O^E;Ŀ{ KK I*PXYHԭjOXME_E2Pu(wWű[vGo/Dru^x{1~3,5Qkwޗ 6X҈j a8@k;>N @0~zb5KU39EFG%݈ 6kHKΥ+&~@W;nKyΗLi#K<.ۏ:yg;gɓ̧{l<{s퓞d'eOwlzcF?^D+=#\z=λ pą(c\,$ۓXѵ$D[gГ> )_QrW(}suݪ%&F,;HFѯ-oH@7z+|xt&493GN0-r cR}H( dAHl$tK nx: U:֚..16TVНs&bi>?^5;n&b(9yx .w.bZDi}nb M<  Rp7L ~#AצLd @04FO(~¶ʞj2jm bvӢWdͫoq_n6Z"Kǜ"<+rpuHhZh<8@6QCm^iX2 5VRZܺ;c(//Ƅ#?Gc ж>e41WGFgOmtuћz@{wsp B%c! mO؅5gΦ\XųSbA~l&YcA-ﶅPk_=2" sr$P]Rb^Ӓ@XIZxz^yfD؀|2יI73ɓ1Cʥy)qJ<61 ޔ_1/PQtM >2_ zU~P@3ajb$mԳ@ߗۢ\}B*h/ݞ[.ǒ==JN55kC(M'>vWJ:wx m[{$"]i( o5ܨ[Ȝ#n4% q CPJpeY*1A[U` !o4lHD$G6ɓeqyC91~Aϳ*NVj!\t>9Rkr~"V(>{{%]HH^@CC>M b7V2o- ?l:{!!sQdsم+yCU9+~y tD эgjY益jKhaÆ%F$)+? Kv{/š51Rh*Vko|(}TKTeĵw<os:fnw5;Lچ[=sX;,LUt F. /ʈbr7!K>Ml/S R7(7%q^ZoNH_Uީ];wɒ hy*wz:i){j?#\%RkW)fҖ8e ]U}ZOYjRy[8B~n &D`ldi{%WVy$ȗJ%.5m*M?viU~ Ӓ Ln]J}ɧP_1"eCiS#X2ꚘM KYSGt~>ݗvb|j0ik#GX- ,hؙ{v:0J\>%snC~/yOE"Ǽ?7lzf@)?{`J!.LD؁8|Q/:ˑ0U.o+Ml>½ _Xݹ/Y;Q Z!AR +@Y-t5 {&|L]&ZH%yqh}c\QSEvw_ Γ;"/UCI=Aܒrp{v7e=O?>AW<:&S:n9xugV^9#az۪'}6P3xm=%9y~-yOr@כQ#3fHȫBV+}f͓(U/g"IQv+KH%Aqm|nbUgEr&@=^Rlf9F _/uJ4004EW B]Ŧ>,Q|FA 8\٪d0jg^~TO鮷TqEY[$ \ 4!^xnhܣNΌ&(<Wv\36e=rz&4Rjj&-^В꒢E $5G"#PA)p;Ӄ.& ֘~₯\b5 JcV_Z:]f#|@kAg, >r:.T=2hk꠩0^5Vhe?exkcCD[!SA#='\ ,*ӺFBr endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 817 /Length 4064 /Filter /FlateDecode >> stream x[Ysɖ~ׯG *qc!l?l"Kn-4̯R-#ff:RYY'ϾeB /A8/^h?+4F(tWV0.6Ҋ+F/+ DsPF$6oC% Q r | k|g/@ؤQ@N%+QA€[OlNPNQk|"P C+b ALH"ZaX:ЇC8(z‡Sɐ\+A r%(]Am`ͩDJkƀy,9 %gA;$$ǐ[ 6\V@. (*HIwlp*!{}K+؁ X"Id xhЄi8E)4(L+PA  r 3!tdO! 6GL$ D!;X#v0J4l!rpB(ju`Y y(Ä VO<t(x4;pPl=:LFo6m{4]Ũ ɨloiW/uw5v֓z<ƥ8\ G;;(q,aorN>m7oۗuKz0#%p:c n^y]w{7Ia!Q Cf0<e뼵iɽ[>/yNt&񺲔PgSGp'z/ӧLA>c>۽d/t\;W^}󟗴Zu׏] ΐ ƾ_7!):+L2Υ*iX7n798旼X0(87eXy$E}MtTh[!s!,+qVWYG;U)wJ^:g>"WK*Z0a \Eԁ:&oi$xbQK$"><*)!ٜ|y\FSPoGI =#*d=Y$|ИPȕ8k7h3%<3tV'wD]DυɨGڨVd@ƄΛ%y:E?͓xs|n^u'Wc~HZD2=-%c~n< a%AE1,C"@O{[JeU~6c>+@x4X٘LXeM쪈j*7p*#|#b%b#L7i@d#6*;PK ]t A4=p4wEFvD\aBZϜn&K~~A/֚s{#qdy~ "XK)Ƀ &KNΎ(&WY`)FI5{tWsYabe9~pAS&KAg 02ȸ͹\BUt ] ,fƗG9!Q{{awKƇ<Α`,Rxs1Sur0[@sje=~{>w|ss86$Ws%H$VDriu1:΢ov5|]zHظHP#FExxbo݃Asy/ ~7u*|GΗzBDa](x4&A=v_:5e;.}@^A)$B(3a3Y^t?2qƽok K~գwʥǿ}8:>c# FqKyk# FiDj?̵n,%g*ZUN9y_A9''\to]n1l+؝G?P> endobj 142 0 obj << /Type /ObjStm /N 21 /First 164 /Length 760 /Filter /FlateDecode >> stream xڝYo0+q6RUP!tՇ,4%=BVK xf{< S@I, p<AA8 (pҬ@ =*R`FP2 $* 4XIm aңFF=g?!$fu2jwu>Y"[0>U^t^u/&{(/IꞜ@_/5.]NCvG7=qS%sfR ?>v8:ߥsqXvþ?Dv,Z6 .9q(^#}px:NǟOF?h‹xKf:NF~NsNmR vA`""eמn<]6(ۆؽDaZ5r 4WW|n)ߚwLe9ѿܨK:i%؆J&yո៺k\$eOG!9#$lAx2OJ[]WT\q^zЇ{kZf!J|HRJXfBg~9sݘh^@V \80ezR (5IQ]q7ٍ:Z{UKXq8xcs17WҼgy{x H+[]nm^[bS3}M?[']EVo endstream endobj 152 0 obj << /Type /XRef /Index [0 153] /Size 153 /W [1 3 1] /Root 150 0 R /Info 151 0 R /ID [ ] /Length 400 /Filter /FlateDecode >> stream x%SqRs H聞\ BakaEVVof36fش6-'iia&?5{Ι'")"7A$N$V ePԶ@9Q"U@%l)_eeN-9s ( C6hPTrvA#4A3P,rq8ݰBЩ(uKJtNaşn9OcB7(b͏ C/A? )8 73Bekpp.eW\pn܆IޑJ+I)nJcߜ(-uziFi}iVY鑲fۜ({Gí\Sk)vy@$ endstream endobj startxref 236373 %%EOF phangorn/inst/doc/Ancestral.Rnw0000644000175100001440000001344612547505677016264 0ustar hornikusers%\VignetteIndexEntry{Ancestral Sequence Reconstruction} %\VignetteKeywords{Documentation} %\VignettePackage{phangorn} %\VignetteEngine{Sweave} \documentclass[12pt]{article} \usepackage{times} \usepackage{hyperref} \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rfunarg}[1]{{\texttt{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\R}{\textsf{R}} \newcommand{\pml}{\Robject{pml}} \newcommand{\phangorn}{\Rpackage{phangorn}} \newcommand{\ape}{\Rpackage{ape}} \newcommand{\multicore}{\Rpackage{multicore}} \newcommand{\term}[1]{\emph{#1}} \newcommand{\mref}[2]{\htmladdnormallinkfoot{#2}{#1}} \begin{document} % Ross Ihakas extenstion for nicer representation \DefineVerbatimEnvironment{Sinput}{Verbatim} {xleftmargin=2em} \DefineVerbatimEnvironment{Soutput}{Verbatim}{xleftmargin=2em} \DefineVerbatimEnvironment{Scode}{Verbatim}{xleftmargin=2em} \fvset{listparameters={\setlength{\topsep}{0pt}}} \renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} <>= options(width=70) foo <- packageDescription("phangorn") @ \title{Ancestral sequence reconstruction with phangorn (Version \Sexpr{foo$Version})} %$ \author{\mref{mailto:klaus.schliep@gmail.com}{Klaus P. Schliep}} \maketitle \nocite{Paradis2006} \section{Introduction} These notes describe the ancestral sequence reconstruction using the \phangorn{} package \cite{Schliep2011}. \phangorn{} provides several methods to estimate ancestral character states with either Maximum Parsimony (MP) or Maximum Likelihood (ML). %For more background on all the methods see e.g. \cite{Felsenstein2004, Yang2006}. \section{Parsimony reconstructions} To reconstruct ancestral sequences we first load some data and reconstruct a tree: <>= library(phangorn) primates = read.phyDat("primates.dna", format = "phylip", type = "DNA") tree = pratchet(primates, trace=0) tree = acctran(tree, primates) parsimony(tree, primates) @ For parsimony analysis of the edge length represent the observed number of changes. Reconstructing ancestral states therefore defines also the edge lengths of a tree. However there can exist several equally parsimonious reconstructions or states can be ambiguous and therefore edge length can differ. %\phangorn{} brakes them equally down. "MPR" reconstructs the ancestral states for each (internal) node as if the tree would be rooted in that node. However the nodes are not independent of each other. If one chooses one state for a specific node, this can restrict the choice of neighbouring nodes (figure \ref{fig:Pars}). The function acctran (accelerated transformation) assigns edge length and internal nodes to the tree \cite{Swofford1987}. <>= anc.acctran = ancestral.pars(tree, primates, "ACCTRAN") anc.mpr = ancestral.pars(tree, primates, "MPR") @ All the ancestral reconstructions for parsimony are based on the fitch algorithm and so far only bifurcating trees are allowed. However trees can get pruned afterwards using the function \Rfunction{multi2di} from \ape{}. <>= tmp <- require(seqLogo) if(tmp) seqLogo( t(subset(anc.mpr, getRoot(tree), 1:20)[[1]]), ic.scale=FALSE) @ \begin{figure} \begin{center} <>= <> @ \caption{Representation for the reconstruction of the first 20 characters for the root node.} \end{center} \end{figure} <>= options(SweaveHooks=list(fig=function() par(mar=c(2.1, 4.1, 2.1, 2.1)))) @ <>= par(mfrow=c(2,1)) plotAnc(tree, anc.mpr, 17) title("MPR") plotAnc(tree, anc.acctran, 17) title("ACCTRAN") @ \begin{figure} \begin{center} <>= <> @ \caption{Ancestral reconstruction for one character for the "MPR" and "ACCTRAN" reconstruction. When nodes contain several colours reconstruction is not unique!}\label{fig:Pars} \end{center} \end{figure} \section{Likelihood reconstructions} \phangorn{} also offers the possibility to estimate ancestral states using a ML. The advantages of ML over parsimony is that the reconstruction accounts for different edge lengths. So far only a marginal construction is implemented (see \cite{Yang2006}). <>= fit = pml(tree, primates) fit = optim.pml(fit, model="F81", control = pml.control(trace=0)) @ We can assign the ancestral states according to the highest likelihood ("ml"): \[ P(x_r = A) = \frac{L(x_r=A)}{\sum_{k \in \{A,C,G,T\}}L(x_r=k)} \] and the highest posterior probability ("bayes") criterion: \[ P(x_r=A) = \frac{\pi_A L(x_r=A)}{\sum_{k \in \{A,C,G,T\}}\pi_k L(x_r=k)}, \] where $L(x_r)$ is the joint probability of states at the tips and the state at the root $x_r$ and $\pi_i$ are the estimated base frequencies of state $i$. Both methods agree if all states (base frequencies) have equal probabilities. <>= anc.ml = ancestral.pml(fit, "ml") anc.bayes = ancestral.pml(fit, "bayes") @ The differences of the two approaches for a specific site (17) are represented in figure\ref{fig:MLB}. <>= par(mfrow=c(2,1)) plotAnc(tree, anc.ml, 17) title("ML") plotAnc(tree, anc.bayes, 17) title("Bayes") @ \begin{figure} \begin{center} <>= <> @ \caption{Ancestral reconstruction for fig.\ref{fig:Pars} the using the maximum likelihood and (empirical) Bayesian reconstruction.}\label{fig:MLB} \end{center} \end{figure} \bibliographystyle{plain} \bibliography{phangorn} \section{Session Information} The version number of \R{} and packages loaded for generating the vignette were: <>= toLatex(sessionInfo()) @ \end{document} phangorn/inst/doc/phangorn-specials.Rnw0000644000175100001440000003030312547505677017754 0ustar hornikusers%\VignetteIndexEntry{Advanced features} %\VignetteKeywords{Documentation} %\VignettePackage{phangorn} %\VignetteEngine{Sweave} \documentclass[12pt]{article} % setwd("/home/kschliep/Desktop/phangorn/vignettes") % Sweave("phangorn-specials.Rnw") % tools::texi2dvi("phangorn-specials.tex", pdf=TRUE) \usepackage{times} \usepackage{hyperref} \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rfunarg}[1]{{\texttt{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\R}{\textsf{R}} \newcommand{\pml}{\Robject{pml}} \newcommand{\phangorn}{\Rpackage{phangorn}} \newcommand{\ape}{\Rpackage{ape}} \newcommand{\multicore}{\Rpackage{multicore}} \newcommand{\term}[1]{\emph{#1}} \newcommand{\mref}[2]{\htmladdnormallinkfoot{#2}{#1}} \begin{document} % Ross Ihakas extenstion for nicer representation \DefineVerbatimEnvironment{Sinput}{Verbatim} {xleftmargin=2em} \DefineVerbatimEnvironment{Soutput}{Verbatim}{xleftmargin=2em} \DefineVerbatimEnvironment{Scode}{Verbatim}{xleftmargin=2em} \fvset{listparameters={\setlength{\topsep}{0pt}}} \renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} <>= options(width=70) foo <- packageDescription("phangorn") @ \title{Special features of phangorn (Version \Sexpr{foo$Version})} %$ \author{\mref{mailto:klaus.schliep@gmail.com}{Klaus P. Schliep}} \maketitle \nocite{Paradis2012} \section*{Introduction} This document illustrates some of the \phangorn{} \cite{Schliep2011} specialised features which are useful but maybe not as well-known or just not (yet) described elsewhere. This is mainly interesting for someone who wants to explore different models or set up some simulation studies. We show how to construct data objects for different character states other than nucleotides or amino acids or how to set up different models to estimate transition rate. The vignette \emph{Trees} describes in detail how to estimate phylogenies from nucleotide or amino acids. \section{User defined data formats}\label{sec:USER} To better understand how to define our own data type it is useful to know a bit more about the internal representation of \Robject{phyDat} objects. The internal representation of \Robject{phyDat} object is very similar to \Robject{factor} objects. As an example we will show here several possibilities to define nucleotide data with gaps defined as a fifth state. Ignoring gaps or coding them as ambiguous sites - as it is done in most programs, also in phangorn as default - may be misleading (see Warnow(2012)\cite{Warnow2012}). When the number of gaps is low and the gaps are missing at random coding gaps as separate state may be not important. Let assume we have given a matrix where each row contains a character vector of a taxonomical unit: <>= library(phangorn) data = matrix(c("r","a","y","g","g","a","c","-","c","t","c","g", "a","a","t","g","g","a","t","-","c","t","c","a", "a","a","t","-","g","a","c","c","c","t","?","g"), dimnames = list(c("t1", "t2", "t3"),NULL), nrow=3, byrow=TRUE) data @ Normally we would transform this matrix into an phyDat object and gaps are handled as ambiguous character like "?". <<>>= gapsdata1 = phyDat(data) gapsdata1 @ Now we will define a "USER" defined object and have to supply a vector levels of the character states for the new data, in our case the for nucleotide states and the gap. Additional we can define ambiguous states which can be any of the states. <>= gapsdata2 = phyDat(data, type="USER", levels=c("a","c","g","t","-"), ambiguity = c("?", "n")) gapsdata2 @ This is not yet what we wanted as two sites of our alignment, which contain the ambiguous characters "r" and "y", got deleted. To define ambiguous characters like "r" and "y" explicitly we have to supply a contrast matrix similar to contrasts for factors. <>= contrast = matrix(data = c(1,0,0,0,0, 0,1,0,0,0, 0,0,1,0,0, 0,0,0,1,0, 1,0,1,0,0, 0,1,0,1,0, 0,0,0,0,1, 1,1,1,1,0, 1,1,1,1,1), ncol = 5, byrow = TRUE) dimnames(contrast) = list(c("a","c","g","t","r","y","-","n","?"), c("a", "c", "g", "t", "-")) contrast gapsdata3 = phyDat(data, type="USER", contrast=contrast) gapsdata3 @ Here we defined "n" as a state which can be any nucleotide but not a gap "-" and "?" can be any state including a gap. These data can be used in all functions available in \phangorn{} to compute distance matrices or perform parsimony and maximum likelihood analysis. \section{Estimation of non-standard transition rate matrices} In the last section \ref{sec:USER} we described how to set up user defined data formats. Now we describe how to estimate transition matrices with pml. Again for nucleotide data the most common models can be called directly in the \Rfunction{optim.pml} function (e.g. "JC69", "HKY", "GTR" to name a few). Table \ref{models} lists all the available nucleotide models, which can estimated directly in \Rfunction{optim.pml}. For amino acids several transition matrices are available ("WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa", "mtREV24", "VT","RtREV", "HIVw", "HIVb", "FLU", "Blossum62", "Dayhoff\_DCMut" and "JTT-DCMut") or can be estimated with \Rfunction{optim.pml}. For example Mathews et al. (2010) \cite{Mathews2010} used this function to estimate a phytochrome amino acid transition matrix. We will now show how to estimate a rate matrix with different transition ($\alpha$) and transversion ratio ($\beta$) and a fixed rate to the gap state ($\gamma$) - a kind of Kimura two-parameter model (K81) for nucleotide data with gaps as fifth state (see table \ref{gaps}). \begin{table}[htbp] \centering \begin{tabular}{l|lllll} & a & c & g & t & - \\ \hline a & & & & & \\ c & $\beta$ & & & & \\ g & $\alpha$ & $\beta$ & & & \\ t & $\beta$ & $\alpha$ & $\beta$ & & \\ - & $\gamma$ & $\gamma$ & $\gamma$ & $\gamma$ & \\ \end{tabular} \caption{Rate matrix K to optimise. }\label{gaps} \end{table} The parameters subs accepts a vector of consecutive integers and at least one element has to be zero (these gets the reference rate of 1). <<>>= tree = unroot(rtree(3)) fit = pml(tree, gapsdata3) fit = optim.pml(fit, optQ=TRUE, subs=c(1,0,1,2,1,0,2,1,2,2), control=pml.control(trace=0)) fit @ Here are some conventions how the models are estimated: \\ If a model is supplied the base frequencies bf and rate matrix Q are optimised according to the model (nucleotides) or the adequate rate matrix and frequencies are chosen (for amino acids). If optQ=TRUE and neither a model or subs are supplied than a symmetric (optBf=FALSE) or reversible model (optBf=TRUE, i.e. the GTR for nucleotides) is estimated. This can be slow if the there are many character states, e.g. for amino acids. \begin{table}[htbp] \centering \begin{tabular}{|llllr|} \hline model & optQ & optBf & subs & df \\ \hline JC & FALSE & FALSE & $c(0, 0, 0, 0, 0, 0)$ & 0 \\ F81 & FALSE & TRUE & $c(0, 0, 0, 0, 0, 0)$ & 3 \\ K80 & TRUE & FALSE & $c(0, 1, 0, 0, 1, 0)$ & 1 \\ HKY & TRUE & TRUE & $c(0, 1, 0, 0, 1, 0)$ & 4 \\ TrNe & TRUE & FALSE & $c(0, 1, 0, 0, 2, 0)$ & 2 \\ TrN & TRUE & TRUE & $c(0, 1, 0, 0, 2, 0)$ & 5 \\ TPM1 & TRUE & FALSE & $c(0, 1, 2, 2, 1, 0)$ & 2 \\ K81 & TRUE & FALSE & $c(0, 1, 2, 2, 1, 0)$ & 2 \\ TPM1u & TRUE & TRUE & $c(0, 1, 2, 2, 1, 0)$ & 5 \\ TPM2 & TRUE & FALSE & $c(1, 2, 1, 0, 2, 0)$ & 2 \\ TPM2u & TRUE & TRUE & $c(1, 2, 1, 0, 2, 0)$ & 5 \\ TPM3 & TRUE & FALSE & $c(1, 2, 0, 1, 2, 0)$ & 2 \\ TPM3u & TRUE & TRUE & $c(1, 2, 0, 1, 2, 0)$ & 5 \\ TIM1e & TRUE & FALSE & $c(0, 1, 2, 2, 3, 0)$ & 3 \\ TIM1 & TRUE & TRUE & $c(0, 1, 2, 2, 3, 0)$ & 6 \\ TIM2e & TRUE & FALSE & $c(1, 2, 1, 0, 3, 0)$ & 3 \\ TIM2 & TRUE & TRUE & $c(1, 2, 1, 0, 3, 0)$ & 6 \\ TIM3e & TRUE & FALSE & $c(1, 2, 0, 1, 3, 0)$ & 3 \\ TIM3 & TRUE & TRUE & $c(1, 2, 0, 1, 3, 0)$ & 6 \\ TVMe & TRUE & FALSE & $c(1, 2, 3, 4, 2, 0)$ & 4 \\ TVM & TRUE & TRUE & $c(1, 2, 3, 4, 2, 0)$ & 7 \\ SYM & TRUE & FALSE & $c(1, 2, 3, 4, 5, 0)$ & 5 \\ GTR & TRUE & TRUE & $c(1, 2, 3, 4, 5, 0)$ & 8 \\ \hline \end{tabular} \caption{DNA models available in phangorn, how they are defined and number of parameters to estimate. }\label{models} \end{table} \section{Codon substitution models} A special case of the transition rates are codon models. \phangorn{} now offers the possibility to estimate the $d_N/d_S$ ratio (sometimes called ka/ks), for an overview see \cite{Yang2006}. These functions extend the option to estimates the $d_N/d_S$ ratio for pairwise sequence comparison as it is available through the function \Rfunction{kaks} in \Rpackage{seqinr}. The transition rate between between codon $i$ and $j$ is defined as follows: \begin{eqnarray} q_{ij}=\left\{ \begin{array}{l@{\quad}l} 0 & \textrm{if i and j differ in more than one position} \\ \pi_j & \textrm{for synonymous transversion} \\ \pi_j\kappa & \textrm{for synonymous transition} \\ \pi_j\omega & \textrm{for non-synonymous transversion} \\ \pi_j\omega\kappa & \textrm{for non synonymous transition} \end{array} \right. \nonumber \end{eqnarray} where $\omega$ is the $d_N/d_S$ ratio, $\kappa$ the transition transversion ratio and $\pi_j$ is the the equilibrium frequencies of codon $j$. For $\omega\sim1$ the an amino acid change is neutral, for $\omega < 1$ purifying selection and $\omega > 1$ positive selection. There are four models available: "codon0", where both parameter $\kappa$ and $\omega$ are fixed to 1, "codon1" where both parameters are estimated and "codon2" or "codon3" where $\kappa$ or $\omega$ is fixed to 1. We compute the $d_N/d_S$ for some sequences given a tree using the ML functions \Rfunction{pml} and \Rfunction{optim.pml}. First we have to transform the the nucleotide sequences into codons (so far the algorithms always takes triplets). <>= library(phangorn) primates = read.phyDat("primates.dna", format="phylip", type="DNA") tree <- NJ(dist.ml(primates)) dat <- phyDat(as.character(primates), "CODON") fit <- pml(tree, dat) fit0 <- optim.pml(fit, control = pml.control(trace = 0)) fit1 <- optim.pml(fit, model="codon1", control=pml.control(trace=0)) fit2 <- optim.pml(fit, model="codon2", control=pml.control(trace=0)) fit3 <- optim.pml(fit, model="codon3", control=pml.control(trace=0)) anova(fit0, fit2, fit3, fit1) @ The models described here all assume equal frequencies for each codon (=1/61). One can optimise the codon frequencies setting the option to optBf=TRUE. As the convergence of the 61 parameters the convergence is likely slow set the maximal iterations to a higher value than the default (e.g. control = pml.control(maxit=50)). \section{Generating trees} \phangorn{} has several functions to generate tree topologies, which may are interesting for simulation studies. \Rfunction{allTrees} computes all possible bifurcating tree topologies either rooted or unrooted for up to 10 taxa. One has to keep in mind that the number of trees is growing exponentially, use \Rfunction(howmanytrees) from \ape{} as a reminder. %<>= %trees = allTrees(5) %@ <>= trees = allTrees(5) par(mfrow=c(3,5), mar=rep(0,4)) for(i in 1:15)plot(trees[[i]], cex=1, type="u") @ \begin{figure} \begin{center} <>= <> @ \end{center} \caption{all (15) unrooted trees with 5 taxa} \label{fig:NJ} \end{figure} \Rfunction{nni} returns a list of all trees which are one nearest neighbor interchange away. <>= trees = nni(trees[[1]]) @ \Rfunction{rNNI} and \Rfunction{rSPR} generate trees which are a defined number of NNI (nearest neighbor interchange) or SPR (subtree pruning and regrafting) away. \bibliographystyle{plain} \bibliography{phangorn} \section{Session Information} The version number of \R{} and packages loaded for generating the vignette were: <>= toLatex(sessionInfo()) @ \end{document} phangorn/inst/doc/Networx.Rmd0000644000175100001440000000776712547505677016003 0ustar hornikusers--- title: "Splits and Networx" author: "Klaus Schliep" date: "`r format(Sys.time(), '%B %d, %Y')`" output: rmarkdown::html_vignette bibliography: phangorn.bib vignette: > %\VignetteIndexEntry{Splits and Networx} %\VignetteEngine{knitr::rmarkdown} %\usepackage[utf8]{inputenc} --- This tutorial gives a basic introduction on constructing phylogenetic networks and to add parameter to trees or networx using [phangorn](http://cran.r-project.org/package=phangorn) [@Schliep2011] in R. Splits graph or phylogenetic networks are a nice way to display conflict data or summarize different trees. Here we present to popular networks, consensus networks [@Holland2004] and neighborNet [@Bryant2004]. Often trees or networks are missing either edge weights or support values about the edges. We show how to improve a tree/networx by adding support values or estimating edge weights using non-negative Least-Squares (nnls). We first load the phangorn package and a few data sets we use in this vignette. ```{r, eval=TRUE} library(phangorn) data(Laurasiatherian) data(yeast) ``` ## consensusNet A consensusNet [@Holland2004] is a generalization of a consensus tree. Instead only representing splits with at least 50% in a bootstrap or MCMC sample one can use a lower threshold. However of important competing splits are left out. The input for `consensusNet` is a list of trees i.e. an object of class `multiPhylo`. ```{r, eval=TRUE} set.seed(1) bs <- bootstrap.phyDat(yeast, FUN = function(x)nj(dist.hamming(x)), bs=100) tree <- nj(dist.hamming(yeast)) par("mar" = rep(2, 4)) tree <- plotBS(tree, bs, "phylogram") cnet <- consensusNet(bs, .3) plot(cnet, "2D", show.edge.label=TRUE) ``` Often `consensusNet` will return incompatible splits, which cannot plotted as a planar graph. A nice way to get still a good impression of the network is to plot it in 3 dimensions. ```{r, eval=FALSE} plot(cnet) # rotate 3d plot play3d(spin3d(axis=c(0,1,0), rpm=6), duration=10) # create animated gif file movie3d(spin3d(axis=c(0,1,0), rpm=6), duration=10) ``` which will result in a spinning graph similar to this ![rotatingNetworx](movie.gif) ## neighborNet The function `neighborNet` implements the popular method of @Bryant2004. The Neighbor-Net algorithm extends the Neighbor joining allowing again algorithm is computed in 2 parts, the first computes a circular ordering. The second step involves estimation of edge weights using non-negative Least-Squares (nnls). ```{r, eval=TRUE} dm <- dist.hamming(yeast) nnet <- neighborNet(dm) par("mar" = rep(2, 4)) plot(nnet, "2D") ``` The advantage of Neighbor-Net is that it returns a circular split system which can be always displayed in a planar (2D) graph. The plots displayed in `phangorn` may not planar, but re-plotting may gives you a planar graph. This unwanted behavior will be improved in future version. The rendering of the `networx` is done using the the fantastic igraph package [@Csardi2006]. ## Adding support values We can use the generic function `addConfidences` to add support values from a tree, i.e. an object of class `phylo` to a `networx`, `splits` or `phylo` object. The Neighbor-Net object we computed above contains no support values. We can add the support values fro the tree we computed to the splits these two objects share. ```{r, eval=TRUE} nnet <- addConfidences(nnet, tree) par("mar" = rep(2, 4)) plot(nnet, "2D", show.edge.label=TRUE) ``` We can also add support values to a tree: ```{r, eval=TRUE} tree2 <- rNNI(tree, 2) tree2 <- addConfidences(tree2, tree) # several support values are missing plot(tree2, show.node.label=TRUE) ``` ## Estimating edge weights (nnls) Consensus networks on the other hand have information about support values corresponding to a split, but are generally without edge weights. Given a distance matrix we can estimate edge weights using non-negative Least-Squares. ```{r, eval=TRUE} cnet <- nnls.networx(cnet, dm) par("mar" = rep(2, 4)) plot(cnet, "2D", show.edge.label=TRUE) ``` ## References phangorn/inst/doc/phangorn-specials.pdf0000644000175100001440000046316612507002037017752 0ustar hornikusers%PDF-1.5 % 28 0 obj << /Length 2176 /Filter /FlateDecode >> stream xڕYKϯ`DUhU[I\S-LJ=`)${)4xsFOP߮ͳezHʔIڬhdNޥ?/LzZ,m wK=|G^9.pyz"|py{Qi?o%mk (o_o+*K22Yo4,cƤKR[:ݒ&q#LY[يN,&)3W}9a Z:`63ls8>Չ3kʂxfyUU2g@`-atgx2Y[$T,mJxBMv9BG$(N#K+-Q [x3-l)0D2gex05[Dqn#(!~֥.9; G:ʯqb38pՑ)O4M>C`PhmŃ1瑉J3 v @kk}nˤ!Tlj".y%;S#ȡ4qd$WQX 9 6x Os D@H:?":ԑto}ߚ+a-WCRQl x+GjvуC&&E2`ŷ{TQ!sj:~Q搁y%ϲmI$Gd;_If5гTpR]n-ZZt=(=e^C ߪH? F= fjQp`qIj]}(1  NUZ7&,ȭ`Kذ4a-xW cڬ. au%ϋ4B#<*CV@7v"{0b\ PvŁ!dE7.s3/%0bz\D&BY6SEPݲH~g'@i(F;{0$WMqUWf2>} BJhsìM 2y{n1o)-QqR|p;<-]qҥ&AP^oro )x/[>SeAx8VM"ct] z^iNe^}d91/SsI85ҩq@r&`(m%53Wc-4¥/rQ_[Q PLFyDp3R"}?.2;J0ǯg&ބi!`x9}q+c:̵MDd{ȇ "wk0.v Fjk)R[޾WoEV6 '/Ad{ 5ߐR~-SxV$6sEI͚&ܪC\ endstream endobj 45 0 obj << /Length 1478 /Filter /FlateDecode >> stream xڭX;s8+4!VM+rR0N|"YHθ k))&J4&DE*xyP{3]+x}J'":{e?5nf,-]f$/8}WE)&Ad| Mǿz1 +bep!AP(MO81m#Ddcv4/ZVмf$Or7؋EJPboۿj)*@v&QPYS(y 8 (=[tWQiP甕& NLB4߷EojsYb֭Vb@Lo06tlkP2L\Hv(P.9L`0Hjܙhf.H}ҧa5`nAEEr (Zݱ^IKlth;6CQ̢gFgWXm$*Qk3g юFJwԱcF|r|+snL1i[:f$)ݑD"&?6S"w߿0d/*r.> stream xڭrF`DV zvPDSqj"APʴ@4߾t׾ij'$6Βby\$0|͢Ըi75^24qL"c3^w['=̺qR^=Cg}~@_cRՅVj؂/ǫx5ί={&(.yv~kxݼP07]4#׷4{dV1A?I{Z5&R=ƧR$vj&8AS9f Q@)螥 F Zlnl(I$ȲBD燉nҦ_0=sJ8DkWՒ/ؤ1ZΝ9XhN8&QQ.ESqHDj*VrrZybo5l`"Ϟ!B6R`Nt-mQpAeLH3#F/QGoKLb>AGOfd2\Hs^*"X+a%ػrgFf7,|8\t_8`_0|;Ӓ=I בUG>0nw _ye*d`pRyg0Od 4y19n㼰N~޻ =.NMN{yR$ZPP`zƈ' ESs|$p#P&a 8^k 'PFQߊ (=3:I>'nweݒ2'S7=CQ{++5cR8hMAGl|$&1Vb2Wwz󷪻/Ϟ]|9 b>.JFPaukZ8ejQRCx*/2DG=55E-T>B J n5l%` &nBd/L8h ا6Ag#h$IeApgT㮕(KaDt>d5Nuȥ MWhϳP8 t, cIoV x2c0vA$5PYCWmz HEIR+LpXJΦkA )o>HS Q")jsp0+"Nzݨɂ:WkN 0ouRtސ/P(DLTuL0AP[qA9h`sbV+w@^1Be)BzNqG#;%\,VXYi%ڟ ͵LپL % ,a՜I].(l^ e7:\9P|#Q۔ QY_$U endstream endobj 62 0 obj << /Length 1845 /Filter /FlateDecode >> stream xXo6_GY~KЇvhuÀSǖ#N,'m"(A(>ǻ}$J{+o0JUeɷ&b@v+,WZ=9]-6nڀ ub]}RV+ >_mu=}^=z8Πl#GPJ@)%SaTu+ZZ+ 銤JǮX=y!ߚIJ?IeQ]sՐ;,OAhp{"։ À@2H 2<V LM N#OKn82RHNdN(m1kl!UsO7kϳ5~ӇQ,B=],S§RNb%A3" Vhg+BF7hئw**lz]ÿK +Y%+ȵ|/z8ZMhߺ}&1 vZL7uF-7X7;oAcjZI?˞EE }un%o@X[s6Cs9~hSDyɱD φ"uwl>#x`S/WCI'STv0O(.r/ץ˃ L': sɎEz*$)=g+Lt~}b`Chp~a}4弁aR[G/:KfsP"|N~۳ ᱆O1ѓp6ySD@s;72P`'FڠofJ@~uOnޢ{BYgAM~\6;te"ǯ͌ .\{m 4bA,?/ hmBM*-_4a!+R)RZ8I,Cמ2m MlVf;i*eZ9  R7tr/,Cqt9Kmr D|~_ %e'L|;56}5wʆۨW$hb;ٳUh[x$'Kmp $îN'?.hL,Ļ{ܭݨ[v֮ϽXhNUI[}['5MjWHN;=+_ley ` )I9s I0a 1>hp|SGq8T:>zoYxbjzH-}0y+;Ǣ{5@>pd &nPEVǒ OGt=KxJU\ΰM9I%M}$>1@M)v^5PO˩O\7!g>ns}WSplg6r?%NWڤ swHEpRBd+8w 8V6}p endstream endobj 68 0 obj << /Length 1239 /Filter /FlateDecode >> stream x[o6)(3s{jf[k (>ȥM;Ԯ DZ CEQG)~@8R@Pϊuu$'+(sB!/òu~̈$glɽ=HPc1PJDU/f>줙Cz/GW=kCَ%z]_~7]6St6Q;W &PֆPtU > +O\>sfJ:`ȹR#e{$U^ʺǴ`1ŷ}{:+mNҊ!d"i(o_m6xlH͂4݀u6M "Y.pfpx…)&0g wH2hT`,$ixiBT\$o y6H( $ SH[HR_ؓ#fylz ܬD/Dx/DE9ŝ(I,$ތd>N $=*+mUIV "Ը;N!1+0Ew_0m0⚠+l8R+n}u_l@RPh]! DaA?6tӛX7PCdа썙WMC K6J aIDW#; ow&hB FBj-"Җj PIJA/47M^ ~-MpDJ`h]פe0t "=LHtL;pMI@Ҡ2BƪvI)7vBq %0$ Hȧ(5*@QtZAK,'zwD7b6D  (vr-A$zˉzoݔ˺hV7؝ORFrJcihdS/}v[󒸩JAhG5A@SL~KaI\LQ7SXAˁ1aScL}ndSY nAy.r̎$ކC,3K>7]Yf~r4~4th-OB}.b-2f]wP<b\MiH?e endstream endobj 72 0 obj << /Length 2668 /Filter /FlateDecode >> stream xko{~OaowgX&.v(ںhD*DYG96ڽlGn?H۝޷<~a֪LO&e$T x_M9}30m3SMr43==ͭIYhj;_8'S)2̈!U:B,lƨҔZ9m:rz"eN7DX [mؘ׵Һ]ʊIc@@,4y@Z~,B*LzpG A:Tl*B(u^TcQuUq24iگG87$e*[Ni㆛$J!\E,7{^ۅB*ܵ+(+`Yĺ> +ڋQ *Kt&QSh-5OpSiLգ9Qdu~+zlKy}Jxs1SO-PD[Bh*ܼtWgv(9/Q+Ѵ! *)jc~3 6[ߖe@C .%帵;넣J,٦0IQ~,M*dyU5hX[TmsrϝeAr͡ER} (E\-\/SpLŹlɄ8R\S(cA [GyQf^@.Uu`q4'=B.<",8,ȳtJ4ֱٍxB7j.b+oITyn |jҜ {XOOLq~Q/R%1Nש'ٸQN|܇*P QQչ?xĨ;!G| y_^o;΍.=qj]Zǘ,rCdK=nϋ?{~4|sfĹ6̅68z,n|bE+I '(!6n!ݥ֥pG0)ҩv!v@TχI9Sɖ]*kl5]⦍9ob<|ݻYnUF똠|uY3\˨cPVg P7vli]x]7d)c"H.; OcM/:l !L7'62:yf:P^MwS|{IG endstream endobj 79 0 obj << /Length 1012 /Filter /FlateDecode >> stream xڅVIo8W=@̈)Qr)fd.9(`l#)H6jI%H(IQjʌʛ,'#%!\uWZW97^PII\AYf׍A6-XSP:>KQ;Ib\P R.® o^ eNhu59^ ,S b# U8wXσd,y۱4n5l PBcO\dbeF?@UׇGDv=T&$rb@XEz|!LfÒC Iг ~W*2 1KA(iϥ70wm5 c(HfJ;/XKo8&altI\`rOTǰޕq} c88q:5]ϷT $GXZ\ 'EoGcϜGҾ Q' + 9G_up<h}ԣ0C[q]=̀yǝB\Iz W؃Nˎ:gnT:߅Gi,-ƅͼ{e \*拡m]|r&x0m>$'e,;n6IE{[ =˅s{mK ehiR%NOU }}I9R~ * }??w_@莄OJjHn02r>2xL2yÉZ^E endstream endobj 76 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (./phangorn-specials-figAll.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 83 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F4 84 0 R>> /ExtGState << >>/ColorSpace << /sRGB 85 0 R >>>> /Length 1567 /Filter /FlateDecode >> stream xM4+|Uv+@Z $8=-a ]Nt:NJ'z'^~U_(4jg8/K>ީO(4J|z GeԟPR?_젍U'@I&1/i VazԞo1*F@,ڄ{QCjOw47W}v<Viy#]:k`_V=\~xN=|IģifcGCMi)r(Nh$}6#=aD\)\ІvXmP=FjOJ1MSPF=r|gtGRTjX cR |Ѷ S2joϣz;ׄp^ Gz@عRPt5!$fI 5+ܙ "6 =)GkPN5)G3ZސØژlj=.Tq\ܳk_U'k5N۪>;sRGl)X(%uĎB)kϥ_Rs ZTO++ÜoV,J.TqdZɴL̴W ZqN&eJ =)>RԨ#v\R a7]Jjm[ڳe0)Ou9Gs|uYM5ߊsK9oC.g IPDjĪ}D=t0U8F!Q[JJjNB~} :W!R^f\,Exi0єJт(526k;_^޺[6}DL,広JiC)Lz0;HI>uĦjdr-ȅ) l*TVd:_c!-95]s,ieIЍ.3MI2KeIMH{W2EfG8gfv"uE;K"6._ g(s;;SI]<;Z]<.f"ggx^.sND2_+݉d^|gIuĖH3':bO$/:)r9ce KeΙ]ȴWldT.sGQ)|j{\Rd2)rmveʳeʳe1_LG2jq5K6LUYFpV9).]L0 lE㇡fr冝yn](^Y[ R_ ү>Uf7f |]g=qŰx[]>ye6{> 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 90 0 obj << /Length 1907 /Filter /FlateDecode >> stream xڥXr8 }WQY"uL$6ՖcO;kM:@Pm9ft!Ed8TheMg8餹Н$KE&ug8|IWE oQ uϗo(%rk5NNNr7#Sp}LGx^袨1q#N[@7?Fs- ,Ë4Ƽ"N=O椦*\;neka0 \w<G CaL8ܶ삡Ѳj,|.u^e9F:**;=e1K,h:6 kӜ)Q :nSp=c[f/'I*K_t Y5Lrk@bi &vS/k`ٵ2q뤍YJ"/|D6"61(U3o9v#y4Jd2(X,Xo5ȟr 1/Hb[R:2KI]pآXπ IB겚s|S͖ ׼USv݆6ZXiX=Vww~#g%*aT1Vk$hzJzu@}>i$8/ E|fD: i#;VC{0X2( "T/)c+C~6Bi䂇pFρLFS kjW̖dăV$*8AO" \0d0FrOl 䜮3Drx@DŽEOy7{p=&pUugȱaFQx>z~ҷ!mӝWwR ҙ_ 볳Q>N8CW wxPYScu#9Ƽw*XT}~nVJӷFsg5qXDB:(A=z; [J\)Vcs Q{%NwY`6*@vɶfT޲άmrHU}@1v[%WOK$4 PeEMRʇ@ gљ05]q.rXHz 1(3#3DyIz#!OWC\;vs%LX"$%k)jat4BbL# u7Rz<`BƧm~ ͙&1]%1d͛ր mlOe{-eA@LAC!m0|ɄZ%Jeu’#|{6OvY]?紟®\"/_m9 ކp{Un}r ;oVYmɻStO%.5)jZ7Xq !3/5 zs:@e?*C0h+c [(fZǁP@g{\(_ϝw4h,qc4@4~6]3Og`ك %_y=Jg3]qDz5a:} 6n$c@Q,R?'07Dq׾^ 1]3p Y8m'Xg/jpΐ"^N}!dzBNs2IAջT\gj BgT.J~3w x_r~u{bn~guGݷ'qC;44N nT PQ)k*__~yv _+־NKœ+9c/R<]<f]=l`[<+= 7确oR@\ I YCYE_q5 endstream endobj 96 0 obj << /Length 161 /Filter /FlateDecode >> stream x337U0P0U0S01CB.c I$r9yr\`W4K)YKE!P E? 00(?;h0a$>z A?$h LF N8\ù\=Y endstream endobj 112 0 obj << /Length1 1830 /Length2 11043 /Length3 0 /Length 12185 /Filter /FlateDecode >> stream xڍP-Ӹ\[h]'$wwwAnᑙ3sUUWѽ^Y@C"n` qp $$t98\H44֮vؑhA.`1$A@WȻ8|NvvR@wks+@ rAtprr}z3q{ PZ_+f WJA/d( waupa`xXZA. gw9e=XhV.:4,\= vy qrGOf_`;_ѿY9;^`K" v.@wG@:_9[;XwcK:ۃ.Hv_k vYX-~aȦvrIy5!cxx '̊wM/GN|c-@_H>.@w o#$+di F'd'~gkO8?2zUW&.#,;%$<>,<\Ny>LUhWwd[83_ʠkm]AU ?7da7{iw#7;??~_W=놀s%' |qh"c 2Wv5SDv`?ם3}}T\^u4q@/$Wq|8^l`p~ g7`m ؤF|6Mo `S4A<6k?fzg7=?k}пkIod7|+tWߐI+/Ggƫ_Wf+u}o/77_pVrk*W+gпyCuܜ__?U*< ' iyMMmH]8,ͮN*ϲs|2Co7#k;b+>G-}Lէwې "h>;jB@vd;byz -U* ?ΰjfP¹"0by]be}}!OdBUࣿw?^MHMO@ }5>M#q"S\/]hAj$ҁt⮡Z*5Fph(Y3oM#1rhI]W4aֹ]19XtX3XiAWY0+Mc)*(Ew_t+^lE Kblkwy)92 ]1ڻC\tu Y2/5Mǥa85r > dJb+A9U)tDWE%3ȇUIrS'o="+˾N92˸t>uGO]vɳ.VΑ j*l q&',WL!Ҥosc;ˣ|驞:{Զᖎ2dIvGo3&윸腝 KORjm)rgWB&D;7RǸje7Ea7aչh"?fr9,œZd\7;o va7[%C@?~CHxMBH}2D?8clBvCg E g@㸌ntH7!t+{䁟z,jQ t>K=C>Nb/t?Q;a$]Q_|^K0b:h"7t2~.ġ^-RS6Prܘv[prTǁXNqH̠އ9\gne+Ֆ7#@i{ g׆/FHLmjQB<)2H26]Hy|TnǹR1R0{]fE/lEwś&"?dKn*D`RSw?{ a m1 QDW CjTcbm3f0} yמ`nw?\\j@Dd|Ck>A=HJj:88@t.WB]*<Q>9ςP.w)l6Ed\4M\YgҜnAk Y}eӲc8IMrbcВ!I!(64 A%3Rǚ_l$3Y-nHq 9^9|}{#X8=[6  L*&xu}j!l GnUqV]sYK5MVǽ&}6wVgӹ?DcAl ,5|P ko7ph*B`\dw#ʽ%A[,>B]GQ 2Ӓ*LU S`ԁjr1a8lJ:woVbP/|\]"R`%r5{5{]I "LiD`ז;n>PNNjǠ p`#n&$Q1 !Y a1E|O A آ&aF_ (p'?:^h~7ֲڼ&H-j0w! o}5bc}vN7|#n*¦'OL%Dx `5Q]ߥ(-vR}QE>oHv@*FB•@Lw`z_2җ)߶9W1`ܬgb0MR=ۥ3Lg+"'Cdew\P x 5 I-iJDy|@As_֓]tv'(B,nVSaXՑj7is Xp\N&a&)P9Rv)Ģ)}6E+3{ |qO(|퐗a 8wG Ge1cBzOWCPqG8[ ?(ASXȤ!9)1YcȕX%A( E_BVr_"(mtat]~HW̜W|G{XlU[2@V w1nKH~MW1m$\c*m8}voL nn$jI2a-k<^nD7!kÈ$ߴdJaФ%ˠF-~)3е|zW M %FAVF4mj0WջX,g7soon[ĉM:O"qdLl3rq8ӓWӒSSO:Ex*߮l4qC`wD k`Y?qj_%N3V т^$6_?%6@& 1hNO)C>ɫӋ lllP"v2t [A+1jKhb9`8,Ey$QlPzV&-Y4]ot͑ث۽>=P3`ҏOujFbjC>ݱ3QK[ȡ#˒ViTU)d*`D KP+F-v~ݥf3ݡ1S S0\G)hfHhD!=a+^߇0,4P" "C&kUVjy\PJ/>':8$F6 dǁyFN g !@9kG0XO09PЙ+;ɍU ˽aLND+vºa$qCoY;a?b똵9OaFLjf64~SXJM#}bOT=7]M5|4nbBA%. pfDc i (-MU(dc/f5m?S6Th\"wv"re]R)3$l:f`#<}''wx8'h+ZC%>w{>W&u$Ql7覿N]. ML[@zP^aqv=?wɗ g7 NW;u|AI6*;6λ`_.B:j<ݽ"ʔ ݳ4(pkC/T)uәDkL]8d.^j:wq~W( sz m@oWRʜ ki. - .ti&"xT:/6t&9kW Ѽe3e^&/"n$xe$ɞuOpZt j>tLJyCdҞo+m{LGdJW #I$k| W2,Jm= '= Y:c[$~Cp}j @McoӶRףy˵"I/E- †f"sرL_Ge\G֋޴ ^VAozk#:)"E E2^Jarl!HpMe^0SH}rh 'vS<I|w#$h3&cۥV_:)5m*j6=pzX!`×UDV;≼nO n=T}+ˉI*&$m(15%'A.0]9`").ߏmoU~nR"c^ŀ}pԨH9tg1UGѲ^1`FDϒ,78>g|~Ov^Fq"Gy<j(a(Ēhꑙ'kz7!?jSA߂d˾P6?k"U3}}?ƁAb!i$Dp(5$![P}oT46&w~y"~Y1]i/Gx;rX7xG#bkYL>PO ,8BD6+67'nۤÚf O5'ՑFM iY=8֐.=*hޝ9>GrtpSò9ZoAm9]EI %O  viֹgTZ|PU]K-C0&kK;)UHފrީ)2+{GTim߫FXF}j9{a_\Dz }`EQh /JF\b È;W[mӜ(HڹrpHכNg "ЉE%(9[Gh7sloXŤ4SP4Sy167MX#4q ǁ6Yq.vE>pp9Al1y0hh~eff"quTv\[l|yھm0%rҳzc"nV.Җ8ItvD*/ ng{L?j<ڼ&JLNMJMP~dInM>S?Ev&h2h-E.9?l'.iX `t~n(xʌu?s]$9%i2'e<&򇵰o q㟱3u0t @C+ XoP4.$pS|1K"`;K}L+*4$Ϯ>aٓT\ߗJ`r&esO!i !5M˯,+>B +y#E\w;Jg3EH3rd9nwYǔϔYX)\A7ɺrZE4᫴b3ZHi Wڿߧi1$Q(^V%W&lPLQnY+r#(~Ql~&f]RhLmd\r*'Z UB&֙ݽr7#B AO^Fˡ>EJRɼLH=s/&P xod|p 52d/w7cr5 O9+S@'ƞR@ "wR:dv43B8ȼ)b~M kk)OC$?G)ax<Y9 9Q{ :,8c5~ Zs@a't(;4aUo);fM\y17LD%@ Šmh2q8Ÿ& 3Qfb;̦F#p{䉖B:~{aúՔt67c^)򖒧5!%W،Y)4 }pU-mv;`6 I"V"Iyj2ԨQ$:XsLk*i})UiQ@O?@2W#b$x]|~6/ҵܭ*B&|=W2MmK/W}Y0|Z-㸬;]|ֽ@OU=>+li!O9$흰vBxTpx>͢Jp1Ϊ2 pѺ-Msqˣ% J݅ei @ ه< rs;m,:Ahg7Oz`~4"ljكcS qgjYAG; uʓ/,S^ o\_7|^Y8!YqrpZ, <>ޅQ"9 mԫ]Pqv첓Y{uSv@c҄*E̩\)6aA,>„XCpHm:Ӎq!,7 }OE7NlNGU:pB;M[Y۲7X }x#v77&aT R>a6_nXTrf.ȭʄo˸L]\..naı%YBaC C|͢$uaDG.e cj^!s/:X[Fh]-#t!N~'<2;t7b2I X.1fe(ѻiIj&ͣ胉dꒈ9G_jTc;WglV? 8C: ZQ?b̵Yd28h4g9.IGa8(`!B-m-p/B BLJS,blW߻Rඊۆx/ k\.m503'&+%0\ߍݜtBm޻(azvB!d8op {^T;9,{6l ONm+Mmaf"~,F,Z4XlIIK7mvRzV㕪q*8v!b&q#ɣ=Pn(%/n> fj~MW2ػcm!G=kӄ4_1T,!*t\>[T2yںNW'XYš_uWwN2]ox*M? @M3-7EVc9q<xe5ۚ$ɋ@˽$$ aX.Y:u6_;޳qEr]|>N|D4S̅3u=Lۺ`s: Cw2S7O*yD`O }#s4LyP^uj`i?42epm?V+OX0ڛW5"yVA)ߒEjeVFpƍ&u.>X„l?jmiʃO5c4?ZVO~WM!W6 L)I$e~1GOߝaA7|ydr(Ɯ!aDoQ4%xd51֭DSMI=w+jZ {ZQch7df_/1׷¸a&M7+BA$\cՊhH*n,Z(2yW[L2"HuµC:S DiZ}uÕv_K!FR}n^כ )_' ֦X{! OxމPdQJ TWTPO/{ŔRgx z7UK=(_͏ޙJw\WFEPƲ97:zQDvm8OYC8uA}AAmmٲn4 EicnIjAUKbާ;^Y~\%ZAB hK{YHwBqa̘7htđR}xrM?xz9V?owfqlx7^)ԈaTh!MZ"sjttթ|:9\sw*Ykn9.U7l1.0xՒ|^uj endstream endobj 114 0 obj << /Length1 1473 /Length2 6217 /Length3 0 /Length 7203 /Filter /FlateDecode >> stream xڍTk6Lw7J 1twt0  1ÐCHwH+]4J JJH  |sgy=lʎp Tu-aaQAaa"NN(7NiAxC0b" $S!D]8 p%d2aa鿉p @ u ao"NUgD %= (肐.tF0` C!ȀsA"=eAނp?tA!_#dG '! 4C`h#@gk=!:@Pog 0gD# /" 4A eC>o0(+ ap MkjP>?u`WNP/>B0DK s "v$5<' H0 ~A F+" #g(?05?Z~@/[t9a.2UT@@DZBHJ#[o sR>i ?sw=8!0.+wG>?v=>Hp#_9䯉օ8B}<תDAB5G(W]txw( bs@a솾Wm)a`P8Dϩ#w{ap$ p#~TB !hCptW@_{8H.>zwZ7:3L0 F>ޠ|O`s\=yj ?>/|q9G}'j?=ݰ2f໲=fB&^Afanm=9| Jo6zvp^BjJ 4&b!)LKuO>}v G|DI(U䋙WwϨNElgݧCU/N%;yh*Z!|I cւu***p1ҷfp#Mٰү~{jTu񙰣X8|kH=x!+$|QO$Ed۪lއP_^qS}ŒE/fţ-,=1dߓפ ߝ&Ԙ^՚+L70o ˖r")V1o )53Vl8/'5=- ܐϸi~O|k> M\[_ia`xܷpE膓L33 U+H]f5{?>"K;&gSb@$G:⡹5tlp3.-Ƀ=T%/x}J)3'g+:ؗv 03ߨ"\i=n2Msu*AYl> ]+w k6 ,}]ǎKjdV{QdA4^jwͥ?xpk\dPRuwVkrl=R̼8[T{sh{>pB-*u.;USo^ycN7qrk*l[z[};,/&ɭg27s$kte ع͵`nLqH*r+`lr`ᚮճ[ck{\bk-(#]ԇvv 5AK&=#cV*bR.o?bWq)ҬqN-±nYսm=q]'+禪A'>WU?afr^Ofv`to#O|N>4h=ThL$[ Z{M[έlyŪĐ3}; \( hdTK+ϕTwSMzWb=4G/g7w1eoY^V'AǨV 0H3c~zŁOC ;A4 SxLBU{>gM>eY?W52Oݐ!'F`6x.>ȂҍɎ{by,WU նXR[,P]_q\fTW48gf1lԁϐ6&!m`;RTo2N.{]7?`fcXmU }. m瘸|sqF8Z8,gqOD: 8:2l] )+i1 !Qjq1U:,8!6XwnRӇ^x(G@D1n\Æ˂&{Iz/PC[. 9ܡ_ W䚑P LP;[MLܴcˏqM^|ڬ%F=CZ(ӛG_1djXlلx20Zon%`40BCƱe#M |~WDŽ)#Uf T!œ]3YySx0c&Bb3ǩ{'kE1I7ckSg דYJ3':I GiMtmdMz7uC]m Q%xx˂t>q -q8RXa`9e lu;?6P|xIpcUqɃ4~Vk>ܺb(f3QY/ֆF70/^e~Q2~dtlps2JF2A%(j7p_ɀd>*`qI5Bד:! ?=ԋZ?W/jbqܾ~J[DR7/yax `37\|8:w\uԕfyv9)+o5aE4zGBAr4rwEGua-gL%GHO68 oN1u`04 sz8SZ!UNG =,Z(q|Dk49ziQ$xh @, .]#3+ _NOS4t%IcD4Ebpt"zΰew#d=n[WB9$o)gm7;pkXJiRXi<k `|ޠl4I(jbx~|{åeo 0j)%[Ei1]54o: ;8c^jr2+5.AH5.8Y$G]BҏVdf%w?R !Lb<=pzm+-zd(v,dq ~\W2tA<^kMsOV#/BJO.5X~AH'$ (] ~Dh,q>'F'Rt}.:[ "-βi0FO {:@qWߘS)u[ٷ%gT-07]g{Ӕ&JkͰ>NLmn, ##Ja ڒa8Z~eݢXQ pDcOL#\z(&uY{t+}ƅ_2eQ)o.7ȼCs`4y^vF;°Wej'Ž 8MԀF‘K52w";Lzll+}u˒ʦCIqcRq ZLjR~5pjxjh"{BCL,l׃>0OȟZ k%SIR됌R~%l߇ B9sXQwQp3PfPXw_C=w(xe(İ9!vd9z"I|!T-~qөhwaKnv>䅌۝N>dM8H$-P ٺgYk;-0Bп{?npLV:ĥY+ c)`a.=C+*@]hCi2dN}MQ \-:ah{ӜP}s%ư*ݨ $wJٳ޼bpyyQa??14`(hl|CQѠ~"{S{䔭˷k+oopˢ)U]ߛXGb%:uud2yx4[ޣ;i}w7k8 T.p}$g~~IseAӬ؏7w!,e vs}3xl 1.%kDWQ9_LԫT@n^ݸo0(`~rNe4`·Puު% `F5z(zXt},wַ9<4?_o*-1~'`@{xM ,Nl5})wP.I㧕*oV-a;=C7YAL^04Bȟ0q3 8&'eA\$ʡޔZs ,~\A< :33oy3gNJgD/:j>TRGѲF-4(p tVޡDⴐ-6;IUIϴY%upGQx[O%G]o 4IhAtԴIiP]GД1wa:DQ7w-&+ZE0F>_u (r&YfYOބp>V,AX9uSHX݂YY$9]ThlYI(Rˌ ԇ0ټ6JTLϮ *k7ί͗Bp;* endstream endobj 116 0 obj << /Length1 1652 /Length2 9620 /Length3 0 /Length 10699 /Filter /FlateDecode >> stream xڍP- $h\ n}aݝ@`! #{zj{jrU &1HPRccr0PSkBm@Q߁ vPeH8L}ωJvP  `ge;Α i vP #lK9r-bn (:[lw47hؙC@A+hlljlcA- '+Mlj 3 5@g@xv@AP(x!PALV3Wsll7G), 6 "3# hjd\oj 15{Ni153ÿ9;B읝 69yn(agk :;>$dw.j۲@i]Y_9.|`3r-Y~oa#`L=x9Ύ. Bac!3E ~G;@Y~lߟ xH))K2E?Aqq;w y^7:7?NO_ҠknݳAoj<7U{"i?&⦶2<Jv#TmПB\l7*l<$bPЙ8Y9C! *O1}{@ U;'繊bϳgn8=ٟ!SAtz۠QsHA퀿g`h,g <@0C휟KϜ}v(/Y,6z,f ||X\AW3 ?&lgDWqX 2,V1ٟMݘق?# Ax&dcdzh??9d2;mg.dUv]+Fƴ1*z4Zh'5a+^#+sN\zMȪSY:{zGK&2m0Y%+bifU.d Oݛg&-N4|prGWmi".1߻UuA s|UۘHt x^/T!ΘRĒ5sJ\ұd%p5Q%[ )u2,Pӷ,Rn8ySr~P|{:Z~~_^y56۲W1js=&f\4v^/9뫫AԎ`~-lUקu#C XS,ֆC8hg'DĤDo&KWHNכ<=׷'P-V߼ sNy13wۊy!iQݒ]82A0s:/DS Y8mj#(-§>$A<$qOsm"YZwA-7ot6ɍUKl^m5 ƒd/+ !Yn0p9i,f&Q_8͍WRZ{cHQ5p) R,]8;GXr)@ͥd o 9Q:v1"iĊ3+ĦȢfGDs#"s-p1)^orIB`g&3PS R':bD;Aq(X(V< ZԳ64v9^1ƈ\=T<)-}*01iaǪ[sDI}rX$E)cǰZ΅,G+;_^#ʹOj{;glv"Q9<X EYƤ)^v!( ɬk@j-M'9:A &bX>Ef]9<;CYts3').K csVJCU(^~=Q/zN*vx"xm1V $aG^ZŅzo>T@%[l8ˎJOf/c%V"w(!ma?]<)E\oܱ!#,դ]60R,;>ؚIKVUuD>ՙoC}퉁۬wd({DiPrymq'4;UcY{I,~C6WHɄ%ڱ =LPXǘM sңZ/=8nd{{񣪗G=Ls#1fr3wwJoI>a JAs^ yVamƙR?|zf(>7vά,F}`a0*^p9;:_rk^ȺdnҠɾ] /./SZ Zھ9 K %##-o8'pJ%w>N7Q^ۿ@y-Ig/#1w9_hlߪL5]/+{.Nd '>XeWx%yaDKZm'wӢXie6Xm_(r#5vR'<_ٳI~RTPq=W%}'E02;|2>09ǖGheZI{f< Y\TVf0F+mNC"@|KUV3WqfD5-{.6KsĦ1V afg^*?أHS|S`&6/F;<_58klMj9P+{5(/OZ)vwT'~ ͷ=pM8YTT9j7 Sخ^B-08-uWm+/"0Fu gg_glP!۶\ѸF{Ac۸4Ӓ<ޕ(pi9*~#`}-ssLχ(4u0_XҥwW\F} sgG}8AqfGL)KQZ^:!ˏQxMY}rx"\( .Udbo?|YtFb?'o ԅSHͻ&-<~ lrS$;-fs)kcxhE<6Lj7L_Ƙ@G5 }[f)eo!l VFϚD#mHmxTc^ycN8^^BUG% F3VaL<.UJ̊Wi_[an+U#0q⹱/hvӡBF$Y'lG2j4h\S*جl݂Sؙ[ lHK&,VivŸ͓\/J DI(A$/>o^fGiԐ%YMmdBeB\ H&9v; Te1Qq]^9a̺}) ^Z-LIJMcw-{C$ )Bak9-ou g;H7DN8l';uWqXrvwdۜu(44- rv4 w pߛfaRaBz>(DO%`[cˣΑeoHRpCr)a(L'*?P*&h E˝_~k<ǝqۏD$8k #uAgGOm.?"Ɉr]UH^dUDFRNl+g%ye=4Jc%E~1sTL_psX+]2ESLjZcyְT {ꝶ~LI rx}T6%ZoG{y^F ;nepI%'k[ڿkZ$Oݤ]}OA1Q4Cy]PTΨc];^/gLK*;Loئ uU9q\[? ,>ėq|{Gc ؂LAWdv|NWطqAU)lo8Ⓧ6?ecy}w+‚ki0";Y :)E)ipϷi䔂 ÊWm^Pu&naRxH>[xd!XB"Ԕw!ԡSq _JroV9NIm诿hkങ>=L_OD١HvDaQnC!3d;qΡSǑbF>?tMrU & ޝ_Ղ?OșVghOZOL;5P^.fKHjs"^o*rf$q`t W>_d C(8\31܊KyK7ACUyB%b`m)lBۚ $p ς~p!Շ@W}<&6^"UvS0G8w٭@NLR;Pǘ\9'#xw}EqNsuxvBa8q!>)V눎Uiy)n,:qa?/*߾K~L%|DL6D3``5Mf0Ny$t|SI^IP )<#7.=b>;W.擛9mXr=nלb 7T7ĺъǓ%c|e泣[(5?J M8fmV'lFpa(`XZn&/-Su|$rLvSs{/Y:uLꊪ.{Qmp6Z?>C̵!̋wzSeLɳ^⟴(R2BO[+{{֝ΉPBJӾpy41c<2WЋU8׾26-}ƛMgEֳؘ+/q4:1לiBZ8XIwE>X1nQ'P%  A8xC AZ -K~d$@K%Uzjր)2=cr_/AlH2MiN{ mfՔO|ao1q45bP`Հ$/eg*M<10ZrYD<++JsiX IL*B%aL6XA_/D2jε5!;q JD[H`x W'Cym#TqФ.4Js_/ڎJ,_%ᡌVH?nf$/Êѹ ţwe\r K',Spyԥ{y{o,9:U0 ))16W *-^R,rY'QQ ")KJG-b b̐PV Lϖ+%\T~1 7#,ҁ$dY[^~$D ^+MGe_wv(#HZ-ɈsAJNi$A1UK 2兴ueɘ$U+7Jv\Bo0q'Ȫu>;ja!u9#I]/r4x19e?MEm Ԛ-KZ焵':a_BaW>QO(gͮnM<>J@A=7Z#9sl ޹jo5u)֥M%WZ#0{Lrw+ =m5وMfz [88Z'cwЊwC}Ⱦf*IJu0mU6Y W눣HfcZSOiFޒRؤ Mdڊ-·u"h )3SV깤g Sk"xI87TϾl Q`x'Z F| ,ں'˓qn_(e@slhȸs晥9 6QYHTFD X,3W mN|I2r^z̡Y}$RH_;EhXMY?*@ސYB5[ \C,%% ޙLO R@'u a8_)G;(4>L]|X;1D:$AB^ŗjD]yxwq^i5 !󻴁+e>DOYbp^2AO{C˦:MD,6#p}ЋKw9T1GO Ȣ 4+K/("i Lއ#%Fo (z&Ha  /Pho)@&|ʝM3~f=8 nnyh aK= Ҁ=C-G@< ~`/)ݱ% Fc.Cڅb{9S$Nx1L)?֩8é&,>1Q 1xߧ3DUHe\e1fHZ*| p`V["}c#GA>9v[3sGr:G;nGZ)BJ| zHB)AJ*/gⓆdDu6yax, '$tgN5m_2>'d =Klho-7 ˊM8z٩ MF/=.!d cGgMh+|fQO׫u1x|j|Ib4MR:cp ^15ӷ(J1K,gW d~i,PMw¯ '%&#^.{!T0˅FvWa*6_mL d>i}u]Hlfyk,\ɎxlY t r7zr;c}5]L6{y7LhpAOYB,Q5\@0ymYpꁺO7-n ThU*5:{$G6z"zVRLiOǑ53{L(#sME@S2K=?!ǤAC$~(`+xڶI>&i- iEH@%\;(!Z쪆DeXt/Q;i&LEL2<읨`w#6YI7Qy\roG&ChX>LF*Pzj[EvlUVbu:QQjYc,J'1S`Fdr 6اg)2y\ '4 Ģn4Z[dKkɹG1G7p۠L15f˓{- 0-z3QFFHyIFm K6w5@2*;Wy9t"А ם?Ní¾NgnP tdef$Z4cYۿg/~˽c$KU ~{Mbð4p?7º˚'Rp^DUzޫ96 /"Pv%~)yys_H:`17;`L5KsHS]b [ rp_w݁ 19z.3k6Ab5zkԚs`<`Ǫ aUD+k㋮Qhv(K:2{9/y}4#YU dʍFmk_Ӑk/ˈ ; ]'F˟qk4W#fDYj/#qZzv|jb]βTI5Wpca $D%%}& 튞eoqY= { Dr=`^k1S '8 鷝`WG /y07̕&HX;xYeokd(Ha܏3&v%q4Ԭ6`] B3~7V[ղ ku/ܵa,p> P~U](`tEF;ƾ}BJZ/쟷OQ #l7.OWڿOb&Y4Mgʂ4;OT%]PٶZ:kg)HK(aM⭑9kgIVƺj/BM@O endstream endobj 118 0 obj << /Length1 1451 /Length2 6833 /Length3 0 /Length 7821 /Filter /FlateDecode >> stream xڍv46DMe:ѣD 1=z!ZN$D "JA(A=${soZ3]zzװ5GU(,?D, (jk`,Dn"I؍% pSaqyh DT"& B`߉hI@ 慰 4 !aWDz c~r@m ; v8-X7IAAooo+F(x#N>:0Wd$쀡ovz<΁DQ\' Ե]78O֟>௻ W#w1C"P tU>X>Cbиz ~OT_0v7,F@( QhWW8 !5nv_?uAQ/nF('\]>G8ńŅ;s ;!wC8C⏁y'8{:A/$UYԣ .S,ec;}ڷS9niD4봴Քeib0}ecN˙g M'US$ɻr]o U'S{lW7H,TQLR j[늷 YiIz _Z:g=pzLIK K:8D&;o/=j2w#|2m+ tY^P`Asz9I|z~'5*$M'h/%B 8w&kXv%SeJ+=3 na/zS,ͥ&$9'9'JħubT2ߐ!co(w{,8|56jۦ)~JDFg2"{&s;T| O5¯^ @W5}SpO@/D@k ikJW\&{xGj&7s1o)GʄJu?C>gh1wRIH( KzuvW2V.yL?0X[ _>p!hkHf}fc:-&Dn|!g_=gœr L]J޵`'?-ZO(7/04l;wSܥ"^a=elv["~a}^@|_|aE! a+&~ +,z=HS]v?U񑢻#A~R8k1yI ,Up:jUmA{Mۚ7L VJL>I-tGTn4(Aӯ鉵`􁦾"LWgw'BRvB=)0M}az{ nىF7˂rփ t10jw/g T "+ Z Fm*p m}kCn{#dmԔRyƎ!ROߛ<4}*{F&{tOetX$8g| h"d-כ).1ԮcxXA Xn΍+v;T#6+89VFdT ]ʪqbXeH0T~hb'|t JM'HrǢLp`!oCOXCE\p ``kkݧ]VƣyК]Pqm{=KCRRT\Wf\ O^hCmaBLՒ/ɪ{9.)1|^՞(h:">ËQy$.˭m)0b`W \a? q^LrRQLHD1/LP=ٳ93p:*ٽ/_C.qlMlm1tkzsw!ULN/  [=@V5 RbR5~8m+׷A%]d܈ GyBێbgSyI1 F3aO*|7ʽL[$-vٸvJ][e'- ꊗCj{lj/e=P (\'Z*[h[!qr5X2X>dl4~zVO!ubuhcެb;$S'gZ[v{1SD8Sdb <'}@{Y2'29L(U߼H11aͩ/桏 gS+9_񁚚)eD 9O8P©1aRL&]Tު{\,봚7xjfLƾB4E*a%U;#iAVkQ<4}uTS"6 qSd~N eh>UI6k# leoZ s&d);W"nA5Dn$3{r[;}'7:(d<{%CiIujYL%Qzu54n9^t> owX'm'b>7$ i|{3k٥{wPT j3|BMuÆRDNv. PxsяaζN%{cvzkeI = o+!aq1o|~ﺵF;^ +(fB79x?߫(=/}]qD;čQ7vkOF:|{v?Fd¾|a''Q4`cNix/LHlC}Z} _nYO?W՚{.+>jy|cY´NOI#_[#=|Z$Jxg C*.ʾLwsڥ"gvחe}YQW?72( M7i;7G]t: TmoK)zyBH<.AB5AjE`DI)ّ@QiBVtyZ{IF14,EmG:o{XXN_Qa[FЛ]A򏽣qEW'>sCK-¤\[@s|_efZ\(QW,9ڗڎW̗xrZ~H`V(Pދa^xu6cNoB? ԯͫnM 8 fa7/4 LJ}sQ#~lm76pfP})S]A>CzEnac#t &uF[g Sq0uK.'WVnݝ:L: Du"Wns+TOyaHSOmt G5u7я M 嶻) kz^h%lե ʾhAy2#ׇd[Ywl>KSW/8ˢdؕ1ŪsR97~B/Y8dm@P]5u6 Ir gF5fbշV)B/$g}+f;MbY7WQxE&%T AMI .ql^N8BQ=auD]rkH&TИ%*~UXGdHҁ{z(W R+$mJkF'v<*LJRS EYۧ-[Z{s!)4%mSG(s\keIݰ{!sL8 '(+}zi7D!.GOU= nѺq .lƣU gXhA{ Ro|8>Nj&q(&=~݈=38c'Tz$nj}lFJ؋ʴJձO7٩j:}m'=ǹ#>ڃiO,&OFJ*4y^.fXG>1DL"L{4 &AQxQ7of`_!x4gu=aᇌP7ft}~9ߐDRsSƣCД)1% Rjx~1^nq8g}i^_NC$-(r7)bNoVef~%Q~cIMtS65[Ҷ?ZPTI^fY,=tBU-rl+]:T[L5(iɫVlp38AҢױܳStHVG+u\ܩ4u.>s \ 5)h?4ِ͛\h IY[0U,A*9OozibUgaያ vյeXJب<7. u''ɥ\0 A!Ŷ͢b9ơ0zBLȓmTvH` hL~uJ` L#!ϛLtY50$+LvbKF\U$ -~_zwWhNq%UYWܻ [jc_I<#͕m+v8x y?|2.e(k I= GqݫsZC9R{[]TbR!%V[[Gb7_LKp ?uL1g-䟓 *]&ksf{6Z hS%"f-8>UfqyYSKЄ I_ϜD\Ta}%'߭bg8&F DU囗"xXxbyp>w!8yt"6iS9yin h]k韙E!I?v t}Rn܊rQB֓jqL6_?^Auc|7)~'HI=`' Y[ݾZ@RMפH_Ͷ9"bW&t3*ٯebf\>g&/oY=u>~F/WV!P{W.Ԏ ]%%oͺ 8t,4?]3EFDMA8";h5%*7#ȇ4ƃD֞ڏ|rެlΞ!m9`̗&tV( endstream endobj 120 0 obj << /Length1 1631 /Length2 11000 /Length3 0 /Length 12053 /Filter /FlateDecode >> stream xڍPk. u!0; ='K 8] n#{vޚi}鷾bZ76 ;@Z ɅJO vs-FH,^d2n/vP@B.NNB]2`k*;@ KC]vn/i`bYtH:\V%@ jyW&;77'!OOOv GWv3+fxrx PpU;*=@\ jiV 닇;xIRT; e 7 ;#򧳅 l +b+`ab-r. vD?¼tYb- utA\Q8 dvo& lk?vwЁA2P#x999 gʎN??/:A6/E6T_W O#T ` rXlDl/w{8_p 9_7J :,Uo ` ˃wUR ߇GDE  W /Wӂaw5 APߘ (7T3-Pe-T/_S=_ ;Ve=$!n#UYšM%Ҁll/Y}P\_f ORbcx..ި/A_ˆZ6u{q1QA~? r7pX I% |f d~%"q@N<|/JPX$s|1q|'fZ2^i  uij%j_vS#Ic\t^3K&R suf˕dP7,ӥ2գz-I~f o~.NOGBΦ-}g^y/}e+?4wʦbtg,i(_za^^L4ڜy=o&aCMa1C3F`V3oX|]3[2`.V6TM+61[ήfm( 9 5ݐ۸SγOK u`rZYn/K1|Ռ n96]M}v̀`$t!#U͓d✖E~. PRST?1$I.ڒmBa+ɩ7(1V+)I<}3^Ízƥq! 9O$`Ҵ;e6i4@B\7,7QW֚Pҽ, Ir݈'_k3 VZp"%#[CDMn\ɸӋ`KtWjlu?Q/y-kQd]Y1lM&lMxo6W5)ע֢WKaàeޑ3ȿv0zoq9XχOѧ3!sX ьu bXKn;ϩF% v,Z+_{]f?q@ )pJ*yhLu{#騕 jr +o3,wCT X6>Dzl~I L sq|>vM8ý*Zz=zy MGC%Bf 0zxBIA۰t uHc2`Pqۄ倇.^`}7+wGզYO\mȈ..ZS 8'\FBE!b e,,է[ϊ$,jH`Ru ` /@\$zyy|l<n߼K7 43F7OGVj7eNb\JR pǑ_m~zhbUm %ɻ5 Q4gsb7Dz +R}#eJF//f YBu+'HxX d%a}Ky͓0k7!*a)T α/I,B]R~BV1:$T0 Q̾'6&1<*Qzk: U,yᛦSB8iY 1HZ$͗B;nJ^_Bd8凅[V4_Ŗ$fl>w&,9H{cQz w&}Z,wWZ\chJá)Lg3 tȔ-!NjzH?枕 3<1:zz~ GR R`ngag ~([V7RgJ-*j!3-8vF*vel?iNccg۔xcD*ƛ>PM{+(q 6G|Bk j|Dۦ72.=qǴeZG?\Ks`ZޝL>a Xt=3uX 0wBdٵ)+58Q5_4nW-G, |"Ym#nv^9o:95pI!sy%lMn $醃,yŢ`nkBhYkXP9$W[Bnv(z+(2灐|oxE6{l^2N?;N-cl{s<ܢAHHlQnO.C J2<]E(pސ}~/H~@޻ƦqB^cbV;\D F5 Q9L1 Ý(KS?}r-oi75~:`QsxD&e{h6%fXgvb'6޽^.wHZSY䫻mmyLyJ>g,vM:ui:GЯ ' .>)@_TJ #7GQ[AE߉6Sp[,xKEũ؃ԝ=4V1; (NW0($Yw#5".^"6@B\gxO<f6@ZW^eeЕB`ÔԹ~ .֐'TM(!f,gg!y&hHWFicK>TK Q> 㫴d aH6FL;=k$8 R84O(~o2ƽ |Ϛ}iY܃^MTTZBe8G+MnJ HbyǙ.߃ILjĘNrLnxF{yrجj %xHZ5.sٱߓTBGr'D{jhHZ]k"̭vzA<6r2vq+__1j!LQA<Y" ՚d &aW_żA5t^rM~]t;zz25#{gŨ0>T^KgO͘S؃А!"׊3 4':>gC;r6pKa%̲X:wUx#γBիvHhmP fDTe8ymJ?v~ }\‚{U" mۊ%OOиzEI捾X7.&=(e~!$?':\&|CqNgHdthOĊ}f0S|5jBp"’֊dAlX>sLecAl$ kzZ?4ƪ$Cz {WLNʞp-N*hwUS ʪ&,J}ʡÅ19lz ggIs& vy׺s*|>" $B|FL.D5̶>4h44 G^C ح7+I%>KV)UJ7 ӻ·r j4[~zG먷a%`]R>AeWp2O(@j:Q6t`%/H;p)>+xp\u`rTK4~o|zT49~Nq$̪2Ag$ epFCї՘L5)],*x:dp!daրj~H8Gg R^&Y!Ț_Sp#KsDc|:e$RJsxh N9}͕vKST"-@j&&e8dD!/ߊ'x E+Lte]3CU.ݞÅݵz{(~k `َDG̝1$$nB8reսʝIRL bx:/H6B0.hE,0޳~PBIO}Ko'rVc)5؝>IalI?+hgSVgFGcWj}\ !důQbYg>%eB=LC\U2ub y.$Ƞ"U콥m 6TћgLCAFrb1asW~:gZ`j=4nv1)j}!!\q([(ܟ8z˺hxpGګ8Q8Ya`{&Y[*f@X _ܵAu BUMBMfaT~Z~Pd1)}Z BF-BZhc,@*˻.VGMNʦدJuj]NCaDt_o=$G>'ko#]Nz".qODkv6nb-<+i~jDS{lSuk 漹2oI%_41<-1cwSel͛ y21vnu{!jǒq "F#dd@M q…q!]; j%s<7<I8hs7Mpc2QHKGuUv~ɝ82N8MeN΢NRޥPr_R%dDwGV)84*wX矀ќ1|~V׍5zz^46׷u%SI2쇵*U"˖]9VZEh| 4 wbF=yM.wk`-_Da?n}$nB K.e[3.溝#-[ʢ[Sr!ib|ғa-H`[&C;ϨW! 0W"D2w]LܺNCQ%_"8.ay%)ӄ;儓} 2̫B-LpHNwr6xjx$W$C_-8F ]1㨣#9䄶&iY$}tJ;UwyRlYC-b!״3wiJTeU8A]wΥ/@zRZl{E[ lŷdb]FzN1.m?OEsWy/ɇeeH6S7_`hȰcP8icb^8mk<|7"iZ4)/: wn3fV<ج|R5<!ODLOֆjp$"*WTqfLt2 ^2#.b8?l(U&(  XvĴ)WF @U4B:'qt葐olk/2Ho,KP Ox4><\}1䙺4QL3i$Fz=6]p<];vAZ\O3-IN/N983V .n\0`-υmSE]; Uԣʲw9贆ՋL_ ڜ< 2%,IB6m:SX'1]p 'B3ݹ{c:*/ Ezl1 c133z J90mw&׎^m;oN?uF4i+;qY_RkILgM%eG1(`u 'l# .\9Xλw ZyJrl8L,v1g$t! |Đ#KKb)wl Ƅu;S[Ú Zi4Ow?&XLZ^}n#<0}1O$<0Ze$y ,qҀ|ӻզ#/XE/zgkRuRLZ5:4 @P<5W. 2)Bd+G}QT1wKo?E90P 4l2&Q7{?^̮RVDauUo7;sV̼弒< .N=b׊Y)/uj_a填!n~kG13Nmc~W[U0˽ͺ rpL&pXPWbO'jzL@*=1kylՋB4sG|Z ;m ]p endstream endobj 122 0 obj << /Length1 2593 /Length2 19496 /Length3 0 /Length 20976 /Filter /FlateDecode >> stream xڌP"[NpNN%;;Angɜ{*um*2e5&QS{c `e`feeGR#F:9[@ h$@`;{;  `ge?@ :#P;x8Y[i@kB`a j t41(,&F65{K B X@,,nnnFNBt7K@ tr~ P4]3@o  l,Mv`;S&+Prm,#?1?޿Yldbbo`daig0A FoC#g{1/F)Qldrfv]"0.Kڙ@IX:Mm`{vnv^fvf0uq`ѰttJ,B#3\<|#nb;/%o1/{9}_04v@1xN]VXI^v6/ WNL `bbxX>[_Re#pcPw l. \&_l/k;_BR.66il-m3{',bEHA|+EbHA?"qX 0(A`.J ^0?EsQ\ 0?Es\ p >pv?liYA`fNF&@菜߷fboޛJ89Klm$P,?E';87xŌ- 0w VZI['os{E Æ<  ݿ,2ApYVX R=W)~v_Z;\58k\[g BSڃ6 W[]rSotWw&9I~Y@N-`1\w_{v9p$Oߩ=4qq7xt ,/؛dUVЍioRpjO+k٩.&3pV4immGFd븭.=QA^4Th1<Ⱦf5tW9\G^|{~i=OLQJ򌳾ÂcaL3 (sRݹ_c|K0Ywѫhi<NĖg6CZ=E{K}j)~Z|<h,ȨvXά5MwK6cgFW%.UDǜC8ZzmPU R>PbȜj=h܍C&XM|(m]nGd#kòraG;6X&_'Mm!kۓr$#q]na)2s8 2j;~`kTf<@nMHOoKl`nɅżІ_iU^M|:+`b`.7WCER'6E؇_T !ӫW_8`%Կ|Aq?c'P~qr vщQpx%>;|P뛝|(׺55ZH!r+SVE/??[on'9ɏ!\ЁgAD|ҁQS'Wtj3x_+ pI#oRѰ:\+J4Gee2K7u뜝&xebRLT& Yi:u}V`P2s^/3w91n ML;c\ANKe``{7mXbc"\Ifz,l6Ԅx=ROQ ZJ*5N'TN<]K!AJ? &֒,lD& 96khkÏ)u=dYd#3ݖrC>t.#$/r05H=kSg|Ṫ|k@G6؞dz4N¿H7K^K ~@B<D ( meG5eOVvTbk >xEq`;|>oUѸkĤbl/Ō IfQVϋ4}u/"[3'UƓW xڣ q0Mqr 9*3Vz?O"cTptdMc,mw&ݟ鯐 /{g$iLTom%rZs³/o6Mđ|wոN߶TjE=o_"4B8ĹsNd@\0^Lߘ="c%{G?ʞB`TB*É( 6Y0Aj=kAP9:R/9..A̟۔7GOy&ɍշ@ͰP3#ׇYifrinuxG)D8%`m*cf XvռK*aI,hLQ]R5ф(E=A 2ˆt!/HQ iZ 3ho۝-zהu#'" v-.ZT*n/:M`[lF'؟5n\S">Ш^G XB/+ȿ2@'+4މaC`p4V!|C`V^4ϜGV3;ؔ_'p˻"hG(XY*ZZkפ}F>H њ+Eo{_pc_$OsZӫ#5Vers.1JV#pҋX+Gy)tnTm4.`f^}B RJF<^wՁF'׉D;)^ZX&J#su$=C9bVC+z.jhP-ڏAqA.eps:gƯ8DwSvAVI7x衼{9uYa|Uh:d_$fOGZ,m_399 Y_B_B< PJKo/s͙'U*R|#7Ru# ~2%RED uo?Wz@z Qb(\cߐQ sꗩ-bTj^5n@5DQ z[=2/ڛ]dz5k"eH\'SL\N2{GU%5,$N%h5TJ_sEMRGۧ>~Ͼ65 UxT6dWzTzGT>hcN=2,MB=L62ŜWCPx_qAh@0?N >xL0N۪sEfdCDܰ[6kFL5/WQ06tD:$sv’11[Fk~Ѝp.y!tAHdC3{URg8OWiy (6Tp١Zq~Jqn%B# JBU=H%{SnC}^5j7׉ľ-PSj7sԩޫ)a1qVRa9+B|ճO/~$[۝g ۭl:zh%veŞ`ALjaǿё 7*H6ۗe+%ьFfKB6qG MEbȫ/sgg/Y 5t}Bx (U[A4<VYy<$I41N -GR۳EQ̹^9!5kEzW8 r=f)˒öŽNF8Cd$f C0jZ^ հ(KXRҴLrB" ގ'? xw-za@o W,ՀthVNm\umyiҫTf64o|I}<xX'ͳS$|Ūb ,#H(5.z!۟F*.:)}|YF4dUUH}SAQ/T^̥-uxMZlZ47֡"K(""QXwf5A Ny<30!TD3E<'c-'B}teI9W}X?i:Y7u{.2G(S< WMY\Dw f^K 8d|$XO=nv K3E9%ocUrP 7aR`L4.K4)fC  Ǔ o̟;&]:GRT\ֱ ܼˌ7O q 3@Nckt+PoєUة1,݋ 7nrP/5VMp_d*('fuLZ g+CiH Kh>ۉi!fGp= }LXuDOUugayQ^/4aHg c>MYu>3g j62گei-&7"KfCBtDbуK>Z8T7'W4:t#ЩZ;St/Hae|/lpѲVvEQL'dy V9v6<0]c"+vՇ-{y95&|y@#c!D.]fB8ᛝp߈~q-/(kcEP}(}~S謁M)]󴳧GZoG m1Y j"i 3jy)¢>(x\MZŐK9ǾoiV&̐HOhHτ?`&S# }CS!k[g]ljXAի+vM2"u+؂Og4N1+_[&r@M4Žt+W%Ns[ZD^LQͥ3bWǕܴ|#CqoǝpTI#蹾vʭ,W޳ -LQkq+*#KӒo l?<4lJE ~C@O؊T-p&s'H~bb9A- G>ב!h:)^.Ԯ]ɐ| ?hi.!GM_~9#h~Lwon%Hj,l*PS?8Gڗmv Q,^EjJPaGXwUcQA1|B^&A5orNGQ1Px;l$3G9! o"0Y1bNu?v~$f2|BJ 1OVT]v oJn}WV $i>b6dDu'"] e6ڱYP*,$[iN6~Hנ S ×jaJ NK37f˜63,VKp+#^1u(SBiclypr 7"ƻμNjqU(2*گ+wg*(B(iZ1BWC0'OXʹY#a%nqӡfϯ   _,b bon/xs7jkr5LmN!K4+Q1Nh.G8e=v\ ` ͖%iMxաhik3UyƠڪd_Ci%WkF6F6f {{-Je#*(Q.i쾳]@p]- \mUgkgh>Iv7%쮥cKI{~No|ُHӟ}?x?3WN ꒀ`̻g&.Sd:$yFH;z^&4E?GbNk7Wx߿k߄H+~V5ּy(2 %k? ޶):sRe~}p!lp=ԛݼoy\)Nl'$s2qpu3Z!4x֤ >MvO.'gKiQ4߸5uo}4$R}Cb JADPCA@h'C~/ĕR3q<ө+ٔ73VUQM7i<\WV2-G"hR$S&Z =952B(^_zn̺Uzude@`Ƥw+:S+W|8/.SOm;:lrmV/j#PK ~=Tg97>$2Cӹ1n 3.|.I8ǚ[6m:x(a^8]/XیKI7{h5Fgt[oZ4Uz:|(ӮHJw;Ҕ5>i`'^W>C2k${J҄p8D@Yv#Dba;Bty?djDZ=J_8 =d`PO7:^)GIySnH|W=V4$OumِdT6]p+)W0`PY"JcZbz (+S!aZE1> QvW<#` :ќ@EP@u]'GIKId`$[oG3 3z("-2&T͒?|dw|V1'ݷ#ߪfSK5;z J="a|αn=: M5?e&_6J \kF?.gq.J٤]lC <}G~ONPo3 ^Os6yV$z\fTb=B!=hܯ{_Ӣ>M̄m;9y[;">viykjQbԾa|18]ЉH^`wW`;91^9s棑] ZoFd~ړxo~jo{Farn1| qs7eFЇ9HHE49+rP@hucؾ[]uL1lFSK O٣0v gE32U_. [3?W nl>UWpゾmBl]OP4)sU (j 0a{NyS\ţ a;bHݘ\ Nr:L s6UPD~bEVDt94qWVi'?85'ٗ+F$dpaNjs=Q63od a=]Y |2ksR)VnjUmV/* :BK ͛[<_t,:xۯ> mpb_I73pޣߛ7ԍc?PTnK~j-&S$\Y6u߲`EI:c`*{cHa%>iIc~.њiߘ?]$tFCҫ(,qFy_Gr+O؅_WtD]^ceoP1I99Ioj8 qU]tGYѥv4* oAfG/nvm/N- b+16rJ<r 5B}D\R;b`k*Eٜ)攄)[bca 0%,R~%]ÖH,p $}Dk_AQG _ю!u}ߧA{ `:apKqA*vǟʿT' mwP{0O]y "r%LŔ5ْL_nE52$0=Ix &lGG͊X~x|?>!ÏJ:~^Æ& އ7:wm-l<H΍v3ꠇ{A}PA`+Km\x }0r3:e %Hi0SȊ;~dwc-|o.s'˕g|kٽyәhajq҃+OЄ CyȤ^ m"FQ.HH<q?)Ѕ5wtmyʚ7۰1 ipLVv)eLgʾ@ @1TBAݱh֣UnjĞ*w7}JOD ;bG=ox1ubjeM"3=Rgξ%jb5QU o900hHB@Nz*&DM@ Ql+/+&voDXn?11Hu&0;u̻^q}w04!fcǂ{%@l֑駃Cc d՗Aj-Y__$tf JtnoV%e|NDT'7NG>->ފ_>#*+D2DsEд8>۟∢va|{{DtO, }{0&uBͳx2jjr`#YBR]G&JT" C2"KV $wlرq*i\::zO kxg7dI_tbNe)̦'{ABf{:dQ2OW9 yŏ.//:503Zl+TU(z"7C+$q] múݘ(ӓxjԷPm9sxH]~{ч_h^SeJZmh?R_j]zzHU&>@L>o^Y,Av#̹PYtVAd-0ɾPU|oɀ;{N\>ަpjTuTCB-oyQaZgMFb-7q: yG4y"3ij۟ S=ipT<b+;^um"E{  $-;0LCKոgY|FxV&τzL1!$<(? Sl-,7*]V+3zeh"Fz˕/kyCx0)ib{X`DJvXbp`$.AiAP·b ,OF>@|=`;2߷e ,b|O=dk/@ 2[eU3q,'>sCH+lr\!,znzH.Pd~Bqu$q-mtqK43>5.z{L)Xsƣ8] MpV+u(9AcFyЅTx|yh}e2i⺛X>cɕuDD WK /zNg/Z7@\Fӱ"y<*Q K+ˣWyF>(nwkgNp$U;$G K%&e[66RTUdfxd?@쨫T/?i/xz4mM۪2~ GbLQVla=wcW^73vŽ嚈U%J?MWsd[ ֏GdX\j.cN(}o|sOEI>!As6$|RgqZPˢN#Y0[0/M8^l7?Ț/&xm'Ğ[٦ >R@~MJ?ӪJZe%!I= јvg8㻷TS}Ϙɏ[AR;Vcagn{a/%˭lP ?*: 9_z=2aoAݼI{xCX<Cjk?IhTYwi+C(6V넠BVz8"{Ԡ^dܚ戱̘_09@; =3}vIxR2ǭ*rUP)a^8lst.녈>]Ck^rSDj3bXGIei/^:mB`ɜ2̏䗓oгPA7Z$?1̔㪮O.ǡ?-e[g8ZXGRsV?5rM軗 ݷD"r.Wƶ5-a_ҏ_~e(m~RĴ_\ϭ: }mPcPX_Ң6q1-h.SC7~QVtA+w041T&,]Aŀ 6 7OVt "o/UDŽp K" VG x TxVSPѳW VlY{Z%KHWf)ƞ3ͼ| 2gϐj,iGɠ\]ݷsc%1VXUQ 7e3lDG|iy"n49 q9Ǵ]Ky_M!T[c Pᦞ_.ӣ?PT3nPl JbCnX`f_&z"$nqYvTuATּ"P$|WD"nԧ();6]>Tʰ4%W~eqIxw2kHRG `ѵ&Azj RMGWV%v`03^c}߰uIrSr ]j%Lŝ@MǮ%DoYrAS003RۙmZ LZ/JN])=@o{[x!Ui:ͭ-P8a լ2C@LI=tҗDڙ#Q+?vV:~u$?Ƿ,³m0)jʤ6R !pexw Q'NntBH9I#oĕf)rlP@Ѱ9~?I  (OfrJg"f=Xc]\y4-sS1@4.-K<5eN'˳_8u%wpNWI_XI>3G{(x?IάmaM hGFC7 $qG 4):t$Ҏ*AӇ׏< X/ ԪTsQ*.D{q=bGYIk.͖K z:]Z)7ܿsO 1S~92q[6zkl J1d6 j× GLOr ?rvݯDM2h(\2*~*qqe!lRޯ_D'֥K._̕i:ftqX" d!fa+vomtULSkҾAU`U.5$)}~F+qvJ. K0J,PaO+RZxescK3g)#Uծ/B+[eZş\i]Ab#vfg1Ao52Ep3͎t_Dp4,SuB:v .(9qltVAXϨ5ey,>8Bc r 3xy!gړSL܉oW2V1o:)ߖ*%$QzteK@}:h@(Ế;Z"a-8linԙMmɊh a'džXi`KJ=,g )oqahؕ@vǍh\Oz^<|n0˜P¶o^ 8UG((2}kbz~hq"fb30vVv 6ۼӶH ~"'.F է=vNOl* cbm=ޚXŀtgk= }6 $״~@J'-vTgZIq#c&Kϥb@Y^c%"FcLjQLHp1EpD?cL,5;S*K֏=>PuPᏝPspeNҘyzvWnʧvT|(L iB8_Y/1TRCvfSYava;u 8_/YyfȼʸFoSN-WlIV:(ܼ 'T-Gsؒl2l=b}ؠ@/cm|1]fn6z86@aᘌ!=uOgaڗ'oDn:{L6!@ gQPshO;,۞\O^Lܖnɚu*=Ӕh~B 4% u #BQ[GXd\32h$G0pz&G\KZ~` C*nvh尸Ňq6-`IXU Bg=!#T2T28~JjP2'ʥy3?uokax%㭢i_PXAI0 ōNWޗr>bM}EKJ.QT+YդGw&~ގP4eԍm8a=mRo2f֍erxXe uN4as[uQDN@Y@ ܵRh R9GE,vсΨZOř)& >nR ק;*P_{T[s6D=*o(F9?//3%L<]-/m6q`8^´^GG;A>C+V&<%<$[e#i7ya #\8e,!E<{Iy%?lb_:ͱ2 gR svFV3`ܥe1mTߤ'+ep}qHgfЧI\VwAEɇ#;4Л_!xAG-Y"H҉&^xJujPT^ 2O?,BJyg=U8h)$ut1?VIRvI` (_۵ϖ|9 b/H,fQI$_V)n?Sg 3w#(݂6?/Lk=մKj&l扔awUB=aKH/p(k1 HpJ>b=$(q׮ 7rJG,6gV!3ôR :Zy:Sw[,?;H)Z8J J:<642[saKo 4-PJ<.cz@,(Nz9۴bDŽޯXܿ-JoX͵[EDIpM<#P+z>Y+&֯'xr֌k cE1gQ;Brz]ﲁ_9k=N`ݧLnR.Lg*y,:O$oٯͥY`xogƫ^ijn,v?j M;1r`G+eہA è84R 7J9F;K@ϑB+y =eY*z[n5UȄ9£P(8r&D]H2e#<2^[ 3A\65AFqQYY(n:{qO!v<-U>xZP~` -ٗc&hbOqiI:RsX~{jo y`2nO 5g[hwd\ZG#XCa.׌uZd@큊9,mMsB2堳/!R=ݝuz|϶>Q~nj=l"k6?-qriVY<ȗi>'@},b-td+:~t,@$N&On +l<ڟ{a1 'nvŽBSHp[G G4{xbP& r Ud5s2}LBL@e;u`z2s*S@Duf 8 Mִ]fT(z2j S} nD??N;3UfQV'Ҡj{)0B[v~Igu>lBg_ydIfkYiڕcjNԽM$ PF"4bqwTgaK'OD r:M&ӅSOL~jp ʇo1,bm&}d 먮IqԖ#"bh9hObW҃@ IaX`: ZUI)K!$88w8c$JIyoǣ>`ܓJd+Y-#R 9twdw%,I2e7w&Ԙkr7-Z8i<)ŁP+ HHNMY'MBiZSx3r\eVFי-^"6a c/s 'rTDeO B *3Dl(ks\@'MJTNJqtij2id5b3,*W{dG'r[Ppm/h|oaQw5 [I_9@׸?׬?7@skOΖں')f-@,5u:񱭛 D .ϖ[2;=~P5/hח1(-B+woh)$#EVᩮsts/#=d J+[ԲG$+RmkM1HQ0gS;k1;OP2'bibNj T܄kpz^1c?y Z (Qΰ*_fRps O""\`k`@񧛸~~W]0ƟnI[6#yLOtKR* @eĕRG ;FOM xuGV 8ㅮRHC Y*IU`JJo[iύd;-q+#5#7 j:`}'ja徭cJ[ }gb%Q_Z<%2Lxm_^ۤv[qC:,g!Td\cA` z>-e\!Geͳ44~][$rc%Kw z\U1Z^\Z.E)MʻWIK@4ې#YMN- @(d*x YQv: iݤ ,ߌ k|=(m@TGO8 ;Zj/[Gˣr&f.a}j&jxa^̵[ݙ"0, !k߮gk$6pt>qp@"t2V}dfTD;xqZSX1 aK+y 'AjOnjQN_L%-<w%׿Bn,8=NVwQCt^da/Q4'Hg'UA:zzUOթ=n()52w@P`TވB6PF_d^2S9hA<ݤ^IQFIZժۉ{=zV1n+]S~* CD':@N$T,?[̐VUPL]}(p?$mB٫cm8ӯg[20Z.Qkoa"6F.tLP,WE:An{lniOV۷s$ a^Y6^̈jɎ[:d[t$sʁcdi[37 wDG43eEөL1#ސzJ-%*-QH2c> stream xڍP-C`%7H7.%8!-ydf{EھBUIb]ؘYJl<VVfVVvM=/1 6@h"4s}Sn67??++?g~; .(4G/gK|Zxp9Af` %=@bzWZAWWG~f3f0#jP݁߄f?14m@.5 Vf@dx-΀ 9E#z`cf;_޿8YX@^ 5 dH+2z2 ] /ff {3?*7H^EMw.K-% @ $A@{9Y;0-~tsd܀rPY]\<|\ia;#%o _oG#d|b:}oÝ 0?_@?A֗czYB^1_51]q?x88L\>N.'?r`+O / we*l!+/oGm$foGme\_B r5yJ@Kj\^C lmwA. O*^ۃ@U [`bce˽Yؽ'./C|9N)X;v.n zsq^fX =_Dy9,E"n߈bX^67|gg1`X $ _EX,sT ~׿/AR;/9~ 6V0dK_8_:,._^8 /Ƽ\,&i[{) @YXVV{0 M1y/:c &U| ZsK֍%E{%D}T֜$N}rea<@ISϣvlt0eAx'vL Qz='0mM/;VZ:d<H ߰-`;|ngݎ' A#M^9kgetXj?Εp_SIY]5s%Gi yk NCmq"%Y I/}Dh Jݍ_k;'LYCt+G1[PGwxotf8=7mZ8H<ч$yN8 &Ș?@&Vµ{uڣ5kfLW4i-IDCH:5njƖԏ)Od2I7j0_vA!yVHH ϧjw3"T]v`*Z?/yJiĦ%^vR[jR/`dl}!41ubTBѴwQmV ~*g˅iaK֦z2x)yʬEa?cABwP"7t><?F( 4Q#kj9Q>-xNd ̮,N¢"s]3g%WpƙԚH0<>`He4^~u%DЂUe4):mFr}wؓQc.㉲8*|JCS0U9W}tV`#_נ6p6G@br_s [pyShKM*M9Đ$>m~Ъρ{wBFş4rєdGƙ{S$Fxv]ZYY.axq[p`ۤ2xN5\-j7.+%Е*u#(BK? iv\'VtO.^= lu¯g.]"t (N `${]$WIz\-m'vN5$[gwxO3CUaX2T3f)DfbbYs6$egg)S'SU8]֤/s ̗{uU7qՉlZV1;6L®:.}$#WJfGOT=ڳ*_mDiiSgqCeҎ4Hk:5 f p*h_π7NGa#6|XBu/*D~1ZF,|\6L9DHD- 523*oZaZGBl$~6vX;!E.La>#pSTW(`yzvɎZzsǻ6$÷yqPڄP>_ݷ@T|$ -!ESF.oݟὑJ`9'nUUlS^u[:bƴqw5\nu)5.zsŬǷrDԠɭv|:QZ%[i"/3 Iө,Y i@] x~ҋǏWә2A2aLA$llVҚ?M}\w pU4UX)Wp ' 7H#42fQ^@g-tIXodzUKN7RPtZOEZ7`YToŠ 6kdOy >]ؾ* b}Ւi(9Q;įtlSrHY6!=]vL &$k۠c7J#XM>[,r|"&wlGuA2QT2ZQ@rP"V3{sч ǖǺҴӌ8Ų!IFq20RK^nCsne'=R)IugR@O6S-[ؐLd79W<~:#:~x_YX!I4eP9'ݺL)u3yUI7djl i! B rt G. wFQ?g/sFgZ>ieXGRkABmW߲z=lK ؚczj֣?tA? hhG=>yCEM_} *ORHuk3Khr-6g]?AJ9OL,N|vՇ@bZK*z5]hʟ&$D֕iH,6|ZQy4݆u"-- # G62'TH|ŷKQkbgU{@P&#Ƣ{Ls9XaF VSld/{~B ~PBK<hQ!A_0R]F*|) Cc^; CuɈ\,шq=*z8eSWIj5ҿ*b3cE SFZ{P~ϧ؇ky+Fdgɬgw,})R1őxz2Pi)~61Q ZZWŪl[MyDC 펔n `@ U:\Ip@mpf2֨E1"t@w-yfv:28uڮr ֥xfFQE#uwp]-If5*zU&Ͼ($ӣ<=?\vė!'[#s w Xwߤ;FFс5{"-rXVj^<훝nsy!|VZV̩J(eۻzA*CNJ٧  |s.BF-Dб8Q^s {mDm53`a鸬Ƅ#d:"P"b k'J_ c9@C?:t/k;GC[}~k/FЭm0ēޘY@/sET:8^if5hQ#u}dV"j"0cۘ{4/FNQ! Q Q.BQA<:0L}8@4jI1$W%.b 9D2odAQsZ ̌Xa΁dFL sC'ntds>/6zGYb<k3 ccnZZ\Tu^}) pK(ctk*Y3U| KRa2cZ!!\5XXe}4vMBYF4g ƫ!*UQ@iXe;;R6>r+CڅT#9md$La"NJ*(akZyXq(BMƉTl@+$0]; rLsjPy0aUcδS~բ؛l|")XOXMGM >9Wy@'NliGͺuia(9v}!09yIlI"62RY|:"ws1:k^7ExšSI5׹]*,&솟o<"G@.1k~E\ <Dmn%M'Ox448GmMVQېs47(OV8H}#4iWA6-IUa6j ueңќT\$< ?$̭‚ػ>$wÚ:{N'Y)1Τd'f")0R<\cGZYXsy>>;k5F"*]0ɫPdTZ]2[bֳij<-e&rʰ*XAXQMy&W/> `**qp rg0 ?~W0NVӧdף[)5(3 pF`1惗w {~D|ǘ-)gd( â6e¤QkNDjD^F%©Wvz7k(Bz$8^ލОl2gk zME:L ?% tuo@\KAV܇($@ ]L$;W2f2A_=eFA R*o=-`s7HÙG`z0`YcDjZx +2I¯+{Zơ<.aPz6-}}r &.O?67UG8?RZ^6 ֎๫Z6"EemGb_mٟJV>gaDLJ@=A,>7ȊLBvR%򯚸~S*a8Qy\oב`~ӣc"PUwrAau'B~-n]MiPZG^ITȡ8160LEY]2ƜL +mgNugZD3$Bo*T)DlC@OUrd0 ˷u]A_lU ;[>] "d:(=Pn)?bOKo6gmi$Cb2P2I#"Ng9>1k]P(I=}UGՒD; <L~ )l5yܡY5!­LP>3LMQ,a|4Ee,WO./c\遷-MO%ǀ8nca]({{9Cg/5+Ri"AM{[_r.,޳[#q4%\Ni8$avެcZvo:;hjju'kÄI_T.iBd" oLu3Z7;ރ}?hNks:ih/15~"QD]<;x]䗿.A>[Z$E }LxVOkNnѵkQ\2aڿ*)m+=ۘyH9T^/RPuV vM`"$}Ǎw`9%;0޳SG/._sVLeIQ]Qg#I hl![j@iSw@ [je>VJ&AG;EGwFՎɥL;ذpoJfS wݑ~E>V=tv|R$>w)CT62((6L$fD#%X)auzۡɅ`sE=:pӫɍS&c݌HC^cXDs-jjw- "섆j#2+KL8 =M5 pyvX!?mJ?b8@}wdkeBꙙƯPV⍕qin2%y2-E]z(9FNW w\{̎ڤAQ[8_0O0{a|)㿶[jQoVfI".L&+?~{%CALKu5=`U>^qQsU %%\ԐGse\L0{G?RDx'gCqpEm`;z.{5$VEF2+KU"ǧoG:{+aFxa>ڋk6azZLolPVIKɍ!vGu WN}pZh_ֆߖ|AD>SF44S3%OJitꂪ>?ETD 5fxSN9[qTm=%WdMwt *,8K;R/!TskߗRwNW>2}dĢqyVprﰅJge' .9=:QmlbAm#ғH^Nό^',|"%LUZ7cHk [xt*XdWե˛y /idܖJݷV#D 99$O`PT %6i:zC'F,!sQ.Z}[zW%Lm#QR;utȉO3%$dmEOL[@̖4`jlquT8SfF,#ሏ]$݀ 'Yh|TIt^IIm6X q~/h*@MmI2Nd@u-V%I3PGPAOV"vЃ"\AgUo角0iOA}b -J}udlt0͕4z=ڕ{0aJv cZR 4)G %kX:0.L+08H/iCxLDyGˎ`hjXLg+W9ɮc.3=_t$+w;"ԇHET0Ma=^tA!*,TT,'x?J^[<<_d1}/qxGeoZy.zD`n?ϻ"ԡr O.s}UOL#wX*5t}^W ?G`Oer1~̹4AhI,P8'@BqviJ6 FXL󫦧mm5BF~$~Ss/.!wD5D[0NWbFF;Ȝ9!v2Z^6ÝP1/7zz⻻cʉVVMWۖPh.4=ixl$pGD|Bۊ%jv׫Tv1(߈8ըmK37G΅/vb6dޯn~= |$׫bUhgy\?*TEr7SE\=x-PA(^ZѾyKJxG"dj<~Y[~v}- 5Л'(XUNŵ]mDwg+%o%Ģ]%4\Ko"s:{DԜn@i"MY NAcHxWh{ OaJ\JYs} )uM GUFRP8WRt(P ~T^T*(*@Lj'\ endstream endobj 126 0 obj << /Length1 1392 /Length2 5960 /Length3 0 /Length 6904 /Filter /FlateDecode >> stream xڍwTk-H&]JH"B EHtT.7M"E@?߽kݻVgf̳gfYag3䗇 l*8_H(P64"@0; Nn E`B(" 4ƦBc8@ $@@R A "bWDz#ahL!IIqy( S r"0(_)dhW)AAOOO JP~Q\ `;' ` 00„!P$S`uki@H@t%`+ `P ! gA遲*~(0F `ο8 Ji2pq(_S!`L߽ }!vh@]anPu??6{( %P7 +S Ѐ젘"_ @#ݡ~P{?1f_g0/9~B?,1A=bA%:Z(TP@x|ń¢BIq ii[@?':y\T wflPƼ kwmenH/ 0HCY W HDnO#a(CڢI C(د'_/Ft`'SoT_H7a¢_!J!P #И$5S a/ѿ҂ݑH~SoC^P0,XpV!Oɿ6k&uкMRJӗ7U:2glˢ%-KZKcEa?zO _{Hfckxxzܫ&ԺBΜHOoںi̶5 A4Ov7R4tu#T!{EJ|wZgGaf[Xi(-sz_\i5(,ذO%HK3gێ7I\ߣ7#,K25(iTD55 H&_Q{/X⤸*E}? moS%ǽVD-)0&O1 C`ɴ#AM\Ouo`?S?Kefs&PnRQj\!+t1+D({.q/w+ޭ~^څ^.*TF}_fz/VF{99w^al%߲Wn Htӊ> }-V$l'}_`=ZR17.Cbއ;,ϣ[ LlNUtPVN QZ7τ@׫/&5,mӗ"^%InD[Wf_S9I_rob;ykU B&Ur %)*㔷Ompng$h01&I 1! V|^b,Q 74d|3yxG%6lT ^mJDh 6Yf [b 3PʘKj"9yZr`@6TI?AcX+OJ/ϛ+7 kRi;.㯞e7C%:Z5e,Gm|[2?H ;*ˑʙN_7/Q>ʃY^R2/JJ:rF`ܣ), z|'4X|qoLA!e!qO^q?p^C01'Yi2݊ŇIM6UOLu?Iw<^+ukETDOHA+_L{ Q#Nt*SylWvhO@T#ΟLX :mo;+c}޿gLI['PH~NG^u@CF`;օ/f{-?(J.Zz͝ f\(u1A\ N l@C`f߯]Ia&yV f"O' $b 6 }\b9jcO{dn?Slܴ ~ץ#"P7l*3qI;8,o(;.or3 ٴ`KfL.|QZ${;4Vd͙G19Xn*X\ zI>'eVr&g/9*ϗeԸ&]<ͫpyt8uT^}Xw A_3||%]id\^|)z5&muMKU"Gjd14ѻ}wNE;X,؇0fu=B`S/lSIQ%?s*⧡R+t:99}pL^PQzT)Fl:,0v"~eS KF8$dK%g .oa5=Fj׫.:fT?5;6 nf<n\|'.ɯCgu)~Un|;Aŭ;Y[tB9 V4?OTg?D9=lT,?ON8F@Af،Θ8^1//&tS=kHڷr,eMhLȿ۽Ϲ龚}ANU{dSȍV* E Adq]o+Vёz˖ECukWT=Bu0_$?.7VD|_ #g)5"&Ffʔ,%5[qhoq$ل3e`j>Fj`՛n-HhQc\)`7k.d^CnIJ!Bxfn8NL6% ."$Tf]%b|:FSCPT mY:䨩;bj-&)H7^>lLv82;{iIQ\Sgn4Cga!W"%[*sdŊ2EMe(/7.׍yX_,8 q9&-YL,I-ngpK/%)ViN\d*1XZ\4 ~1;IhlNyiE֪o汑 r9Ux^朘́gKT:qrt 9ǵ =Nqwa gIS&m@K' <: ~j~hb]V]w/!@Z17A IvtȃѥYEFsϤ-8MCtdR48<]-;%}1q$=ϦyF񱱙ڱs%%U3hF[4I' Fu;`jrG9 :T>͂Tؼ'lAZ]Vg?;3D]m6G}9#FNt}i[il#iͧSk݌ag6u]ؽK9:;cڝ'ȅXoU k<?)8Nk]{HC i J+8e¿#SĥlI 0=_ t}<Ǒ,>0"1" i;롑+{9Jw:sxoXIbUGvӒ-)fYj{gZ)8?[cGny=5]I˹*J&J xâBx}U9d]i#e#:2vsw׵AUyҶBSe.ﰄ>MWs~3.0En]C(_`CΘ} J"$ke(e(D)=6' &R6t:Œ)HvFDos?z;Ӆ-֗C7ky:Fo5[0U铯CI7Wzo^4~Rout*T}|_?V^A %o4‹ ޛq(Оki)CX|g,C ~;ر0Bh(^IPG\Y+xN*VA.lYrQSxz6:\ХKT). (j[gh{*y/iRz6Fg]6Iy7G/mmdTť?_F{ \Y{xL'?B)r~U8a|.gf Cђ/5mibT'=]]ю9:NK9z a&)̉|E'XGUEm HLַ[cȻv=:/d~-+H7QJb c[èy#IIYxAJcnop^-[]цNqBvgZz$̂i&8>mzj[c ^vx# 5;4Il_Qf^^j?܈Sy^ DwlX"2\Ř}1cN; 6=}vm-6 FM{F3R}o>-|/}=%"VɇQ@j?lsBS T vrņӻ6l0uA!yFu6&dZjp[ O rGoгl.L#Ɣ<)Ѝs !ОE~ҼX3b9H8|V>vt{4yŏgKnzF'ޑ*)em@϶+<Y6~gy)(dú$W=q06 ~w BЅ<7ZS37x,TO5 OaUk1$?D˹,PmApŖ:V|}*<;)\7XQk«W꺽r*t"Dq7y2fp{%&nȝXn~ *&v$VJZ?sul4!zaZ+CWa*hOO1D4ȸ ;[]M3uo{8I׺5x΄U]Moz ßSS]Y-NI,mvr16n`/ i,ˢu]s=2rB>HtN}b:u!hwt;-=^)}B-mȞ%[ KM$UGR[$[*L3 dg!ڍ)?yYĩ~0%+B CJl=20*t>=?(7%8Z\9y@7ʃ0jJNGY(=6Vv묭 |x,d!K<*?{0ϊRZ ?տn~X*כMEJl(0Z]NdMaѭ7~Lf˜c4gՇ ?;Z R:7?kߊ7$m{e+> stream xڍxT6E:[@z I/{GJ!A:H#H/R#]z4E@@s=w<3=dE߈_aQCQB@iP 򷝀⁄"PPh  MO@H $.-$! @i h"$2BIII(A<`B9C BPHur!Nr|o(`AB< _ 7jcg(/  #!p]` sk9п  n /p =5m;`H:@hףּj~H@Ba8 J>fU2 G! ~OWOs]o+G( OwA8'DCm" ńGYWc_woo3C; :BH+!!CpgG!h ^zF+ł:Jf(˩ Kā!!!q yumA?2jHOo"^gl@ŀ`y~+*ޑ' ܠ0?=QA'P3_qzWBψ" s~!Q_v(R qЇifkp> uG슾[vAГϺp0 @ _+1zV >%#Pc A"AtE]X `O\VzG_L8˄ oU]YICq?wz0HΡfBy\=t|j1зn'iBY:Q#gUDEם-K=䜔%׹Ăm5l4*Xd 4B=UBǏosjֈWGRdIL|P;W.OKb-vXƲX1S8Ж<(褫rGhg=BlN6gv# MsJ3_36%ጣX~/6 Bs)qIKd!a4YJ0&Gi :v } ,]Uϑ{|__C+͙Sgoۇ{l!IY{}ɯ5ߑ򨊣]܉y3Aymd,&YMEH 捵02to[HG(ϐS3\}.,& |~~"io86Iǂ6Zv($h^նtȱrO [$|:k<7W<Z}1a9fr3mG91AbXeSXvY3GϨc7B! эwF#T$ R":R؄ѦA*D_%ɉ@sp g& UۓX܏{>R1j/C$x|$h'WUwxoJN nJid3YEhp˝rz?4ݡ]ήvOڀ6w3]fF,է'%-3g?8gnia: dR˳RR=#RgrE:N0^<Ѭ6AU+"7HAKõ*X4Ľyc!O[ԌLf藌AO{(R;&sֿ~5l:O%}Q)fe=k2,K˓?["ꟽjO,4Nv_zieCoMiYS8^i 9*3 |yT#9$T-EK}̊L,!u?W.HϏ$ء}a}zG1$]EM{WwUAˏfmvLT /Fy% 5:ȟɯ̅KxS˾B? IU(M9I1ެtlDq7U%f>OG@X=Ԥ kJi#s ,!9O}jm_μT3I$q~}%'K}RaRQd+Lb GXVK,_/laȂߺ.Cf>W閇b9#U0ZWuB76L6ú@Yg|'Xj3x^Wm)hTKvwEE{Lqev+/YUz : Յ@(gR0ܺceyVbo1bCmϯ[o:qu$[.voi"|+!H`Em$򊮯PXrbN*g{Nxj+Eg`o^juɊ\Wn=b} HXOtg(TH&)oV-F엕eU0P-Gz~?sVDJhz"h?7-MkZĨb' T=po4|8U]vvYqiKw Y7~]`a)dЏix'8tbx.E0] qK%BY'{Bـ ?C*{M]1~[]r7.Y!n>*uRM>M>ZxӚuKm8Zy9H5?#sL*ncbVI¥@ǥU6%Pܫ/0#K,&}~8E ._H8._"$GU3/Etk 9XjX&y^ Z1fp\b9+FH&ky8}w ٫#6y|ҍ. 4Nd~w_.k(C݆a<UÁ~^22?y*73a |ղ`^DW#uoz1Lw5ʲu^Gz3p "i,G0}s鯝[rY[` T+j sV[c1X!t]!sn'Qں] 5ʝ.%&ӳlRTI.O۹85$b"jN3]Je^M0Ymċe*J<zHv)ߜQz;sR^v~Su\<`ɧ/ޝ,h3uŅںPYnG[<#[޸}1\ O n>3gy20"6a6UV߾̕|J=s2Gדo_dP ~E쪨aMsIdT"}H8Qc8yV Yx=peE'A-bS0qupǾn&;!R,K_78Kt4dcqn i/^F갇1?c]~94Z+rX>Q_!JT^k. &OsxB9\;dv5Ltu˙sf-WC} vl.^Cڦmp2rC$;3̠yl2JA[SuMIbU$KQû)tJ?ەvnjy񅓇y- >l |-wȄYKAZ=;% zRvA rŧqKjɑʑjjIO!wWw>:(IE*҉wgf1ytz2wd^f yw uW##G Qi8/֔scWs̱e"+䮛j]xGG>рGSʦ.F%X? :Q{?ɳ:&mZ㑑 y`%W9>ԁ>KAOB?)f롌,gI|u醗W-R m,hKWWY<1w?zrW]M-gp@) |ւscfla`ecc*i[Ϥ? e'VVl^fhx$o)aY0ٚc!)!Dp⵺u?GgfYD~>1\]2/ 5p%12,E;TX&/Rdc޹Nkx󕭉YW|lCԁW+q6]]zxv?ĠV!B`{>r]:gyͺS/QZzWW]am)j&@-\3Z3@Z)ٽ/ȝ0|˨G'y 1Bӵz*Uo%bMY/|6RŮx8%F=MlAƂd޳]\.jTi D!AuMB2]@܋ۆVԓ.> kX ~#LrP'(<%I?\eҊv..)"P1z hh~*|~Cx|')%p=WڶeO R'+IMnkmI.$荃]ݬ?UIȅ}w-.,1 {uXBCBsߤռ{Im{<ia=z/S(N4J)^Uc \L8I~8\(;_H(hX`FZdFSddJ#h&\INYRbsdl SEu(a^ ޽ɷÅ{Gf.4_@xS'=8;]xty:Nn˱^l}COEDN]4fr="vd"TInXCAS5a8Ʀcz`ke_ә*"7aAvs>f9e=BL•rg= <|U>gAz}5-;-4n|SFfX4k/e6>xnփ`1lzb+޽1XeVͩoN~JUdYe;] fGBco}gG>_Ꞓ߼R!Nu%]vð;? O|2o,aPk^ z*7$cMOyq<ߥDKEA]B݂ *],,LP$I?l8|{˧(XQM̑\%!ty^nƚe>nn=8rrSY;c[ֳE0b5ÎwgL \#mbF+Y'0]/d7gwK#rZo;)iGJ2T7/WM8fzWӘ.vymRSAW9c37E`nѨ ݚs}#xVb5+=N%'҅ک/-gP)r_ެ|*ߨmݡvjYجހ)9E～LƝ.Lb'{:z~xҧRZ 59 s֬AԚO2gg:`Fp ROgwr)ySk͢}yQ"gV%yx?0܆[Z zIDBOn7[肹ZL3 SCA=mL dngxs&`r^9?CiγHkYjSU,5[ٍ*.V;01ߞ)T$Ҩr3,5 g.J2jnA endstream endobj 130 0 obj << /Length1 1400 /Length2 6059 /Length3 0 /Length 7015 /Filter /FlateDecode >> stream xڍtTk.(1( !!!ݍH C0tw#!%%*(% -(9kz}|M׀Oa UFQ| I88 a('_f"#( K$B(tPwwD%$A $w ) P{lZuFġpFQ6  rP$ ({3#0@@`PJpI٣P.@'?ٍP7(j vAO0 lQ`$68 P:nEj(O柀fO'!  laNP&? u ;!`0 l}s0@YNF  sA~A*F ܈~OBc٬# ` a|C AAQ8 zA쁿z@;~}].[4?#u{@(;;}" (5': sF/ ~M/()A< ' b۪ u9? /Zp%n;h#\9HA?;_U_ );9vsn34QhYh!wc)kAm`UCۡ)' c)ü60^ E~}qY Ъ8*nvAѢw_%8aK}"0 &I&("@ ?B$ѯ `74f#z DjqG"tϿzA!Dȃ0r|xщ&Q"(ΉUF\luc>e);x.M5Թ,`7$L| ^bmBo M%΀324FT\n6V "Ĝ,inh +p.Gl;;ۓՙ.tRhy%=:[n_r7=uRzș«;EsUcLL  g@ C, 3s[}q_G7 [HT0G V.Mj^k>VYH tq)ǺֹYX |ªVDqt`ZOOtWx\)C㵉*^gLۏpPZ7[ԲT:k} \rɝ7UBg^}ARa19RfdxG<d|_ەn֏ê[}YEl@_#AH; p2,pv3h6)ua>^jQm_T;kBL ڪO)hShz)% ͈ מݞOx[Dx@>ͼL.ttZO!p:DrӇ$Wq|3CȮ~4\sSz[#^FbIK(Zu0~Na0Ҝdu*yQ{^+39IzLR^/)JA}> @/=KA:zKs_GEdTwL oR}+']`~̓Ne5 :\yݛ>:&%Fx'+*B\HSTJ ֑fš{q$YES?UFI蔨lcIBdXP8a s~0YMgl+M(Ұ&ˎ-ݪy؋ƍIH/&p߫V >2:B5 6"qΙo3:_"jWќ 0*tkT?h7ϻyg븨sƛ-;lJ6YRڜ 8ԛ 2YȭH7RO[uܴ=l,Kk=a\.fSv~=ʕVO3rF&"ư| 5 ~Hs.;6Jӵ>a K wd顨JSxGWiv'ݵZƢJlI'"Ln\*%HtMK 墈qT#}T=Y+!)kƋф Yr< {+SN0l=:zyMzV A2J/b>ƂOQ}a!|4c=;]0~oF\z?ÉW&B&F.<ʼEZ8v1Qy#pʆu#Lm>i2o6إ[Y<.uSOM6[л4cPw]Q Qj!ʚYq1L!v0ZeDEM@h U^LRqޭ灂`<}#Fm6}ϵq$8 _Kqcn}M_#FК&;p(&I#xU2ƹ7.-6KRS~ޘhLAYh5V /Jۇ0Ws|%ց}ܳEf]νΨ;.y+>l/F1Idڙ6gPsG xD3SY[瘸.ߑ,3U=9ͨ;n=J\)"]JiHJ\m繀U!/Cw^=!)3 mqlPDmFs|1)6\e"nOfGo0 e xs-⨊ |dcy{ t;$} P[4 mb%ul JZQd=4 RI@mktj}[8Y/RNoo (7b$s<:-q L8jE>/EZ4ۦbE"] Tfy ޽ (l=/ߠvzC]BǢxG3" Ӻ7GbjL_*d$<#[L$)äc ,e7L$vL :WZ[Ս9Kv,}R~u|XZk,wv-f% }k`Q?=9u1"Ԃ"?y(aCOܬ2v@6nwD$%#Jjs,HP}ц-]1Z?t 1˂J#tqSބĪbZ?'Q169_}14o[(J.x6)‡L VO-z%YpU"|p)i6G7OL樿M=x\%ǩֈuƷB1]LVZ;6A3aϾ{;|:dWobt%Uid޺qH00s96_X!Gv̀L $UGػZ .0ʾS>cso>nyM)xu2<%?eבRߩH;%5i OAͩ?7XW|[6ތ M<̬kX~Our6H]>}g NCT1%xa G6'}*JUc_s'jLU~aJ5Xin1D5E҈H"g\ 2)-j^myE^~[NInٟgN0V6\7z})nXa.aVIGMĶZcV ^Ӝ)L'Qӂ 96{ @%DVZSkk 7?]AcNLiSOdMrT=ì򍗋iZv5s>F˔R,dM/ou 7VbDB8?֗գm\|Ku!R42NZ=f%i6:3b组{[ ҷD;kIREP驓GPL^/'I7]mb*m \LJe圦Ԗ@ݎ+Ne?S'd{?8#b٦/{ߢʳO͐5-k';G} RXpQӆMe,? f lZ/%>h2Yؐ dSP?7kqJ첕NCQҒNg٣ly,]8t:? oF^31eXpHucx+"D_H5i،LIi?WW:5X1(*xZRӞ|VAUjr?s U9'QI<}X::Dh'V_5 |fD(ܲa57;bA$0M^v^VWz,g{i<:e|irFgV'Xbu!7Lg:HR2\$3A& >[mHjm8R\!s"Oc۝ol2C`!fwsduK֝Q_rV8Uu|>*Ͽ~AMu-5ͧR2Їq"}!7=Fn~ڰN.Y.-+kag]?QQ0"QRxEU@0PxjUɡG^6ʔt33#gpH#<Ƹ1|J Bd{cA>!f{PHU<]g"c˟vM|J{)#+BԼdo KƾQg'Bef G?#īy:jI!&їC~@ƺk'ǞELڮ9*s'n\&tUJ卑W3n^3ƥeyO1/pSFG0#EdW{[ar/rC!s'?NBܥ~gDR&%Ǭ#>z#OVyb<[EFzz1x8m'ΗhE=WњF[9R{ Jpte(tk2RNBߐA|ůl2' ÿS*S]'ERĔK &}Q>TPD7 I;sWS}əS[Yl 8,JLCIxDL4$FV.fӝMnwz&4oc(n߶o>/_ Xp)c ؒ[x&IdfKfxp[ɂ7CeR"J|8,K> stream xڍPҀ ! ݝAww %Xpwe9{-`^m^ %U3{sI{  #3/@L^M GAt5Bh˻LPqX8yYx<1w{3=>Mi,<<\ؙ;MAyc+sƶU{Srqqebrwwg4sfw]*Nnf?J(ۙ]#@ B.ߏ̝rEs_rn># Ʀv O `5(J1xAf:ۿ7v31@RD`^9:\6KA.p't27}'ߗkwy, 3?0su`R]ͥy#4wp033sVLPt0S_o{{@ ?pn'Ws_+XXf@S%w_~N@.' 3zc3i+]o6N+ _?Sd ;;_%ߌ$]mmSe7zm>Ϯ.!o!kiB˛]V}GD@s, 07SZ5K@3)f{_=Sg2߬+27cY98NNƞpsfyU3s?Gwy?x`arrDE& $$K\rл?n_f0)C& K<>w?:d/d0 ߃X ߣX X ;rlqA{\{\"{_09 Sq/|w/|o=Q{ {fϽ~osssS%{S뺐_5" SC7Qw{nAbl+"= я?NYKߚmm |2yV:-Lv}fN\Ydu@fX-*#w4_)[*.?P51"@LFfCY%Z+2%M|#wY4ֱP^M؇J9!tgo)GVS>7}4I+߇d]d{p(FiONiWD{.nI}x .`,+TAbGnOWE䞱\<TP UAX>'K›TA޸ms(€9hU)w-!4.vV(c,o5 c;V؃v @&GOOh+b #`KEBa<*,Tj!iE@Aqb|*h$dϛ{MwU<>; `|fǢBii;:o]N1[+~O`K՘2oFYܨp_qF l 17v۱E '!p>Ұ ޮ8|#8u_M0<:!S~*'Fejw'l]6/PXy"^U|)`Sf3!轐f ]cՑ.BCir{k븆6 X55~ŭ&^_nLT(ƵiQ58ҙ 4Cͭ: ӹ%B9AgYf6|*#g w v7a %^1,_59lXUWJfoF29ŷci{Əhb$wf*cH|hi5!Y(⧛ BA6xZ ~S:!M(xDneLOե0>/u͆3b@ NdV׼+,~ "Чbzw('9w%|@tZ$[I|Br 7;:R3ת{jՊ Hd0XQ>^{~JKk ofY^/\zPڡnS䔓f 6m|CҮNCnM@$#+j ɤ@ImDU͸[%,c%IPOZ 9򌰒FD,xzw0pm2}%ٳ}8|MϢw9h9HP⫀7zKGβ^ S5>CS$UO $k} &1S7MQFm(qCś?NFOt<"w^9ۣRh:ZU2pNCϖ y/N x{~iBy0.E+ o9sO `ȯ 7Og@KoP2bŘЫ2SazRF%-tjmqZ?H*8:͑Q~dal4CG@q0f $MmMz%&UAJ evBv* Hser, \G=]P 2߯!v:sgiΙǯ#XG!_;~V&,ljÖ%Cђ {%~}E ]IMq!oa?`9=g%E{jAuRK=[dܴD軸\ 2W>Imc~S71PJTZrwAlkz)ȷJ~VifmWs98#R4dU !AWZ_~%3F.A#[xҠ[(ږyN}7T$.x8Ojh$F&Q&b S/eml`2T;>"s] 3hjRymhKe@)<)dӎ^e`Bt(} hߌR-dRUqsJNng:g][X4rQ[!9QM磢yPY3[e4,F^U4C8- vQNB/V 7_º=ݠ `~ l+ᰫ۝`zI~f]4Y?]sɲpK~H49ueFdO0[2&ٍa~WD}RNV0g F~!$."OUC l9(,Wx*h$>`d%'(|;Wa+ ֘4 ̚XN- YB 7̚Z![zܗJ6FE~R*&-DF\"{[͸tQ%78UOcsa+G䵚Gkf ܠ~R)g LxI}jUH>5GFfY{MR]|G)3KXB=L_)s_ y;wM$6i#FW.t6V唌:D]TB|BdSw̅{|xυ_+>;k7)vEir0lт 2\\CL 6Qn?@?,<_xb,;FC K/NJpZ.N;{}{@]zX:G(V+hT?~3O_ȥU( ܴ>UBL; 7ѹQ1zU^BgQ"i [m~Ͷ{- MsJu`b;6m&F썻&4I%!TDCjI=/m_hGYcG,|K|fȜKLl35-ڑ1_C6Ӫk ao)L4Z&DCgZ;qi//})7Jqj2@Heexf fz"eS؁l(F åNˁ؄ l!]PN4dsb/r\Ci@#m]ζOyZZ`&qwW!~i^.O@< aش: xRr&N13õrU*ZDm}2 MS:H!zJ6BU1#$V֚uJAl\ 5C~}=ARm״Ϣ4uEֻpUa,K8ò[QMߙs%i ^?LٯZ@v3^{ >=-<&&QsK)b4ӓ,B,ËPJxfq#75Dijf͜,_ gF8Ԣىҫ)LJȣkoɽNKHO8c&QRv~c~o\ye#8!" {R`~o%6= #-任A@c,ؽ+.kWRLzro*w(#$ ;ʚi٦J) ҪHh?~~`qCyjIfe[MؘZzzC2`}b~#$*xH^E~|V1ϹG'W@)bE]15 Ra:TjY'+>mbKj'%e1OC K2h&ѧkI^یJ ě ].:`Է>A.`c7IOH_ĚtAv! LAROInMՠ C 785s@_bdsh=u)Nie~bw>1# 9DNPs"+&0W=*e t*n;^Wpn˜:Y,ҖxbV|kz\ 7|bUտ`G4Eݐ|ִ^!Y| яY/7&64FȪNN׵<]c$F/Ow$,˷!yA!Լ\QyQW iR&9FX(ȗJ}X(˼lb?oۗi!yLUj@ L-)-;LDg/vz틲]Pz{~mQ&\ˑ7+&Yuz,|8 ,ݞ+3ܓ>d]pm]8LF(*"~n:xv+`au60ȚD;@m *,|Տ^c:5'͌dIy)Iu`}I5f:2*&=3=BQbPx.^OCVI:h_miqO,4"e(&6.:&$aؖn;$3_#SӬ;Sk;/# BRRi4W0IdazjdlzmKC?նx FvIʠ^$w;yGC}o]UTXG:hmSDG:V,X/@ԡ|ھMu,qX Lgz`cúR;םA2E囜%>E ͐uaQgwNcLm!ch]ͺ}_A҂t%V2 GY# /nfZos9) daua"f]Yܧ~X {VtiiaFeS[2 8шXq¼1v0X !N$D8gqO°4?X\g frԡK=0tUDs'8Z7|JW6kI߁Hڡ6%)qjZ "(]M2ܦ;x,M  X|'6S@xpv< "jfJ7=v,f# [V,(_anjQ ;ʞzzNCZL]ֈ-u go,+ >b i&18Wz`lg|kJ]k a0g15^r2qq,J 漽M'x% GٔnRP2x\۱s~E}֖pv: _9 *!o6nC)m7A/WKN>м _Vݠڣ=CϞeŜ"u0LS\*^E՜1~Ф^))YadT+E@ڗGkuIb$sW7876~Xu3r3h ( s7/r*M&߅XܚӅDc)*2bEm/l!7iOI6Og<\@^ <ԟaϦ;X ۑ.Ryoy4-tGa'&OpW1# bb ^mEN|.IB-<8EH:'`vR3.nKYZS3[-FdTГgJ։iX`s^}82P =c~0 .U>RHtpIb:/xdٿZ9(urh}OV&-ѻ"+֘G^JDlilmP̥W]`FA*)DB`+v I EcBGΗ-3 "XOꏙ3}\*zP:&[*xtQ}&MC|o th>jaJ霷e,T8:w^xC_mƣQㅑJuW_SGx /zد ĤB Ys,ZװT SXwZHDzJkOc(` Q/.G;=C  )-& >Q}Vq FZ$] )#MgALӄ3l^G= ,Yb%înt[O1υaO$Q Sl \<<lY]eKg n>9,o)+ yf9D~gE*el_cx/| )!A>JL *m@dC97ebfqqҌ{Y)z_uM8t%MLu- 㿺mu}R| M x=h*py2W)Kaq0zmUi$sLd>`֓@z F ycEAihޠ+d)в:'kX`͵rn%(%jBc\iuEf&}WvX4)iH]eG4 OnV"7IKTj[&ż~AB(Jpn *B^o߷;Hk^e.~6۩__> S09gdp,z}IƼ/YW|Hp ^0<8aa9z"ZQ5@iڈlPLi479ɁЙEA?=jS,vއ[VwQ4.SF.825<ޫRuIU aK ]A1Q-zi ; ?7rn跡Rux6;W eq8cL~kvyE@z8>L0&.w%DH endstream endobj 134 0 obj << /Length1 2636 /Length2 11581 /Length3 0 /Length 13080 /Filter /FlateDecode >> stream xڍ83`Mwl&f3̘1L{>e]s.z}4:ҖP %Upqrpq`]A1A00"򇅬3.3wA!W{7/[@[P %!Y gqT ^ q_-,,;@ Cj.6 xF=@ \<'';l-pA02@5Lz Bjn ` B,Axv*@Xo6?psp߁́@9 XA U69򷡹= 7w3ۛ[ * 03 vtq9ro xvϮ5CB]k? xvϮ{@ F!ax? 47Ak@3?9o9|0c81`0w~PX8@˃?'/ P{WoiGQp–`3?3=do'*wr V.pV?*:7~[~4o@>EOG P{0CnnCl~x,PYCʁ;CG s!3[>;Y>x} =T Ntz``=__ p!dih? CXSxuŸ.6Π?f :ׇ%g:/t~{=w9@Wgxw]z>^@ sz  n&wg_9~{n*O궡(+vy›Cs|=rΐՂOjtm+ 0LՕgyG/ҚQ31DƖCc24]GQh$BB؏ۤ3eە).Sy{fJK8O3%R6? =7ѯ~'e >;s=4걌baeu@c+/o6Әra틱'o=H)v,3'iYR4#MVhrR:t(dz2XBޙфS~ӹ7JpfOj\:Elb@ϵ^wvӜvp`ϐU5l>n;@Q}R\nXA:D)4ض Ek#-žO\_/OEpX^TZH0'OލHTI?{έ$$*-  3/'b|ΘT4;\ hW;^=-w>]sE$S6 p%/e`vnW 8u]*h5g `"3sfTaU R fKY!ԓ|vDnےʮJ[/2L#DZ{9'utwA2Y\{fÂ*AU^LBl\dmm`g8˅e^ cGfO=*|ǀ)v6颲jg ThaR`rkx4GsI6O$?E ʉl E"冢KVoOjۥwvZu~EqMXRѯdVq0(Q -Fha]agw_GYp`^X,cݳ '~fͥ ьs2c (* Ck31  5q A⹤F?4jhl+1ɞκ p5>눾ȑSU"]__U4*w_^Ǹ\Qyk% nR#fM@%&m?hx G8o:^Ŝ'-11 &~BHP泲: LۺBtf7V A3;U¢zȻ(\ct}ʲChOoW6߇]+/j12;9 ~D>u5)yKP܎+ـ0p"2;RMm 6NpdEChbM4Dೄ?X.7KhS*=jb%@uz87q@ mD: ƅyfwyU Ż2b%bKXF>pUN]-  EıB#K,i\ Km[Oe_L]Lg'Xzj f89P"7#9&ޠS{' GƐg7stDZl6i]>E4׎~AygQv.܊6ܓd0W58d.'i lkP$KdPW)mańuݯr?bdlًUfK1Uu!bva׽ECr:!CjP4 uAU5A/ x3Ӝw4 GO=t;?P^_8c8iM]Lbz(Bo}UBF'?x1ZK%_=}k+kukP=nlMByMqz#qgH;8~j(yRТ7*+?Bb؃| ^Mw(פ!쮕';EEC7wnS\Ǥye w]zޚ@ۓ/؀#Qyq 3^?~n^·CL &݋uמxk$ 8]j*1d* 8ٸjwKg/L Itg,y.ToF+ƵST EY~_Z_{62ǀlhPھKr"/]hN2t#(8lX`Ʈ1*d^= OUkٟWtYC>ZTbNN1J=,{#m8sn̜S:prEb)9nLVBIBHRιFx2,3S_@ |` b]epq 7bvVx2 Dl[{\IЍ0)V(7Bzʌz(3}P|vQ-4W|+02 C51<[1OoH2֡+JqZN +Jӎoٖl^υ~ʭ],u~ [y? ^%yYO䫕7FDXCAMH8"yvdO5EK?ݒJmڒXͽZaE3.fRȭH8A5)  zE̩/"m_S:Gײ~Ļemj}o`.ȰziuJfdO= z@ǑnSA$_?7x,͡#E!&Hcd {i^@ħ#cKej2>*?ˇ u-}`/mu:utzk3r4dM3EAS7r9?xsWXI/_5[3~P$UŭO`x6 !9vK'/d9>mSp9P[SZx\MIJQ=/: 7C~+ "5Шͻ4BE@o-ˢJS4caeQ5IP? !0/X~RwVpSLa_KuMPႈ Z2%Ə'FZ(yuOlՏ$_1/b55g \ ecp"w W el"j2ImgseR_,n' C߬$` Z^)oi/p? F/0ڮt?kv{@~8%rg82o\WJqBXDZWm&LdrJ9?mɄ} ĘΎ{(6q6 -Оllj$i1NJZbq\rz]4[L|ľ<7/J젵Bjw?DZJI=:&gl}%Δ)XwSMmbZT(>'tttoMmЉ_gKLhGsZ8*B9)S~q!ܾGqHm@US;;bz^ ;/<ʈ66|M`XunU> ٨ -n、p]YOb?c?z`Ԑ_@6=8ǖÁ3հ ]$fi+>KHI .wƓ,g3=kғ,&(לUuCPQ3Qn)u7H\$Dž&I [*~¤V$ٕ\Vf&۲HX5>1D_K?Ft?Pe?e^}5zǩ 5lVk-2G^f~dụMPeuKL{E 1ʯ^1#,Mg%r?X`4< y {ާh'Q~\:Fu:>%Ͻ>;.Q KƉe>{-Ybڏ {}J}ȐWTM`S=2{#AAv\?O#ѿ/A%3e媾C3CuRpγ@L3_F}b{A k#hFIo}I*H*']\ř+T,~?v*U(-tG_zFc" 8I{L[WSȫng2}ovk+$O0|e%깅Н۰5Nܻl#z99xބi'G`9F? nZO=XG.w@2 ://]#7;Wb־H3 Gcǫc!k)J=Zu%ՖV k61$1@B=ui',W}; TU6.azm5+BzWcց#A9=_py&)2^"&,rubaR h.Qo +9$F A8?ԪT@c(`eL3u^\}1M'qKPAzX:›`C?iV^WO2v6:Kʓ͵e-7O;n v֌꨺26}+Jz~Z l:&/в׏lhTd~%(7p[箖(؊m>`*[Rudr Ryu+3Hu4ws؞@7Yo ~RnW<&>tRWNXWد.l=TKxd !^-&$3^Y Gp͝*EMH@7FvMR{lM5;^c]eL\CfuxT9t T 9 J岋TgFѧ&2 o]-ੁvb}^;3XQ T#!H#ˆ|vO/~1ÊszN N YP 4 q >I#Y#=dϕ#?ZJF4នddwqv+{ GDUpPhn GXgh>6Y+¨ dIrVOl#L- V9=@t$O&S]k"MEKhYdײM#RW4Gڽy\WbP;ôhLjGr[S03 /D ]YΥdBKW+)_ħ,3\RRYd\ͷ^tUZ)+SpQh}?gt$+bdTIrD2:|R2pf+6].+I6rA٩%`!z5؃4q+>?nQ| 8/*!\qǥi.GX/ʐwR Լ#,[K S -܌\ږC!%FU$spU3[S`N$+gѯIT DN"˖]D5oj=CT$8n!4ԴᕍXWBA P'h:$bKfaR kjSJa}hmS=Oچ[Qۯ}<57=)o)gb_tVuh"lV7|[ gr_[ w7BT ?OpGHKcԊHX'Z! &uNO|՟]1Xnjpȕtm単j7~| Bz]es]\)1)q=_ő gI=Lm\$lI7G~k%BQf7U uV?Q1; ؋F@,:AԸqPVCjI$ÅԛŶ;/`WuR)r h䕫զ!Fx UX9l I~77-W^Be?oh쇗OdA+)[#mUxdXoU0ga*[#1TSbU}3!:OF$3U )lP4h Q@@wJ^Q! lUH|%z@e1Ur{!rh2:mJ&01?xvy2MS}hH^z=džP}ƻ @odDܞxs!O'rD=oy/ =)9ЊBPEHjȁTϨn<1Y2m۳q5dl;Tؗ;~GxgwOG/.6b*'~H?!lh\¯;e@sԾ~N7L'Y/' -W#P]ISYk}ū'{骺^o _L¶ꢏ^X= B!m:;M';>f8<(]AlL1hPs k^R&XҝC7Ђ]ܓ1K1cb%,1],VdခߞͩuM$=*+N7djMG 5E[RIXN NcfĜaZҲ>dz"K,S]cH=cRqnw62Xgk2I wmNy‰؋d9uzB6v8~"$:k3 <>md`iV&#I4.f" FgLjO# Hi2sш܉8R}f]#&YF ŦGS۩b9u٩ٺjA2~UAB]T-ݒ2e$z3$cyY9S iWT>0JlhaRFΚ څWF`1kGj>^{6 edZ;7&OyqJVsxtFrn.k=Dl O?vlt.aF*²Ac(QbJL萌\ wm!gL[&\&h |#XnMi)@~ 5M#-TkR݈%ߏO*/+IUE,cƎjLoA%f~ +0Cîg<|U}f,r桼Z, B]X]@~cx"E֮ާtt_<m-^rs5^s(28%8 ojtb;kH\+]lZGڜ >e!4M6];=hW;PvdXYadJ]D1'k0ZDD-;5bXL$q/*/̗Zi2CѴ/:l9鵄҄g4 QkhELiߪLx $}K~^opUaܤV8];,M M-~z.wP7ϊ5:AOֆN654bɁ1]ŋ-K4^MhLg  Ե/əL޹#t5 o.HsE91X+u2=qyIҎn~}^I'pmLhmNHTYu$OO݆sevFu={L-ufxSk1K>T9 L~uv^͢]D/yuuO"sdüf;qŮRA|'~2\w|aO?/;6]2&Ux:PPODPO &|$/{e\lv+.OP! 0!5ak-Zb 6iO뙊P3KQƿ=O/`J@c^Nԑ<M86R`fNSPH/T4x}:eU}hK9wuJB\8XFqyA/H]i~=Hz`ҠƕoryV;Vt)c5ѻY`}b~(1b5 a/ PHK>~&v{TA`-%2]9nl@H"qIU6O*X֗Ehq[~ zywK=oF 4=&A kAi0Ī m-&h3Eɰ4x㽉'[Lܣgz7tA?FY!1db"c)Țlmaf˞x?ktIW~%xk|RZb>E뾟C Yɀ8P_f">~Sۣ0V1kKfvcb26,>z6_V0t/qiA~qedn!-jIW۫73'"{NureI|@典ٯU۸%[,aW4+(~=L&Nb_­|)~gB=SKK!u;eMݚY-& Z`,SN@ yI6MQY 60qGͤdW]Teny9=~6/]b[`(+@}C]RҪz.Vd y*53ia1l-]" !c3k/>jU|~I9 :-4(\ I=t *_`v>EqNV/o 3LИ3=ޯ~tѵs6rւݡ!{rI}t< TN<Wz{k溾#!t9mFYG rxNࡏ&:*]eg@ endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 810 /Length 4131 /Filter /FlateDecode >> stream x[Ys7~][ n̖kkuPىK#r$MC&~nRDʪڗX F D.0EQʅZ(#T c$ (JPtJt0`BXNx/\!DafE`:}ZtnxNP u,sXj7 !@R@U v?m8]^#ż+96 hbxFxn n %ȣ(0 ? ?DDDA ;Dw=X_@Qi7 s4 e& H@C`jl  Ё@, [MCAD=4V`}E'$sc F S[QDr kأCv>d7"%MB\d- *'u`KlZXꐡHAМb!qT/ dځH֋*BцC i8D8 GVgi(s*ↈ+n`\q␎>Oms*6m;>fމWNis=m2Gi5̚ U =]e$݊T4:M99UN*ֆ|]UM-=_ȋawԣTs>ˣZr"6Ohzr 2-'p:_W Y Vɲ;m*٭_}MUrPv8+`IBWĤ G[9mم r1x5^'F.G얄or]vێ:L PxAu*{ ZvjߞI ?dEn1>o, `Σ*peƪWP~-<Zvse%OHYٺlkH;{ kN߲b* ԃm[}W*e=4W)w/eCk&t-b OZp,j%,,dC/F Ls1K{[&3"2nT]0ӈqh#2GbEl5@QGd\XerZʽaG!ö.r̺et5*dخ8 rK!ptaEC7i5p+$?إ L;M< 8́|b፧]Q,;x 8AT$PZo M`/Xi> $,i+@NDe1K 5$X ?$KҊc'#(l\ 6qх-]k [wr.eܚv#@z7fm[N@*ҤՊDgk/Fw6C_- Ndʁ/,Yc`S:|뿴nm SF!qVB< 󡧲lo[أ!(Пig׏@czާ£]L +NS.sa xqSKm^v1ۣ[{֥y9kE%Vq'H0?368N.8ykxdFKiJIW0OP9 _S eݶ ZwM;s`( ((&>=Fɂp^D4B\9T=tA* a >  UE !Z":mi9C #%=S.ʖH [y:Їxϡ(4mӪ/kD<՗8R_T>+ KjmWrk֢Ћ o$j]aCC8TwӪF=Rjq 0` ӛd/W \ ^enM~G_"0[eF]$z^Jss%EỜKMԶ Z:xYbDR?HD˚M#FGp!g34`,$aߺT)/ +#UMn >BGV$qImN.8,afk83%;mdވٳjhn(ҵ7/qpQiLˉ;gΈgr/3T<yP^+FߑD)Wo^G fʲaGC8|}aky]Q=zՏu o&)чGay=}CsY'ECo7|}I!KՐ{c¾3*Te5euZ)tg@!ϙԇrX#X &ʽDr봚+U？)Oo;'\ K~TѪfwЯ~q56h$k.,[kmЬ3mm͞@c*Xqo3ќlzY61[d ||qqic.3)}oZdzeP6WA/ǫO2X9Gi `؊NQǿQ=\Iy]Iǩ$=Z)Ζ2ey1ys3gDvVN%OO7IJ+:> endobj 136 0 obj << /Type /ObjStm /N 21 /First 162 /Length 760 /Filter /FlateDecode >> stream xڕU]O0}ϯtӈ?DBHhA&BHtl~Nֹܴ_7Br".c> $8T781h((!ȑ01$A2*FAafKrKC@*!V)R  0ʄ( ruboYOM9)eVm+i"/晘lZ=V<>~n;r-pF/D=>G[te#G^|t~i;U zG7̔A8WDFoГmH{MK&.%zqԶvy܃c'C器^Ulaܙ{NY57.]Zk0OѕnKR^WweG8lN쒓Q=  ~Ub98'FUZT=u0*s8LgZrJ{N$‹&,)=Eb%{t1E=TeUi.UZeP[G6[zF̒:ll)lA-Id\'n s~E>!V $yvL.IJ|$Bv|yWؚOےԛ:TcOզc>)+mӶn}jzW :f[4) a9iYP9isr04ozi}w:3: endstream endobj 148 0 obj << /Type /XRef /Index [0 149] /Size 149 /W [1 3 1] /Root 146 0 R /Info 147 0 R /ID [<19985C1F452CF02100F3BF125DF7B919> <19985C1F452CF02100F3BF125DF7B919>] /Length 388 /Filter /FlateDecode >> stream x%KOSQQ[Zr (BߕIdȎ30a&NDN|{}YdDf)llp$)hnj'IGR;A:p''*ARfq  x+\-%]z d]aAJ˟m6h4d" a z +ksP yYvw/u*˧VkN6ب A/`/7&ܒ$ fQ 0%[wLC f`>ado~CFd<=}D{S)5as뚧_O/Wҟ׊29Ooվc&'0/y HNBJQTvq:u endstream endobj startxref 156658 %%EOF phangorn/inst/doc/Ancestral.R0000644000175100001440000000632012547505677015710 0ustar hornikusers### R code from vignette source 'Ancestral.Rnw' ################################################### ### code chunk number 1: Ancestral.Rnw:44-46 ################################################### options(width=70) foo <- packageDescription("phangorn") ################################################### ### code chunk number 2: Ancestral.Rnw:61-66 ################################################### library(phangorn) primates = read.phyDat("primates.dna", format = "phylip", type = "DNA") tree = pratchet(primates, trace=0) tree = acctran(tree, primates) parsimony(tree, primates) ################################################### ### code chunk number 3: Ancestral.Rnw:72-74 ################################################### anc.acctran = ancestral.pars(tree, primates, "ACCTRAN") anc.mpr = ancestral.pars(tree, primates, "MPR") ################################################### ### code chunk number 4: plotLOGO ################################################### tmp <- require(seqLogo) if(tmp) seqLogo( t(subset(anc.mpr, getRoot(tree), 1:20)[[1]]), ic.scale=FALSE) ################################################### ### code chunk number 5: figLOGO ################################################### getOption("SweaveHooks")[["fig"]]() tmp <- require(seqLogo) if(tmp) seqLogo( t(subset(anc.mpr, getRoot(tree), 1:20)[[1]]), ic.scale=FALSE) ################################################### ### code chunk number 6: Ancestral.Rnw:93-95 ################################################### options(SweaveHooks=list(fig=function() par(mar=c(2.1, 4.1, 2.1, 2.1)))) ################################################### ### code chunk number 7: plotMPR ################################################### par(mfrow=c(2,1)) plotAnc(tree, anc.mpr, 17) title("MPR") plotAnc(tree, anc.acctran, 17) title("ACCTRAN") ################################################### ### code chunk number 8: figMPR ################################################### getOption("SweaveHooks")[["fig"]]() par(mfrow=c(2,1)) plotAnc(tree, anc.mpr, 17) title("MPR") plotAnc(tree, anc.acctran, 17) title("ACCTRAN") ################################################### ### code chunk number 9: Ancestral.Rnw:122-124 ################################################### fit = pml(tree, primates) fit = optim.pml(fit, model="F81", control = pml.control(trace=0)) ################################################### ### code chunk number 10: Ancestral.Rnw:136-138 ################################################### anc.ml = ancestral.pml(fit, "ml") anc.bayes = ancestral.pml(fit, "bayes") ################################################### ### code chunk number 11: plotMLB ################################################### par(mfrow=c(2,1)) plotAnc(tree, anc.ml, 17) title("ML") plotAnc(tree, anc.bayes, 17) title("Bayes") ################################################### ### code chunk number 12: figMLB ################################################### getOption("SweaveHooks")[["fig"]]() par(mfrow=c(2,1)) plotAnc(tree, anc.ml, 17) title("ML") plotAnc(tree, anc.bayes, 17) title("Bayes") ################################################### ### code chunk number 13: Ancestral.Rnw:162-163 ################################################### toLatex(sessionInfo()) phangorn/inst/doc/Trees.R0000644000175100001440000001531712547505677015064 0ustar hornikusers### R code from vignette source 'Trees.Rnw' ################################################### ### code chunk number 1: Trees.Rnw:48-50 ################################################### options(width=70) foo <- packageDescription("phangorn") ################################################### ### code chunk number 2: Trees.Rnw:66-68 ################################################### library(phangorn) primates = read.phyDat("primates.dna", format="phylip", type="DNA") ################################################### ### code chunk number 3: Trees.Rnw:75-78 ################################################### dm = dist.ml(primates) treeUPGMA = upgma(dm) treeNJ = NJ(dm) ################################################### ### code chunk number 4: plotNJ ################################################### layout(matrix(c(1,2), 2, 1), height=c(1,2)) par(mar = c(.1,.1,.1,.1)) plot(treeUPGMA, main="UPGMA") plot(treeNJ, "unrooted", main="NJ") ################################################### ### code chunk number 5: figNJ ################################################### getOption("SweaveHooks")[["fig"]]() layout(matrix(c(1,2), 2, 1), height=c(1,2)) par(mar = c(.1,.1,.1,.1)) plot(treeUPGMA, main="UPGMA") plot(treeNJ, "unrooted", main="NJ") ################################################### ### code chunk number 6: Trees.Rnw:100-102 ################################################### parsimony(treeUPGMA, primates) parsimony(treeNJ, primates) ################################################### ### code chunk number 7: Trees.Rnw:105-108 ################################################### treePars = optim.parsimony(treeUPGMA, primates) treeRatchet = pratchet(primates, trace = 0) parsimony(c(treePars, treeRatchet), primates) ################################################### ### code chunk number 8: Trees.Rnw:111-112 (eval = FALSE) ################################################### ## (trees <- bab(subset(primates,1:10))) ################################################### ### code chunk number 9: Trees.Rnw:118-120 ################################################### fit = pml(treeNJ, data=primates) fit ################################################### ### code chunk number 10: Trees.Rnw:123-124 ################################################### methods(class="pml") ################################################### ### code chunk number 11: Trees.Rnw:127-129 ################################################### fitJC = optim.pml(fit, TRUE) logLik(fitJC) ################################################### ### code chunk number 12: Trees.Rnw:132-136 ################################################### fitGTR = update(fit, k=4, inv=0.2) fitGTR = optim.pml(fitGTR, TRUE,TRUE, TRUE, TRUE, TRUE, control = pml.control(trace = 0)) fitGTR ################################################### ### code chunk number 13: Trees.Rnw:139-140 ################################################### anova(fitJC, fitGTR) ################################################### ### code chunk number 14: Trees.Rnw:143-145 ################################################### AIC(fitGTR) AIC(fitJC) ################################################### ### code chunk number 15: Trees.Rnw:148-149 ################################################### SH.test(fitGTR, fitJC) ################################################### ### code chunk number 16: Trees.Rnw:152-153 ################################################### load("Trees.RData") ################################################### ### code chunk number 17: Trees.Rnw:155-156 (eval = FALSE) ################################################### ## mt = modelTest(primates) ################################################### ### code chunk number 18: Trees.Rnw:160-162 ################################################### library(xtable) xtable(mt, caption="Summary table of modelTest", label="tab:modelTest") ################################################### ### code chunk number 19: Trees.Rnw:166-169 ################################################### env <- attr(mt, "env") ls(envir=env) (fit <- eval(get("HKY+G+I", env), env)) ################################################### ### code chunk number 20: Trees.Rnw:173-175 (eval = FALSE) ################################################### ## bs = bootstrap.pml(fitJC, bs=100, optNni=TRUE, ## control = pml.control(trace = 0)) ################################################### ### code chunk number 21: plotBS ################################################### par(mar=c(.1,.1,.1,.1)) plotBS(fitJC$tree, bs) ################################################### ### code chunk number 22: figBS ################################################### getOption("SweaveHooks")[["fig"]]() par(mar=c(.1,.1,.1,.1)) plotBS(fitJC$tree, bs) ################################################### ### code chunk number 23: Trees.Rnw:199-201 ################################################### options(prompt=" ") options(continue=" ") ################################################### ### code chunk number 24: Trees.Rnw:203-226 (eval = FALSE) ################################################### ## library(parallel) # supports parallel computing ## library(phangorn) ## file="myfile" ## dat = read.phyDat(file) ## dm = dist.ml(dat) ## tree = NJ(dm) ## # as alternative for a starting tree: ## tree <- pratchet(dat) ## ## # 1. alternative: estimate an GTR model ## fitStart = pml(tree, dat, k=4, inv=.2) ## fit = optim.pml(fitStart, TRUE, TRUE, TRUE, TRUE, TRUE) ## ## # 2. alternative: modelTest ## (mt <- modelTest(dat, multicore=TRUE)) ## mt$Model[which.min(mt$BIC)] ## # choose best model from the table, assume now GTR+G+I ## env = attr(mt, "env") ## fitStart = eval(get("GTR+G+I", env), env) ## fitStart = eval(get(mt$Model[which.min(mt$BIC)], env), env) ## fit = optim.pml(fitStart, optNni=TRUE, optGamma=TRUE, optInv=TRUE, ## model="GTR") ## bs = bootstrap.pml(fit, bs=100, optNni=TRUE, multicore=TRUE) ################################################### ### code chunk number 25: Trees.Rnw:230-244 (eval = FALSE) ################################################### ## library(parallel) # supports parallel computing ## library(phangorn) ## file="myfile" ## dat = read.phyDat(file, type = "AA") ## dm = dist.ml(dat, model="JTT") ## tree = NJ(dm) ## ## (mt <- modelTest(dat, model=c("JTT", "LG", "WAG"), multicore=TRUE)) ## fitStart = eval(get(mt$Model[which.min(mt$BIC)], env), env) ## ## fitNJ = pml(tree, dat, model="JTT", k=4, inv=.2) ## fit = optim.pml(fitNJ, optNni=TRUE, optInv=TRUE, optGamma=TRUE) ## fit ## bs = bootstrap.pml(fit, bs=100, optNni=TRUE, multicore=TRUE) ################################################### ### code chunk number 26: Trees.Rnw:252-253 ################################################### toLatex(sessionInfo()) phangorn/tests/0000755000175100001440000000000012536105544013253 5ustar hornikusersphangorn/tests/testthat.R0000644000175100001440000000013412536103645015234 0ustar hornikuserslibrary(testthat) suppressPackageStartupMessages(library(phangorn)) test_check("phangorn") phangorn/tests/testthat/0000755000175100001440000000000012547516461015121 5ustar hornikusersphangorn/tests/testthat/test_treedist.R0000644000175100001440000000126012536122071020111 0ustar hornikuserscontext("treedist") test_that("Robinson-Foulds distance", { skip_on_cran() tree1 = read.tree(text="(t5:1.0,(t4:1.0,t3:1.0):1.0,(t1:1.0,t2:1.0):1.0);") tree2 = read.tree(text="(t4:1.0,(t5:1.0,t3:1.0):1.0,(t1:1.0,t2:1.0):1.0);") tree3 = read.tree(text="(t5:1.0,t4:1.0,t3:1.0,(t1:1.0,t2:1.0):1.0);") expect_that(RF.dist(tree1, tree1), is_equivalent_to(0)) expect_that(RF.dist(tree1, tree2), is_equivalent_to(2)) expect_that(RF.dist(tree1, tree3), is_equivalent_to(1)) expect_that(treedist(tree1, tree1)[1], is_equivalent_to(0)) expect_that(treedist(tree1, tree2)[1], is_equivalent_to(2)) expect_that(treedist(tree1, tree3)[1], is_equivalent_to(1)) })phangorn/tests/testthat/test_phyDat.R0000644000175100001440000000126312536331004017520 0ustar hornikuserscontext("conversion_and_subsetting") data(Laurasiatherian) phy_matrix <- as.character(Laurasiatherian) phy_df <- as.data.frame(Laurasiatherian) phy_dnabin <- as.DNAbin(Laurasiatherian) phy_align <- phyDat2alignment(Laurasiatherian) test_that("conversion work as expected", { skip_on_cran() expect_that(phy_matrix, is_a("matrix")) expect_that(phy_df, is_a("data.frame")) expect_that(phy_dnabin, is_a("DNAbin")) expect_that(phy_align, is_a("alignment")) expect_that(as.phyDat(phy_matrix), is_a("phyDat")) expect_that(as.phyDat(phy_df), is_a("phyDat")) expect_that(as.phyDat(phy_dnabin), is_a("phyDat")) expect_that(as.phyDat(phy_align), is_a("phyDat")) })phangorn/tests/testthat/test_parsimony.R0000644000175100001440000000111112536331004020300 0ustar hornikuserscontext("parsimony") tree1 = read.tree(text = "((t1,t2),t3,t4);") tree2 = read.tree(text = "((t1,t3),t2,t4);") dat <- phyDat(c(t1="a", t2="a",t3="t",t4="t"), type="USER", levels=c("a","c","g","t")) #tr_acctran = acctran(tree1, dat) #tr_ratchet = pratchet(dat, trace=0) #bab(dat) test_that("parsimony works properly", { skip_on_cran() expect_that(fitch(tree1, dat), equals(1)) expect_that(fitch(tree2, dat), equals(2)) expect_that(sankoff(tree1, dat), equals(1)) expect_that(sankoff(tree2, dat), equals(2)) expect_that(parsimony(tree1, dat), equals(1)) }) phangorn/src/0000755000175100001440000000000012547505677012715 5ustar hornikusersphangorn/src/Makevars0000644000175100001440000000015512547505677014412 0ustar hornikusersPKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(SHLIB_OPENMP_CFLAGS) PKG_CFLAGS = $(SHLIB_OPENMP_CFLAGS) phangorn/src/fitch.c0000644000175100001440000004623512547505677014170 0ustar hornikusers#define USE_RINTERNALS #include #include #include #include // use R_len_t stat int, e.g. nr double huge = 1.0e300; static int *data1, *data2; static double *weight; void fitch_free(){ free(data1); free(data2); free(weight); } // type of fitch depending on nc e.g. int, long generic C++ void fitch_init(int *data, int *m, int *n, double *weights, int *nr) { int i; data1 = (int *) calloc(*n, sizeof(int)); data2 = (int *) calloc(*n, sizeof(int)); weight = (double *) calloc(*nr, sizeof(double)); for(i=0; i<*m; i++) data1[i] = data[i]; for(i=0; i<*nr; i++) weight[i] = weights[i]; } int bitcount(int x){ int count; for (count=0; x != 0; x>>=1) if ( x & 01) count++; return count; } void bitCount(int *x, int *count){ count[0]=bitcount(x[0]); } void addOne(int *edge, int *tip, int *ind, int *l, int *m, int *result){ int add = 1L, j=0L, p, k, i, l2=*l+2L, ei; p = edge[*ind-1L]; k = edge[*ind-1L + *l]; for(i=0; i<*l; i++){ ei = edge[i]; if( (add==1L) && (ei==p) ){ result[j] = *m; result[j+l2] = k; j++; result[j] = *m; result[j+l2] = *tip; j++; add=0L; } if(i== (*ind-1L)) result[j+l2] = *m; else result[j+l2] = edge[i+ *l]; result[j] = edge[i]; j++; } } SEXP AddOne(SEXP edge, SEXP tip, SEXP ind, SEXP l, SEXP m){ SEXP result; PROTECT(result = allocMatrix(INTSXP, INTEGER(l)[0]+2L, 2L)); addOne(INTEGER(edge), INTEGER(tip), INTEGER(ind), INTEGER(l), INTEGER(m), INTEGER(result)); UNPROTECT(1); return(result); } void fitch43(int *dat1, int *dat2, int *nr, int *pars, double *weight, double *w){ int k, tmp; for(k = 0; k < (*nr); k++){ tmp = dat1[k] & dat2[k]; if(!tmp){ tmp = dat1[k] | dat2[k]; (pars[k])++; (*w)+=weight[k]; } dat1[k] = tmp; } } void fitch44(int *res, int *dat1, int *dat2, int *nr, int *pars, double *weight, double *w){ int k, tmp; for(k = 0; k < (*nr); k++){ tmp = dat1[k] & dat2[k]; if(!tmp){ tmp = dat1[k] | dat2[k]; (pars[k])++; (*w)+=weight[k]; } res[k] = tmp; } } void fitch53(int *dat1, int *dat2, int *nr, double *weight, double *w){ int k, tmp; for(k = 0; k < (*nr); k++){ tmp = dat1[k] & dat2[k]; if(!tmp){ tmp = dat1[k] | dat2[k]; (*w)+=weight[k]; } dat1[k] = tmp; } } void fitch54(int *res, int *dat1, int *dat2, int *nr, double *weight, double *w){ int k, tmp; for(k = 0; k < (*nr); k++){ tmp = dat1[k] & dat2[k]; if(!tmp){ tmp = dat1[k] | dat2[k]; (*w)+=weight[k]; } res[k] = tmp; } } SEXP FITCHTRIP3(SEXP DAT3, SEXP nrx, SEXP edge, SEXP score, SEXP PS){ R_len_t i, m = length(edge); int nr=INTEGER(nrx)[0], k, tmp, ei, *edges=INTEGER(edge); int d3=INTEGER(DAT3)[0] - 1; double *pvtmp; double ps = REAL(PS)[0]; SEXP pvec; PROTECT(pvec = allocVector(REALSXP, m)); pvtmp = REAL(pvec); for(i=0; ips)break; } // if(pvtmp[i] 0L){ dat1[k] = tmp; } } } void fitchT3(int *dat1, int *dat2, int *nr, double *pars, double *weight, double *w){ int k; int tmp; for(k = 0; k < (*nr); k++){ tmp = dat1[k] & dat2[k]; if(tmp==0L) { (*w)+=weight[k]; pars[k] += 1; } if(tmp >0){ if(tmp < dat2[k]){ (*w)+= .5*weight[k]; pars[k] += .5; } } } } // return lower and upper bound for the number of changes // upper bound very conservative void countMPR(double *res, int *dat1, int *dat2, int *nr, double *weight, int *external){ int k; int tmp; for(k = 0; k < (*nr); k++){ tmp = dat1[k] & dat2[k]; if(tmp==0){ res[0] += weight[k]; res[1] += weight[k]; } else{ if( external[0]==0L){ if( bitcount(dat1[k] | dat2[k])>1L ) res[1] += weight[k]; // dat1[k] != dat2[k] } else{ if( tmp < dat2[k] ) res[1] += weight[k]; } } } } void ACCTRAN2(int *dat, int *nr, double *pars, int *node, int *edge, int *nl, double *weight, double *pvec, int *nTips) { int i; for (i=0; i< *nl; i++) { if(edge[i]>nTips[0]) fitchT(&dat[(edge[i]-1L) * (*nr)], &dat[(node[i]-1) * (*nr)], nr, pars, weight, &pvec[i]); } } void ACCTRAN3(int *dat, int *nr, double *pars, int *node, int *edge, int *nl, double *weight, double *pvec, int *nTips) { int i; for (i=0; i< *nr; i++)pars[i]=0.0; for(i=0; i< *nl; i++)pvec[i] = 0.0; for (i=0; i< *nl; i++) { fitchT3(&dat[(edge[i]-1L) * (*nr)], &dat[(node[i]-1) * (*nr)], nr, pars, weight, &pvec[i]); } } void fitchNNN(int d1, int d2){ int tmp; tmp = d1 & d2; if(tmp) d1 = tmp; else d1 = d1 | d2; } // haeufig 0 void fitchTripletNew(int *res, int *dat1, int *dat2, int *dat3, int *nr) { int k, v1, v2, v3; for(k = 0; k < (*nr); k++){ v1 = dat1[k]; fitchNNN(v1, dat2[k]); fitchNNN(v1, dat3[k]); v2 = dat1[k]; fitchNNN(v2, dat3[k]); fitchNNN(v2, dat2[k]); v3 = dat2[k]; fitchNNN(v3, dat3[k]); fitchNNN(v3, dat1[k]); res[k] = v1 & v2; // &v3[k]; res[k] = res[k] & v3; } } void fitchN(int *dat1, int *dat2, int *nr){ int k; int tmp; for(k = 0; k < (*nr); k++){ tmp = dat1[k] & dat2[k]; if(tmp) dat1[k] = tmp; else dat1[k] = dat1[k] | dat2[k]; } } // MPR reconstruction nicht immer gleiches ergebnis void fitchTriplet(int *res, int *dat1, int *dat2, int *dat3, int *nr) { int k; // ni, // ni = 0; int *v1, *v2, *v3; v1 = (int *) R_alloc(*nr, sizeof(int)); v2 = (int *) R_alloc(*nr, sizeof(int)); v3 = (int *) R_alloc(*nr, sizeof(int)); for(k = 0; k < (*nr); k++) v1[k] = dat1[k]; fitchN(v1, dat2, nr); fitchN(v1, dat3, nr); for(k = 0; k < (*nr); k++) v2[k] = dat1[k]; fitchN(v2, dat3, nr); fitchN(v2, dat2, nr); for(k = 0; k < (*nr); k++) v3[k] = dat2[k]; fitchN(v3, dat3, nr); fitchN(v3, dat1, nr); for(k = 0; k < (*nr); k++)res[k] = v1[k] & v2[k]; // &v3[k]; for(k = 0; k < (*nr); k++)res[k] = res[k] & v3[k]; } void prepRooted(int *res, int *nr, int *kids){ //int *data1, fitchTriplet(res, &data1[*nr * (kids[0]-1L)], &data1[*nr * (kids[1]-1L)], &data1[*nr * (kids[2]-1L)], nr); } void C_MPR(int *res, int *nr, int *parent, int *kids, int *nl) { int p, k1, k2; int i = *nl -1; while (i > 0L) { p = parent[i] - 1L; k1 = kids[i] - 1L; k2 = kids[i-1L] - 1L; fitchTriplet(&res[*nr * p], &data1[*nr* (k1)], &data1[*nr* (k2) ], &data2[*nr * p], nr); i -= 2L; } } SEXP C_MPR2(SEXP nrx, SEXP PARENT, SEXP KIDS, SEXP nlx, SEXP M) { int nr=INTEGER(nrx)[0], nl=INTEGER(nlx)[0], m=INTEGER(M)[0], *res; int *parent = INTEGER(PARENT), *kids=INTEGER(KIDS); int j, p, k1, k2; int i = nl -1; SEXP RES; PROTECT(RES = allocVector(INTSXP, nr * m)); res = INTEGER(RES); for(j = 0; j < (nr * m); j++) res[j]=0; while (i > 0L) { p = parent[i] - 1L; k1 = kids[i] - 1L; k2 = kids[i-1L] - 1L; fitchTripletNew(&res[nr * p], &data1[nr * k1], &data1[nr * k2], &data2[nr * p], &nr); i -= 2L; } UNPROTECT(1); return(RES); } void fitchNACC2(int *root, int *dat, int *nr, double *pars, int *result, double *weight, double *pars1){ int k; int tmp; for(k = 0; k < (*nr); k++){ // result[k] = 0L; tmp = root[k] & dat[k]; if(tmp==0L) { pars[0] += weight[k]; pars1[k] += weight[k]; } if(tmp >0){ if(tmp < root[k]){ pars[0] += .5*weight[k]; pars1[k] += .5*weight[k]; result[k] += 1L; } } } } void fitchTripletACC4(int *root, int *dat1, int *dat2, int *dat3, int *nr, double *p1, double *p2, double *p3, double *weight, double *pars1, int *v1) { int k; int tmp, a, b, c, t1, t2, t3; double d, f; for(k = 0; k < (*nr); k++){ tmp = root[k]; a = dat1[k] & dat2[k]; b = dat1[k] & dat3[k]; c = dat2[k] & dat3[k]; if((a+b+c) == 0L){ d = (2.0/3.0) * weight[k]; p1[0] += d; p2[0] += d; p3[0] += d; pars1[k] += 2*weight[k]; v1[k] = 2L; } else{ f = 0.0; d = weight[k]; t1 = 0.0; t2 = 0.0; t3 = 0.0; if( (dat1[k] & tmp)0.0){ pars1[k] += weight[k]; p1[0] += t1/f; p2[0] += t2/f; p3[0] += t3/f; v1[k] += 1L; } } } } SEXP FITCH345(SEXP nrx, SEXP node, SEXP edge, SEXP l, SEXP mx, SEXP ps){ int *nr=INTEGER(nrx), m=INTEGER(mx)[0], i; double *pvtmp; SEXP pars, pscore; PROTECT(pars = allocVector(INTSXP, *nr)); PROTECT(pscore = allocVector(REALSXP, 1L)); pvtmp = (double *) R_alloc(m, sizeof(double)); for(i=0; i #include // The initial code defining and initialising the translation table: // //"a" "r" "n" "d" "c" "q" "e" "g" "h" "i" "l" "k" "m" "f" "p" "s" "t" "w" "y" "v" "b" "z" "x" // "-" "?" // // for (i = 0; i < 122; i++) tab_trans[i] = 0x00; // // tab_trans[65] = 0x88; /* A */ // tab_trans[71] = 0x48; /* G */ // tab_trans[67] = 0x28; /* C */ // tab_trans[84] = 0x18; /* T */ // tab_trans[82] = 0xc0; /* R */ // tab_trans[77] = 0xa0; /* M */ // tab_trans[87] = 0x90; /* W */ // tab_trans[83] = 0x60; /* S */ // tab_trans[75] = 0x50; /* K */ // tab_trans[89] = 0x30; /* Y */ // tab_trans[86] = 0xe0; /* V */ // tab_trans[72] = 0xb0; /* H */ // tab_trans[68] = 0xd0; /* D */ // tab_trans[66] = 0x70; /* B */ // tab_trans[78] = 0xf0; /* N */ // // tab_trans[97] = 0x88; /* a */ // tab_trans[103] = 0x48; /* g */ // tab_trans[99] = 0x28; /* c */ // tab_trans[116] = 0x18; /* t */ // tab_trans[114] = 0xc0; /* r */ // tab_trans[109] = 0xa0; /* m */ // tab_trans[119] = 0x90; /* w */ // tab_trans[115] = 0x60; /* s */ // tab_trans[107] = 0x50; /* k */ // tab_trans[121] = 0x30; /* y */ // tab_trans[118] = 0xe0; /* v */ // tab_trans[104] = 0xb0; /* h */ // tab_trans[100] = 0xd0; /* d */ // tab_trans[98] = 0x70; /* b */ // tab_trans[110] = 0xf0; /* n */ // // tab_trans[45] = 0x04; /* - */ // tab_trans[63] = 0x02; /* ? */ static const int tab_trans2[] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0-9 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 10-19 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 20-29 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 30-39 */ 0, 0, 0, 0, 0, 24, 0, 0, 0, 0, /* 40-49 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 50-59 */ 0, 0, 0, 25, 0, 1, 21, 5, 4, 7, /* 60-69 */ 14, 8, 9, 10, 0, 12, 11, 13, 3, 0, /* 70-79 */ 15, 6, 2, 16, 17, 0, 20, 18, 23, 19, /* 80-89 */ 22, 0, 0, 0, 0, 0, 0, 1, 21, 5, /* 90-99 */ 4, 7, 14, 8, 9, 10, 0, 12, 11, 13, /* 100-109 */ 3, 0, 15, 6, 2, 16, 17, 0, 20, 18, /* 110-119 */ 23, 19, 22, 0, 0, 0, 0, 0, 0, 0, /* 120-129 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 130-139 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 140-149 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 150-159 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 160-169 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 170-179 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 180-189 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 190-199 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 200-209 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 210-219 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 220-229 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 230-239 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 240-249 */ 0, 0, 0, 0, 0, 0}; /* 250-255 */ static const unsigned char hook = 0x3e; static const unsigned char lineFeed = 0x0a; /* static const unsigned char space = 0x20; */ // needs buffer seq // + buffer names SEXP rawStream2phyDat(SEXP x) { int N, i, j, k, n, startOfSeq; unsigned char *xr, *bufferNames; int *rseq, *buffer, tmp; SEXP obj, nms, seq; PROTECT(x = coerceVector(x, RAWSXP)); N = LENGTH(x); xr = RAW(x); /* do a 1st pass to find the number of sequences this code should be robust to '>' present inside a label or in the header text before the sequences */ n = j = 0; /* use j as a flag */ if (xr[0] == hook) { j = 1; startOfSeq = 0; } i = 1; for (i = 1; i < N; i++) { if (j && xr[i] == lineFeed) { n++; j = 0; } else if (xr[i] == hook) { if (!n) startOfSeq = i; j = 1; } } PROTECT(obj = allocVector(VECSXP, n)); PROTECT(nms = allocVector(STRSXP, n)); /* Refine the way the size of the buffer is set? */ buffer = (int *)R_alloc(N, sizeof(int *)); bufferNames = (unsigned char *)R_alloc(N, sizeof(unsigned char *)); i = startOfSeq; j = 0; /* gives the index of the sequence */ while (i < N) { /* 1st read the label... */ i++; k = 0; while (xr[i] != lineFeed) bufferNames[k++] = xr[i++]; bufferNames[k] = '\0'; SET_STRING_ELT(nms, j, mkChar((char *)bufferNames)); /* ... then read the sequence */ n = 0; while (i < N && xr[i] != hook) { tmp = tab_trans2[xr[i++]]; /* If we are sure that the FASTA file is correct (ie, the sequence on a single line and only the IUAPC code (plus '-' and '?') is used, then the following check would not be needed; additionally the size of tab_trans could be restriced to 0-121. This check has the advantage that all invalid characters are simply ignored without causing error -- except if '>' occurs in the middle of a sequence. */ if(tmp) buffer[n++] = tmp; } PROTECT(seq = allocVector(INTSXP, n)); rseq = INTEGER(seq); for (k = 0; k < n; k++) rseq[k] = buffer[k]; SET_VECTOR_ELT(obj, j, seq); UNPROTECT(1); j++; } setAttrib(obj, R_NamesSymbol, nms); UNPROTECT(3); return obj; } phangorn/src/sankoff.c0000644000175100001440000002035712547505677014517 0ustar hornikusers/* * dist.c * * (c) 2008-2015 Klaus Schliep (klaus.schliep@gmail.com) * * * This code may be distributed under the GNU GPL * */ # define USE_RINTERNALS #include #include #include #include #include SEXP C_rowMin(SEXP sdat, SEXP sn, SEXP sk){ int i, h, n=INTEGER(sn)[0], k=INTEGER(sk)[0]; double x, *res, *dat; SEXP result; PROTECT(result = allocVector(REALSXP, n)); res = REAL(result); PROTECT(sdat = coerceVector(sdat, REALSXP)); dat = REAL(sdat); for(i = 0; i < n; i++){ x = dat[i]; for(h = 1; h< k; h++) {if(dat[i + h*n] < x) x=dat[i + h*n];} res[i] = x; } UNPROTECT(2); return(result); } void rowMin2(double *dat, int n, int k, double *res){ int i, h; double x; for(i = 0; i < n; i++){ x = dat[i]; for(h = 1; h< k; h++) {if(dat[i + h*n] < x) x=dat[i + h*n];} res[i] = x; } } void rowMinInt(int *dat, int n, int k, int *res){ int i, h; int x; for(i = 0; i < n; i++){ x = dat[i]; for(h = 1; h< k; h++) {if(dat[i + h*n] < x) x=dat[i + h*n];} res[i] = x; } } void sankoff4(double *dat, int n, double *cost, int k, double *result){ int i, j, h; double tmp[k], x; for(i = 0; i < n; i++){ for(j = 0; j < k; j++){ for(h = 0; h< k; h++){tmp[h] = dat[i + h*n] + cost[h + j*k];} x = tmp[0]; for(h = 1; h< k; h++) {if(tmp[h]=0; j--) { PROTECT(result = allocMatrix(REALSXP, nrx, ncx)); res = REAL(result); if (pj != nodes[j]) { for(i=0; i<(nrx * ncx); i++) tmp[i] = 0.0; sankoff4(REAL(VECTOR_ELT(dlist, nodes[j])), nrx, cost, ncx, tmp); for(i=0; i<(nrx * ncx); i++) res[i] = tmp[i] ; pj = nodes[j]; start = j; } else for(i=0; i<(nrx * ncx); i++) res[i] = tmp[i] ; k = start; while (k >= 0 && pj == nodes[k]) { if (k != j) sankoff4(REAL(VECTOR_ELT(data, edges[k])), nrx, cost, ncx, res); k--; } SET_VECTOR_ELT(dlist, edges[j], result); UNPROTECT(1); } UNPROTECT(1); return(dlist); } SEXP sankoffMPR(SEXP dlist, SEXP plist, SEXP scost, SEXP nr, SEXP nc, SEXP node, SEXP edge){ R_len_t i, n = length(node); int nrx=INTEGER(nr)[0], ncx=INTEGER(nc)[0], n0; int ei, j, *nodes=INTEGER(node), *edges=INTEGER(edge); SEXP result, dlist2; //tmp, double *res, *cost; // *rtmp, cost = REAL(scost); n0 = nodes[n-1L]; PROTECT(dlist2 = allocVector(VECSXP, n+1L)); PROTECT(result = allocMatrix(REALSXP, nrx, ncx)); res = REAL(result); for(j=0;j<(nrx*ncx);j++)res[j]=0.0; for(j=n-1L; j>=0; j--) { if(nodes[j]!=n0){ SET_VECTOR_ELT(dlist2, n0, result); UNPROTECT(1); n0 = nodes[j]; PROTECT(result = allocMatrix(REALSXP, nrx, ncx)); res = REAL(result); for(i=0; i<(nrx * ncx); i++) res[i] = 0.0; sankoff4(REAL(VECTOR_ELT(plist,nodes[j])), nrx, cost, ncx, res); } ei = edges[j]; sankoff4(REAL(VECTOR_ELT(dlist,ei)), nrx, cost, ncx, res); } SET_VECTOR_ELT(dlist2, n0, result); UNPROTECT(2); return(dlist2); } phangorn/src/ml.c0000644000175100001440000013027612547505677013502 0ustar hornikusers/* * ml.c * * (c) 2008-2015 Klaus Schliep (klaus.schliep@gmail.com) * * * This code may be distributed under the GNU GPL * */ # define USE_RINTERNALS #include #include #include #include #include #define LINDEX(i, k) (i - ntips - 1L) * (nr * nc) + k * ntips * (nr * nc) // index for LL #define LINDEX2(i, k) (i - *ntips - 1L) * (*nr* *nc) + k * *ntips * (*nr * *nc) // index for scaling matrix SCM #define LINDEX3(i, j) (i - *ntips - 1L) * *nr + j * *ntips * *nr char *transa = "N", *transb = "N"; double one = 1.0, zero = 0.0; int ONE = 1L; const double ScaleEPS = 1.0/4294967296.0; const double ScaleMAX = 4294967296.0; const double LOG_SCALE_EPS = -22.18070977791824915926; // 2^64 = 18446744073709551616 static double *LL; static int *SCM, *XXX; void ll_free(){ free(LL); free(SCM); } /* LL likelihood for internal edges SCM scaling coefficients nNodes, nTips, kmax */ void ll_init(int *nr, int *nTips, int *nc, int *k) { int i; LL = (double *) calloc(*nr * *nc * *k * *nTips, sizeof(double)); SCM = (int *) calloc(*nr * *k * *nTips, sizeof(int)); // * 2L for(i =0; i < (*nr * *k * *nTips); i++) SCM[i] = 0L; } // contrast und nr,nc,k void ll_free2(){ free(LL); free(SCM); free(XXX); } void ll_init2(int *data, int *weights, int *nr, int *nTips, int *nc, int *k) { int i; LL = (double *) calloc(*nr * *nc * *k * *nTips, sizeof(double)); XXX = (int *) calloc(*nr * *nTips, sizeof(int)); SCM = (int *) calloc(*nr * *k * *nTips, sizeof(int)); // * 2L for(i =0; i < (*nr * *k * *nTips); i++) SCM[i] = 0L; for(i =0; i < (*nr * *nTips); i++) XXX[i] = data[i]; } void matm(int *x, double *contrast, int *nr, int *nc, int *nco, double *result){ int i, j; for(i = 0; i < (*nr); i++){ for(j = 0; j < (*nc); j++) result[i + j*(*nr)] *= contrast[x[i] - 1L + j*(*nco)]; } } SEXP invSites(SEXP dlist, SEXP nr, SEXP nc, SEXP contrast, SEXP nco){ R_len_t n = length(dlist); int nrx=INTEGER(nr)[0], ncx=INTEGER(nc)[0], i, j; SEXP result; PROTECT(result = allocMatrix(REALSXP, nrx, ncx)); double *res; res = REAL(result); for(j=0; j < (nrx * ncx); j++) res[j] = 1.0; for(i=0; i < n; i++) matm(INTEGER(VECTOR_ELT(dlist, i)), REAL(contrast), INTEGER(nr), INTEGER(nc), INTEGER(nco), res); UNPROTECT(1); // result return(result); } void scaleMatrix(double *X, int *nr, int *nc, int *result){ int i, j; double tmp; for(i = 0; i < *nr; i++) { tmp = 0.0; for(j = 0; j < *nc; j++) tmp += X[i + j* *nr]; while(tmp < ScaleEPS){ for(j = 0; j < *nc; j++) X[i + j* *nr] *=ScaleMAX; result[i] +=1L; tmp *= ScaleMAX; } } } // contrast to full void matp(int *x, double *contrast, double *P, int *nr, int *nc, int *nrs, double *result){ int i, j; double *tmp; tmp = (double *) R_alloc((*nc) *(*nrs), sizeof(double)); // matprod(contrast, (*nrs), (*nc), P, (*nc), (*nc), tmp); F77_CALL(dgemm)(transa, transb, nrs, nc, nc, &one, contrast, nrs, P, nc, &zero, tmp, nrs); for(i = 0; i < (*nr); i++){ for(j = 0; j < (*nc); j++) result[i + j*(*nr)] = tmp[x[i] - 1L + j*(*nrs)]; } } static R_INLINE void getP(double *eva, double *ev, double *evi, int m, double el, double w, double *result){ int i, j, h; double tmp[m], res; for(i = 0; i < m; i++) tmp[i] = exp(eva[i] * w * el); for(i = 0; i < m; i++){ for(j = 0; j < m; j++){ res = 0.0; for(h = 0; h < m; h++) res += ev[i + h*m] * tmp[h] * evi[h + j*m]; result[i+j*m] = res; } } } SEXP getPM(SEXP eig, SEXP nc, SEXP el, SEXP w){ R_len_t i, j, nel, nw, k; int m=INTEGER(nc)[0], l=0; double *ws=REAL(w); double *edgelen=REAL(el); double *eva, *eve, *evei; SEXP P, RESULT; nel = length(el); nw = length(w); if(!isNewList(eig)) error("'eig' must be a list"); eva = REAL(VECTOR_ELT(eig, 0)); eve = REAL(VECTOR_ELT(eig, 1)); evei = REAL(VECTOR_ELT(eig, 2)); PROTECT(RESULT = allocVector(VECSXP, nel*nw)); for(j=0; j0)scaleMatrix(&ans[ni * rc], nr, nc, scaleTmp); // (ni-nTips) ni = node[i]; if(ei < nTips) matp(INTEGER(VECTOR_ELT(dlist, ei)), contrast, P, nr, nc, &nco, &ans[ni * rc]); else F77_CALL(dgemm)(transa, transb, nr, nc, nc, &one, &ans[(ei-nTips) * rc], nr, P, nc, &zero, &ans[ni * rc], nr); } else { if(ei < nTips) matp(INTEGER(VECTOR_ELT(dlist, ei)), contrast, P, nr, nc, &nco, rtmp); else F77_CALL(dgemm)(transa, transb, nr, nc, nc, &one, &ans[(ei-nTips) * rc], nr, P, nc, &zero, rtmp, nr); for(j=0; j < rc; j++) ans[ni * rc + j] *= rtmp[j]; } } scaleMatrix(&ans[ni * rc], nr, nc, scaleTmp); F77_CALL(dgemv)(transa, nr, nc, &one, &ans[ni * rc], nr, bf, &ONE, &zero, TMP, &ONE); } // neue Version: keine SEXP (dlist) // Ziel: openMP fuer Gamma (4 mal schneller) void lll0(int *X, double *eva, double *eve, double *evei, double *el, double g, int *nr, int *nc, int *node, int *edge, int nTips, double *contrast, int nco, int n, int *scaleTmp, double *bf, double *TMP, double *ans){ int ni, ei, j, i, rc; // R_len_t i, n = length(node); double *rtmp, *P; ni = -1; rc = *nr * *nc; rtmp = (double *) R_alloc(*nr * *nc, sizeof(double)); P = (double *) R_alloc(*nc * *nc, sizeof(double)); for(j=0; j < *nr; j++) scaleTmp[j] = 0L; for(i = 0; i < n; i++) { getP(eva, eve, evei, *nc, el[i], g, P); ei = edge[i]; if(ni != node[i]){ if(ni>0)scaleMatrix(&ans[ni * rc], nr, nc, scaleTmp); // (ni-nTips) ni = node[i]; if(ei < nTips) matp(&X[ei * *nr], contrast, P, nr, nc, &nco, &ans[ni * rc]); else F77_CALL(dgemm)(transa, transb, nr, nc, nc, &one, &ans[(ei-nTips) * rc], nr, P, nc, &zero, &ans[ni * rc], nr); } else { if(ei < nTips) matp(&X[ei * *nr], contrast, P, nr, nc, &nco, rtmp); else F77_CALL(dgemm)(transa, transb, nr, nc, nc, &one, &ans[(ei-nTips) * rc], nr, P, nc, &zero, rtmp, nr); for(j=0; j < rc; j++) ans[ni * rc + j] *= rtmp[j]; } } scaleMatrix(&ans[ni * rc], nr, nc, scaleTmp); F77_CALL(dgemv)(transa, nr, nc, &one, &ans[ni * rc], nr, bf, &ONE, &zero, TMP, &ONE); } // this seems to work perfectly void lll3(SEXP dlist, double *eva, double *eve, double *evei, double *el, double g, int *nr, int *nc, int *node, int *edge, int nTips, double *contrast, int nco, int n, int *scaleTmp, double *bf, double *TMP, double *ans, int *SC){ int ni, ei, j, i, rc; // R_len_t i, n = length(node); double *rtmp, *P; ni = -1L; rc = *nr * *nc; rtmp = (double *) R_alloc(*nr * *nc, sizeof(double)); P = (double *) R_alloc(*nc * *nc, sizeof(double)); for(j=0; j < *nr; j++) scaleTmp[j] = 0L; for(i = 0; i < n; i++) { getP(eva, eve, evei, *nc, el[i], g, P); ei = edge[i]; if(ni != node[i]){ if(ni>0)scaleMatrix(&ans[ni * rc], nr, nc, &SC[ni * *nr]); // (ni-nTips) ni = node[i]; for(j=0; j < *nr; j++) SC[j + ni * *nr] = 0L; if(ei < nTips) matp(INTEGER(VECTOR_ELT(dlist, ei)), contrast, P, nr, nc, &nco, &ans[ni * rc]); else{ F77_CALL(dgemm)(transa, transb, nr, nc, nc, &one, &ans[(ei-nTips) * rc], nr, P, nc, &zero, &ans[ni * rc], nr); for(j=0; j < *nr; j++) SC[ni * *nr + j] = SC[(ei-nTips) * *nr + j]; } } else { if(ei < nTips) matp(INTEGER(VECTOR_ELT(dlist, ei)), contrast, P, nr, nc, &nco, rtmp); else{ F77_CALL(dgemm)(transa, transb, nr, nc, nc, &one, &ans[(ei-nTips) * rc], nr, P, nc, &zero, rtmp, nr); for(j=0; j < *nr; j++) SC[ni * *nr + j] += SC[(ei-nTips) * *nr + j]; } for(j=0; j < rc; j++) ans[ni * rc + j] *= rtmp[j]; } } scaleMatrix(&ans[ni * rc], nr, nc, &SC[ni * *nr]); for(j=0; j < *nr; j++) scaleTmp[j] = SC[ni * *nr + j]; F77_CALL(dgemv)(transa, nr, nc, &one, &ans[ni * rc], nr, bf, &ONE, &zero, TMP, &ONE); } // ohne openMP SEXP PML_NEW2(SEXP EL, SEXP W, SEXP G, SEXP NR, SEXP NC, SEXP K, SEXP eig, SEXP bf, SEXP node, SEXP edge, SEXP NTips, SEXP root, SEXP nco, SEXP contrast, SEXP N){ int nr=INTEGER(NR)[0], nc=INTEGER(NC)[0], k=INTEGER(K)[0], i, indLL; int nTips = INTEGER(NTips)[0], *SC; // int *nodes=INTEGER(node), double *g=REAL(G), *tmp, logScaleEPS; SEXP TMP; double *eva, *eve, *evei; eva = REAL(VECTOR_ELT(eig, 0)); eve = REAL(VECTOR_ELT(eig, 1)); evei = REAL(VECTOR_ELT(eig, 2)); SC = (int *) R_alloc(nr * k, sizeof(int)); PROTECT(TMP = allocMatrix(REALSXP, nr, k)); // changed tmp=REAL(TMP); for(i=0; i<(k*nr); i++)tmp[i]=0.0; indLL = nr * nc * nTips; for(i=0; intips){ for(i = 0; i < k; i++){ PROTECT(X = allocMatrix(REALSXP, nr, nc)); getP(eva, eve, evei, nc, el, g[i], P); helpDADI(&LL[LINDEX(pa, i)], &LL[LINDEX(ch, i)], P, nr, nc, tmp); helpPrep(&LL[LINDEX(pa, i)], &LL[LINDEX(ch, i)], eve, evi, nr, nc, tmp, REAL(X)); SET_VECTOR_ELT(RESULT, i, X); UNPROTECT(1); } } else{ for(i = 0; i < k; i++){ PROTECT(X = allocMatrix(REALSXP, nr, nc)); getP(eva, eve, evei, nc, el, g[i], P); helpDAD5(&LL[LINDEX(pa, i)], INTEGER(VECTOR_ELT(dlist, ch-1L)), contrast, P, nr, nc, nco, tmp); helpPrep2(&LL[LINDEX(pa, i)], INTEGER(VECTOR_ELT(dlist, ch-1L)), contrast2, evi, nr, nc, nco, REAL(X)); //; SET_VECTOR_ELT(RESULT, i, X); UNPROTECT(1); } } UNPROTECT(1); //RESULT return(RESULT); } // child *= (dad * P) void goDown(double *dad, double *child, double *P, int nr, int nc, double *res){ F77_CALL(dgemm)(transa, transb, &nr, &nc, &nc, &one, dad, &nr, P, &nc, &zero, res, &nr); for(int j=0; j<(nc * nr); j++) child[j]*=res[j]; } // dad *= (child * P) void goUp(double *dad, int *child, double *contrast, double *P, int nr, int nc, int nco, double *res){ matp(child, contrast, P, &nr, &nc, &nco, res); for(int j=0; j<(nc * nr); j++) dad[j]*=res[j]; } // in optimEdgeOld SEXP updateLL(SEXP dlist, SEXP PA, SEXP CH, SEXP eig, SEXP EL, SEXP W, SEXP G, SEXP NR, SEXP NC, SEXP NTIPS, SEXP CONTRAST, SEXP NCO){ int i, k=length(W); int nc=INTEGER(NC)[0], nr=INTEGER(NR)[0], ntips=INTEGER(NTIPS)[0]; //, j, blub int pa=INTEGER(PA)[0], ch=INTEGER(CH)[0], nco =INTEGER(NCO)[0]; double *g=REAL(G), *contrast=REAL(CONTRAST); //*w=REAL(W), double el=REAL(EL)[0]; double *eva, *eve, *evei, *tmp, *P; tmp = (double *) R_alloc(nr * nc, sizeof(double)); P = (double *) R_alloc(nc * nc, sizeof(double)); eva = REAL(VECTOR_ELT(eig, 0)); eve = REAL(VECTOR_ELT(eig, 1)); evei = REAL(VECTOR_ELT(eig, 2)); if(ch>ntips){ for(i = 0; i < k; i++){ getP(eva, eve, evei, nc, el, g[i], P); goDown(&LL[LINDEX(pa, i)], &LL[LINDEX(ch, i)], P, nr, nc, tmp); } } else{ for(i = 0; i < k; i++){ getP(eva, eve, evei, nc, el, g[i], P); goUp(&LL[LINDEX(pa, i)], INTEGER(VECTOR_ELT(dlist, ch-1L)), contrast, P, nr, nc, nco, tmp); } } return ScalarReal(1L); } void updateLL2(SEXP dlist, int pa, int ch, double *eva, double *eve, double*evei, double el, double *w, double *g, int nr, int nc, int ntips, double *contrast, int nco, int k, double *tmp, double *P){ int i; if(ch>ntips){ for(i = 0; i < k; i++){ getP(eva, eve, evei, nc, el, g[i], P); goDown(&LL[LINDEX(pa, i)], &LL[LINDEX(ch, i)], P, nr, nc, tmp); } } else{ for(i = 0; i < k; i++){ getP(eva, eve, evei, nc, el, g[i], P); goUp(&LL[LINDEX(pa, i)], INTEGER(VECTOR_ELT(dlist, ch-1L)), contrast, P, nr, nc, nco, tmp); } } } SEXP extractI(SEXP CH, SEXP W, SEXP G, SEXP NR, SEXP NC, SEXP NTIPS){ int i, k=length(W); int nc=INTEGER(NC)[0], nr=INTEGER(NR)[0], ntips=INTEGER(NTIPS)[0], j, blub; int ch=INTEGER(CH)[0]; // double *w=REAL(W), *g=REAL(G); SEXP X, RESULT; PROTECT(RESULT = allocVector(VECSXP, k)); for(i = 0; i < k; i++){ PROTECT(X = allocMatrix(REALSXP, nr, nc)); blub = LINDEX(ch, i); for(j=0; j< (nr*nc); j++) REAL(X)[j] = LL[blub+j]; SET_VECTOR_ELT(RESULT, i, X); UNPROTECT(1); } UNPROTECT(1); //RESULT return(RESULT); } SEXP extractScale(SEXP CH, SEXP W, SEXP G, SEXP NR, SEXP NC, SEXP NTIPS){ int i, k=length(W); int *nr=INTEGER(NR), *ntips=INTEGER(NTIPS), j, blub; int ch=INTEGER(CH)[0]; SEXP RESULT; PROTECT(RESULT = allocMatrix(REALSXP, *nr, k)); for(i = 0; i < k; i++){ blub = LINDEX3(ch, i); for(j=0; j< (*nr); j++) REAL(RESULT)[j +i * *nr] = SCM[blub+j]; } UNPROTECT(1); //RESULT return(RESULT); } // dad / child * P void helpDAD(double *dad, double *child, double *P, int nr, int nc, double *res){ F77_CALL(dgemm)(transa, transb, &nr, &nc, &nc, &one, child, &nr, P, &nc, &zero, res, &nr); for(int j=0; j<(nc * nr); j++) res[j]=dad[j]/res[j]; } SEXP getDAD(SEXP dad, SEXP child, SEXP P, SEXP nr, SEXP nc){ R_len_t i, n=length(P); int ncx=INTEGER(nc)[0], nrx=INTEGER(nr)[0]; //, j SEXP TMP, RESULT; PROTECT(RESULT = allocVector(VECSXP, n)); for(i=0; i 1e-05) && (k < 5) ) { if(scalep>0.6){ NR55(eva, ncx-1L, edle, ws, gs, X, INTEGER(ld)[0], nrx, f, tmp); ll=0.0; lll=0.0; for(i=0; i 10.0) newedle = 10.0; if (newedle < 1e-8) newedle = edle/2; if (newedle < 1e-8) newedle = 1e-8; // 1e-8 phyML for(i=0; i0L)SET_VECTOR_ELT(RESULT, 1, getM3(child, dad, P, nr, nc)); if(INTEGER(retB)[0]>0L)SET_VECTOR_ELT(RESULT, 2, getM3(dad, child, P, nr, nc)); // add variance ?? SET_VECTOR_ELT(RESULT, 3, ScalarReal(l1)); UNPROTECT(3); return (RESULT); } SEXP FS5(SEXP eig, SEXP nc, SEXP el, SEXP w, SEXP g, SEXP X, SEXP ld, SEXP nr, SEXP basefreq, SEXP weight, SEXP f0) { SEXP RESULT; // EL, P; double *tmp, *f, *wgt=REAL(weight), edle, ledle, newedle, eps=10, *eva=REAL(VECTOR_ELT(eig,0)); double ll, lll, delta=0.0, scalep = 1.0, *ws=REAL(w), *gs=REAL(g), l1=0.0, l0=0.0; double y; int i, k=0, ncx=INTEGER(nc)[0], nrx=INTEGER(nr)[0]; tmp = (double *) R_alloc(nrx, sizeof(double)); f = (double *) R_alloc(nrx, sizeof(double)); PROTECT(RESULT = allocVector(REALSXP, 3)); edle = REAL(el)[0]; for(i=0; i 1e-05) && (k < 10) ) { if(scalep>0.6){ NR55(eva, ncx-1L, edle, ws, gs, X, INTEGER(ld)[0], nrx, f, tmp); ll=0.0; lll=0.0; for(i=0; i 10.0) newedle = 10.0; // if (newedle < 1e-8) newedle = edle/2; if (newedle < 1e-8) newedle = 1e-8; // 1e-8 phyML for(i=0; i 1e-05) && (k < 10) ) { if(scalep>0.6){ NR77(eva, nc-1L, edle, w, g, X, ld, nr, f, tmp); ll=0.0; lll=0.0; for(i=0; i 10.0) newedle = 10.0; if (newedle < 1e-8) newedle = 1e-8; // 1e-8 phyML for(i=0; intips){ for(i = 0; i < k; i++){ getP(eva, eve, evei, nc, oldel, g[i], P); helpDADI(&LL[LINDEX(pa, i)], &LL[LINDEX(ch, i)], P, nr, nc, tmp); helpPrep(&LL[LINDEX(pa, i)], &LL[LINDEX(ch, i)], eve, evi, nr, nc, tmp, &X[i*nr*nc]); for(h = 0; h < nc; h++){ for(j = 0; j < nr; j++){ X[j+h*nr + i*nr*nc] *= blub[j+i*nr]; } } } } else{ for(i = 0; i < k; i++){ getP(eva, eve, evei, nc, oldel, g[i], P); helpDAD5(&LL[LINDEX(pa, i)], INTEGER(VECTOR_ELT(dlist, ch-1L)), contrast, P, nr, nc, nco, tmp); helpPrep2(&LL[LINDEX(pa, i)], INTEGER(VECTOR_ELT(dlist, ch-1L)), contrast2, evi, nr, nc, nco, &X[i*nr*nc]); //; for(h = 0; h < nc; h++){ for(j = 0; j < nr; j++){ X[j+h*nr + i*nr*nc] *= blub[j+i*nr]; } } } } fs3(eva, nc, oldel, w, g, X, k, nr, weight, f0, res); updateLL2(dlist, pa, ch, eva, eve, evei, res[0], w, g, nr, nc, ntips, contrast, nco, k, tmp, P); el[ch-1L] = res[0]; if (ch > ntips) loli = ch; else loli = pa; } UNPROTECT(1); //RESULT return(RESULT); } void rowMinScale(int *dat, int n, int k, int *res){ int i, h; int tmp; for(i = 0; i < n; i++){ tmp = dat[i]; for(h = 1; h< k; h++) {if(dat[i + h*n] < tmp) tmp=dat[i + h*n];} if(tmp>0L){for(h = 0; h< k; h++) dat[i + h*n] -= tmp;} res[i] = tmp; } } SEXP PML4(SEXP dlist, SEXP EL, SEXP W, SEXP G, SEXP NR, SEXP NC, SEXP K, SEXP eig, SEXP bf, SEXP node, SEXP edge, SEXP NTips, SEXP root, SEXP nco, SEXP contrast, SEXP N){ int nr=INTEGER(NR)[0], nc=INTEGER(NC)[0], k=INTEGER(K)[0], i, j, indLL; int nTips = INTEGER(NTips)[0], *SC, *sc; double *g=REAL(G), *w=REAL(W), *tmp, *res; SEXP TMP; double *eva, *eve, *evei; eva = REAL(VECTOR_ELT(eig, 0)); eve = REAL(VECTOR_ELT(eig, 1)); evei = REAL(VECTOR_ELT(eig, 2)); SC = (int *) R_alloc(nr * k, sizeof(int)); sc = (int *) R_alloc(nr, sizeof(int)); tmp = (double *) R_alloc(nr * k, sizeof(double)); PROTECT(TMP = allocVector(REALSXP, nr)); res=REAL(TMP); for(i=0; i<(k*nr); i++)tmp[i]=0.0; indLL = nr * nc * nTips; for(i=0; i #include #include #include #include // off-diagonal #define DINDEX(i, j) n*(i - 1) - i * (i - 1)/2 + j - i - 1 // with diagonal (+i), R index (+1) #define DINDEX2(i, j) n*(i - 1) - i * (i - 1)/2 + j - 1 // index likelihood pml // need to define nr, nc, nTips, nNodes k #define LINDEX(i) (i-nTips) * (nr*nc) //+ k * nTips * (nr * nc) #define LINDEX2(i, k) (i-nTips) * (nr*nc) + k * nTips * (nr * nc) #define LINDEX3(i, k) (i-*nTips-1L) * (*nr* *nc) + k * *nTips * (*nr * *nc) // index sankoff #define SINDEX(i) i * (nr*nc) /* from coalescentMCMC void get_single_index_integer(int *x, int *val, int *index) { int i = 0, v = *val; while (x[i] != v) i++; *index = i + 1; } void get_two_index_integer(int *x, int *val, int *index) { int i1 = 0, i2, v = *val; while (x[i1] != v) i1++; i2 = i1 + 1; while (x[i2] != v) i2++; index[0] = i1 + 1; index[1] = i2 + 1; } */ void countCycle(int *M, int *l, int *m, int *res){ int j, i, tmp; res[0]=0L; for (i=0; i<*l; i++) { tmp = 0; if(M[i] != M[i + (*m -1) * *l])tmp++; for (j=1; j<*m; j++) { if(M[i + (j-1)* *l] != M[i + j * *l])tmp++; } if(tmp>2L)res[0]+=tmp; } } void countCycle2(int *M, int *l, int *m, int *res){ int j, i, tmp; for (i=0; i<*l; i++) { tmp = 0L; if(M[i] != M[i + (*m -1) * *l])tmp=1L; for (j=1; j<*m; j++) { if(M[i + (j-1L)* *l] != M[i + j * *l])tmp++; } res[i]=tmp; } } void nodeH(int *edge, int *node, double *el, int *l, double *res){ int ei, i; for (i=*l-1L; i>=0; i--) { ei = edge[i] - 1L; res[ei] = res[node[i]-1L] + el[ei]; } } SEXP rowMax(SEXP sdat, SEXP sn, SEXP sk){ int i, h, n=INTEGER(sn)[0], k=INTEGER(sk)[0]; double x, *res, *dat; SEXP result; PROTECT(result = allocVector(REALSXP, n)); res = REAL(result); PROTECT(sdat = coerceVector(sdat, REALSXP)); dat = REAL(sdat); for(i = 0; i < n; i++){ x = dat[i]; for(h = 1; h< k; h++) {if(dat[i + h*n] > x) x=dat[i + h*n];} res[i] = x; } UNPROTECT(2); return(result); } /* static R_INLINE void getP00(double *eva, double *ev, double *evi, int m, double el, double w, double *result){ int i, j, h; double tmp, res; for(i = 0; i < m; i++){ tmp = exp(eva[i] * w * el); for(j=0; j0) & (tmp<(*nbin+1L)) ) ans[tmp-1L] ++; } } void C_reorder(int *from, int *to, int *n, int *sumNode, int *neworder, int *root){ int i, j, sum=0, k, Nnode, ind, *ord, *csum, *tips, *stack, z=0; // l, double *parent; int m=sumNode[0]; parent = (double *) R_alloc((*n), sizeof(double)); tips = (int *) R_alloc(m, sizeof(int)); ord = (int *) R_alloc((*n), sizeof(int)); csum = (int *) R_alloc( (m+1), sizeof(int)); stack = (int *) R_alloc(m, sizeof(int)); for(j=0;j<(*n);j++) parent[j] = (double)from[j]; for(j=0;j<(*n);j++) ord[j] = j; for(j=0;j -1){ j=stack[z]; if(tips[j]>0){ for(i=csum[j];i=0L; i--){ p = INTEGER(parent)[i]; if(tab[p]==1L){ res[i] = 1L; tab[INTEGER(child)[i]] = 1L; } } UNPROTECT(1); return(RESULT); } // combine two sorted vectors void crsort(double *x, double *y, int *a, int *b, double *res){ double xi, yi; int i, j, k; i=0; j=0; k=0; xi=x[0]; yi=y[0]; while(k<((*a)+(*b))){ if(i<(*a)){ if( (xi j) return(DINDEX(j, i)); else return(DINDEX(i, j)); } // faster and less memory consuming cophenetic void copheneticHelp(int *left, int *right, int *ll, int *lr, int h, double *nh, int *nTips, double *dm){ int i, j, ind; for(i=0; i<*ll; i++){ for(j=0; j<*lr; j++){ ind = give_index3(left[i], right[j], *nTips); dm[ind] = 2.0*nh[h] - nh[left[i]-1L] - nh[right[j]-1L]; } } } void C_coph(int *tips, int *kids, int *ptips, int *pkids, int *ltips, int *lkids, int*Nnode, double *nh, int *nTips, double *dm){ int h, j, k, lk, pk, lt, rt, leftk, rightk; for(h=0; h<*Nnode; h++){ lk=lkids[h]; pk=pkids[h]; for(j=0; j<(lk-1L); j++){ leftk=kids[pk+j] - 1L; lt=ptips[leftk]; for(k=j+1L; k #include #include #include #include // #include "dist.h" // off-diagonal #define DINDEX(i, j) n*(i - 1) - i * (i - 1)/2 + j - i - 1 // with diagonal (+i), R index (+1) #define DINDEX2(i, j) n*(i - 1) - i * (i - 1)/2 + j - 1 // #define threshold parameters int give_index(int i, int j, int n) { if (i > j) return(DINDEX(j, i)); else return(DINDEX(i, j)); } int give_index2(int i, int j, int n) { if (i > j) return(DINDEX2(j, i)); else return(DINDEX2(i, j)); } void giveIndex(int *left, int* right, int *ll, int *lr, int *n, int *res){ int i, j, k; k=0; for (i = 0; i < *ll; i++){ for (j = 0; j < *lr; j++){ res[k] = give_index(left[i], right[j], *n); k++; } } } void giveIndex2(int *left, int* right, int *ll, int *lr, int *n, int *res){ int i, j, k; k=0; for (i = 0; i < *ll; i++){ for (j = 0; j < *lr; j++){ res[k] = give_index2(left[i], right[j], *n); k++; } } } void PD(int *x, int *y, int *n, int *weight){ int i, k; //n =length(x) for(i=0; i< *n; i++){ k=give_index(x[i], y[i], *n); weight[k]++; } } void pwIndex(int *left, int* right, int *l, int *n, double *w, double *res){ int i, k; k=0; for (i = 0; i < *l; i++){ k = give_index2(left[i], right[i], *n); res[k] += w[i]; } } SEXP PWI(SEXP LEFT, SEXP RIGHT, SEXP L, SEXP N, SEXP W, SEXP LI){ int i, li=INTEGER(LI)[0]; SEXP res; PROTECT(res = allocVector(REALSXP, li)); for(i = 0; i < li; i++)REAL(res)[i] = 0.0; pwIndex(INTEGER(LEFT), INTEGER(RIGHT), INTEGER(L), INTEGER(N), REAL(W), REAL(res)); UNPROTECT(1); return(res); } void C_fhm(double *v, int *n){ unsigned int level, i, j; unsigned int start, step, num_splits; double vi, vj; num_splits = (1 << (*n)); step = 1; for(level = 0; level < (*n); level++){ start = 0; while(start < (num_splits-1)){ for(i = start; i < (start + step); i++){ j = i + step; vi = v[i]; vj = v[j]; v[i] = vi + vj; v[j] = vi - vj; } start = start + 2*step; } step *= 2; } } void distance_hadamard(double *d, int n) { unsigned int num_splits; unsigned int x, r, nr, p, b, e; unsigned int odd = 1; // The inner while loop can only terminate with odd == 1 so we don't need to set it inside the for loop. double cost, best_cost; num_splits = (1 << (n - 1)); for (x = 1; x < num_splits; ++x) { r = (x - 1) & x; // r = x without LSB nr = (r - 1) & r; // nr = r without LSB if (nr) { // If x contains 1 or 2 bits only, then it has already been computed as a pairwise distance. b = x - r; // b = LSB of x: the "fixed" taxon in the pair. best_cost = 1e20; e = 0; // e holds bits to the right of the current p. while (1) { p = r - nr; // p = 2nd half of pair cost = d[nr + e] + d[p + b]; if (cost < best_cost) best_cost = cost; if (!nr && odd) break; // Ensure we get the (LSB with reference taxon) pair when there are an odd number of taxa r = nr; e += p; nr = (r - 1) & r; // nr = r without LSB odd ^= 1; } d[x] = best_cost; } } d[0] = 0.0; } void pairwise_distances(double *dm, int n, int num_splits, double *d) { int k=0; unsigned int offset; for (int i = 0; i < (n-1); ++i) { for (int j = (i+1); j < n; ++j) { // Calculate the offset within the array to put the next value offset = (1 << i); if (j < n - 1) { // If i == n - 1 then this is a distance between the reference taxon and some other taxon. offset += (1 << j); // Note that "+" is safe since (1 << i) and (1 << j) are always different bits. } d[offset]=dm[k]; k++; } } } SEXP dist2spectra(SEXP dm, SEXP nx, SEXP ns) { int n = INTEGER(nx)[0]; int nsp = INTEGER(ns)[0]; double *res; SEXP result; PROTECT(result = allocVector(REALSXP, nsp)); res = REAL(result); pairwise_distances(REAL(dm), n, nsp, res); distance_hadamard(res, n); UNPROTECT(1); return(result); } // speed up some code for NJ void out(double *d, double *r, int *n, int *k, int *l){ int i, j; double res, tmp; k[0]=1; l[0]=2; res = d[1] - r[0] - r[1]; for(i = 0; i < (*n-1); i++){ for(j = i+1; j < (*n); j++){ tmp = d[i*(*n)+j] - r[i] - r[j]; if(tmp= 0.6 OTHER CHANGES o arguments of pratchet changed CHANGES in PHANGORN VERSION 1.6-0 NEW FEATURES o dist.ml has more options and is faster (ca. 5 times for nucleotides and 20 times for amino acids) BUG FIXES o plotBS did not work properly with ape version 3.0 OTHER CHANGES o vignettes changed for a faster compilation of the package o Ancestors allows a vector of nodes as input o midpoint uses less memory and works for larger trees (10000 of tips) o ancestral.pars gives better formated output CHANGES in PHANGORN VERSION 1.5-1 OTHER CHANGES o several examples changed for a faster compilation of the package CHANGES in PHANGORN VERSION 1.5-0 NEW FEATURES o codon models can be used directly (dn/ds ratio can be computed) o modelTest works now also for amino acids BUG FIXES o the code to compute RI and CI changed and should be more robust OTHER CHANGES o package parallel is used instead of multicore o vignettes, examples, help improved o ChangeLog is called NEWS CHANGES in PHANGORN VERSION 1.4-1 NEW FEATURES o parsimony branch-and-bould algorithms bab (so far pretty slow and memory intensive) o more amino acid models o function nnls.tree to compute non-negative edge weights for a given tree and a distance matrix BUG FIXES o allTrees returns now an integer edge matrix, this could have caused some problems previously o CI and RI now take better care of ambiguous states o dist.ml has default value for amino acids o as.splits.multiPhylo produces more sensible bipartitions and so lento and consensusNet produce more useful plots (thanks to Emmanuel Paradis) OTHER CHANGES o several changes to the networx classes and methods o modelTest now also returns the function calls of the estimated models, which can be used in downstream analyses o vignette "Trees" has a few more examples o dist.ml is more general (base frequencies and rate matrix can be supplied) o pml objects are more compact, thanks to the Matrix package o xtable is now a suggested package (needed for vignettes) CHANGES in PHANGORN VERSION 1.4-0 NEW FEATURES o plot.network to plot split networks in 3D (requires rgl) and 2D (still very experimantal) o consensusNet computes consensus networks o Lento plot allows to take multiPhylo objects as input BUG FIXES o CI and RI did not work with only one site pattern present o pratchet returned only one, not all of the best trees found OTHER CHANGES o phangorn now requires the Matrix, igraph and rgl packages o designTree returns a sparse Matrix and this can save a lot of memory o internal code for computing bipartitions is much faster for large trees, and so are several functions depending on it, e.g. RF.dist, treedist, Descendants CHANGES in PHANGORN VERSION 1.3-1 BUG FIXES o the multicore package may failed, if executed in a GUI environment, more error checks included o optim.pml, in rare cases may failed to optimize edge length (should be more robust now) OTHER CHANGES o some changes to keep R CMD check happy o modelTest, pratchet, bootstrap.pml, bootstrap.phyDat got an additional argument multicore option to switch between serial and parallel execution CHANGES in PHANGORN VERSION 1.3-0 NEW FEATURES o acctran to assign edge length to parsimony trees OTHER CHANGES o phangorn can now be cited o additional and improved ancestral reconstructions methods (ACCTRAN, MPR) o new vignette describing ancestral sequence reconstruction CHANGES in PHANGORN VERSION 1.2-0 NEW FEATURES o new function pratchet (parsimony ratchet) o new function midpoint for rooting trees o new function pruneTree to build concensus trees from node labels (e.g. bootstrap values) o multicore support for modelTest BUG FIXES o ancestral.pars sometimes did not show all possible states o the call-attributes did not get proper changed in update.pml and optim.pml OTHER CHANGES o there is now a general help page displayed with '?phangorn' o dist.hamming is faster o getClans, getSlices and getDiverstity can now handle multifurcating trees CHANGES in PHANGORN VERSION 1.1-2 NEW FEATURES o more generic methods for class splits (print, as.matrix) o plotBS can plot now cladograms and phylograms BUG FIXES o read.phyDat sometimes did not work properly for amino acids CHANGES in PHANGORN VERSION 1.1-1 NEW FEATURES o optim.pml allows to optimise rooted trees OTHER CHANGES o description of getClans improved CHANGES in PHANGORN VERSION 1.1-0 NEW FEATURES o Consistency Index (CI) and and Rentention Index (RI) o clanistic tools o new generic function cbind.phyDat o optim.parsimony works now also with the fitch algorithm, faster than the sankoff version BUG FIXES o treedist and RF.dist now check whether trees are binary and try to handle multifurcations (thanks to Jeremy Beaulieu for bug fixes) OTHER CHANGES o second vignette describing some special features o allTrees is faster o trace and pml.control are now more consistent o optim.pml uses less memory and can be faster for data with lots of characters CHANGES in PHANGORN VERSION 1.0-2 BUG FIXES o pml.control did not work properly OTHER CHANGES o pmlCluster, pmlMix and pmlPart gained an attribute control, which controls the outermost loop o some more error checking for pml and parsimony classes (thanks to Emmanuel and Liat) CHANGES in PHANGORN VERSION 1.0-1 NEW FEATURES o ancestral sequence reconstruction (parsimony and likelihood based) o a small convenience function acgt2ry for ry-coding o as.phylo.splits computes a tree from compatible splits BUG FIXES o a small error in pmlCluster was fixed OTHER CHANGES o upgma changed to accommodate change in as.phylo.hclust o lento plots are looking nicer CHANGES IN PHANGORN VERSION 1.0-0 NEW FEATURES o implementation of many nucleotide substitution models (additional general transition models can be defined) o new function modelTest, comparison of different phylogenetic model with AIC or BIC o Lento plot o subset functions for phyDat objects BUG FIXES o an error in pace is fixed OTHER CHANGES o parsimony (fitch and sankoff) can now handle multiPhylo objects o splits structure (which is a list of bipartitions), used by lento and hadamard conjugation o phyDat objects can be more general generated using a contrast matrix CHANGES IN PHANGORN VERSION 0.99-6 NEW FEATURES o pace, extracts the ancestral states of the root of a tree using the sankoff algorithm BUG FIXES o fixed a bug in dist.ml (thanks to Emmanuel) o fixed a bug introduced to SH.test in 0.99-5 OTHER CHANGES o fixed several spelling mistakes in the documentation CHANGES IN PHANGORN VERSION 0.99-5 NEW FEATURES o parallel computing via multicore (so far bootstrap.pml, bootstrap.pml profit under linux) o compute edge weights for parsimony trees BUG FIXES o optim.pml had problems when o as.character converted ?,- wrongly to NA o fitch needed binary trees as input, otherwise pscore is likely to be wrong (returns now a warning) o optim.pml had a problem with identical sequences OTHER CHANGES o optim.parsimony returns now a tree with edge weights o vignette is enhanced, I fixed some spelling mistakes and added some more examples. CHANGES IN PHANGORN VERSION 0.99-4 NEW FEATURES o new generic function unique.phyDat OTHER CHANGES o internal data format phyDat changed and data are stored more memory efficient (optim.pml and friends use less memory and may be faster) CHANGES IN PHANGORN VERSION 0.99-3 BUG FIXES o RF.dist sometimes returned wrong distances o rate parameter is now properly normalized in pml.Part and pmlCluster o simSeq had problems simulating a single character NEW FEATURES o rSPR and rNNI to simulate tree rearrangements CHANGES IN PHANGORN VERSION 0.99-2 NEW FEATURES o bootstrap.pml and bootstrap.phyDat: parametric bootstrap methods o simSeq: A new function to simulate sequence data o read.phyDat: simplifies reading in alignments o SH.test: Shimodaira-Hasegawa test o RF.dist: Robinson-Foulds distance as replacement for treedist (uses less memory and is much faster) BUG FIXES o dist.ml returned wrong variances. o as.character.phyDat, as.data.frame caused an error for alignments with only one site. OTHER CHANGES o added vignette describing how to perform some standard phylogenetic analysis with phangorn. o more functions to convert between different data formats. o NNI tree search is now general possible for partition models (pmlPart, pmlCluster) CHANGES IN PHANGORN VERSION 0.0-5 BUG FIXES o Solved a namespace problem with ape (>=2.2-3). CHANGES IN PHANGORN VERSION 0.0-4 NEW FEATURES o splitsNetwork fits a phylogenetic network using a L1 penalty. (High memory consumption) o pmlPen: A new function to estimate penalized likelihood models for sets of edge weights in mixtures or partition models. BUG FIXES o dist.ml should be more forgiving for different inputs. OTHER CHANGES o a new dataset. CHANGES IN PHANGORN VERSION 0.0-3 NEW FEATURES o amino acid models o several new maximum likelihood models: mixture models (pmlMix), and some model for phylogenomic data partition models (pmlPart), and clustering of partitions / genes (pmlCluster) (still experimental, feed back wellcome) o design matrices for phylogenetic distance methods o added some functions useful for simulations (nni, allTrees) OTHER CHANGES o the data object phyDat changed slightly internally o a new dataset o read.aa to read amino acid data in phylip format based on read.dna from the ape package CHANGES IN PHANGORN VERSION 0.0-2 NEW FEATURES o more generic functions (plot.pml, update.pml) BUG FIXES o the "Fitch" algorithm in parsimony contained a bug OTHER CHANGES o pml has a cleaner interface (less parameter) o new faster parsimony analysis (more compiled C-Code) o added NAMESPACE phangorn/data/0000755000175100001440000000000012507002037013011 5ustar hornikusersphangorn/data/yeast.RData0000644000175100001440000046427412507002037015074 0ustar hornikusers7zXZi"6!X])TW"nRʟX\qjnj-&d k9oP66R Rw yXg!qP_?DSՆX]OB`_dR۹ajvRS O%TJ|qxK Ne6J*M8% Vō1}m :P?6kdFs|pKwFqY}HƧB,>ž(:kPhŖ-7\Z"Ӎ@<Y@HM; 9y"O+qt]I'/T-0U˝('2!+l)p|T凸mP'P|hW|r4n(ʡ\+15v8exgc%-=<^ϑթC_ x=9`MR9~(7b*V(t_~*pc{{?KiuLb1B%#wSzS;*QP{]zVnSs{taSְqO n=S;҉|8ZZo]\زuR6!&HKΎDͯ<(c6vg|MBقrݩvBo;*F7I*؀FP{$ަ_>1-/##(c~2w Hsvš2NI\nbyNz\!Uc!4s5\@L#mkt^\c0exO4oDzvE)< rN拑&4C<=0QeuЊN#;ܾ=ڎSҚo K&s2Sp7|bf/81r_avRRBfdhCC- 7H;1r-G( ӥ Za7mܥVFz[$'f:t-og,̂TYэЃg{ܷ'AwF:M5jk}AY $)uԌ7,-ٵ1PS#@A= p 锎`"ZY[G$}48_} Y@SBy or{?ѕv;bN{ &5汦|eKg N(R. \b2gZ}6-^5705Ҵդ~}< u3aœzbp}j8 ~ccF"#>̌w-oeŁC'OT4'EmGekfS\U_OI:inuĺŰ_uU3tbvRIp}kBQְ nJڵ]>멂2Iӑ~ƞrc a&sy]a/* P|D𙯩)AHuZ:oZa?&eszЄ;c?:*: if$EvUIoԨ;' R@G*֩BJSMӍ4q+n}0ލ:1N8-R F[lZy"hjY/;temd'~+8-DRmz^ :M|:q#1 G IErc4oɰ ϿWFM5K2]9NsC0Vw7 pVUR @"1;-CaKB@X^T|oZq=5Ny+n l2X,E>#j-ͲהpSFLKH6V1{Mek]86XN A]Vdg.*0pr#g'l scH6n%ӳ9j[5/`'Rj,2XG\7Eg&̞k?x 7~*3l~g!Ӎ <àlV(E>0wdk$D,‾G4 [ż;4.4 VYIZo#ZUsH0EǍK翃ˮf1t ߩt6&jl{.$u3r;g諠W>ĸ[4RǺ̷@lq'= 0ủ_Ew;+P,-y-jPwj|X5d\x4n9pNﹸq' Xw jLll kQnw2esEUh\z3jd8( *xjā_a^6#$݉O c;Yp>et%?H{>$|mGm*e_*mDKCq a&J%Ovnl9A,E#9Sł+*\7,X«w' ϶-o}"6.*]G"o "p|"딮jj1ybVLz;GaB,3y9 UUgX~e7l,ZCQi5V4nɛ;>{uD5Z#9-$+zmS=jSC`:Zd־^e%8#U) "EM:S v_! nu~WJz < % ^嬂fy !qvFV8-|n@VcR { /()&Q1Dye$h՞=dΕ\ $}p T{>gm;uWGDp?y" |-_o}EX,>18&&ⲁG%y0R=;7gJO.kbr=BϭSO{Yv}_͊`G>0x{/m}_q4sIW={bR8 1M-[t^ ! .3, RE 4/9kkPraA&8B3J]e"<2V[۪ (ہjZkd~[ '>L3qϏ-HAu[u-bt(TGb ƲDqiM⁴kv*D->ygl}'-H*F |"?3q] b\v(f;Ɂ\~hD?۬ї&C|Gta d.߄0@-w{l( ZY5v>GLNsMR#R)R;Xo|&.k#,%VghjDB 8D ?K nSO²uFr|+_gFۜ,T_fYi } DB2] @ 5q IcJOܿi󣡓,u$Bbtm ~zq{"  .}'SoW˘R h16}'k"k<3l6PaIpKCsmp9?C[U1(w렸~=';KF> {ziጘ[7،:v(N :WL1?d[ ( OwM3Y"K҇1꿖V5AepG(KNRv$do W/*.n5Vln4'U/ Śc <%BC M[/_0RڱUC*z2νo!*%V4ҧXӟ} #*U=DJ»v] 1_gCUT!yH%%fVW[?z.F"nh ]L8NkQz }C~oU]GW^[Ԝ#GF~76(+DٙϪGpLCrG[i}p4䂴PEKp|5!qU)`r! L`\B Bxdkn9w#ա\hͽ'bQZmg5o2+X^@JY iR#"dmY*j]$6mhhu8E&*e 6q2L*ut.nh}KlK$[p(%z58a̤" R胢.Гث7׮]&e^Pe$L=t{6WV JgL RG!se=np>QxpVدo1a/3qN 9V{0(Gw#-ݛ4c8faG[4cAN07 n6,\PM/ppJ֯8讪ɗH0J[3%1),Y c>;r 3AH=6v9#VOvqW-x֭r'k˘nna m4TDVr':S}ɿ3GP740҉FU6RmbYD Bd൉yͳmV!jNStO`5аiOg,Hg< Fǀc":U.EЛ!P)6{:q͈N9`GHJTGx؆Lb͎ĿnGl.ֿ F-ӒK.-uU!5_>:<t5r(d*-ވ] oVXf8sAŊpPPݠ+}_Q+6X_ї3})7 8z!gS*UŅ^*kRpK_{RT^j[ӑ Uf̯H]B=B!al#0Thע? 1JD2}̙ |06V%ecI>虗7 5D(V8O1 bK͜ Ȑ: +3E>FQo2152&])\~#z+JpBI'шYejtZ @1}BPo,Z4:"ЉBE;Z:}JB+ 6p}='C܌l>R#)%$ 0DyCdS[1lcwˣܾdyNDH GvVĉ'Zmb3EYL.n}h@U%4R9jj;|u7gՠI[vx pifx=|KbLZ^μ^u=4:ewfT)=cN?[L>`G<~9KV-~"RJ]yB-HLlYC.Gf/mC-xHOmցwzQDfɯz9ޓ'b 5脧.7 -/D[L4ϗ7Y- ǴTҳ"_;G|Lv]~z}Q E c**ё#I+60Z:K@guvUJΠ%]kNmWI Z\1+QAj (BxªvwȭVdd~ LXeO9 +SJ<4ԏǘUڏR;90kP^ņW4h< _F5XĿoxZݿlBQ!8KwT{='4K_FyYeۏvkRn_?\f#̹JF6`D2YR4|8M-RI<1]xT#XĔDfGUW켿yT]-Ooo0Ble\"AdgsQEr*T6sHtb&IWN߁}΍{]=-ՍT.HX9SNX0͜/tsԯl>]XQ;Ez2FM"$%N!69;ǏN"8ݸ0T3Cm4bebSPSoMࣃBEzR!^0TBSt$|j_$Z`d6.䣺T]. t eh;ew"Ur&NSh#c$j )ʆ wSBA㡜ɽzr ::Y@;OhEX{!g쬲H0j0p9ɫΦ,V&bLO!IX k;uth;L?]T RdgPFA-i{82j'aCF[Gb(7ԀsR &TmVK=鷤󿊱rd |2|Lv8NW$4}#"<cȫVئ\msDw#]b^F/~ƀk+=7P[" X1 7kٽ84ת!akrjS0̪4.I}xDqWUޮm?1oF,4EnL¶h//v5i#AFḻAch8ՠ@|А\ pbg?߽5ǎ, {.I}0ZN 3>{Q(:+ r؝GVn7SȲ3Q#ЮCP9":G,b84rc-踢.Pu1mF:t(s&I<%䫛JH<6}Fe4s*14x*DY/Bf$ڛ +Ed[e9z5CY tqtiv,°!59m p;_Ѳ ikS JD| 'R!6IB"ZoLMe-/̻8\0?}:&wg6Ef 5&(5H7V.+P }= -L -5l1rק@h[\*F\/e8$=aoocw3)ڨnú =e1Sdӹx^xC}ikxU|5C!Wpu*v.o3ԇf :i--RHh'?֌\aeG7^@ -d2$m<3d%$9,>dLS\ï.[iLHEN&fC '2[z+oq:qX^\/Ӛw11 ]绽*:-Tw } YX0Sk?Cz0Ƃ斈V&mUH/8S/-%m' SJsP>)\CZNg[vPtY,ENe []S(ag_𭵊1z씜 QDMKZu^IuM¶(?9*$nK\jQ,Z /P,<޽%{XzePɖ8?ZUX@t6\d:;+qcz%y x_ºک S=vOv@8S:`*lh\(YE#͋OYӗc_Xc h:[]2ɆpjN1R.BMKprɉ形LnFSuArN:|L;iH?P9wtxܷѯ$z eoS]6id;Yn}eԅ/y{ڬa).3jP7/Κ^c#n>𘡍־{/<7Ew>W~H=Z $Cy@春&im*(4"<8LT σ^SR8:nm{!V#?i<6D&a?4K*GʱYFWPy2[* ZMw 2v(9~h:C)huTy(I_ĺ fZhϗVw۹칏K;er%1.Ӊ< Xdy)1ZH`r ʞyŁ>Eiw SBwvX½B^&^sx#xxtg%hݔA'SLh˚Bm-KXBשaȡvAAFriRe1\A&W%Aa Wju =nB}8P c!fqaV YT 8c`4&? 4{x+(S `s;a >!&h~6Ѷg+h%gaXQgm|H rCS&؍SZ1-> L+vO.^$JlsqC7$4uؠW1R%A8 8jsA Kro]Cq#Ԣ-h3QtH\bQBì0yʘoγ>^}eQ4՞o{vAMWwKn)Jׄ2&Utu)iwUooɮ̼F nib˲2 k(6Ʒ/#9U{m<7&yb[a.Ŗۦgdk#"8M(>x樲?W8"T  }C%L&Ւi>8B :i^2}gZHr &֙ᤂEa&Ujy\ve4gWt iE hͤcA,6o%rJ )@?R2'/AiY2fEcJ̓ K2Y"zPN'K#3-=RC1X'Hv/EV`I ;?Ab ;xfP3Y JJ%?2vdS闣_>`\C&RǭzxvCZ~` (U9़T}4wf_͂R߯k Dq WY2ơȱY#ys y}[L|AP6~PuH rBtj6z69s.IJDZ JxIc0g ~M6  (줐ҢqŬiϩ|G:4 d7F|i|ڡHU )ϒFEj\2zߎ-=<bZ]ݳnbQb`!B;1bhucJL+'$P1(S!m/ci0 WÜi`4,Y4!Naf.iMG #XHPh\c [ , mI`O cު{ez:rki=̫k[ %jУd;/|_BxbQSİ [\D(nweqД'<(,[Ѽ)tz#9EtSQzh/2]f ʺPߍHo\"1`8)IToI`bTÿ. MҚ t qgUNY-įf!Cp(To斒ٵûaw*քI %7'.Mkfkys6;Cn%௯!r򽑹ۥl$f awj^|^!dc6ۣ1{V09+r eV8QV4ԼJ*pi֊ FنS%Wsȧ=xi9e;jFVa]WŴdyՇp.G(<߾tA(|4]SKyo!ln\Bd±\OBLVG2*Zk$P:/ż{CZ=&=!͇1'ۙ@7V,^Ks.p.4$5+LR Jԙ,,ʙۯ qi=_N[̰+8Qv[k>|I&*;i #\|3e Vwq}&4>8 _Aݖ_pc UAt,FD?pRiFfSObѽg&ym͵Mj=j7qT,dyfdVR4۠ +(uqVؑIA.X5Quu~bekx0{%;3\I./-53@1=)oBN*Ig`f=dHAu3Tk cMүr2kB1aIg3-Ea1Y+| 5.]&3Ua ;`5ݪzP(2‰j,*h뙳) ܌0"Q]kij`{SmH<8ABl@t8Ml'>$_EVCZj3EMm: .?.V>{\4̢2=yPdz/ 6SEU5<ݹ{q TF3#ZgpQBmQd@8J̷fS'HDt.B8 1 2YӉ2? Y'x#:,xO"= 96]1 _r"h`fX${ T<6Ǐ',߁Hd ֧%%̳ަE%39@ \ [ϞN!JFZ絢W g8A 8.}uUf\k}SNݳzLOASF|ӞW)[֟8gUy\HLOI8N@f: o;>]ޞ1ܜ)[+<ٙx .ᛂoL +7AǙb]Ph vJwV)Ĝ0ccK߶?@i#CUs-H8{<^;n[Y 27MDCMrRiga|#'0vÝW /K+ѡyov-<E"IWRߕj.F!_dH:؈ٕ.zz7a .%m2s (9x!ɔIV䈙C~ %wyAYe aKAMi6Kz|ҕ Pj %y^N JVm،ԓ_Yd?ɷv⋝ ^PA &B!odm^Bn0pIck/PL%nόqV`jBO`iM|STx jv\PE|K$&4$&;jѐ=Z x\Ad=^׍KPlyτIõBwR^R_. p2HHh.Fr2*NJc]WaX~͊*ʼn98Y  ;bJFRONFCwKzL [(Rjp ={31 Xi .eU,DHm W'hY4]kf\xQnVadƽ mʫ X DD[gHd0+$C9z㜯L,+c%U&$q /? 'kE}bȷ`%n^Za5ۧ8 m~t(%+o) &N?4!Ho<.u _WRA *1Y.`)u{O ~]GgwW3d0(--;&WAu[u.Ͳ_2o_K@[35fs?6"yD5r}AxVЅ6Ox\DU2PJU/n{6{MEAY:92~qѡD$pQzƕŋCIn$`+@FT*V_de2{vye|`*0'A۱RBHȘ\/h vw[2rSzDznok4ckl }$60JXINFXT WEQb" lU5ܯ7HSySju 88Xݦ">>ua%4T:ԲS2&S"'8 SrdSU[и q)5mtFUϡ ۠T3W{('3Ks$9F%YebNY<`}uCe îRq{wlxi/> bou|+uq5Шf5}- &TZ{LvtCB~MAJSx=`21K ljGgm;7j}Lkaf{̓]@yJbcɰK   fYv ScN?2iiDc1L݀LJ$4+ VQ [($~ Zքa/2rs2k8] f>_yC[}s̷|i>;>}jqT bNf@St#qy>X#{vL5 f4`c&~?>rtƂԘ?$(Ϥ2}f/[/ YhjA~)|r5.2p֕+͸tn*_"ۤX8}Gɯ->Gc^&A)4ϳG%,Mk"GST7 (iBUߝ˪mL+,ASGٕYGK`<5?7FB;̎Zԇ D6u +2mt Z fCh/~K2Oi@xD{ᕭڡ$}KƷ`;RY"oj--HOȾz96tS$ykwêy&Op@(]yP!K+kNs-.f#5L~# f'࣌8e7;a nd2, ׸Rk31ib)r)EUͽpygiKu JR]+* :Gn>)/狀I^鉓{~"̏}{IĐpOy%#cte=fvyN_XJQ0XAivr6R@ ހr MK,[}}w۴vHڷn}L"=A1o\)W$Lst{bq'<&ચyw^E <ߡ-UB豫P(IC۹{=ߐ'MSK9@K-<ȓpLtLZA-rKdntw(19ۅ.`|~uBqCnk<5-7h _;4}iƭq]si}d2+?= Q'v:ڟqyR.1o%B?_q;58=98%Nzz%r=lUjefupx?6 LIr+=0mH x}(nDC-gRn?6,ꃯx;QݨWn*ǧG2yʟgc^,-+<<KlI!hc%e$k~^放Vfm7V~.N\U#qc{#r!mL.|[v:wsr})a}4(i%Ȍv<8-5d[(FtB(<^(ۂ , D❏^'-܆e> wyzL*sPgaڝIG2 p~ς514a2:oH1#JPP p+gNbnY"G rÓ:]tE$mOɂLd xoQyʀ뢌Z*FT* f䒶 kygȖx%C29z=y?Lcc-+4FwF|~Y粕,nPR+iQuC9̂Q˿pbqC.!̴&ZGdUsԤ PXNomjTYs\42+":'qs}Q"hR새^*h)cO恇-qrbywLYCjE戨 8d̃xo#%=#.qRzwwiƯFX_SʖZգיCPf[-u#e MCN e@HhcحtD5T$췳 fI#9)I7_^!~,Z QDa>x eu0]t3t~@̈́+U26X"_2,!?cUQ( m[ =Y;`%zVBJ{GKNW`Wr;~x.l@`',kk%*u|Q@H!aD;F"# W cF3iK2kgQj3[l g*n^"X2ޗJc 11FEacu90F5Z[?a1/  BFw6dӝNտ93RX%`7FVcRfΏHX(^͕[g%Scכ?zT2auP[=q wzDvȄ2 [Ek+ zl=(f]-x j׻bb֐McQY(흽 sS(Q*3jk'FXĈVԥt1"ג Q)3kM½h=W->2 eƭ0ifcHC`7(X_E}E`5k02UЦѝΘIj@KA[u֗ڌt6vv=~q}R媿hN$p}r8pC; !l?%@|g'᷑[vqW5QoH{ `E$0"LͰk4;"YwD @O)>qҊuv_=V#?b9e@-tfԛhm#MgAUuh[:.z.@զ0緎Dko~[kMY *l4*JE.np 4٨@@M'hS}<|X)t2 y?TݾVwP>`Rߍ2xHf$0*02 fb!EgVϰ!H~_!g@hk';ʢadQz)f#v1H^42jBPbp_Yzt2[~g+Nye[g_' q6@Z4T(r$J-$q/&P;<^[_ y{vA$7:w\fݻ䨪ax/E?ܛUGO/,X|م~}?J.?"_i21_ lLPgF."GZ%lgLTCL%e;ߝ m'D4jN%˘XHߗ& ˓+`YAmWS6IwbԵDYyBxC O/xG6O4VD w~1K:OOO4{^楤oB҃46/h\=Q`lz/4-$6H##,G>CWd53n8NnM:Q+Uؼ:\ݹ2tOÇŚhhcheJ}3y.u?Gjy| /.r`*o^=T ޴~Xyrʸ팕#(YTp f+7N3Oͺ`F @C# Ec~ ۧS[#~a\Lzz hQ~ً-s0fZv/9.d*ȗgMMEzn$ Z*R+P9F<$x33ΰ>6oRwh9ۂ9k|,"W2 r序=PL#Mɻ|*x_U[ pA[5jH}&9>֐ ׮.BD\*ga@=R_XC`P-껋e P2Yn3)@2=st a+.*hlu/r[ y3E|U;i6G2rjǜjnqھwWJ7،BExR_HӚ;Ƀ<((abq&z]8hp4?ݓ]7 6qNPx"!Ux"k "uK.kh imF-Ԍ:|tܮ+r#[::I<ּ~DŽ*$m-+pҬ1#vS+ie@(f#' ݙՋ \ﰞ,< _#>g"?| a@qRPj^c2oxݻaC6Q# E V0,f*m06i+v1/:q2Ķ2&O13$V)6AD=/:`y>#ijoȢ2@qYPe5CʔId0  --&qS('b[mYS)JY݈e! ,S"W#0ⅪAh/?ٛj^qʞNy XvMTƜ `e똏)6j&1P"[-4uvc>;3CeѓTuYaIE 0 xЋ=_b6kI]$TC PdmjAn?434?uxQ$d*;AzC#Qu2>v'vb+`\LJ=j{%=)yj}.[2ގx$)I>zD¶EI>Sܵ2UuLpǓw${F^ 8:>8+$rcT) +c"d] 5iFK}axh^U/v:xd^hvbT GެG*4"Wm3>>n[a}h;{P.a6)AGG1rk!д,LZm~F_2°0^Afږ8ө\MzrD[۞Ҝ5RTf mrZ-1P\߈=F\wRʮf2o <+*a ҅3jd@4+dw^KZ`_$eNT2{m-xG8$r_`vnܟމD~,2b<ئ-0ſVD P*K){hPBDJ3t]4O(TŸvb ;;pdٓdv,^Qͥ 8 H)~l]  ?C8Qh mEQfx˙TbxTa qJG<ǿxhԵ<Av C ژorqIWE_^8!?ނ岝n7Lh<uhm. oaOGr#Ho(Tk9DϗOAlaHb:rN;;2a|(%9 u΋#FPܛ80s#1[! `H[VhC@pC*Q*dr![TX)Xݒ=\eYj_ꍵiY[t?FȒ,Sso0k \dKyyD4p-1Yu\:}![{.>գ&/-CAqh}ڝdL4ft8'̩@y:J8,|JTgTM ؉vtR Su{6nC+>j"p=|{=WNFWY>$~ytZȯwO| joObIst2."t27!q+3xA^a2;y61gUZr*΃`?Ѫ IK$R`Αw? Ю;̛ZZBy٥oZv$sQrė+=PMazEtFtj˝:MַJ%8 \81$ۈnjfh Kh8Ԓ62|5[yZ]p 1CѲސXhB"y\\B6̠ В~ 1\*8RݞAIt痞S_ߣ*ukK g.NRe ~A/c^g@(3.wuWg&m[1C(UgfߙZ̋EF 55sOw TS[5祍5C5L X |h B Xע."4^3k''}&6~EZ*~8 l[rl:/rHqGR4ƥWFcѷ/͞sOXmͩ@4kKMq0лk $<3e/Ux3[RJ堖mcGeħfpG#M!4ڏ1f=Rvm_H~'˖FZm>Mex)EùztQtOе 0u/cKmA+z}#;H,;ݻKQqړeXeFz-Ļ?UY~lHGWMpٽNy(VE)L`_>s;"H_!t^/v.'%A .Tޫ|kS]IM%z4@Fi)H)=XD&QONB/udS-+g>JJ/wEX2gЦVY0Wڟcz͓@p24L>g|U&J;v^!d7~ 9;'?,Ha~F Іa\ցTbከr|!',l} ĭ!~BV罈?y1Bj|akiXa0i+`4y.u_&c<-'p}L+x||( Z-L7"^=ݘsG^'{L2Iz܃d zCvykM'okUt*d.iH9s~U F.ە)M+z8PQHyIϒ"@lT}ꂙOc܄@X襤]}rJ2kdO_oY~]lEu-hw$RjNkbg z<{DL(ޜ+qN}S~[.)ߒ%*"*9ۃ` 倃 ;_oDiKI?@@n;mXkJfܛaw5g)ClP_lrhq {פ _}H!O]^ZS.-4Yl=ǂzٚx^'by2htuq c@k~_s^+A?})<*Dg%}GjSv1x2ΉFt/i6"t"0pVⰵB?@N=GmLKuY4H6iReS.] zb|ϐ+Kz-Hw?B\ CPTGxURs YS6U  aZ[To~ yrȭcFS^-MLFh$Nϧ'Gl˜sM҇w[5AKPQ({hLFgp-ޙ/Hzc۳5lkzw_AȹR}-XUs6^w <4)#Ќ'BWLmT>ZM'D֥VUz!OD U+{s\).Y 7|b@Yՙa]mXBz\# VX,ڒSR(oXFd@~0_r7k[k:3 UfaQngPB8^DRsF3[B"hӇ/V։@sCfLrQ~lpaH)Dy/mB=s&ȍ;R 8zb'^Կ0emݟeFf /u[DJkAJgKA;#HZi80,Uju26Z5ivF2tJȘ{eJ{9*̖~q8&zwu=@T5 v?٢^DuEMz/?Դ "#g)*rZGm7kJ5lL>o~Q .j4p _.Fm t @m\53 Sb/d]W[0yUnPgl"sq!8!Ň>UW92zh5s}}w Hwø5S앓ݻK]Fbs$ߡ2M0aд@ +\"+VZvUn}"ڭa-@?"xb{A<'" ,IWU6+ r 'G36o]!Q~" ",+F+ Sߖc0,3}HeB%Ih_cLH9A?A.%ܑX4CQiKVPY۞'|P5 Xia*E>**1FDT]ڊ,X8 : ~=Ȓ~a;y|a !rf֣&0EnQﲫSu΃dueDpbux4%NfDy(.ɋẃ= fʱs/% D Y!,q_LW(khQ,Qރ݃^~%`Pf ( "fꭈ1CgQ2G*x{8 '&:acD*1= h 81Y~'~ D~_3}/o?A5]뙁\XK[ 7z?lY*+BaV-ptHC^D:fv@D{av ! ٺ ͛ބ=Ys#S㟲НpJZL(oIw[(l[=An%5^QwL䨞Fs"A-v0 <\nbiA+\jgl><ө|vw9mdWZ+H;$WFyE ~Y Y2Ҽ"X݋'T<3Bkpƅ׫ޅ蚚,-AGtF=^Sc^mۻZwhإIDVlJŐ[<`u#y;"MH+)p^=^[je3+3$)~yLR6h{%bo` ZAlV'Ep ~,*Ldj>͙.-hPjeRo}O{<.kŒYF0}bO [^}#@ –3B%$h K#k0gU;|^Sܻ)#˚y[ptR8"y|9ΈA~5!oIyߗ$ߞBb)D&R.RJ.U_bLML _.`k.sƌ(G1ʹ=̩Q2]S%'Dwy %jZAbCbEu+(ɦU\G"0 s.PǸ q^EsI @ MS @䭨w3 HҪd&هkz}kp]H DQ~%|k(x52ZM50f\2;,`ztX:V]CCmQOlr1_&ٿ3jlCHCŝv1lfÀ12NwXqWz@+c x5Vi[5UX=on8 96aGߏE`O3) y,W̶)fdʦ;_s"2X# nvkD696?8sI}Tzxp (!-z*Lq/VKpxBSۤ)&wBHi-3,-9ZZ>~sO"NQVt2KrL?kU_;ߔ1JѓcT(\{ϣV[1_tw%][V" kf=(]tEyG3XY&ZfMm@i%7Iq8 Jg/T(:?@];G1Rbkka)cy =R>jB(&U&F1H\\kKD(H#Gm_@ԦT9=r! xl'M^):,x[r'C4"" rOky[Ћ(K93I޴ojԢiK"&Dg'lѫR޸F۷~yIpQ1˹['Ӈ8,~LK}a+v(EٕXiQnn<'_$zGD,|(K*P3J3 |U'ܣl(%8I[LlcoEüϋM]kDI{ł?? 2;աvqEʧPW2mrཿM ֒Z~rwuIZ}3!I=X32JԃN 9ì $5'42LJAi^ZZ VM[iv}Z> )oU^È.$(Zo:Ud26g%ΚRlƍCzRP,;(4Qdn݌N ipCY 4#|Itߐ*nSohM8Emt7@Ycie!s{O x #QF%۷sM` !7ZW,ZiuB{Yew9I<=TU5R$6hvd~7J楖Go<9̗%66w> s/%zM&;NXt(MA6"2~"9E`lڳQBqx˭{|#h@dtdD[rF>.bbM )50 pVWJ3o V`L{BzEf( >`ЀU'ژb t4 ޭ ܯ`دʗnԯs/R!H:0+j]`*W&ϧr;̱C}FifhO?|O]sf'GU7.;>;F4)=mV!z 󷫆;fpz,Y ~^ i/'֮A2!':'@'+8 aG+ċow3~[]mYtU3TzI$` w]x0|92ua,Z\169KEҌK88` TN󭊵{ p1t{ˆǤB4DDԾ!>_#He}zL%{A`qUU+8Y:KI4!O5P $*=f!t30KIɍܩAƱhC)l%+aN'cH9_4cо ' +ҔȌFyݾ86Ovw)/+) y[ALrĖeM}sDSrͻoN!yWFsJܮp J?An }A/公Z+|As[AW dKݿ6]g`hl ?]GP|NtY~HwvY(ڸpHQJ<Y!Rͷ?\Po.X au1# j#w!wydqm?Lm#4e~Y5? @ɂ]3<p3"NGXR0\duPGJktI"<.aI$:u} OfWahYӹA"ɩ()m`aUR5sL#'\gt8 %Q X^]/Sc bdHc4g$e-]"@8vWJYG|Bg#sעuyXsO;މtύE_åj- ڋ嫅.9|N/3~<#)xglQ… Ff AU=6.ʦ]*"TJ4Sg;`NS,S{&Ƞ{?u osa.c6ǘhIS[K^(ĥu5,Պ 횐=m1cŲ4RptCK<˫3t0Y9yz2:]$*b;jl+3WQTո@6OOD{[j sb!i%eBh,k[K)\|KLgLJ;+B@+R[޷W0.a:W!&*[mY3u_(V,l>3tݕB$Cv,E|SS] )!f|y;M'A'(.ub~N# S||&*$e 1b+^LBc~tc $˖'(y$VװHЏѿks"L%Ě y#6ͱEwfa&V6 ґ'sl 3l'9klH<{Ӯ\xc @sliw`GFg-&:0wV^[[' !(.:ALl y1ig3O',8}ckGRe)> >DZnG({rE"DmY="=xGLr>2icelq%P?ma&PpFua\y.2Gł+[\swKt^@4RF;\.WgvaRռ9-@ĒBD}u:SC yO;U u'޺T̺oUhzhX3Jb=mbev+<Ȉx}@:e),6fAD<--|21[(; gC6E]%?I[4TFhT3,wA#^&nVHO`@B ì=h~Ы3sTl RḲe3p>o:@]yvbRBiQ޷tDy˩s"ԗSdDO$v`56wvSNc79l^enw.ʂQ!\v "͟s[ȔI(!Xx4k/ G/-$Rԟx+eg7O[i,8-O&y׾"nY}_;R 5ô>q: ^꒞zb앻>Im]Hp5!']( j Qaؤ~N?Sn؞zP0esfJ,^O f`ސ0dw!PLJ>M6 1&Tt/h5Ke& RQl5b;D󦺳`6/cu&A6[w9Qۊ^,>fu*ur==:U+҂73C ( s*=£ E^W!moѾNimGj˜>9c0k5\-BEۑ_l<.D k,%CrQ$RuKoƂ鼰 lcy[b*A FGIbÏ 7+ŢBP|Ք =;؈kKjnј=@61훃 >(FVtp@pֽit[L%"'J5(\*iJ0eR#qκ2AO7{\ȎS|њT(sՑUw jB Z"lj{_tJL0DA?#h:UDRd1LQȳ&m Zq';•ױ"xc A{}atܞ5Lhꞇ3u<iVIFQacS' %#'3ŵE]t.R S!kI(=3Jk Wf&QlӖ;6MM/NX,5gLso'g_޾$ A}6@ۯr=FA<)EQcn u B$[D9QmkMBXq{V%C6_wͫy>`,ĩj ' SӸE>Jk&Kn /+I*:vMbWy0=&ֶI;<)7$u4xPA`v&xR4sXz${690iAIjk&5KS}ih?'ϖ5 C,{ 4+~<@}7G$ón.uA Vg=;2\?'S[hCT߼l<7!&WAwcO(fEQ<\x+ij0GYL|h.v+|r*drijEҘ#Ԏ# ŠhR@a.[jkjPt>p8"zщPΑw2m\/cWn-s xU4tzi'ʦ3Lxj+n$uϝ/z -(F#J8^Ew 1_N=U8 ؎?~LQtatKՇI'˰n 5 akJp_N,FO{‘cع I*poStM fj[q舸@y|쮃Th'~7󎥨ӈŴq3|Y݁-GR09 K95zNxyP.81р@5l)8^]RZOb3Mw@p?73wiZ#{pb DB/ Oc*is<#홓 bO a|u_'ԈT,\oحc v; 䝔H4Hy6Nq0Vטeۿ "oNfad{$Ţ!zH=79hW|F}4߃RgHU`MJuU!ϤTNVͫj`ii!o9*4݌Vj-tʷb~5@5C;dì1jk6ԚlJ͂z/vWtKuꗘmQC _ߙ vDM;YOJFٳq9 d{R gѾxq *}#ISnVtw u 8Yp9BÄ>mDD!K>VP4+@` L;CwS(W\))BZ'ӌlQ)--K΃|:cł.A˓f( 94~|yQ#1Rrp&E 6$BCj >@zd.#hSwVľ-WRIݣ6^Z;slΦ`.1W˿}yˀ5dbۘ-K˃v̜_@ɩ+8fJJ)E_rpR@|mV^s տs eĺ?[΅,Lkx,gCE^*UPg㘤¡{f\: v90NQRLLQ"8(\E>WgD9MMJaM]stPtV ]zͱ9 ]Ng܃-u>n5}oZ ,pK @*ؑJ1օKÛo9%}S*Ԡ<ڷs&6HPbV-HX$YCW7RKGDHeT3(F_.sH9v,xJ(0ˌ}~WevQ/T : QgD|s^7I+8:>TC nr:<׿j@.7{d;6: A h,\pa03.ˏī]5F \!6^ѧ[2 "Ylm W&ӧiw o]'=2P="% u3J8ڕ[hܗB'@rةM  !s)fvpW-Af߾5: */O:ăT&\(ɯ{~'F-9@8jm}P(ieYv",`q_ 'Q0IaI㥲EY(L7wʮCIfv0PH}h|c\e%HH Mq X ID9BU; ۔:2Dʡ1^C)*#h .8$sUF:LwBn2O9'7}PpKWJ{.lIY XTяm?@'.(Etqy)K]CbXf@@ީ_g܍Ӂ]{\! ~>!ѷIF _]`޼B$4.k AS!v6Ҡ]%丄!C/V=R:~vl ߼#լ[g :~ kl,F4<~DŽ/V[6)_Ī 9ܜVf'eԹYL%.ߥ.EBipт "Mx:[߀պ15r' +@2[S$W0BؙSPwOWv~ hǩKA}mU 6nyRI\f'mj: ܨVk7Z tHI2 CT|1l8oCAÙs;rqP&>jGl%wX pdl-6OfAl.[wA뫟P ҇us%S#OmeUfG%Cm86IƤSvfz~aj>1Q>)"pp@ħ'^տ;`_vtrcwηZ'zsB9;^oZ^(n $xN. >q:-xG/x >*Ā /<_-x{yhO"H11_N5Ukc# lk F,?o H#vFѠ="8}iMRѷ{X?%N ҉#=1נhR ?@;35; qLb7zE4b̜eO9&o툭@ï<PېղLW!/EE2al/"{yMYE/LH)a(#(XhYppbFvPDh 3@דᎻE~ QvS:Ή)kQ:M۠ [C6QL lT!7~LZ6A~¦"N:]=:+a ,-sW5{MX_hz-W.~nZ@3vާ#i;q˔|[*p=X!]Jj%>.eOTe5Y𡵪 Kb\{83OЎs_.Mm 1֕H|nUGE{/`mRbez"%FvlfGj`0#^F'}] /UTح/bk[2F'cU1q#b+0E6CR"ZLVrd. (Hn>Ͽ,-jtI JCDg@NWңN">c>u62?&fGtyn/Z/WB&w$D}/Ռ&.(s 8@d1g"7g8z7yדEz)TGp>@) ƄJ^ٔCD:O+t9z<籼/V{mb|"1R-q YY;F& fXPo6lW 6U)M;QaDZD~PhCfkse[ ݶ}Ycvk_#QAT|ݣL^7opڣ9ٱf!FAM>H1 T*8tcNQ!٦EMʇNg0L?֜΁  Z}Y:s#OZ@F}/?REsl) ka:?Y|!nqEaOUn_+!ѵ 9Ҽ&ۈv܋rLw5ٔ zgB,@5,xx{ U ,Rv%NMn(Law!4v3\ju/f{JijU" srLNrG ܌ӷf[ZɐoDޒAL|y3-Ӻ;U,<4s"qR̤.6h_R`)eZ,kWƯX`LXYuǂG,hT߉¤c/;mx"z<  8E<&U3MX'axcً\;럟E3]L cTo5a%7|VWuއ{GAYAbd++;T98Ey-Uޏ$4Z%<8Ik`?oHrr=y+n3hB|j^JZi:H yȮzaqנl5q^Z-0A;/*3z e)ʟOxZ@Ogh*k~0*3H?ʙ u:HH9!^hlq>̓f7Qfr{fN+@1LKԞz ٚ,{2;5yK=0aѪGfB`dm-.,W[o5t%of[hkC9p1Og×+I,HD/9@5AC"W'K_9!}?t`K :2sYiNҦ'`&4oAuSq뙊73˲՘;Y$xU(R6!_=dsN7)_8+%Ʊ[EP'#\ә.Q)$7.K>u/(Nmg@2y=t h) 7f4"T!_Ԍ+nnt Їdaa!Ni0Tj>ma+oP$ϴ{*;,[GyUSqGtnfn#vʩJuI xb=龋b#dMm1}ke>R5! (||2c ;H V Ɇez% t={ ;ZSot(4<aG-5qRy٠~_= 53^n1\o42ݡvwo%3}Io%KHnUѯ(CuaO G҆*h}s Qmf<@fފQK ?/'(h$lA̓cv jh,熇fAp3f$YDI 5A־%IČ#ː㨇z_A^M;aT0?<(| Lc+WC.9A9ș7aLH"d-c`q: !Tսx7w=;FWkiotWkZգ #"KK> 0: ٛj<6ЁiD|ȅJ7G\uuD{oVbXcq#1lJSvr4`Ĵ4V~RxZQ>/WA%u,=T"90-{ ȝ (r3rS+(Zp7 D ؼq> %E2;8VY^r/:7;u4 qK/?-Ja0OC>gК.дW!%4%U|b+\b|tx|i^a˻*4 3Ւ-5 4J^'Y"ZBȀ9DjweJ6,&i-6[@!S%i*4, i2nq$r|;e?Q\?6ױ{*m0BpgVs5ߜI`EǻN[pr!p 2\--#e&{TWj!! #1\Hւ;FEkmoBoU@qP V*΂6g; پ~؛zW`%G}& j à.@r ߹\9?iXct29Lq7RU$*EuS/j57UrrRCf4hW.FKÿ0S 7^/0q\͖Xv*Bt ) <ۇA\C;h㯐o܉'U!*ʯRo_b>-:>~dJS`03!|muD$U0;Gi}VNLOpEe]ȁ|]P'>|<&SnĔsX}xXӣHK HT-]5plEVAU(k]Ra:78yILgBKۍfq= 9B\wS!żS1C@>*y|.њﶂZ"kO381FxB+:6-#PufC9~ӡMY];R{T7zM|&˭=!NUnΙy WX baoD%fHF1QχWԦy % :YIԃd<~oy$ojqV#s'[kYwfc} _%#*2HF̝j ߈m(X$@,,$ 'wS]w>iQ!oaj=ɰ΅$[3*k* Wo1[.2(AAglzhr%/no|lat n 6oK4??I,PT>S!iOvG!@ߵeM#{e# L|E5{S$rb eYHlv¤ИY*:G ^ ]YsZS,u{4yHTUP˓n4~@t"HCg &5s:$'[ӗ^uqtyy'80W>0fg2x v` fGלsc79 ]So/7]ޝ"9tH52EOHrm9)vYO 9Rl"_9\}6l>QT2{+|& JcP?HMn;>&tI8ņ!+&s# ޲mhF;Qx6An9;LTLنSƸ'GSb.$Ÿ}],KW?9\ù]:,]Z׈d<|}%.-&kNx7akyYd85gN+)ʭP}x҅0ܕ.w|EyvsdO40gVOf;ST)}P4H ]>z,\]|D`Uٚ{7PXt(p% @z_\L E :H,`d@Ymf%leC)aiH+QVƛw3:蹩<]%t? d7=t)KH:O{NEYۊZdX7G5:`n}_RnB-p'-RkV}yDNo-eb%M: jSXr7D? 5bj %31 GMe4/m L[F/<]0sa!cs\΅:jb jvS'!^L~R*6X{NED?/!WQ8ޏ= -z>>",c݈r-/&rĉd+&$?*BJκ""{#I㿶CVK}kI1Te9(⑤LHˊ9Y\/$IdB.dh|L-cw\>7 _JF)Ǘ|[t׮DJeE"< dDV4 *YUpk9{:][gQX:0%p_+*IPuj?[P ++(ܣjD@c 4qGE YM'^~gjX'8k\IWF+ t<r~kJzrTas\9 VRyYyVDhahkɔ%q(Hvd;M(jn2EY حQ‘nT^:CY~&9Vs$ԣuo_ð~Ω.DZzJ}uw'lD]m5_h# P(s&-UM.hE[ _ /DH55 9y})9#jGh|\3c-Y_~5vU\$I붼IjDT]p ?=>6P;qhFp]th# b>""U%7/ ݉lFfclEz|С;yX D&D2A.ԠkIޢu7=eYs5o=x}tD tb|YZ:p(euzAu&ɔO>ѰpAKwBʲ/,*DoY2,ԸEfA[V%PSpzank^]xȧ e0!;3sxSVȾR5i ӶG4Q E]:ٌ_uΗK.0@Sݐ&\_Nj5t+YDŽZXD.5#^x+:XÎBrt2 B17SUn̯EyDx Sߔ_Iɛ\Oos .=;dO0QxK+Xn8CJ00 wt@["MfݺH\ʍw WR gku15A]ٺ;ɩP'*NٲLZ+lP] .IJ02ٮץځ4A$נI =QEvcw"rǑ[hdQ1m) t&UMb6אvRY=88F?5X-dlϭbDzd7.]H)TBﷂ #pk`]n Oz)vFu˃WSlԖy._FmNް9~x,]{}`&rdc"}ڛ|?ޞqd78d}#ژ"1JEШlE&<_Nv5z_5>o;i!~r"mٴ??:kvp-e(1֡Q++}en {-"qo=fC˅dDH%4Vo%鱲QTz8&q2/*jXlAu'Q[Qkm-mm4 ޜ5$=K(g4N)z ]6j`2^ bjG0-K~'z| DJ7삕b8L1)x.Qo V0,b-yhr((F;Z |kMj?Zrp $ 7$ Si%9dV7] sٸJO"`hZ  ql|jk{1RʥQq=Y'Ej ''_7{P#(6/YUĊ'\vE`ƴ Ģ|(J_dk ƀi3LTKWʾvWSOu1Q>ݶ#>$UA6;;(; w3S; Pg>-'73-y K+K_Pd#HP4PL˯v ?tHS+G x[;00~I{]f]tV͓㡘ܸg*ퟦlع: 3 )S?Y~^$+惑 .^*Zg Kf)Ԣ4f8žβ-]m-u[M^' *R#Hg{%lXԔ2Sfk3U1}sgw ҟӌS9((38%ù\jU5$zIS؈=1K~;oݷT.}xyTE)nDQU,eFNU9b Gz/r ʿԢ1Zן#߭y1: "}ŒVKWäKwh<:k?p{da!9|qOYBPvݷH4K&NMřh8C)Z5z̢Q]j/Aˣ4e,/El[^BS=6~ӂE^@.cw2zc]@uM%'<9)BEMͻ0->ѠI%oP{#b[VޠJQ?r 5i>rRJ?4mk2Fwǥ&xKz&y{Rs8G ZdBel4騱/>V-UrSjθJ&u>ElW(فjR6id4V>LM*#-LTÄZ\~Nah )[ճ?Zbwnb ,MbpgӛZfmB1:39GBp?({b<#i̎6敐 _ 1V*{ٲ;Vq@D5<3R%M#X}r@I9!]$KLڭڙw8Nϣ'LP{@M䀶60Y)/.uN8jnd,oqr]̟v(nf8 halO;JϝstXc6=¬XZ uĪ_p&^FJ>)95~f9=wJjHyKPg*WwV.<'K7`Flm[75O&p=h*0?}d$MٟVCª dD5Ie6Ojڼl0rrLICOH",vuB< Y]02;WV}$: r؞5ق וBˢfh^s t|pe-k /, %/v},y&Ʊٱ.:Rv* G(Ux'mT;Ȼ0&8lHc*/ g:j ~L !N h : ^!U˒4ZߌÓYȡ\2mIQSS5hq34cT^gPi-fo_ĜW ژ0=?W^;kygA7d/=0\@OMo1;qᾕ[UGLs7I}KpSWXmHMݢC!oՎD\P5FaUid(n>"%JV&޸n<Ƈ1 mj/gk,t;C4(;\7chaItU%ol"-x#F)c0!ZByyҞ, uȿS /*&XpQ!,p'YQ8ҿ*{WtKßztU2&4HT%;B|6/UQ'>﹋7۸hU$07}娠*3<\t1ޮ1 IW*wOnD@* 9xzA =jf J!\r+ 5zlҼGPAGV7-#bBMpTNi.ޙfp \+}s%.=-!p06h(J=I1S= ߬F E=6f78 USyliΑwNEjޓg;х)P*LBI*i(Z[,8®pbQܩ爗gZ7]Y<^)o^@0C6?dz!};>2OBMZa@L\DRL  ݂LqIF=?/-s%̥K[i{B"f&k3p)u|_Wmp#pcU<9U{h@lbaK+PEׇAKc|+Đ^¦C,9/؄ӹ- 0h*Z";cm|K5 _`f% ;W$ V YrZ;Db_RXGJYJ-JeC]n)M'9?2k'H^q_y<{bWKfW%8R~KEɅ,Nɫ&>CwHqwE0| +Et9p?7@ֻrr89K/fղgVC1@r/q:t³W'p+ mŔI-X? ǣQgh4@CTxY g&Iy Kn6/u]'&vP8u`,5q˚"ppJ?p|vfUaûf̭[֞\;.{6hzSm$:#diܬȨѬ`P;E9h#uXO˫% $7J*w@4P4qʏPNtT&;Կ2`r| LhƣDadu|ܓ<ԟ}`9zu sҶ!38@Iq@8[b(_|~uӱbVB"V(χ Y|(ZMKCZ>z>.l4r;'HOp:ĝiS@]`iҭoh7Yj1%Pø'TPM%k^jgEh>7=7?ϧ~n\;~ǶJ:ӊ=짿*.@2 R U7VƬ-x_U?Әlwfʗak-9u"OJRIx];QURe={A.Guy4Kqg:S9 7c^_<&h7Uh2^:څwpqit|A5ۃ؅HB@en\]uPowN[ߓ@Evj~o:-nr{ZY:>HӆvLeD&_Z/9 y#J{ Dg XU5IUu3Ś'XDAِX`m [[5sJ;w!K<6)=³6X>Ќs\.+}O> 1Lb]Mv}Z=5ʴufKcz;-iV=i"KB("}gqbk2[)p)?}r:jL&W私e&Cxw]@Q%BbO ÓA6;AZd0C-]MF=تRԡEb3#op!yW.b&=ccDK) WT\lw8]#JJZF }Fi/sHGֿ9}Z--x_S7|ٞtǞ}_Ċ+ Kar[ɽ6 !lrʘ97$*Eꤞpo0+hrCEy ߞi TrNt;F( T~!T&/{~ylrԙ2{' #mq˿Uړ}Zv ^f0Ǟk,@!Ԟlzǖzkl_}IBN|6gd@28"1kq_W{+/Y5]^[fFsnhcᡗ3J{C JԡE#FaT@BҸ?6/Kh7X!bk ”x3}FFH Y#+U_ԪRm9ZR&ʉ{r$:I_Lb>E>pS$Ğ;kyp(cպ ‹Iٗ6gtY^QT0=۱m֢4m;2Y-u,G~NvЗWvBN*h·[P'^ o J eFFїthB*Rƞ;0ܛ9ZiܔS3bD"/a&waʙK׌s|v%(+0N~:Vpc /0ʼKX#VLsBm"Րy&}\ahV,ݭBs *MC,;{7-LJT_bUb Rt"KW(y%!o:IIk?[vsPewb1ԑ(W>Y~ |sOʋ9u6Kh:.>R0P8AvP% i}NrXtx{8Dz951%r^'TB*8GRA(zԓ!<9)EVR ၣ1˯#QT¸o_[Z%S.,[Ia1vyz>!X:MVk/dHFZꨗgZt/#͆18P̪@Cl4N,g$h^J,\KbATlK w' >F-/d 㨚pSQ6Wnj}"7PK3Tj ꪪ{زF%.6<['&jȓ$؏V:`*Jy'XEĤ\29(lM&[8o0 -Š%tP~lSX;^H3OPYiRqٱ9mgCZ(f6DN~kj *RD匆AWF\lHlRMmM:Wm jI0oUG]{y|pnV*i^#ǧGzs(z?Z'7/A}Ĺ_>o% Ab5[XIhPJyuPIf}Hj?X2_:@Dbg N개06i C%'I]:+ϣu(>:YcR;y{H/4}JS5t1m讔R!FмVxAI pkĦ"hk(ʚ׏;sexH0Rn x۶}@VMrKU%j+1;鱐Ǝi o{6%.)~n0p u:V)6bS2lTd’s̒ dW (y (޲BGݏ; Uv޽;WH& #٧944(j}~46*X6S9 /6(;?zJp֌H𻃭'M'}Jt>G{AK-:^7s$eW ĺ^%?!,J>3=g3"4zP;յC٠58ؙ^1Ta:`5+s`$ϯwgW Q=N̪?)۶tҲh09՗ָl>8PO_4I\x`{};G-<8.K 3l*Rk.9IЃp{G_#8L5iF=8b/Tq(4oGl& #b[tb5J~8xNh\ ֍8Gx]z Is+M\VKņOe 0%l{)??k%i( ?LAaǤ;DŽsFwvJVdh]I :n͕v_ l뽺j-1hu V݅LQ1 z5!?aq5JsL*Trc}6 [[ݮT6itr9Bx*u 25yu_\D 2ZeB1#os ʻO&.[|׷ڐxmL]GR-ycEU iS0Ŗf;ٿZd)!`l>g|h5Ebz&YOx7 V(__'Q WP4{Z,q8T'7:[N><یI$F*iG5Ge12-9U39 Gxh6͑7IEdGZZ_}űJ0 mf`êLA2xM#%J4q?ȖɅ62M})! wA ;Z9֗q}xLȹSU"` G0zH)=zwHs# AB/?=T#h:˙pд}Pi?Zq7C.6"Q#sYUB."OL T] 4@%fYikX'X4;sxP0̈́gpz7C ޓF+t.MȖ7GiH[hHY3D= ׆o]gmOlQ|{sqx$fL,Qk.BWsD╋ʵc^\~KYʹJi]?}?L1H&7t)ݮk3+o17s)i24J/T-Ir `c:=hۇqe7t_ʶbxd|*/4 j."Y"Pݵ[h:#D~Uv33b 6'JbG!stzGr5S6bO" b?d%v_u Z6hrK=kIZuJ wOsY" >r)qqf̔ ,'5y.q,D xs~}. ov)@{0uAGτ ne/O`3RpL3KscX>S*xrGPa!ƹ@F^pZ)_v=y׮DWWKqIz,dm#bi7z2>IύjEV?񯽀gYPY%v, 1a; |Zf0BPXEp7c`E&KqNvgCʹn)W׹J9"ysLfHob/&jp.!]$eE"|h@%nxQC *зl3i4MZDc! d!6F98+bj@Oܤjz`վ `Ù+}]L2A>;\e\5. M.?0nRCGz񥈈عA)sA}H|Z@=Y&_uMpźie%Rv-ϒIC2,P)}W,Ii* &2+ fy%W2֛ h-- PY=@tH!BFu3 bKO2cw_mmR ¥M6#@GҞcvp3:9Yý7N3/DzlF ̼^(*pؼ>"0=ю—0)a?Ku1Uwyw&>ΣM*.O}y=i6(֓$ϵ`D hAX0AβbVKFumn%M+.:@ȂHi|2 ؙ]\u=Mu%0Efj+A ާEz?˜:j"Ig~rH K^ZԣϘѣN* xT~823UZ벺Hzb 2HF5A.wk"Ďy˸"&gַ++X"jȱX[F;x F'q2QVޱ[ǩ1 UZ7cj7&'O3 p MB0i"a c8a7GVM37c$Ԝq¥v+%]CkC<$ZXƥT:dcka:\k~rFmK &Koj +*CǽH[0"!kcW,# Oʋ0Xn8Ki.%bs7Ttc,Zӳ_jTH+6y@K TU#xbJsr_G* q-PɪV} ff_F*p[Zv^6m, ^3[,-C*r |n0]78xV+sQK}.8M|WHrHD[{#KH HH5$n*|{ C e-^ܣ50>mxu4{էB"F g2؊/aaCU 0b qЇz~v pR:;*89y'./"JRPTnCD*>dT|ѱ\N l<ȥO Q̓ ;$5瑳sS(TP&sCr|/v e`uocdOR!S0͊Sr&vpl=ӡ" Ldnq$TBA?S ֓] OzN #-h{(M,kt|f|q0O¬5T]gND.~ W*q5]Gz~{% TqA1cSn PQ 2IIBAxV%/yYoSv3xec5|0_p `zJS q0/8(Vutڑ e)4@`A 0i+69~'z5Y"\Te6ERcPAdK`.PťcH 1CP4XM &Xk $O13=?nH]ϹO-=Ԩ2DJU mwMy 7i sEon2X?_7T1&,O![+1jYnp:f(=s/tC?C#e߭}oLdևȶ 9#"0̡+Zkaz7=zP3Гae`rB4*ɢguL(x肃Vnj'o eCufM/Fտc O^B @"zd:y4;'E4&6 mW@* P@: R!=gakJ-t_w5SofC#3ʠkl*h/Gt{d i.f[)c18er7 -Q;? YgRmfLv1+]An$(AXAHcg6OrW@\/wO=I6NDڕndT96AUF),?< vm%BZUK r%; 2JX8$27=dAwvj=d N T»Gf+SzCS{>eݍ>ksmQ i()>l"h ̖-q)(,\Ӎ(^Ӽo־И'ҌUf{u]h;JCo:eφ q>uR1:+Q 1l,b0r9&|14 k2Ǒ>icHOmg2aH5$0ϜqY攅BԺO4بO*O!3Yd[9sI,mP#?YN WcZ6`DX;I]d[.C<+ώ.x/!d`%Vdw;޿2`m$MA)eGqϑ@70(|5ydƺާKEXWg Zh595#Tb}-l||cJ3W6aL8 Ofjb\ ,K{ ϓ7 >:64 &b{y J>v!>QABo@*ZNnh(W)ĉh/T[&`wV ^ֱ ,.m$DKpIE(o20HDopٖ*iF \$[gdPhhܒ: Әc1| RLxbayi'm]o}&@pΦI^I<~U jSV `$>rxJSwLKPAa2N$ewlpFI4zlh2w0tczۤ-F@X{vAr]Gu|gd "LM(s-Jq6TC+1k3e܇6J,QD. h~jUKh} (yذHlL ?z;/CސZ'HMF  SpgsErUE "X]D{zS ɯdu~vzY=L=|pH!R(c{l%K2$R$EX006`tuye%v5[W1w^c*"v5Υ3Xݡ u 8+*.rz&ef3G'O@6Rf XƓ l~V:LiK̼QTGHqաFAQZV"O"zIע;Z;kn?h@,u*'O.>򯅨^glE`6{\ȱvPb[p(g?=qCdrl/62Wk3_\g{Rs XaoI L_^זҩa|uޚ\$ܮCjCp}rbgH8>iW~npI7)3lOZ uᲦLH\~/nbAcT8ɏ~A "ALX`u4Xn%YjAgg6y>2\b<1sEMӄ>FꦆH?_Kd9o_lR5'{CL5~/OGaX ~^ɨ$U 5;g[M-.pޠ[& H(ôIyr9>#ETQD$5cX@زn϶L8? R'GG7"&\ܚJBLi `<08VhrnApc{W^mw/ 2ȝ"vzۭcI 6o";XW5$U\i6+8ֵ6o g>~tM5JqH=l4~_,Z(B&c2!L{U.V@ٺT|}D3OQwx~C`m;3P\]A8a{\~v&BcXhw>։^31D[sX2IEW,i99Ϥ#EA697ŶzM(8)ZCD' V*Zd"YQyϥ'P#ms2CT\XжVvnwwRJY]]Oرu.Pڧ ªuW5#5߸J%~!Œ(/m^Ccx&>;Fkՠak(M9FXNz*eX1hV/l9&ڃě@Ir# ir6~KCXɓ'􇏕)fLٕ!FՑ+KM$_*zՠ҉ fNYdPnvfةyK7îƒZIfː]ȫݸ۠ĕ,?:Ug3vf>A0ۜ^)P 3, د ̵1^s vAe`^|@Ri/tp㪩,oNbhyO'w#,vXTLw.HY_:?{(oqo,Kr+cƢVcFV?%liHSW&i\K 1e rxmVD;[^W$Q4 8F !o(Cₙa9OTO3mUq0m$ XEQ~;q_RIAB&%BQ%tao34Y_:͂3:`6ԣ1FG<^lį/n0$( x3 1~_꓎YR@pRDQ`G'{HL$R+*G1ʙFg1Ô!< $]l8nϲ(ô*زds">&I.8Y&1I!h.icB ޴Obz[*5o4'toO*K)At'ڜ)s@Ib$d"%.5aEe2. vMS7:D\ܨbJ,6F~|mOԙBPL2쾊5[̥lR嚛9pqS DʴWVC:r*f? ۛW"/&]1F yM<  EN K:z]ooWog3t8h{= ;[z\[Έy1\X+ϫ[qP.;8srnSanhh}SOkJ ҤR24tRG"fYvOxzxh<+pۧO;(O,G-mG<5$Y4 9e` : cSG&nK\[~27R{dvQTNogE8JU6[٬Wdkub=#O Sz(&\< }1‹ *eAY~ڡ2yg@6Mu(!h `sNV*ReTSR-:(*ͤsQ*\Њ9)C>Gm(8_|h"w/ҝVG\Jeq4ytl8|$;`XI r"[Nmo}Rs?F͊"_4`zʡ35>4~EJ$}TTDW{ۜx͊D'Zu֮(x\>z6՘bU2\!Hgxh/ Ŷsnj;0& Tw)%Bp 'NSoUvXYۘ4Ikes? &2uh(n2ZgB%btRTLK"Ei~bij>R7흠Apg?H MceLȶ6˽ML QK?iA 9 ("ZϨ#=yFݮp+joCZ9w}yAUU)p .1z8B,_ YRmokE:!}HVgJu Z ~^5PƲTO҅5PԴ>e KSlCJ)s!y:aPtx&<~iݽhw\a_Bm&\@~ޮ$djݾϲyl%\'wI4)ec†"fjL3ɠKb߃_x՞.MY6hizimfANTEh܍-coUs$Reˈ=]+/ȮY BD"x?Sq>RŷTœPl*y[Ș!OWr˝HSǥai#Ky^{-i! AOi*Y\ճ-YP -l,'ط8C78Q/*n!J?$}/n˄M<ԟ9e٣nw1DKG LxRY]8qZ(D%jA:f.=uƭ"[ #UI]|btR&TdM?;fzMgIU{"2H}]+@_)B:yOxWߣsm 튅T=C˒ RFlhDAv^j ^EF"ߛ֘l8v|*tUp̌EEbmG`ߧ xSB%,!{]&rV-.>Bd/ DX5MsZ;[) 8džzNҋ3m˲ ^U9"@.s鐟Jv) kn/a9xSfg2wIyγ|o _~| 3Siv4OKsQ nY)/ajڷV/:!"i [x$g{53r/ JK, ߶t#҇O{jru_;~9?$;)1FE*+T{C B+42LG-Wl#7Yu9\uJ{c85k?s4RUx@5Ok26rbZ8Bn+Zi4T"is" dk3݈R`YgUX=Ȱ!FK'E coI4wcJ 'U" +TH# "}w"@+Cʑޠa;\-yHҽlqj@GJ3 5Ma&SV(3hrhY<Ч;$RTSp)fQ'ht xv=+}?pCÃ@rqDQ|1 !;lS6#@$V=뭷nZ|]` ziq,- ߼! זd8~n'Hi}oWol)(~zkwr ,94`}- 9R2&]\Qo%X1_Dr1'n.(i!VjKyP v t6K-]9LB] ] dS/Oaat /yq'wf}x]JţqI{*rDk@'g?T61q ]:rqXv\ )S原1?T:* 0+023 R 0ƊN3W3o❶Nfy h[*?e>LCǝ<*]ܱBk4eӦ5,2_܈v0ƇU8c\D[%/rDW.W{H*E[k,(>R BAr=ys19l $x.Ll82xQ)y'L!?tASs4__ 20f %T1Xky;^n-k#SK>7Rg$OXg&Z. qc<('U)cb9b ?vj!rzsY(!đL #6U'@x_~WްY"?d¢gdeKQ9 Pes ԱmBV38`~)[7"C#)=kd5I(&0m'G$IH,+r1[@O b > w o>->$%4"IX'mZ YvIsD,| ӒwL8[r/p`- i <("N3?Az7?ÃxKr-W9.itl>Ob+?L3̳=A3ЄʾdC+Q$CTNʊ~>&z-q RSC94F+6~"=PO+I"[j쬀6){siRx8PZԔ/8GQv`7#1SxO=^!/fhQ'27Y~:+P5Nu/V}.4임9fR 6ߟ:AE{y_}L,滫(yzlW ÝȪ6,;g؉|?*0{ib쭆n]f%9B S6zSh6ŊKanW9,"/4N(n1(<DVTœ5(Z;%|8@Ѯ*g"Pa&K*HQS X(`,y%_$FDžD)iqMn2tIJ,QvdQc5`ߡ7y6ZIP7l^PQFSW[@,*rM1!xcWp/,}jT.2egҞD]YWځ}ɒt=/ nFk@N{'@/;-j 6r19cMcEw#vHAID`0F!X(K[ sA4v!'@3Sm̘R1CԾ`u&h6%8Y᧬jǩ`u Հ70I HNբc: JP3d˄G.p{rxiv @;D\W,^W0w)a:&Ri?)fMF448$I(}7\ 7 &O1S:NQG"]ާQY)763K:" h*z`"rK^[v敫=ٻuS TUz;" QGYDcQ։nh̡jR]KD^1i0|)t}ʍ>6K:3L e yɎxB s)VV:Xͫb˜D;,(isrRώ̄2|C,iEbM- =oKmoq`oi1݇T\"E}`kgq41m-ʖxdnSС¼=X4y-?UŮu~8x"'9 Pt(o3쭼m->Jb]~79QgɯNa(0ذ`BqAk|9%~Dܝq{-(2lZ#R)fӍq牶Bžz.'|U.or?X&:DTzZSaIoȦmOb~*Y[we71Tw&Կpz >qOM 8RǂDyX4 m1$`[G#zCw Vnwf׋tB33||D Wdxb&WVY*LLCrHfL qӸ{fXi, : )su{k곦>"l;Ry_{ޘsv/˟DӖN<)eȪ}(U,lv^\sSO >4*҉Xɔ& GE͝ 1Nȯ..3YDkmpvmڽvex : [' \͝\ERCTD{˝ d:E[륕3Q% AKɧڭb68$ùMXҗ_1r{`} ט9=r+Z{H7cl 6sJ0utI dݧ|2ʑGo̺҃Cg5ٟ" Z6<| ؁"lnB*Dd'IJ Mfh)h=dVWwKcN.֯X41?>iJ ULcAR]tyRUw=ڻrp)b-7䃅ys1N)_]Mho?\{kȬa"sÆ)[bC(vwE bS |1Y5o|wn!0]: K8qnk?yǝO!L!h Cr 0Nr*7JG@ ^a,Zvau[ N R.KZ44B0is#NMW`Pn) yΆ[)c[ W1ʞuNmWAjwN F8ɆU?၌Nf9QqڪQUc)V-aZcjI8I{Ѧ.A_Ŭ uuØL3,.r0Tx:;ډb6!̍au*աGF"J@o4~mP [GF;A[UIUJDͼ&V;)sJl & #Zj-sO&  ;hC>i1Qv@{Y%<&Q9̑ێ-ZR[5P;ǃH]Ԫ⠽,ϯl 1n`N.  =OʹuEvC{oqaC+$q#UP3A[*8ܴVm*HZ/ fLđdo Df (xaJEYvcM"E@ĽW_D-Tm2"ưSqY!r) Mj 8nR~3 |Gr Gt\ғՒ-|;aa&_֒-2 j#)7:ȩNq]F^[47Ey^cʎ@\QŭX':wkg-."~Q]R  oMٔ,2A$sp 4JFfvl?#uO@ ]j1N<ᙏ۞6qvw2Jvb#6r5HMҫg>Ux06D{~⟶eWrڦv-6ju2-apthyn4t&CRXg*?Xy.ȉ=1}̼FoE_|-Zd61k[G+rJw4א!$|/Nr`$Le5gӊcdHiRue$+ r~v\$AODDp4_y i}:ZЃsrEδ -p37~QcI7rά-^ͯi\W1N=J0ZJ/.B%c1Gf,6|>PlC7-!ê-3Kߓ\0tx|H@>t0wgE!$~|A> S[Wܭ'eSa3+hU|T#M9yY egy@:k&=YɓmާzU\Hu+:^k1ecCkKeBϚkz2ԴP v[#9~eC\dznM)6a;0 wuX4 !0h"_L&6iEn F X ] p5vǍsO -KrDvd)ܝĽOx kju jUKW%H~ en s|,BdDU0d"r.D q'O)7\[7;NvOnUnK(51fh[@zkI@#ܯ4MB^,AraU84u%sAE~7Р鵞&L1Shĭ(NT셃#Bŵ^bea֒|D2/S}ǁ4|(SBp2 A1HR`'Z4iXّa |q7ZCp.>9c-^,{'6dL@5x7@Md0(C"٤'(՟%˧;>FWaI4S۴6C1EW[s?}* ;QXfQ夼])Bl"K=m]͏'4uZvw}j)i2J|JItwԺFVOPvpm3kqzN_R$Trr1]c-3%!\{L(X7`k-"b:Ί4/Rs\[hAZnSk.eڕ X岷y!_|X(!)*ي!6Uq= ӕQОͥ5LTohYxW 9>j^wz$o`d^XXzN=:0(58).(o6_^_$ii݋}D{ 6у2rKGa4Id3Y\wj|7z3TU"=. /&pt=d?Ɉ3<ke{%VYVv+=z}X>!2/,5>g\Cn^*ugi#܃"KRx"rؔM627e請2\1wh}:@59K,Er*+@eN'[)'-"MM*ȏWFT|rlP9HfT((HY*g O21MZK ~j}_Nؚ\6rVgMUzXZ;y9v۩R?oQP30k$l$jPC+mPk0]\FFIIȶu平Qp?Qi=\!ĕoWI.c`eGbblTdO}VKO2}!` u[/ϴ7\?_uw,Db'&-Վ!.a:A-Jo =X A|YaD}1!᳑BqgB/Z|e mnI3@W45-9/ڕ U ˚0 .‘Rp`ƍpZUX:ңz x((CrmѻY̦η]Z "@0)6GPzPMykwPMN't+AT].Ϥf $uEhXR۬ K](J·"9>Us"(ɺPAY!e6f{1i`z 0pȱ >5$Y+0 A9J_DD G"ݴaw :0ĭ'z莑 ^^s@iCy@\)IЯ`aQLի=G5q|xEP`9%/ )Wt@9s^R6i*yxGb+EC-(ε{`6람YB>EH=#^!%NϕFKg N2Xq]QrJ|$->[ݵP } ![u"uȼ!BMzkrC:Oa8~EFѵ7ikHt_ک<;L@R H"S&/Hh{K4iXU<Ր Qgxk{y3&仭PmoD,٠_DuLKnCL9~V}(Ӊz >sCpD03?weuNp& bEPuD–Y ;O2J{A3͛+7irX?zڝR?Wx|ԣYUX%gxhx_kOl7^Mw:A20MXg`PZK80dpk. aE|d\r(- _h-'=ʓUjHzyq]"X --$ Q8XABjw8#y"ACYkfTvkޱ|G?1N/kг]~<$sJ޾Z:Ŗj.$Mk=q8s '3KHl,LlEw?>:o8S.B^W*{ xĻhE.06ܿ=pý )Rj̭OZd 3ѠӦ*7XSZwĤңmJY^9ʁ(lwf֛Ӛ v1;UsǍ+F 4HFx&=^=0/щ},ijU-yDwr̎FЩH\flU<!q2xA!Px4S;WL"W>Yi,B1K%t~UvP=P?f#Rc7ے|`p(W4&2{0/*vb~۵Sw|XClP^JGͧD&H~$^N ە8JbōʓtSϟ^gRWsl}[D㘘x[MS5E%9rwΊUe01 ߑe{&xB>J {W$dcW~4 X  d1ӫwFkcd"3IIiY:*m9o|VC`p5ᗫPO%ħcٚȫ]h'ʭ]cB&Z|^3BS6Tɝ,Fݠ&D+ѝ&̜K{801t=ԕD;? #H9_2΅+s9*gqQ2\k]q+hM ݏҸg&Pex.o>qx -q}S*)]{%^P5xԿ4C:= j1 %҃r?V)tq;^}jˠiqdecF"Q?6ݳ26|!]IY7$~ɴ"RXo {AE> bv'dRYDZ攛ŰM!(=X#@$ӱL, J~Auk2K#ah)Xm('(N) Qz3pfzT )P p0.ߝ燜OMѲ>h'ӢXRK  filbу1cɐmr8&~6BKU`DT'C8DLj xpXtm|~1g&\cs/JV Xs sPK"D7 ͸!Jc魁`&TWLH W Mܬ A-<5xdDoPxl['5 (o8W s(zKN[t5z`sjZ/'*NFnM7RiYI#=Z,_)tg`ZF]VED#y ʸ)w]%iͪܙ;1!-C?|dyd:YΦkOGx}S` ù Lx 6(p*N$uZčF2›٢nfy$5R7LYgke|_A;a<G?bUt@#I.X:1n##"W|̴Ví0Xi,Xr*N-%#kpz`@|@@wj^C=9f ~C5Ӷop[4F:]+N-W10忍{1 `jKE.uD\1Y1u~tPə09"Ye~E߰9!`S;B]`@hP.Vjh>e #Ro|[tM dtG ios7Aͳ!6 L᫘b; xO:sNMg+|U,K}+czbf@Nȁ JLNZo΄7cmgW@}IlL j'y<1GZKV6~ ,LvZqJ؞83(= H}.uDe2o=oT쬵$vZX:6|-H25X!}6Vu!zD7P Q/Dwy 6 npH؂sef2uzhӾY|"{%s$AǞ̇pq崷G,xFCW @7 QNvOQ]NB1`8TCpE {l!6ǐvFswOR b_0ʹݩ!9&ȁ=tFP& gC^aJ>ؼhey?LS@ ~<d> q 'Ğ/*slҧonn5-Liũd54ǬQΟ'F 2_]B\k*H*ZLjF;pN{pt8]e Y%6LYȈ\!dȯ`fېv~*Pܒ; @trCl3$LU: , N:lcf%bq3 dU=rFj֋QLwؘz>ݟwOtZM TRFa 79*A)4;+V1+&w5sTO% -㉞]- jlV{̕SJ gK6Y99;@rdV*mr &Ql/ ݌;s..Z[8x\lK֌0$ NK'!(Az#%f8]+֘&8Q_״Lcru:?ةEϏ =c@Ptǒc'd po3;PggƹS)>C05 fR=Yr'/+[o6E#kIWr ū L y hw8E㽯bOtY-O(.Z'VO$4q?}dL1-&$]գNӕ×g[4R&1 ,Vڼh=Hғw!w+8/*XեC&Mp/TGWa\<};Qe)XԖSgD3nkl=>ȠHⶊQ[lrw8MJ$8zkHM2{_] 2r5H4akB/r:.)%&] ֨_ E4p`4>Fگ% cI!Fj⺗| `OPO4ÁqrN"9sK(oh<*w[uv6;| 8ybq[ x=b֬XBÝߊMC|zˣ(]?= f\Vvo<9gx{>n̩_aA'DIWߓs9),QgK_@c3l"r 9$[2gf#ϿDrk{Bj}0Qg%s>$Zz+O!k96uPw]ʅ6Ii?>P@N}_̀L] bц/yx1|#ADjB1eN0 ƗXz/,^!z?߄7,fBGγu2-8KzQq)sumiS$o˲ΨF=Z6/ "MES%k:h 2`aKQJ~Wwu6s׉ |W#9v"m5=ZgnlViK%_z2:L5y$a,T!rV'r(+jDP@pbk!傊KT!y{%[g  iL5VySLyϊ7#ʑXdr9$+Hs}ɪU/l)lMDg'Clrbrn&-;;СC,)m1P,/"ہ5 jwSf![䱿$\"Vog}R4LaT)4xPn.XA!rl:9e2WvN A=?)!{: @ϋa[Gk#[wm3Cg9$c,c_TyCF`zTIs6LVBZhJqkJS}YWVuw^t7LuxM%^'ZE#Xvj֙ϛzpXazUZX1L{ .):HeN|xhE .Tڙ~-ַ9'B=WhBƔEGH}YS-/lЇ/ H.U%mU $}@m~Qa ``w f\u+)d kYL9'G%Ov=-bxU٨Nm N% ؗʸYoһw85MH7OOB#_c|QKp2#o9lO)Ib ɦr4NL<3` p5 1r pۥQ'-Zs>S|0oKXΌ,"F(cTRc{ dU}'oKb/b(Itf,ۉ(Zmp]tPM\4>)6t~J7nGFid@MMm0]e&00UȐfjhkX,,ojqQ4Y~*I_F+@S [;#L8&B[x :6Ȳ2'cTN7KJ>3PxS=i2>ٻj{s3̴yoͨ2K ^0qGr~sq𘩪wjx | Kdk' 73|X:n(A+Ȧc5 낋t{ODOT 8q7?#j+aՕkcJvf7 $pj-^9<@')?"H3H~h. k};!t>8dfĢq ƽwN*1 зjO,enJyr/R1!'3W$NoE$ USGa4mPYa qa=5d7g=ZAc ;*pܒ5,qۦOHibk zh!$q$PSFފf L=OJu]/=YJٲ8gi6f.bK6%s`>Z:(.mKm*` n]YD?\mrk-P',YfrV=kP+쇳ZԮ&..G?h >8z^Z,Ֆ)+]7 A}֥Lf&5F`6:4e 㶇(,!K%z< #"gkWO(#@fזuL]*'8CPdz_7 ; ]:53jdf_zE ?Xx=sx6ooq*0qG^4/ Z'zvc'E3TjʺzX{rgֈVf TT/x:W@-x#A4QXI*Q6Ėjy星 VLh)I7 ggv!җdZ 1Gt4؉2tWׅ53訜( 9K>:F=üp4nRHjL&rUPgzNV-N u$.dZMܑmݝ-g87T*$rBڑLڭ}7>b#`am4,YY+E*Sϑ()IW2@ `*I>hS_Qp%`}s xK=L.A' x|FGւ@5 -sE+ٍ̄  s af+AVCD?ж_W~Hd!.o(ڋ&CE~43ua8'ع/FeVRJ;q7t=Btmg&ʜe7JSq5!Uk j~Hu4e ݋Yo `Rۼ͹^H% nH,#`;>;nT_Cbz1i Q(P5qC:TO]|_[؁ -O>Pnw kd(ly/}HA70Z%/ݹΤ'[Ɖ:zTs^ uH\* zu2YKl(*;9 y_,E:Ԟ>^fɤ#:v?6gC>nw Q."!؎2[;ShCAC=|`Zo8c~7Gֺ;I߃K^i;kmd MB&f5qW!r5Kp[hs rCw/MY\9 -don${nAVmoJi~U@lvnq(xt-ްՁ~2ߴywuz%BFԂL$4gh'kD*s\sH8aR^ib$I*{jZ~\/NU pS\]z\9UUگWT/b6D ppk,,Z G̗l5j%b ao^)j&doe,wi -$cO[{(,DT=TFL|A"B1ol CU\zTP }&k鴤|m-G4Cp=*vxe?׆LBҤw+~rb{FclZ~IlNO"G!'d&$7T MsHQ.P$@7MWMX07&[RPy;¿6Y5a$u9کDmh_}"14Noxr BSMl<=VH;+qc;NVL_Xmއw30MRB gkHCoe 0\:~#kXZc%xL55[nxԁ^.|gOt;rPFe3 1^x{(S>qvS}NB o0@a>`dbM"=<eړn9v蛎e?S9=<[N)~mMD T7nm!Qd/#(R{~;^lc.'!ԛ=Yo߻5i8r;($RYsR[WrG;mOv8_Qaʫ!Q`~e5d?n2Gl$[Ip|+;'hleQ61]!)na\0Us"Ll3̵y'J,auqpiZE萌DGªf`-WYCxuKP{ NS+yaLp_,=4QO$qy霅vT  ['Z=[f7ǽ9O>({_Ot <9!bPu71_3⽶Y|H!nWufd"q iSե4V_Uudgi˸YwWUa 0\kFGb4cp_T27ǹܳ. Τqk !Bv/ʉf0}tv82葐9+ŕ~į ֧_nS,xSPnPhޯT(yiZ!򹜔8DB\a .};/h.{0fV4 >S9Ĕi ZUE S X~O͖~pPex稵XڥKk#=@ݟrekY2FR YZԾY/"Ċ[InPt&Hssb:l)sGWiPҴLK5s"62/H>DLΙ{n{S7N- ɀ\P68NOp쬾nFmh{LSÙļOEKdDs6/G9[_Q\ Co۽AA ΍n pijLNF]ܤw9M& 2\[.y*wXf=Rh[Č Nuv1g-~0јG_z %|OE #n71~Ζՙ]d[n&Sftd-EW]שTtNQڻQ ru(W7o$:.Z5UAY`D'8b9 /3_.fBv;4SP_ɿ|F -f U Mzj@զ~C'}Oj>m=r62jglWaNn2#o;Wg H\_3C{uq$'1`XE1;춅WA'2N]QȤvG`s]S5qQ(nqV-gft+DuhLW^E&MJ]s>uc a_uD!jog 'P\R:G?cۥcV,Ng #/ro3۞J_Y~X%d*#xd:Zbk \=:n`b#CIsLLexkWPm z>\Q]k9VԺF]=Nrg=Z fUhEcjDgbI_ :LD-щ}9掛8!2Ă/PݩRjw@`[IC_UaBe|@zU@D""6gMgV<|h&l:s|}X|fYS3wyOF3J{M8Q۞-oFGԣ.[!>4~pİu\˝R N\m";x@ -t|dh`VUvv`TIpP ?h4^VOgMŞ kXo&d9)[g~&6Te'u|7Xuuy~G^ r|+%M ?O#RJ}hΎ7OsBEG۟B7**eKXƃDLG|5}!&J)lNafxңDdr~afO~c-ץNG1Tg).;z^Л[)LSt A=OP~>X5G)P,DH5:xF_ѱwԕ zn1ؽ;9X-V *oLaxB.4^( ܀jn.ۦot"5Ռ *5..]#ML mb:d~*YQI((,A p35./_]as6J#w"Y82۶4M&jfRA"reWU].hDMoQZܫ\;AH9fyWHuvC8$C6>z<6ę\tD~ikL =HqpŌ y}/I2y-E~a!IqMUw3P#D*Ys\*)-Y,3RL4EImA}fd {KZz5ثev@Kbm0aV2[=ҧ;-Q<3tQ|"j4 Qշ lP>4=,kg CV zP!WOQ$),s[ZCe,TP*'iz'`o>}DM5-x^sQOFcI&vLKM:/8yZ<1'Flvy1Y9cYJy#qE&kǟP/E/ɪ!pjdk+p NF9\G;E.1MB)ف PCpy⮘8f?*C+(@ʬ,;PЍ]ey7)*5z1{n1}ۍݾ/3T 6kCvUiۖXhl9] rAr8|,v|љe@y?rν+q+]atMߠ<5;>F1K(QbACE ֆJFBLPE.r+ң#uL-?/Cۗ(t`_uk;B\I?ױgAU3 1͙ D,߾myR:$K,PtC4LA'WBugy[K"/1t1{Zᕫm HӱDB tMc~6z5g{) 5x`VJO0Pv6Ǔ6C`Ԧu%y5IcB%Wn7߽?l;(ͺ%.gkk:RiŴ8SS܃osmp nsrCesгR"WL#Mg197S{¢2-xGȠ_e@[q6GTPqW$I 2 VtuCMU w˔oT-/KVJn0miFO3"dq,7KR 0[߯=NLN{'!"]P$_S.TF&Ƥ ~!C`ḋfyB?ǰq&y D&~lŇ~D?YzWp nvC@&*l _"CpS{81&V(5aPƣdֳ7ae0(;5eh׫eӸm3{,.K9 hq8#3 !I-K{(֑A:rHD :ހ xm?rleJ=ZŴ̰1J._ GY"ciQ| '=U;&7|nβ!{h(7[.ʽfKPˎQ Pp+Sr%!&3k9HZae5&?B2SܸASE˿|5YO@R ]\M$`!e|JN2AX&v煯-!G[:AEG\^liqg$4XվUU_#^:Q;\/C׀,һ=~Nl1g` !h_83 >qRК/m<, EKy9|̘ m*0ڵk1G~z<ߙ0B94a)aOWHwK3o2`afKo56f6w3zxߨ,~'p/Nɰ =j0(k/ւfkg9SSy1;<. _G7{27#C|4U4,tOPJ+H.2ŇGư~nnF U95^`۰Asд@%ӷ8PZ/,Ϸ.ֆL- 9\VdmTj'^C#2R7˰(A^f7f=.ׯ愥;E>6E=\)Ko\6[|4J Жu!>.8Nh,B(6M{2rBV+/: ŭSʟbEh,j(6kjކe{[D|kF c-VԜզz9$©W;ɴl:w\p}9@ @ZTL L+GaeҞ jL(O"]gZ)DZU0Cat !5czE4aj6rڍ밭pw~lt~"u}%m]0fXrmR s# %aTy6SԷS _s\̀T>\CJݳ pka#׵нGߨa U$Se#u]45{myTXǷ%ī+6+"3DX#+K*E8Th rk""5)Me5:㠢OAx^nqP h2.j:MK`fր-Q^nrWŠK%Lɓ~ v"91EC@xlNH8Ҿw=i`|ZQ<0<U?3K"\Gcg$J~BF`SWt^7?RJ74Sd7ꆠa z'nPR5]aX̽z;ՅbT,|%d$c[FHҢb"JtΖRĠx 4UgoQGwX޶%&'Ƙ%ZtnuH)5~fv_?owWZv1$mK}{%!TUF#%YSl,_ayNHrBCYRBՅa4yi" L #yToPw-uE,8hi IP_uNe$C m^ f0,I@ap%0oE_2$6ngiܮFpp&zrf!"_y ?)FuFW؈ЅHiUa=N Ğ'>K"x@ $z~VRT9 WbHA1Fq*#hy%aDLB㦣_,H p GAu p_JYC~cO mԔrD`& M$1}]pj͖vA_:ZUNk73Q m< "LbrCp zR >pn0*nxf>Q+#t9P:"mIAnjQ>[sźFqt-!HMTam!4Nj QIEtnǭGQņ*QQ"~Vg3P|]r;#g)|sHLJ5-\q,&!6~^J<,0vC5k @0B-wYe`?㨑2Ak穟&+V4 aħfYV7/#ݮ%<͑=9WqTfȫN6"1by M_ȷl$hU? |X&g'AhkMy׽2hv",>%.Kw,BPYpl-›I7 &Me3Zǎ^[NF;L\ 2/f7Ąk,ƓމD༿ pqJis;gO-d(")L\νqRv)R0"x8njmQm㈹=X,+h1lyuQ Dק$`'L#0=uGa9,ʧw;vQqoLG'^k=+-ɸV#LÒ]{p,*9?5J)y-wru\}gkmfe+X=E cY%(b1M}u6 8k~YZKg!WZ/DRbpy.8'[Y㒝qC./ =p?ڴ " yvkSu8_t!|\agx]usͥ"OTH3N[ aߗH#)/!Ba>V(?D[A3汎n Bc R|ub 8Vk-Qz=2l+ '8 T\1]ȇ拦NtfmGvM9|+)ے&)xKK[);sh3\ff>D,}ȴh~o&{wu[Pٳt#f:5/%o3e"S9G-^u^Ů@gIQHg/ԪܩZ8LhӜ$^t(l?c9oM4=%eW*  f^YtpCWs`+d_S̛r߃` sWgF<w7s8՝:_뼐`Gve ?1 8E$C_#&OX9yd~?Xz̋ =b" ޤGz<>,Q5>BMPMyN9a2"e m`YTD}p"CFI;:ьi3PF_Qr9*ǯꗽm$?vq+#6~xGB,7mLPȃH}Af/F& 1Sօ]xrfC`6!!\t"98E0P=RH~-$+Xe-[@kO滑3ڝ 1*OdɤyGEQea5gsUe00Dw{B{nnؾ@?󋮑REO5ܥg"^w?BS}qGmdL,Gx4z ?!RŖ/\ގ|2$^j;V4j0;v+R&qߗo?d<}auhh`%U ^B&MKE 3_Xr\B-sKJ\}m*I[#ٯfܫ8AL.~5U#"@PrtN3iAr@=f:T(یҪ\ k{Ye R/c4?Xx];\I$irvAGw$ςLe 1[~T9Cg :vpr/ 'E4啽 0C1C:wy*9GeG~Q2]`ڔzJ-3GWgygDDW^/ T2eU)KTM(V{=pĭٰ YRvpkGUA0634@=Fcvm%?n5v(L,6xf0$|GbE$JChUSPt׈}i.a/( 6sX}cG)ij%*,Dݐ1Ĵĵȣa:vj(gz#ĮXZ3"258«QHShVn-l+TOP%՘8V銾rF#ᙹ+KATcmA^AGo28qӵG~`|zK sU'2%&S"'0 2R4c&b;u ߘ(z V^ʇŅZ44FS}^%"?[Z乧 Hi- r0WVv&눛Cr~OrCa&E>\xf5HΆu6rQ>hG2ѣC_}E>pa{ޗA{%+ e; Z[}rb9׋9l&Ձ@m4~eGK;?8WSk@il [|4f~a0N-B2Xriَhu)V?`;9; 5x㎾1|& o>5feTGrޤf,LJP]~> d CZ8O=y蕏 vY#&qPJAJqDGkΉ,OR@hȊPF^\DO/QhoN8jJM/Beً,퇪MxQozLvoo~I!olؤF1P, %Ss}RsZQaۍV\qcǝеP>\Ϛ?=,'+Y]h")|Ccr4b)I3)'8'C}/k98ĂUA&X_:=Üj4~Лrg*xsZ2oeèi>m #dw_})vsj `$79M }۔Vb#;W^&mpI,'Nj"${bP9ٰ)Ffq (2rTPmjpȌrX`U} -կcBj\S&F/BqdY;;/(&SQr:%a-q[x΋q$ߦmW IVkk M;P:Mˏ]ܮ߸3RM-)Օ4oҾTռuyJl'w͝v1q\-Ao(ڊ5e*tR*B;Cf{rXȄ3\t 3qNj4{U%%P\h>ޚΘ@EdX^/ 瘮Zl8}ojB| kl+?|PYsxČj@a*e}R&ܺx܆ ^g٢dY풶Qm\4 V) Al*C7δ I_w x'3l4n򊨈`a]1ghup3R]-1]7:w~le'I?Ư)mM 9 M2mxe CTpBD^¢0b:V+Jʍ".s}4poC\.i7zJH,-r F$@V =j0;F\Г͓Ku_݈}r1edsHnXPYFxCQGfhqf&8l-Xزcn)fpY*2xXER|zV?';8'p4{|tc65OUa?ZJQeUyO)*+SH;(\tx5#`|+2N3b @ϡm; ^2Æ,N'w*xii.W.Ypn7 J*)htB㝾UCV aWt;u6@Z H ͌rHAETaQ]٠P9ZQUrUTsi69|xdY5#{NƳd'8??1 ʍGadE!~v$?SQ?O7O~{$l<~IJ?GbYO7#VX5&,O 34{' IjѨb7Aj!PJGϺ8{P_ 8.KZ$* DJmY8DS.S8?AofN1Br&i(oaYQHSް4e G8.EZ.[7=hRE^RL(v´B3elyw,,>bRA**O(7&ߕVΉY'ǚ!ؘٞZF:\s,Ҕ+$o+qn,ٺ4 (6_J"Ŷתq@{(3re3JK#z[~hxmS]W:P O//R,%Df*.qZ a"! WOCH43G 7M_6u?rP"zH{T Kmta>>O%IR=H*/,1l8TUq)Z>?EI] N WD!XO%z)^VU\Zb9+No*a2~1'xKqr~H"$PrB/ c"~k"{)3ԕOte#MT,}әߕٗ0ZU/+(ts*_fu,GM`HnȨN[ÉN^ztyMҌ%{кQԷZ${ʯu}gKo;DP[2SR=vл/X'2V ?vhA7_L +fD"dx m&FWeV-m)~ePܞ [\ܜ.hΊGa&l/vTrN%T8)Ц}KЌ54l\j(bA$}x5(J+r_s; B븣RZȎ7J"PRaz~!4 ,)CPóXيd ]6"Z P%T,~N+!ed@Ḳћ"tٍ6O_dE>EzU.rn_][ՐFpG;Mr=LKO>V3Zaw~O7vNm1RZ9grVDUJY!pվEbpKSԈ-T޲9HVRMUI;ok>E1?oH5iafJ= 8vm6bڽ*L}O^I5:nؠna)Sr$^Co]`-L2^x軐e!HX+[2r\;h Pt}Op~h'rnD6zb_M2D 7u黊:tc:}V "6w?Q`!s# NIZX.%܌75 w5 tԢ-R}AKFZ K Y]q4c攗A&Clux<{%5b<-x\ |-`/ab"Ss_ng0?+^. NahCɷܣMX@2<[=S ] H|'sHvjUԠyR T RtpNŐs/\ Ow&9=f˫@IIzCC XGpd*}uVsI;Q7xbpd, ˇCH;j/]3Dq[kerGqL"\m7 ?f`Պ2?Ѷf#7 o͕~W1X*+T/ʤaDuc<`Q=@gaNtMOQ~q5]jm\ۜ,k39:(."i@ "^V҈YJ1xgaƖ5gUG CeA!vq$ĶsD |fDD@$a哢4N{>O#;?cHS-tM xHejGH<2|l"-vK*MpF 7f L3N# `2%$ \ s1I. UNSZ(Q)]Epf0rYSG~~)HpˆJlk EycDEfsQy{Ptk*(e0S5LEFQ69YUn1gSMw$= -=edGsR 1w7Ho?p_P\SzC^j/)Jz1^4yeC0 Ca&Ń|wsa#T0 |LYߓG@\IZX.,Ĩfx_nRV~l6"= w D5AIE$ͧ ^\?U{2de>1[콛)U@ݜ+~?+cPEL_N\>z?JU"'GhҒH(=,`px^筽PH- Jf Bô-zzF/-tfbېQtt畈cyږ0/П~+.WG2 eؚTCZ١r>Rr 0Hp*lPUe`]:F:`nBFzA Ua#>U-׌דz'N^cqGcy ,JpԒ BCa W3*]/_NHA6+lG@Fg?\6 ܑ!&6[ Eq-W[hoM7 X<=f3cM~XuC{ ` UYp\pj -"T$Xp:ERoȫ2T)_g7,!͹Ur_ă40L5Es$KH  $-:/f_!#. !"޳ɱ1Z'Nҥ 0;I[ꮨ'*-taW(el jԈJr.%kXIM %2눧$"xQTO6SM~Plޱ +³#V!e4wCIE*нf ]R0^/q;ד|1ݜAE4TZԚt+ׯh>_vm#Put9(JĚ|7wS"s`uFNe$mq^Q7M;}nkaaeN;ZFqsR"T}(r,ͻG jM3?|tTfI‘DaE/5t { 6SΉMJӧ`ww%&l[l4NY+JخOx|؞uwCa4=&I7B,@Z6QDZ6 ܴG_yNjZʄ>"*tnhen )E_*yQct,fP#CS"Tjl}^e?hT;&F@AE DgѪwG/lj>&@:װSOajÿD869!'n^ȑOxdho@*&^e ٌ 3|5{lo * Oeag@\-ȱ 4W\\@M{^n|]AtvzZ1W]1(둣Pk4*.n(PfWs&oT݃i4uU/;q]w C<הHYL/_{Qevr#Y>Qݦ\ɪ-V3퓲 f /x߶WYS:##|$z,y]hܖ&UKoc?vxncR7ћ( ׃aox-oRxBL 9!\#^YgIDIxpɔ1'ZJ񚇡D9`Q0Ũc{L:%f.!ԥgZN"BTTevE4r]-Ԡ`A;=$ltI(Z/^cnfw!w&$} w`g_ꚷ1ŷbdlҺ<;:޷`ˀD2T^ʨF[`[҅3qam1'WH cuĉgvV.t*p\b xb5qf;0,!|z=^Lcا1,,'n` 3r(%lFl,CQ^*'jz[Z`m&~:vǓ7-AB^zDL>(,,P"I.cށJdh /g.dѬ:~KxZ,/: cGǢb"΃ы w.PoC}]Vc譤Ji@vڵolX_tc6kIa `Oj~mpɒSNBE Y(f)tJٹ&j5B:]5nO>j;pSU 2DX, <٦<ZplK!ܘ 꿴VI\a׳ss@_-B(s!]*@~:-hqt3 [|SOGU R ,a?Z]nx8eSoLZ`oU81O0kH7)w" ,54{P? -lOJXL;T(,M116'꬘hո ] &2Aioo !8ʿlR_98S;pt'e9m{xຑs|7pc Oa9*Gr65sZ++:Ej/&YH7Ҁ`k6"𻂒tsGS sP:UeӶ" u, / >REC5שu{ԫ/k~Yp"!]ZPJO6Pk5N ! YʒH;"@yp̵͸r7νa.ݲ')^_3/l=v9^oy%`ZBef9":McN0 ր q'ԱJz\ f,7j& uRPj2gOF>bzV,@ TEuV2aSNO'f_NT]*[rH"Ij_}r* yur% dOf$nVܺz_%|.LT2$4=8F!!ijq?vDU<lObsd'I[*+3r./lƹFq3r[Ş! cIpfYd\T-[ŀ?:8 9z~bYrF(X |ك={7nh!{ekӜ5_ZALmUgE"j>Bsdy`a/dT ՝SZc# rs7ρ \+~u7p`a_Tcy:{@މl#5K}ORXv<IH~@ʅ_r,`9/: *G?O%}իVgg {}Z~h M ڞ;֖‡]Hp}3>/"7e%_gVq@}YZ_)[Uj iq~鮎@;*B$>)F(5d!>>Bꨗɽz`RZa`oJG8u|L'!se2w5uHڢP9A$h(x<3S>H ^)awY͗Dr Dt*Ik%禆D`JT2K``_Xpʰ) Z6ƧGHw2K$:bkE?>HXےC>kˎw&!ŀj-ˁE!kT Ypl\BAy^~;QsK7~2ꝨHC<|<8b[y dt[RR=jZ0QpwiCmJCyJK|Iw*“E Q脴(7O:Pƫ=[jkm?ݾH}tR6 HS dcB<{oRD# ӈ3nU t;g5Bc\&錧K@guFrRH]‡h|,P\~ok!a+뿍Oq.7!ά&*`EsKm$ 'Ba ah =\ʾR(_QXnՉggJ8 L&wGZV:eʵ':hsFS&KԛaT:5²#J%J6y8珼 m1oQX8[_-(=JHq@Ev([0<O1:(KG^\I^ۻڬL3Pɸ )Ck-4m믌!EhD#1ЫƖu.};vse֘fQܹ/UNqI7vR>8"}zdK3<=T^y7hj;Bd9ʌVPڰu꾂jp=H1,)tW{Et{c]4mB R@ `[VN͏QS+/FvO\9"?T})؁Yh&u+du;lP(4^'VZ#*1aU[7v:=f%ҨpU"&#)7P&ÛlX#U{HǷU F {z2ݳyTzG86{j;g*!)͵$@3 ڴ)JQg n_3 ?ټL}?4%&1_cwYkV'x؟ p25mr@UMkPCTf?NyL\ 6A&:yCi 6KMFC-q3N B\biI;b^[[c2`-`4g:JXZYUCX=,|,7O4JoO)[1r=܎\̺ZWj@##fSu$Fxs28k+ {"d o5]գp; QkDiڌ$ Lm,^L5+R' ȃqEwVĝ5+׭W$QfwL+8@v/#`PYd_嬱e$\Nț8M΀Mx[{tQbe7ȇk9fRzVx9X)F0EXjngROxOЯQu;PIf;&b"ClZWa Ɵd,X%5g8:{1^66CPqԚ#lP4LKͻpHNg<2%2+sFtJ`&`/9$r}1[\MDU: BmriNAR;LHذyj_wNX\~( ]9tdKj]h,uT!MjdcOSey nh߾# Ef2@͵";|ekc\6~bFʗ2 =ʒҼfZx#SU#;7 ]kI$a/@cP@Ē\)շ{3qڈIDc͎FxzF WO6"Kr8~RXD8]9X<3]eK1κ˧H6u$Ǝf'o Gџ(M)8ҠRnkA(6@`eSYdi"}"vw"Clg wm"d].ܠ-Nl2"d# kH,~qǔWw&k>T+Ϫ?iw_;qЩ-aHˎ;+FjۣxȤ;?1D#fE;Y az0{Zb:UX݋n\"feKÎeM{og[),B.@:ڝ`@F9M#H_jfSońBfeh{!aZͅS`ejMP#ǝT<7\jF({[hW)BIohU!|'Ȥ'R#Z0~4uT9 >?B~\ptyãbd Y?3c a޴8c,SBZѠ /$\0&G6l޼• ؁<*XF\7$u'zv[ x›u, 0vM?vti Q7KEUD=X.خI^O|8~<6 i(D ŠڊS0C[n>~WjC/^TOq*u"w׺Sڸ!Ą$lV7#}$|]yzZ5?"ho*;y/v =z#mʔ^h56# @$j"4L#LW4GR$.܅{eM@B`^L~n jR pPs=sP),~o w(? *9);饴S}iMHa-}!hbÞ/SsԨ \1:y~e:9I$95 Tt b[,'\ 'O-e$7ҭkvKx#_'R(po vHb_DWDnnn78OV͎cj>ET_*ǮC?TO2a`?v+BTo0fA7P`tSEhP?¤7 8pn!| BA*z  ̩2J͒PѼ02ヤgdn Mb$lҾjLj\5rA5:!ЭywBBzP: j0N=3IeD5=}"&RlEWl*ޟ ȗ?}z>d4u[ln_0sb6LV훝B1;0pq'vZi+n-!3v||Fd<HlplnT> _o 媳>$~1è0DK/TM8T.w;lմqC7Ņ䕑6?\ LUSRNp!Axqz^YS=BOsk%%6W9jݑjzsfG$P_MDT7U}9BN\ݭo%.P͎Ô~~E|wa(/CA7i< L->C.ݕ.bJE9a\'pI#Ǟ$-HL&o' fIYhÇ^@x3E-*a^Yl8M\_BdI؜'i:\ĻCNt%if}uVoP6VɪL8l1Eqǜc8B3hN)~Z/i!7)-N^NpnY7F ޮ% {_#\e|Yt[w\WzMnACd0DI/ApdHj{aL$[y;BI{Zf0&Ȧɗ&{_jo0lhrV>hDslnߧ+5k9:`ᬃtS#Eg7-SF' tB[`f%_/Ӌ}O7sݷ!?޶7`r =(hmZVY@E.R05%pPeۘ騗ӳb TwÝXVAoc(enwȬ,Il28n=4 d YJiƄfuo Y7!QP,_v鸂LO\!S5GVqȠ% 7''h,lX칋ߺMR+Ӣ/^ӃA3蘩䐉f4"<je  ΣAB)EFh8s(@ A4ܴZWdbwC X $)U=|ԱφGiv=_V1MBXW5!O+oEͿ*x!w{ u,U1yaU5 g{ჷDdw@>x'cԌ s5+.jH~8q{}|hhLTDe{D9%V(ܕDOX,Yzy aEl_U])"Q,pOz}?瞸;e4c2ƸZ{ojM&zŀv*Iu?6ih ޣh+*}y p~nq_ V%Hm r7X[x@qXw5Hha[EM!7u#z5]jO`^*t˟]h7*mke|OߏЀ&Ej֛Jgv癒ҥt'x5mg8a(q0V9졁q!^Т=OW(?YM[ >7}pkn m<5] NGQX82t_@9;?cǕ`LZ9gCeuE2b8c=T^ $ UX]@E){G)eymӀG/j{"/^xVKec1䠗Bdf[KJŌ]8+f} -B0W25: QVFQ/9Ծ|xR8%|dTW@1-E%ӿϩ[;KbMC9Àu|'彯bJF+l" ©Ј7rjf!wg! $om%[t}Q=, U(@ ~T^D{!|pGYAKw]qZ[l{gm`hIK5EuCK08Ti?p _嚶^0қd%|t^q*Bx 3Y`=/+lL֍MW6^YEhXsxTpnckXyR6uxw| 뭗ÁYD'w+.J>(jY TmF nzO9--yYih.ᮘE;Th. qn$&UZQ`7{}񋎼$r'[J :$ŊgW ]“TX DsE!ֿ wd' i-۶)xKr5 y"?svVˢܺ_#cW+9m)Q}["vＶ׾ `#͜mHt0|10U2d>U*$‘){PabIL=FӺj@]x;.RZȂC_x@ _&Aɻ߆163v<잆`K# 9:֍/&a p~z |o?P~ jͿHX+Bs!0t/4#q''"oֈўK<$aj UC5H,U@ԓ(T}RՙdEޢ}uC""`gt:$D/Y", mHDm|vB븕XFWڍT껃(̃?1:6˓;0̑ 1D#O׽֎ ]CKeձ? `Ā#qDvnO|eҶy=5.H g}Sa㑛f)~2B d␉ݷb_ 9ah0:&5D3RϱsSܴf 0ԃ[h227^w.sSJD9H6t\.s񵹆JɋGE>pgBN{y#Vc$p 2EE5؇hX|8Io`2#S{y*/E ,mߵmie8J;8ՇH w$FaxW_̯ XtRO}zR:`CC/:[S+䃵g} 0!ΫY@na%D3o7TXx±pjfD]X9F=AKя?H3k3^\{5{|W pV Ġy-EZ:9vlr h|#L)o/S}0՞{=dYQ>׺khcVdjS,Tȃ Ɨqʘ}?t5]e!!1i)=T$n{t8;9,0g11uu tGxO' 6>;Lɝ萪dQߩ@C}deHM=񦁆;D74AcJqt@`@?w ΂Ə(l|?\B*"] 6Bq";ujHZfPIJI?Z69+KQ({Ms 3,0ox~YrǷPh 89K{^S.6F^LQ4:W4*S,ywo\2 8>X!Ma 'cl>61#K"[\F* <$VRZd)bJzԥ[e|m3A{2]RW:ADT@6}YŻQFAI/Aۧ sERs;ieJ~䳩VԶ<*>9[,DSX랱T.za6B-69kj"#ؠHpE ^/~U Uu-, pԅ';f80i|2l-~%^?*}j3Fm~=aݫ7/~A?;->PJb+ל8Ŗ6\%q֦8Bϡsz̋A`A!8r^:čcLVqv0R8ULCv@θ7]SP35ΟI̖JIuvIPR_hE܈ypOWu]q e׎ο6РKK1T㮈uxYKK`dC Ude9/^Z0zzJp_/vfGEx1UYa[5 4@ G9aSSFM__j#V+='yqfL<`Y}^ v:r;Jh=*GJfHȴ.W֣&.o G$\kKG.$Z 9}9+f"D1HD-5 .h向!f> >ek%WIaoԋJ,̋8F'E@Ag-ɴPE~a]3Zg,ۼɫa7-N!q3hNy:ɘVX`%#&F˝ j)99ށ.o<|wtkR{4^MM[iiacIkP|qn$9yNٍլk->6A@0}lZ)Zixe7t )>vҸPˊo5pZk('d[B]T(Ƃҷ Yo [UH=vnֈP3K4!~$MK;Ch:dBk|S?{dBsfaׯhs/ 'G9W[̢%q>KCGDH _ibpp!!'gx1#!]&+[dn0f6W3sӶ .Us7*L%w`uNA,? Y1۠wh<Wz(ZYX_2$Hڠ1H|NOݑ:X[Վa5F1+)>2칦jsGQOY3!o9I%k'⌴LwL{qލvc]58*7BX׮qgfIeΨjB9.Wq@1SZN;tn59MkE?ۄ-̒ >ooN85eY*\G96b4R$LGp5b .q79vNi-1$fU)?Wt.hNGףwEC|!9*߶<A'q;  @< mdǝ-t9FM?}:ًP6 bʲJ۬R$/mA H/*iCZg^;fb‚W*kH:9W J}82m:t)B=?OGwܝ~k7mNFi`43+(KW:Au@ϛK["thwS6J*2wXH?S|(20L=Gl_;MV.:rpRFot8nxP ޕkn178b" 7_ ʂV:\9vIqA$SM0rɕY=dLQ&}d(TYavff/}t`\YA0I2-%]"cKMĀ}ZAwv8%dU~~D)f_o1}Gbg<]&0z/$פx=J]4wңOm2呀O ^ ]%x_WzrZch=#6Z>-M}xxcxIС :5IGc_IP(̠'VL{HT7"k݇#M5LZh`ܬF/Ŵ@^d<1?[ KLψfDΘ,Bl{~8µOqܳyNߍh?y zBr{gj)ܮy7+/>,wkGd+)ڡb2GaA3{b?&4j)9XM.K4,s'c$>獿ձ;;c/<`3&L`˭!P]$R$zjYą̯&<`ztpT9u!l c$AtК mT|> Yc>&G7qXNL(Z*ҙTFֈZ۳:2e9qZLD<<ՃD0 dzdH}NH&ȵg@Uϙ>$Eh![7h1= [^^gX`wߚ-Eu9GRX(*MK̻3ս$'A= tb#)OE-?:%&,'g]U-R[%/s /~Z1!+u^ j$?QsOKe0Q,\H58 M?0d9YnQ$ATȃSx0iWhCil`(u q`%;BMF^unyGniڴʻE&qdx$UlΗ3i^V 'Q&Qy-m!XEuJ^ϭޖW.oXh!)r{YI{# G/y6յftW]@O Vjжw&CDfXBX_K l;rӣ}! [)0RYr&x>A Z };.\М<uV^q~B椝Fă_bGPxE w8\AuVT>Lq%z6 ^K\}U hq#"OPG-=vJ# ±[I69 bc2/ė8MS֝"3GL{*] ~ߘ( " `y51}H#+Ybpo/8֐_ɭ#[hma$lF2mvK$I~,E)EqSR% V@+cG͟ʥws94QwCn/vb- z`WȐtF FrsU\:ZVI;.CP mЀUCUF%l*~K9GV(Bs^DAHQ?\UcxBTzsoN'K@ⳊVǰ[WUjöx>@҄U=V?Z m'X`[nx ʎgϑcRF[h` C.orfqHb78NjS6Ő"݊QvU0?p򍹔3&#L }f<\X'1v'|QOӶs L k"e݊ba6. bXʲZjvxet1񖭈OgvGa(BPwdx ؑkH%cxRڡ;k,eo@wotN3 vr)02:= Kmzsڍ=&ޅ"m2rbLîWN7V4Ԍw[,Оg.\OiONd0G2F;mOYNC<@TsT@ں;ÎA4tvFܥHK:rpR48"fB=:/A3|T#J9뱮y8V\2X4b)2wn%:?WקIjm OPh"KOɽ'-Oh;@Oܥ٢kD['ʐh>/mB~סqԓG[od:|$lBU4# }?]`KrqqJF T|xZ)Be*-)S;)G>oWuEJhYE##ʝK2ʑg@=6Ơ%[:IS_& ֡}ͱ]0#Rvxs`~,nIB?z a[tNXXda2^6cN뙬X瀐JEao%L y/|5:V ŏqBQ˧&Ց>O,1Ҩj\v?,ZLG {k]a]">6lHS۾XKc?YZ}i]awi* z<[iq˄ֲrhbիqFP 8q,ͳW`1슚S V͝EhAc u7ZAI*/^G{0^:аJbJ"^Wib 1~7?αFH6t  ۃ^ !kkLvU 2&aM|By?Z-B"08= v?ͪ%!vvCmΕWastu>eX-DЙv@?MrEdmQ*I{->.Qp\t ah&-)clnWש_yYx~V@rM "w#~1.DTyD<z|1'AP&`)jtp/ʸ pI7[]WOs'Ӈ)L5bW,QCK\k롧kuPB=ʴ+V8tfѤk,?r<50jhE6z:\ݖDyhȬ^$&BaKQR v:Byr$̨q~|oS#-et-@6aPԷ1[=Oa/ 3qm Oa@)eT-S<8.dľPc,`vP?UcWC{segӣi~k1|E ӫ2dmڱ>Ѫ8fBRjv|BA-8 M)^RnjRX'uAr^T5t ;ոe%WK)k*/=5qOM RIUge}E#X!ղsQ3 8F1]v&xhkD>Y#6aڈ=>賄0Bf}c1自hT\t|H 6;0%:'x^rZDX`n5^aj5uL{x4vkRGVVuBU;s, M|k(ɹ:T3Û}'雤ڈNN]q~ |uDVh*N+0tN`*$ L7X66%F%ڿ=+Po3-jrX(wKJZun ? ~Ή7̿W.X`;3 c0+LdV1k[63<| c}?Yi_-^Pm( Z\hLC|%$qL"[Uˮ>,G!,p$A.Cbk$Y!EW]2@>G0Wf{:_f e)α \y!qC^Sq3#f~, !.RƱOt+$&ztN /F1^NCb ښ{BnPUq| G4.L xKAz 7e ^Il}r/dcAeHiC>v:}ڔ}jmYLuNȐyʰڤJ51O+'a=EtbP͙C8rDğsГ'l)nU7o#5+Gy!shd ՘ oM x"0iɑH~ ._*F ~mMNjZwk*^KW B1,s<^47 lo ])/* !(JE4%5?iĒ+xS:1F":ff4%n:xwo#TI0-hS ~CrjE;teVӜV"o]oл %Xm~/9 a{dSt&6b,7F}տ'Q1xA JeKczYM8[S ]q<- U[PLlx$wϝ*Qr^0^tS9EzS0 榆dY;-OOU-&0\P_UA_`IrSy Tu&z:S1,tQ%Jìm\FaO rOͫ2VK@`Ul܂`gB%>q56茀3j9\X)Z ĺˆSO2!eܞki/;N IrX{hDĉhJRWؗvh@-*Xh:na!6VT.gY#OOДݢޞ~E]}e Ph~Q^.? NFU>2x[te7Ie}HZօL[ 2(! I+XW%Y/A_ir~ۖ_~04pm_ *ӕ 0766  X ;%x+O}ͼ8aܫX|m!]h5v)/rW3Bup14zDv51X4n7=_ ˸ۚRsoun!">]IGxGQl[ts#ur[C] E[f|VmUVlz'.2Ə"* +hG.1J!ؽ/od~apXTvE){jhق-UWy=֞ atF \ʬ?iͶ1@^>_:UZ{xБ( 4`/ bH0qP}h=ٽP"KG:W `1ll'Z?Ż;d񆆔&mGT_ 82O$r2TψpDrT D rX9vגPTOv`ԥM`J܎\Wڕ"r= W3YlTRgYEL_3$N>=?(bY⼼*e)W ]A!({-@ vrMUoV%x}-bش(4 Du5cxIo-Nݢ& > +Ԓ7)՟wlV߰6J:dJL:[S c8%)O v^T;>|cvIiEř\)Ŵ^;aK[KmzĻU Hqޮ-yM FRkzH[m+`Zg4.Pu1G6DgI#72Tڬ` &嫯 w5G k/%xɆHx$\JwQ%=so>w(Ϡ;᫚go~@Gpj] `Mb7RhH?9mh;|մa ʒmҔs8"~YDV=^7-Frj3FPajEѿ?^EKy]o#QJze?e3|~9 4"M -.ӷЁn?ca͂ TjWL,%?7(JgLz{\s!l:iKݸ-8^4^ş֘a|ң6 Rzl=/l*衅Y}@e!;hOG 15u$*CCe[J?O68n[ؓ(@-לj5hNU$B#AEZy ̝Mș(y\tB*dYy?:ďa&%sdV@\k]*}"5i[S\N"*}VGR/:Ϣ(a;ȔSoڨ|jk/on~[-y7Q㾿iE"#yGlL{}'Ք|;&*C;Mof٬tS,m| Vt$_L%r[ꤤ~[qB&"iS#C* IuXf0]( }g8L.FMqJآnNAXep~*-gf tә5$ vDSi.|ϱX:ߛoFx\ɹSҀ,N5E|&OH!@wɂi,=+%Z.?! ԒoK5B\h1N*_94RQ]hMN[E(EFUB`-c4HVޚ/W;^gzY6ۑ:GSө^{+W</j ;0ʹ GhW%؃ DSy 02E>GvGa]ݬ4ST7? QEtC{t($')l9 ɱ9e-О T%Jfp^AJ5'_гѡ9UKryIjmf"`2,} 0CWA,`dTUt{K:Iz-ăcgڧk'MLI,E\+u TYEXr q -\c16kkTR=MF88SRnl6m#˗/vfH͟ JO &?XYq(,]n+mR,O-Nm A ;U/v^= |1L!a3]ok'[엊` |)%";(oe%m8i8Xmq8Iq<>|X2~zܶ17ybk(2RMCg$vdcU.m99?B[b@PWL.v.*\:ƫڌ*TrX){"^CV"vo`z|EXRcD04u9C+]U/8%"QY޼ԏzA)H$++oсM"w|en锈J -ǡ NX\v=+y `1˰ؿHhU=K;,VD1ApSƚ|?J,+!"C}5ܽ7M;9<>$?.#Tݳu-2Bjg[Nы\ 491|Lz^ǟT >gK}BpG*%X6-S/EI=@'~(63i8wXl~c+- gS7!)%,('&*;hiڋMPc{6 &-*նAh^S &&|ˇ:pR 'jŪ&,7k }5. H}x+ UWs@km:yƭD-ݟ)_5 }>ep#n!VrFi5>#otXp.`I[GKڧϰ.L|olU7U rInѧ+[;YnN(ʦ C^S%ggbka2wVus%Gqa(fatИkհLQ:fe -VO(XcNL*!_ d V.lpP5k}ѵotvB4ss@3Y"kfA(&P*LnMLg7;!ȂISnIGĩ2C6WfaHTz_f^˘uАdlHX Tyb2$Y߽9͒hTH3|]W@К8J+b4_JVTBߐB \l}O\wD3 14pK9t A'zyCˈ'o8Ϙ0qX 撁ID&޸S>8Q:1V&w%8?JA#KEl"VA{F {'T`LgswP TJA jщJ%Y{[0>Po$x97>6ڎ9A-Wi,o5$ߡ=B`'qn 'KDv Mu3~#[bGf>:F>LHА @po*x lFW]YwX9W# , U 27Y!y~KܥrT@))|gN$Q;㓴!#e7lw'\N<^#+>;qKQ{繨._ *̯C Op dr`_8^`)pF:` 3aLB"G  Oz+nt|)uSqd t۽5G0;/r!8p i68%UQ-_f}ލi9> T%y6%ȖHf|%i\Pt=)5J,$R x]s$Gx \06υ}e4e~s|&ւtT"u_ng"nfʒBZiK/1;^!iH{"!VRuC/A:>p,#IZzSluQM4 tqԠRXA=2GD#5:V& Kv_$1>.q^0_;J-uhl 6dgpy"5v>7sۊ:e.Is2W*nvک!rw@rQL@筓u+4Ab.UCrIx) 3x6?}!Uz%Q } !*B>d m;Vrw5ˆу\ftJtJ6KK^LТ p8Wj'W܇T3lRH M`(Pޱ`Am]H ˾e/;sߕdC¨$-`jX*;cOZx 72zZ_ k{;543Y֩ZTrL ;[(JÉ%}mZ7Fi^yh نl}"HĈ&YP{_V׺ zW>lD׆|d4?[*d rB}jaBo D{:N(1O~{8ے*fBu^ͷY?D?^UU;lUFr"5g@-Gi>IJP)鎬8YF4TXmY*Ťo5<$+ggD6 ^߭ !Vb27ܯ +Zb$kDMA ;.1n-)ѣ]3o) &HE=ŝ#Y WwG0 K)b:jGarnO&Ծҵ ߶cv#-tWшZ*,1m4C423KrB]r:bDlIp4xfAy`ܬdwWnW"*y >H2{n`ϣ,QWpuX}M[9T\~D Q>@,L7_&2w(rȹ=6L$(m/p"7~~jKOJإK*g9Œk}5۟VzȤJ $LJړw -c[x:/Pe6Ƙ;?yH*7xQ-\`ڔ>ٵ",OWe4oTI$4R<>/,+GՃ~R6ż}bZ7#huo#nKܒ!g6d+%%TMaXdG?y JJA-sx/ĉz9Ԟ$P?݅|۶hВ]ea}3XeA heUJq4h{+J~ruъ_Rk-;'kW'lpcCS6on_C5bEոe_9xkMHl|F &0r~t{х $-?촐Xј1CY]FT!5j(a sh9x&\X?W:MĶCH!eXHTJ@a]K7v.i\'xkgqm/9^ב΂l KvKO|+0(4J᛹stj]geO#Upf@i9&аu+)8n;OSO`a8+t#8n&}&#k k!1DqhCՀDy?η\)467 }9`xūHA͹C^ MjTJ]OkyD9˄J$mޥ#h}2Ral ˠh1T!J˝fTN S!2JD,=)[Cd=D]P߰];d!$uYƫSkG`1Q(1no#ZbGLJ'j<`xk-C %7p=ОJƬ_,urVrqo( >Cv#DDdܦY50#gGOtqQv0j?&5,E8pi R TQ"p9uĴ?an'X 'q PFA=yA,G O=o,Xkk$dJL`S d,O|Nig-5L>kLӧx1`(d"5;zwz{~Lcp5ZH5h矑`E 0bEPy:fl=)xbM$Zo%?a$%6~Lp_=vi&oG*Y`)O#WP9L$k("z'ijA'D(GE/X-mȊӪ~zGOd;F:a)x /4x\j4sTx +XrƟ&9|.= nK|b>7ijnEX~{͟u:'oµ)hUFj?S%~ay/ǩtpy81xkhEj2o[whn`|xUXZ̿+$̏x-J_l. e kAXKZ+3LVV LrwjOvAMeI!2 26M"Tv.ux:8PhXbN`54Wc`o" 5/[ꓘ`.AR&8Okq=GaĚJhP'O]cMD=xm ~/Ee,I>|넼k>j%m:z9^Z T*w̯b\/urMb„fЃ ˛ɑ.ъ/mtG' k"h7rrF#|[c "l7 \SB NP +kg2gU*I>u^ؽKj[rؚTҫk\}~uO0lx,=Aڅ4:^E'oGPQ ?"4O )u;N=lL,U_r+|z%&pi2QO^dOq(L5c'lB(ޓ/by%,4.D"-h4Вc7Z2%WsJ˼&ߚ!!L)oa"U+67j&DQɠߌCLNGBAK,h?k0 0W#Dȕ>J)3ܥLҍ^ȥV=gU4z.&QK\pXqYRůb0G頾=]^g)1tA3))%uc)!0MF5^ !{8 YmǛu\oƪ SZ#E{礹6+Dg2ӞwҾ;Wn&<_D UWu]~NL 2WxY}M7Vg{F'l  0Xٚ˴UЭxMϔ(j\hIw.dw* kEZ;M"vJ`ur掗ZSޕo"w]@ (rr0H&.&uwI~ eS踫lq)F! 2M[F0$C2TKDw|}o},TLaF p0Uz%A$Ir3nhPտO.׉8l$Lb%ِV2Uv6;ѴƬoA׿3θrbEzRQq&+~ Qƺ ƈaôԋ=%0"uֺ vU/{~+nUEQ_y:erh&>&LՁCZ Oܰ'Ԁ6bWC>[_ Jz. hl%$4u;: __[0Q-nuZn@ncEhFZ/Y0ә*$UH\@?=<}9 FܸhwہY)/F =_ct5;ix_=_MEॱT/0z2cbQמ%{-! 괃<'㵯ҜPwzD;/4u4G(&U;MUZaA,nyZ!ūs'[ACG!2 1vd(oF. +C"̊-U?IA5ߏ-)FTHIp3ΌN~=mƣ4e充r/6iH.I]6P 4_*p}O=U2\޼d2?=lHU'y0_wE a|0AziN^sP9pHBa_JSc C UVsAO^@+垮I 1W\֮O:pE􏂆yOeVy)ֹRl>#I^b7} g-nyܫA|=6.UtB%a|0PV%G lȶctU1UMt {\+ԀM22Lv*r"nMHn `T-Rvg0 Cᓈ_;]R/|O__kfVz~7`О2i?/eMW%G!EL[Iw{AoLew> A0qGk˰q5$qD߄tBG/{hGޡ?iλu'DHDB{HSxr)~F 3ܲTNy8mwf&(TNW w>Iʫe?j(oIlaHA2tuY ՟@?4VT$+6%*Ъw-Oq1 ^K~[~qp^<}; +FhI#\˭HnU۔TPqUZ%=XB(R4=Ͷ2ǜ -aꠏH?Ϟ{F(p߀*-\ %8gS- .dB@ULSqlEzP7>a5Mb@3s)A̠0*P (yh?Q3$<]sž}%H&%Y:92!cάB ǹN[N-츿DSTyfvUhwℭ.CMJ(=۸-~(>ʄC,˿̗e]mN#a; u( &== *mSJ6}%IQ!7h&2!_ķ--|L-m_ b\ ǹCLp?Ti)G"nwMhm}tK"I_A?m͔-&fSOmb;Ib2M0-/ΔѶ+3aɃapD^O/8z0?mwbpm>`x1ޮcȗsEBk+XwDL5)=)8A*eggQieې28qӵ<&1{kmV\ʸ*XαVt  1Ó5h[a|V3چ>CNkΛ.D? ef`J-f`BR `6Rw]#s⎭T}eZLrNYmgkvY2Tk\dY c2ۍ>yeDV#DrG57MC"G84wTR]%cy^P=˞d硘4eҙF:y>բubzj^ДVGjv=5@)o!$2f^.Me0jw+$lBR,r/i~WT7I 1F}Ҁ83 37]N;^цSǴnfWgha>C$XLOu);&za44ÁV`kE'l)j!g09!V@$lN*|o6HgpQ ar^gVW =X.**f/Q?70IݥxnBqB7 b6=WFgބOIn.>}+Ma! FC} k[dY LHzy@pP*NK{KTew:I-(ɹΎ>0^"vģ@Ws f { Oe҇dڜ,}JR͗. Yu:*DvxO\ŝ;8}^lSs3*cC|(}'n]h"dxWXGovSTK x1,2ڣbml)!(,ľTƣ`̔$#EE(-{=~َGXz_5?Q#(`f\ɁIEh\gnj^'y1ԓ~m w3L|tym0Wjg~9RDl7Q0EՍ8b%- K/vF 7@oEgp:Aߵhq J= >Eϫ:ZDMHQh˛{]X)um%耒D"G pL>!]ptD^R<}~3\U@ĒHޯj\.A[z}xTp!69#Rd~]^A}E+H` o իtC.+ HQx&rWR%,=uX  oW?-{vN`QۯtSw/?˩Z} `e>6L pYk^he/=cac׶̇<0zN}}ܐmǞM.t2na6M+n} jUlHno@ljVE^.( 9d(uF7nn&i|t%T$=v;Inys#Rpf#R;ڪw q^ |USB O]i-yP;'.sUR#mxӧ Qb<>0 YZphangorn/data/Laurasiatherian.RData0000644000175100001440000003716412507002037017055 0ustar hornikusers7zXZi"6!X>8])TW"nRʟX\qjnj-&;"֬S[ׂnzKfeNy$_U1[|(i;ҡ 9{ʥ KR1vfv!oXڝ[^#~4D*MT}Oh۳Աnw9y-OoTRxdr{CCex{P‰W3 9N9sDN'ZHIjmܞ:pqASӥNůK:c. Q);'y x`g7tMHkrLF0QLϒBVA/߈D/z~Ad^Pq ИCOx8}B<8[s:HT%s3u:3]E͵e~&6xQ +H]Ԍt~[2П??oZhzLv7ˉ56t ѻ[]Oqd^3۟N*W0Eh&IĂcWtAeی ^ #4``G06komBa ~1^ `?#)z/cΐ?~0)XWbTt˧R3!k@i<of=aRUo?g>Θ` b+r ele=(IfWնN̈́.zDI'@C9yB? BMzA:H> d({_y<د'Hlfߔy/H Yη F%f"͏:qS(+OD@"P0R:":N.n~o09TR@eY;~K9U{Mh[=xH|^غ|9d BZ=|v 摤^"Yp G˘(66y"76k{7J:w|iXݢ7g3Tm$HG*keޗ7qкU0HC OU(k<Q\ ]&GDPNQ^xz՘ ?mǨ(8\/+vUP Pf@CSK|P=^ UM.LVW^peOՕ]v#mDCsB7nnOjc{;B(1#pigHo#xAwX ɹNLk{I/Q?}@E ýn!Kp-ܯ;eM9T"zctCD8 (V|jR,ĵl.Ly ]R~QaU 4VswcEVo+>݁Yz}L:p?l뢸uy 8 ?ѥPh JTL &DUL\_rAZU (URG\P^5m<9U!k/z+( ${_LD;D:l*Z\5֐$@eUl 6E,50UBfCaQ_`sbIRL'FLHǢ~#ϪkڜܑE\ FPx(6EhkaBK&zl|wut7vH%&^i#4msJ'myFm=$U"<ǻ-OTEg֞{EmcpOa#GW[4EF=8WvXU"C") Gq4:0Ay].RUs?~Z37ߞtyio4 q[?9k7z,6`myMa[Dш}Ii{frGA ĆLkZၸg( ]74jWX|F-YoX_t_jG"_*@t AZZI׿T+sw_I I=yKs*eݟ2OATr^{ڲW~E * @h,Vbɷ^uеYvW"}Іύw3A0V*žȯF ! .*{ID HtJKw)FPMX7_4C\bE{+p{[ChĎr "Ky 0ACA- }O fhl ̮^>Q|"rqS %yA$̸/M&As-[M2Y!-$dKb!v׼,e%.hhn~r Eh{뷵dmҾ="5SQfy2A@oWvtϠ]j~m%$p gH /$^Y^ BCE9IgL!(qa,p34ck!n44d9}F92g"6LF498"kdLSAqL,g{nVAl ^GpY@|^e32⫫V=?9Rz 7IqO) Ʈ,؄\ Bτkսp1i:ATQS wIijZ'tq)j`A`.2sFvݔJ?*Q 0"TR8}Acs #E:`שX,Eaa !݅*0LȻ1cjuYS o'vAIɾj7u*NM-%Q1%5*"2dIK~oi.afձɫKn8ƍGL=l@;:a$ؼF.3C6k˺}I@!7,$Pս"FAWbxz攒4ɐ%8;iT7;V? &7bb q4ܬfmdg^sIDCx!읹`S@YtmKg-u2mS 6Kwv;>,ZrdE2މG\.Ȇ\̇•X簔6F.zٕk`uY):O!Dҟ5\ F_J` g3xVZW󥅅>0ڢ?na2 ^|j>+ަ"o]D$Ul U^Vn?![ʚʤFˣט6,EőN?&щf?} s KZ;8VZmo1k㎋ѣ  1ֱ&)#wxnpNwi"Ɖ]>.j0I4旙O<-#om2^G-k ank4=NXȇK[7Re;,٧w.lݎ[ž.M7c]:+9e^8QN`b_0ʶ _/XU֝f .LKtC9,Wo]N[.rE/y ޮ2L;Uvrye#(ɚ MWφC{E7fZí8T/*-MT:`Y̮#CL:=J^X(J4W[9]e4ŏb3%R'g&W 'T pdY* |@USQ9_4$-*󖩤jהRyѓoyiڏG$J!wk,]IMbsj}W&[#~Q|o[K-S8:KG*"UizqAk%P {M8o*:'uNeDPLOr`4&_=AApXJLt@y.-PUUW9dTa1B!} {׭_4"1 H ڝ6uh{ m| EN ih$='lKDY:m~B/K12 ]BB?GY35eZWTU${QڄRqaoy]`hopZ.mv֌W`@;M ":mD>:)N<M1*j]l_CL%5!cI! -ɷdfvm O $ٺ"YU 'U/oHo\vXYXUS)|tU :"̪ b4g!;<+n2jBFJjC.4)K ։4xѯ &DAM<0tS;.R>z "OMGlC1@iUߊ5GrM<a< 0Ï\dn|12VyMG?'M:뒛_.\gk(!99.N>5I/nPN#%VidwRE.W?xayD;ԉvDe4~@ Gm uba6|߂m JϢ(9*ySѪ؇8+dMf(i]BQ*_0NN-59Nf7g S\GKĽÅw@m=oX'YY7-p >T5 @^Ǒo:>gzߓmZ\xTY;Q)lg #R[\}=QQɵYE_xY$n0@ΊR{tSE^1;ˮiax=Y r/cP6FF&dlr}$v.p,*kzC< f=Gub^9˱,eMI▃O>-Ѫp5:5,̹RH "-eMn>y="xTO1.aA} a &xtզO2c~ڭnpΝjzGג8œte3ѪS@7HJbL/G "X0_~G@/T'e}5 U8chŕCՇ{{4ʅum%.k"L)ذ`865:1ȊOnQ4UXj}`mR(|mX>k1Z!/o}3ys$Ѐ# O[Kbs3 k=sFE啝\;&wSwjv`C(\kknIZ Iz56e?w,,%XwǴv87W?nbgг -`hegUGC~'Q}}˪""m*hGis_̕MS"甆Ѯf ]R?^ R;rR]D2k̴}xcv6gÏ-@nOvgrck(^Ck) `S8[ _^NC MS\9WXfA3ْ ydRJ e\=fGzel cOm)0V6-v'+ԹEzF\r^F =f*=5W*UE[>יz4p16?kRҸ,!!1t[*?YwӸxE77fU2V`U ,Z,oMy'FV1̶*K䃠c[*UG 4Ny O@bP iN0@Xl> \e(Jӣٍ,plשCu5:J>ڽ&p ;BH. rI'31tiT.VnY.43uY!֯;YT#>ScC#:*%Hƴnޝud .?1 y*p ^/sD>9Q[e-w1YʤGvs!.Zh@bRCUկ- rҼ̙ ːKű}Eeh6=FhMhK(P,.t/QA7 ƊХ?˄1+*"B>tՉ `Z} 8}rrX-e[?YV︟u{_2Z[TOG&'. 9.1*jr0#tL>>R87a紶K{/ǂKJod_Fj4+iH~) u`) W{DOT%eHS{؝ `״v/JYS2Q:4نQm|m#FB\\ Z`?o񥑇"X+즎}ݱ LYԪ_>OT_@%Das JL MU92T΅8 \Wjl?~ˊHWQiGN.%ozk73ahkReK^_aK-*$Zpk+Wj! +^ZB2i`W~pTѵ~9V_ ZZ*@Ru)gTuDfqA} @*UD .d`}禰+jN v`PXOi 齌#FB! B/}.gICIeQ^^"YrYSʪe=ě 9/ j;jGNk*Bk673ݲ&kۯiqo1~o2<;{|d3φҒڮ<8V^.+mC|)~I78QofyWJ>7!6߷Q^eV툺F)2qT]{h*7T/ܸ͢YBILS;_:HS)Yruz$ @V4*J=`eWeOCƒ7 wGr|^Jtvs--C>DG 5xDDVŚ<;t3&HsÂ{:a]vӢoEqvi̙}pδl;>3aN.X8{J9NTCڔr@%fnKjcbźŕC |FC됂mwV+)OѲF]M^TD԰۪o#^XnsƢ<#4ȊbI20O.=*`xh L~eb XLW{+%n۫}z+}a J!si.UehGG@ԥeW!-;fdM6!T:MG]bQ,&%^س:\=NDž-ڔ1L>7~: _v TSE`Tk)&1D`e,r?XbF՝'.?Ȅ#.\=!$'N57-wDL-Rm,ʅGX)˄1heK8J~dd`rF xC&4po\|c!_%cVΌjJ8S֢ 0FgDɉ +\@֋ Zo>SKA^IcW`e`p'<#yx %@c&~#gDTF&#حT I vfp] N,:K <<4!s+yiٍ0-֐#!MTN4Ȧ + #YٛO?aQ| =7SRB ^?0u?ˍىhgoK&r@y\e>H \MgWz}9?,汤lPEQim @v7?(yr_)0 M0]c5W3j9;^m7t%D<+ڥQXOeFང@Kkx nJfׅYWhv&To,j*2lO9(p rxv[zlS-7!VCƜi2EVӵ`Jh`jw@pNx`d.r}Hoqg ѮE7C@.|dw9EYW}GPwr;> dC)Pj$Zngy=\84) >-AI-$U]J)]Qx.y#NJRwCiѕ6@R?+HxK &M= pF4TIefR8+Dj`c)*ړ=әk0J:A|a{gS@ 6q}R bf~1Bh!"~gh}Xܗ]6Qڜ'~pI3~{= P2ghܥum+iFILi|j _>pv;O?l #cBb t'%1e.n] GJZ݃=XQT&HGMx1{ҁ6.3 +鈔x"Wӫ4 Y(vN׻GnAWo25G&p$$:s؁ #ڕc'Ka L>i.6'+ىbE뵢vXC5ː B,67,*;20I鴬nbwp'A$bh1@oy'e!u#1{L99)@DAtc }NM-PvoY*Rs#̕"PEMi_U8@mYW[]\7y NTsef 1#-@'1;@=VF:vſ<B Ia. k!{80F). -eĻ]Ag,2W̟k ^@HF(!be !4!u ]S6tW/MMBtM-U00G j@( t;Q@ԱIi%F7C,5fȆr Wü@su[ 8d F'c\ +Ȧټ(pGuVO|UC'SNف18̅~[!tS7{qǶ|SR9l.u`SɴJ?БlQ 8ˈp͐%B-V:66s,wE<$؄zdZNh*8BqG/V_wك%R5a(fVʇ>!z}6iROO'CʃH\el185DK_xhYX\^{4!GD ]USVꍽ9%leBRbp\2oI,,-Vq i x.rm=vعb&.+a&kQ&y^儦ݟr%\U):jLm魱 *q,p:qKGNscl^*zSSNÜ;aɓ*!a(6}qn e),KxǷt0T)A\|/YUK{uY_pPaZ-tΣEV QWI6nl9cA?5,Ǝ׽I\9 4˖kkDnNx舑uE~)4lcb^:F#$6ѳA"a0Os 5aeJ2j0!ҥҜPӽQ: Z7? a Wg Sr>u\th"m5aQ7\%p39Z>R:=[4j+m"%y/PL=a[_ȉLXOt5Ҥ\xq-_TI\DZ't(IH%M O%T/Csg- e6/RŶ D]eYClWYb9YP wV%K14[ܪ6M$aד̫Z; @͋D%R2iM wM ؘ5߫o w>nY`ZdeLcaF^(/b[Cbp)׆s.PˑY;܂ax"r.qL[:]R1   1/b*β*4拺JqLdQ N*801 \ݳ  {xbLFS`Ac*mH@uۆxFh\qd~(PD1MqtQ"΀k뵃7Bh-10'tyN$:s08>&gef TQ)DHy=_Qp$%,].֓d楒ZC~9?wf[ rh8S^t{$R ƀoL{ͯAɊ*u?-bsEٸ4=Y N{ BJNվ\CMWqX_cYKsV{CFJ^wRAEÙl톯Vn%ysAw":K{mov\e;Oc1WG0!p Χ9oOSV+^ݥ0fI98q *j\OYz@2s4LP0BR(#xaOzJ8ofNϠ"OJm) cHȦbWR-%zGZԑWdJѓ__ww)EG. 1=ڧ=!D, BR )C80 YZphangorn/data/chloroplast.RData0000644000175100001440000005227412507002037016272 0ustar hornikusers7zXZi"6!XT])TW"nRʟX\qjnj-&aN ˺T֠5 _2bg Ҫp3{]²|1xǀf11w ?WԪqQlrprEdb6oÓErz #;ͥиxA{/ju,ox 금zt*ͻ #N,~<M8o1 j)d1KG(}i:hj!%s䉄ZWGF3 bD RY.x G]WoPةt_Ekv_QCRC(HC5QǸ+@ Q'ZCj<[[*ۻ+*lj8^dKW55MKI|9:Lku*+,)RK( J^p44Wܕ= \" OuY+𪅹3ɻs){v:CA&bڅhjezE\FҀ^3L5y^6}ocݾX^ZOmԜ[@[3؂d/v\.לxadch1,<)|4ܲ8<\_icW~8ӻ'ͭ4כ]Rc` X9 GN[70oCz{-zExAks(&G 1*UryXέeΑ0vHC o  rsҰa PvV,b֡DϾxjn5  @=:3-Gk^0'(C++?gOKJVZx?|Iߣ* ՁL80@vG59\&/FBB!3ٶ~d ufWkXʯ8ƘX`i3ckggõT."4Yݢf_R4˦G%+^슧T.EKK"u4s*;d>2]9(cV@]Ub-mRՖ d'ԍMt1ް8%gR}d-D<_f$j8Iͣ=.Gxaxv]{U[ Fչ7\@5+HJi #ԇb`;# 8+7D^oS*!dm@y+:Llk'^ȫːz7_t19+&+~WeQ+i@>h"<14jذe'?"·'d`r*D*d@E!Et鍡9iBӣBbQWb[@Q]Fzm N!. !̮Vky'rjS>-utq6(BA&ΉX|Ի9hFc׺{(FZa aUwAkKƍf!(2'CقZu0~KUʈZ'qG/fJίңL*iUˁsuf7rB((n;>DR!PFeoM Ir/(c9`̷Ō4w4AZmF"P-Y%Ib.ʹqU1vR׳z=Mߑ9OQt_  f a}<G:$G5شJ#x!`LPCϐ? eZBNZ*׻`')]̉I|yT#.W1Oc-P_`2胷UX$-J*9Œ辪'U T\Q+v>x [DoyB +3Nꤘ`l$S>bqt͂." eΡOT|G^Ѭ,$ά=`! 龜^q^XϺj@5SH*Mo,?(34q evY11;8QTcBme+1P^,KQVN)['[4T9;Mџ )ӣ G-IފEJZFw W$/8͟0b=rtǍOvQYTk q}ۂTFa"X(xP85JhY|Tkfi]C_ >.a.Ⱋ~j pL\=cWtdK%j!sQ|V^̸Fi\3Ȇ C6yI]76F4at1.:8կb=$+UօK sC]?bTxʭиįOuo):'oG/"qhKFqEÓC($BA6h;ԅCcPo}eKbI/gѨ? h\b-58U3i)exK qyg(!XI^XGFL抇_Ba;p*j JOLqŞ] ItzsnggꮂZCk(m8EcÏ1<{!Uz/T2^R6-[Lp؛+u:D0CCX+IiPT'A3 c7&wWM E__%Sfǂ@7!3~*̿|ff9/g8n#l?kUJԤ `-s4dhlrIyEk< tih0oc/n8?-USSktU!D/T| WGHmJ=pt^J2Ι^lrK 6R⫐1ERKkکdGyV^ HErsH ^\$) 0o$-ۿlʐd# [ai#ba*}1l6_<ʚǩ+ʑeGfP'_B_`P链"ryH]wm|yLNx`kW4vR?f^s,J%$[7J坩YjB?WkdTo'G̓V(1ԦoFZ&pT?8!Y;++0l0J=AVCDsh$m`m5r^e'%ŝ¿)b'<-jr$R9۩,b@]cta‹1^ /7/\0ۆ(ž#K!|8߬|9FkHabJXE늙. kK•`uC.)H{<;y|vԑj}y|ڭ'9쑎Ң >Dz?>|/;}G.Ouĝb%6<i Z KƍT;g p[JWz\LH X.fzyX;i#)*RXmBXkhq7!04Y L*FX69oPF>DIpm:.]~c' i#gfV բ{᪲]H3Ls@{⏮u WGA6ǻd!xl%Ml׃yXBzm nz>A4RMsd 9v}4d\$g}!TKcS''T2'^2K<0Ökn^`LcWhEo= p%TrN# Kk^.q b{",N "8VgA鏚#4 I_C%"Up-OQD-i*wQ̾`ɀXSce.7b[{{+{ι.BI  MP\1[Vv"H.3QBb[6 e! d!ܦ<:֤zɍ%W(? mh!$8;ր+=| &.|@sH*++ߺ: E;aEuMH@2Dz剓}Y'j=9Ia(pވ='6o3}8SD kx˛Ԣ\S <#H2jەJCR(G>FRkAII$r F!Iq*$\6e|ba3  4$^q%uO:q8p!WQSMu] ;P6NiP2'V1}Zl_ks qRZm$8 @F`BGxZo`-hƫ.!)W脊R+x5WY )j%*~`5c an:+>ls1s(Bh)){tEojلt{{dNmMe>^?B] ?Gd(9we4?nQ I7B^p'$?@37\/G %ؽ0Ҡd8DnzӰ|kD-qCjlW00 TSŇ/&SMZmW5n. iv"H^ŵ?{M!-j U0;؄H 48aӔ-8-^Eh[)W_۩Ji-`MIC}X}9F 7^</gyۧ!jSR0rR`Z5y=qgq:4XM[!< .ӝr"5OBldbRNVx 99LJEO>HW\Qgص!&Ȟ,chB>[.|8K\R@fZ%LpnřtR/5A3aSa 5$^.T5SλƋyqXԺ?f^̶BaM2xok;4 N7S #+9bq5ŗJšAuJ<˒*v&Հ q_nzp'=Ww2?P@xr#zk:&NF6Yf>嵝I#i8&{1h,>SW\G'H@5Fp%Ɠgl!%@I1!Ʌ%;b;zoGj怋,tV2vMHkʑ,(ebQc3;߿fʰ9 g1qP)"nn 293Y@ۑRZ*I1َZbEr(ya!8R5"V5Y]]EpCQ2+R',`:p4J۔0y!i\;Dj&VW;UW~F9׮1k7O"eաqy1,$zPLZ"Pf%aG[uUtH%kuSUB0Wi_jox<_,Ĭ7 VuCSB%]hASd#=VfE !_*W>!NaEUʰV6v I3 \dxPq-ΛRsՋ5BYJ,ь|xו`'z9X7YޣP?U|*@9|50iD ̇]y@ۨqbϬߣ72NeNA̢:ڰ|GÇ Eƨa*(J\^/Ts˰D<tN8?EBNehUՓlC0E*aWcǏ }\&f+*;ry/@{0B6%0M(9nմț'߅6mpcZZ8}(~xWdƺM)deΊpۂ)8e=gxxMO-{;`82:C1X Nk={|WNVK2 _2D">p' YҚ([m[Hi^0n)4ZBU+|9@CCo>񣴢BU1}%LQ`EǁHwQ-lӉ|ek[8C@رrݱa S=Qz$ꏓn׭hhf)(##[7[aH~6FObWXKi& =$5ar8(MUfyPTF1E=#fl{~8 s Lgá-/MNyR[J %I1ܹiF琢 G[֎1<#Y~PZ>x(}ܜ(zƚDhB^IX[:{8,2l-\H`bJ)u?=ixΩYWrCOڧMNQ:.W}4vK~Qas&wxyUKLu+GL9:Ycv/4҂IrזS7+rd\bN!QrcTM"n̼q 4y"fxѿϞw)R6@B8lߴv oG$7EC,y~u[K,+R^JVegFjڌ<6>pjɅPMٚ%QO)dZMSyPoPNϘRs!,`KGq_4vj5O8 *[mP.:B.,Tr A]-^¢?\ !.c_L:۬dh@4O-C5dVEڛ Sp[EJJDtQ$3H +͸;qSOU/W(Bgi&}P)XAL%$ l8<(4J2X61 vNX_yjy 3 nB W @m.d0 $|eHAu%D" , aS؇E 2&H+KĩXȹcӅˍ CIj-pqYsXaz%ٗ~EuBɺ߅yǥw풑N @i|u2GaiGak/Cbx;GShO\l N1a<4ԿXr:/-ShI$75dc]Z;dl/-XzT(G͓C~ӹB՘ 4BV[GXXʈ2nu9Iz51(4n%i,0ͥY?-Z`Np" mjm:Ƶ89.\^˝2c1gzL83E"y4ʊB'>u`TCHD0Ft2Jr>p&xwp'N层4@x©xC!Յjب-!C\MTFI6_Àܺoj[96JSDF{OU{?Hth֟dQ|!P~"g %68T(~@N, }(Iٍf>%AoahTكt5Jn6Ό$yāg!"uCLf["; ^36<@/HJoS@ pPXh78*7ZOUYE,Pz!CLa@_= pzNbv:ZN@f UKu-=~Q 5BtW30.VǢ4OC29,v3 dJDqH!<XyLC.jq:vp$K:/zvZvuUsE/Q5{(# twO GJgSgxFkEM?DڸHGPg.53)fU)}>[o~EuN%]Ÿ^ZtxvWK1E}eFw;BC;>exFk92LW32qW!5Ɍ‽fWo{;;u03:4 bb.ҍ&@-E˱"[xS壏i˫ ɾs(E͂uM;NmqHo"WzUKy3[o >}`5EЍLφ 0=47 %"}fv!.A-;D&8g'<0sI;یUBc8H 7O\B1}yLY]bgogMI:KF6 t}lK{k y"5 u4#)}02ۭm]qBQ ;-2]A{ ]a9U?Z[/.BPRUc|Ι$3+P9tUμ(Kg+V stw;fFl!3S8d|v,Ƈ7LpH xh~WDnss<P"ZBl3XJ˚ .Q7$csȽp״^ܿAuL`p1N;YCJ[iO-c\v|ILu-zf߳JY #47Wnw̭4AFF1:J?j/]?}hFqӟ(9VzS~EZ韬$5 x|9,F˱ްl*@T4XswWc..m~TW狭&PjgF`\X_:g ?a}ܷ ԍW\)o;%zV~Sv+'k񝘿pOEZr38I̹Dۊ$6~s+cl"ifnc>}Fr_2NU#/b{ϧ%!|V>bҩ}k(KByPaMI\dzK_B~:0 |?FsǸ(၌ ZU!zYD^0+XV桀frw!_-}6]mT7Uh6|u/+ROU>}Z9B rg?Q{ݯfkLuTzgYN@kv$O ɵ= 0#Zj܊zf@*! oڹmu#)/@$?~A_e B{y4r"feM{_F!p@Ň}iDb"0&?xo=/%D(<Ӭ+gV.^&SP L'O0jmg`r):>Y$ Wl˸h0q[ŗg4j9EC:b\:{y&{9 AlRRYQAC` Xz!41D?Q-;VI >2d/!2NF_C,4oթ%6`-ob /ռXf M\'2kZǔ e;g)iB # :d⼃Yqsau%kձ)+YNLKZS9&:xeètѩyO§q&m;B!z$VK/xK/+Awgi18(u⚂ +6[7@4|!9խg6xEfvG|M(%;I~'5tlPQ=p[Cf~ ǧt 9aʱn5prqn#gO\UwGgr ^b=qx;" Pd'Wi!Ry}vi(o7.VCԜ-eE(x@#`*EMl(LP]k ^V:W/a?g8r$A-vL&x_g!ڜɳxFlϓ dz*P#=F7 Rg< mS>rNݗQ4K0 #.|Gބ)ɪ/5  v2ɍ`4~bEWˡ[4;LF9lOɼu٘ `ƎN􎸂.g oˠcX3L"X 7Y t AUz,4QyZiT7[F,{ $˧L|M8.)W"?UI .{ο%\VB *(yeu&B9')Sf[|ڶn.wirIU]F- F i<":%4f9TFې1ñG(k|cgtܩHIgKP-&Y˒=t(;*SiC駷4{7st[8U t+[ێ;ᣟɩ=]:{_+_jK[b} q>64?D'Ɲ0k4ӥbw_c2tQ0Zf.&AntQ5<ͧ_9˱!ntOgm;y{vv$V.4vR yaiFVVA[Z!쪝K$NCA D@xp4 Z0^vP**&hG.AhThˢcѹ0? _( *`q}ݺh{2q#Rcr{Qka49} iX聽ʫlAQO6X-;W uHW A)]sfp?c _7>bh+; krMCkeՋxk'gS&hCY|')G5N #79`T/ӯHRT;: tmQS*>:'?W^~U',4moYd'ҍ6D^ސrS;iceR}&.~qr&tkj>x p ek/筠Ȣ:x0 DcR;ɾscjEHF)\j.2Il0#}2Ju*ﾙ{)_7&؋NnkVy/I.a5o^qiBNdiXpI `v E;D$6278$bZDUyӨiTBY!IuYnt˂p=91e{d"N^HK-E8W_(ť_ @\H,-Q4/ȈͤjAt*#IhDfW"Տ*bƕ΋>\;0㖶+27K )#3@ ŽɇkLr+w}yId* S,& y264Gcaybg|uRkR2%컛[mR0K>wn]Du%Zv5u~PEY> ynz5iN.(ByRNP0w#;"gUN wvYĠ6$DPevЪ=z#ɴ |:5=\EߕW;[\6߅yMZ?^F_ˎ}/?TOmC0'9aJuuoBY.̠ph6s_x- k Z !{dQ3MkK]:I[Ĩ$7/! V/D @"IO A$b8zJÝ6ܒy%"fv9Ҿ[w_GUU F zaWM(`~l3;#yOkZ.%űp5B27-\kGlv^Ċ[ÿ,[efW_}b]BJ@v)VG,] aq$I|QT}#՝nŢԕh%mjҝFqo]<,r vR/v{mYtK|ơ/&PXS%_6cy]9m].EDPIt4\bW@ @yEAXurH`):%J`UVM%hqgQ(:hx%xRK{JM*~͜I7q >a[ZO|@̊/R=['WTLUAp^Vʆ rQ pr0\0 C3"ωTVWN;DVslI%J1rX78f ^VR|jByS2d0]4Ў\mޯiOýlЁKӓ(?&ЬR] ~/b >euh0ď=<mX6\U#TOTkl$?Yy1r,LQKթ;z$kR{5zkr…M,)Z+"}!`E)ü,Ĉ,92I19=N6Mv1; we<~5<3hI+b:.);AlM HD6P 2zYg H^8 /~D* |mWEw}͋?дR==vD_fiQ*#{9Rwߨ3\s? q.{ܯG1c>c>+.8Q짋2`Qoj]#A@2h!0oe/otû(`v 7紇W3X~r>3&Uo{HiJ@oNqfzmNL*VPTu읇 SI~rjXPI^$=gQȱ)NeL騶I"҈u|Av/Ko ڟFj8MtN)gRaL@r ufP3!E 2XnAOߨ`"1_dRuXow`ˏ-?!G 5l/"]37߬3J8nlh#<:$&QV )p,)wt>ȵ1#Uc茹 z*X1sR 2"G\;JYhHDyM D*KK5MjmH7\k@mW(,.Ϋ:?ת/T7wזp7:`Ȑ9}m0z2o `Fs Tq'\bgƩVʗ9oʀDZ. Z{g_`4UQPXS,|,=up)d+wژ6 2p9WU~%m|3x= ?8G殐կi)'mP/o]zA Z4pW߂/8O OZ8BIUR%Eޘ?YC5+ߵCR`^j{m׶3#@y7p]>N}PD#zZY[?562lby=zs"2%1%\ 3m4$B0cXEPaYq.[t\bJgjJ!l~l.0~ʅ&zTH.o4I'+ ZA%jt/&9纮R=\S\^jf}3b-"1.M, ukְ|2=Jc-<8|!Ph&;bΝB[f IZgLCU(oiʆ\CEvܰEd@Q Yg<5<Hc4 Lqռ[ݮ-jo @KNp4+H}Ga}`:81S=/ic-<0_wgyeGU* /x֜k^wR/8&pQtʆJuS+N!a݂Y癁d/kwKy$R+G n)v*gܽmorD|?|>r2$0XBtP_SA kiR4N\=Jbл5U:j[z]9L,m¯΅ [A Cwk]z@{v*w[Yε-:׶K/v>z\sqZdհN:\Y~lrjX7.y8U<]Vh[?fO b N(X;q+]uݼyS-WLWVB)kWyf7?}aжvv4'13uikz(5s'di*K29J:W"l<,axJjN?ֹ`]DTy3)FRDej5p@9M5=7O 2&X_TO69l(\Ȭ^zHRN tOXsNXn>MTƩwYb,Rۑ۱Tfw'4w+E1ZȾ $ ghדc2Q%,Z2h-ֳv* .lkR[0KUn WAot^%Sԭtq&dh#]DOC@jŽ'0is9  w}'} [RZ\.tr.3S5J8\g%۲bd(& 'd, !9h;;"Yc;V5=ϏHpЯa&_zwljrZʺ۩4DH&"mFSI7pK\_;f=!J"9AW؉X5f6G,V?0$c쩴m;#SA v>Wo q8B|ٺYQ/ˌ"11 ҧ͗oY3lƧh ]G>׿E+c刲sѨW$̞Hix|kcV^.7)OW8XxS-)pmT:b oAM>6yY\4j0Mwj2#{ˬq5 cl画='?$ KKj =ҋf^wݙKߥKa%@X2(E h8} S}&[3wM!../3;MK1~6@捫$pikW%3VԒbvG6ZRMd-s<"!ՌPr 4ys*d,K0/$YSo\V 8+:{\0e/m99K)ԉY4DFL~H-ړ pL>0 YZphangorn/R/0000755000175100001440000000000012547276431012320 5ustar hornikusersphangorn/R/distSeq.R0000644000175100001440000001451412535355315014060 0ustar hornikusers# # dist # dist.hamming <- function (x, ratio = TRUE, exclude = "none") { if (class(x) != "phyDat") stop("x has to be element of class phyDat") l = length(x) contrast <- attr(x, "contrast") nc <- as.integer(attr(x, "nc")) con = rowSums(contrast > 0) < 2 if (exclude == "all") { index = con[x[[1]]] for (i in 2:l) index = index & con[x[[i]]] index = which(index) x = subset(x, , index) } weight <- attr(x, "weight") d = numeric((l * (l - 1))/2) if(exclude == "pairwise"){ k=1 W <- numeric(l*(l-1)/2) for (i in 1:(l - 1)) { tmp = con[x[[i]]] for (j in (i + 1):l) { W[k] = sum(weight[tmp & con[ x[[j]] ] ]) k = k + 1 } } } if(nc > 31){ # contrast <- attr(x, "contrast") k = 1 for (i in 1:(l - 1)) { X = contrast[x[[i]], , drop = FALSE] for (j in (i + 1):l) { d[k] = sum(weight * (rowSums(X * contrast[x[[j]], , drop = FALSE]) == 0)) k = k + 1 } } } # end if else{ nr <- attr(x, "nr") if(exclude == "pairwise")ind <- which(con[unlist(x)]==FALSE) x <- prepareDataFitch(x) if(exclude == "pairwise")x[ind] <- as.integer(2L^nc -1L) res <- .C("distHamming", as.integer(x), as.double(weight), as.integer(nr), as.integer(l), as.double(d), PACKAGE = "phangorn") d <- res[[5]] } if (ratio){ if(exclude == "pairwise") d = d/W else d = d/sum(weight) } attr(d, "Size") <- l if (is.list(x)) attr(d, "Labels") <- names(x) else attr(d, "Labels") <- colnames(x) attr(d, "Diag") <- FALSE attr(d, "Upper") <- FALSE attr(d, "call") <- match.call() attr(d, "method") <- "hamming" class(d) <- "dist" return(d) } dist.ml <- function (x, model = "JC69", exclude = "none", bf = NULL, Q = NULL, ...) { if (class(x) != "phyDat") stop("x has to be element of class phyDat") l = length(x) d = numeric((l * (l - 1))/2) v = numeric((l * (l - 1))/2) contrast <- attr(x, "contrast") nc <- as.integer(attr(x, "nc")) nr <- as.integer(attr(x, "nr")) con = rowSums(contrast > 0) < 2 if (exclude == "all") { index = con[x[[1]]] for (i in 2:l) index = index & con[x[[i]]] index = which(index) x = subset(x, , index) } # model <- match.arg(model, c("JC69", "WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa", "mtREV24")) model <- match.arg(model, c("JC69", .aamodels)) # if (!is.na(match(model, c("WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa", "mtREV24")))) if (!is.na(match(model, .aamodels))) getModelAA(model, bf = is.null(bf), Q = is.null(Q)) if (is.null(bf)) bf <- rep(1/nc, nc) if (is.null(Q)) Q <- rep(1, (nc - 1) * nc/2L) bf = as.double(bf) eig <- edQt(Q = Q, bf = bf) k = 1 w = as.double(1) g = as.double(1) fun <- function(s) -(nc - 1)/nc * log(1 - nc/(nc - 1) * s) eps <- (nc - 1)/nc n = as.integer(dim(contrast)[1]) ind1 = rep(1:n, n:1) ind2 = unlist(lapply(n:1, function(x) seq_len(x) + n - x)) li <- as.integer(length(ind1)) weight = as.double(attr(x, "weight")) ll.0 = as.double(weight * 0) if (exclude == "pairwise") { index = con[ind1] & con[ind2] index = which(!index) } tmp = (contrast %*% eig[[2]])[ind1, ] * (contrast %*% (t(eig[[3]]) * bf))[ind2, ] tmp2 = vector("list", k) wdiag = .Call("PWI", as.integer(1:n), as.integer(1:n), as.integer(n), as.integer(n), rep(1, n), as.integer(li), PACKAGE = "phangorn") wdiag = which(wdiag > 0) for (i in 1:(l - 1)) { for (j in (i + 1):l) { w0 = .Call("PWI", as.integer(x[[i]]), as.integer(x[[j]]), nr, n, weight, li, PACKAGE = "phangorn") if (exclude == "pairwise") w0[index] = 0.0 ind = w0 > 0 old.el <- 1 - (sum(w0[wdiag])/sum(w0)) if (old.el > eps) old.el <- 10 else old.el <- fun(old.el) # sind = sum(ind) # tmp2 = vector("list", k) tmp2[[1]] <- tmp[ind, , drop = FALSE] # FS0 verwenden!!! res <- .Call("FS5", eig, nc, as.double(old.el), w, g, tmp2, 1L, as.integer(sum(ind)), bf, w0[ind], ll.0, PACKAGE = "phangorn") d[k] <- res[1] # res[[1]] v[k] <- res[2] # res[[2]] k = k + 1 } } attr(d, "Size") <- l if (is.list(x)) attr(d, "Labels") <- names(x) else attr(d, "Labels") <- colnames(x) attr(d, "Diag") <- FALSE attr(d, "Upper") <- FALSE attr(d, "call") <- match.call() attr(d, "variance") <- v class(d) <- "dist" return(d) } dist.logDet = function (x) { if (class(x) != "phyDat") stop("x has to be element of class phyDat") weight <- attr(x, "weight") contrast <- attr(x, 'contrast') r <- attr(x, "nc") l = length(x) d = numeric((l * (l - 1))/2) k = 1 for (i in 1:(l - 1)) { Xi = weight * contrast[x[[i]], , drop=FALSE] for (j in (i + 1):l) { tmp = crossprod(Xi, contrast[x[[j]], , drop=FALSE]) class(tmp) = "matrix" z = determinant.matrix(tmp, logarithm=TRUE) res = z$sign*z$modulus if (is.nan(res)) { d[k] = 10 } else d[k] = (-res + sum(log(rowSums(tmp) * colSums(tmp)))/2)/r k = k + 1 } } attr(d, "Size") <- l if (is.list(x)) attr(d, "Labels") <- names(x) else attr(d, "Labels") <- colnames(x) attr(d, "Diag") <- FALSE attr(d, "Upper") <- FALSE attr(d, "call") <- match.call() attr(d, "method") <- "logDet" class(d) <- "dist" return(d) } readDist <- function(file){ #, format="phylip" tmp <- read.table(file, skip=1, stringsAsFactors = FALSE) labels = tmp[,1] dm <- as.matrix(tmp[,-1]) dimnames(dm)=list(labels, labels) as.dist(dm) } writeDist <- function(dm, file=""){ # , format="phylip" dm <- as.matrix(dm) cat(ncol(dm), "\n", file=file) write.table(dm, file, append=TRUE, quote=FALSE, col.names=FALSE) } phangorn/R/clanistic.R0000644000175100001440000002766212544327527014431 0ustar hornikusers########################################################################################### getClans = function (tree) { if (is.rooted(tree)) tree = unroot(tree) bp = bip(tree) nTips = length(tree$tip) root = nTips + 1 bp[root] = NULL X = matrix(0, length(bp) - nTips, nTips) k = 1 nl = NULL if (!is.null(tree$node.label)) { nl = c(rep("-1", nTips), rep("-1", nTips), tree$node.label[-1], tree$node.label[-1]) } if(root<=length(bp)){ for (i in root:length(bp)) { X[k, bp[[i]]] = 1 k = k + 1 } } res <- rbind(diag(nTips), 1 - diag(nTips), X, 1 - X) colnames(res) <- tree$tip if (!is.null(nl)) rownames(res) = nl res } getSlices <- function(tree){ nTips = length(tree$tip) clans = getClans(tree) m = dim(clans)[1] X = tcrossprod(clans) z = rowSums(clans) Z1 = matrix(z,m,m) Z2 = t(Z1) Z = matrix(0,m,m) Z[Z1<=Z2] = Z1[Z1<=Z2] Z[Z20,arr.ind=TRUE) l = dim(index)[1] nSlices = 2 * nTips^2 -10 * nTips + 12 result = matrix(0, nSlices, nTips) strClan = do.call("paste", c(as.data.frame(clans), sep = "")) k=1 for(i in 1:l){ tmp1 = as.numeric((clans[index[i,1],] + clans[index[i,2],])==2) tmp = paste(tmp1,sep="",collapse="") if(is.na(match(tmp,strClan))){ result[k,] = tmp1 k=k+1 } } if(kmin(ind) ) break() within = max(dm[ind, ind]) between = min(dm[ind, -ind]) if (within < between) { res = numeric(nTips) res[ind] = 1L result = rbind(result, res) } } } dimnames(result) = list(NULL, tips) if (all) return(result) ind = which.max(rowSums(result)) result[ind, ] } shannon <- function (x, norm=TRUE) { p = x/sum(x) ShD = -sum(p * log10(p)) if(norm){ if (sum(x) == 1) return(0) ShD = ShD/log10(sum(x)) } ShD } shannon2 <- function (x, norm=TRUE) { p = x/sum(x) ShD = -sum(p * log(p)) if(norm){ if (sum(x) == 1) return(0) ShD = ShD/log(sum(x)) } ShD } getE = function (tree, x, clans = NULL, norm = TRUE) { if (is.rooted(tree)) tree = unroot(tree) if (is.null(clans)) clans = getClans(tree) labels = tree$tip.label x = x[labels] result = rep(NA, 12) names(result) = c("E* tree", "# natives", "# intruder", "# unknown", "E* clan", "# intruder", "# unknown", "E* slice", "# intruder", "# unknown", "bs 1", "bs 2") result[2] = sum(x == 1) result[3] = sum(x == 2) result[4] = sum(x == 3) if (result[2] == 0 || result[3] == 0) { if (result[2] > 1) return(list(result, labels)) else return(list(result, integer(0))) } LHG = E_Intruder(clans, x) d = dim(LHG)[1] if (d == 1) { result[1] = 0 if (!is.null(tree$node.label)) result[11] = as.numeric(rownames(LHG)) return(list(result, labels[LHG == 0])) } intr = drop(LHG %*% as.numeric(x == 2)) result[1] = shannon2(intr, norm = norm) o <- order(intr, decreasing = TRUE) if (!is.null(tree$node.label)) result[11:12] = as.numeric(rownames(LHG)[o[c(1, 2)]]) ind = which(LHG[o[1], ] == 1) result[6] = sum(x[-ind] == 2) result[7] = sum(x[-ind] == 3) if (length(x[-ind]) < 4) return(list(result, NULL)) result[5] = shannon2(intr[-o[1]], norm = norm) ind2 = c(which(LHG[o[1], ] == 1), which(LHG[o[2], ] == 1)) spl = structure(list(which(colSums(LHG)==0)), labels=labels, weights=1) class(spl)="splits" if (d == 2) { return(list(result, spl)) } result[9] = sum(x[-ind2] == 2) result[10] = sum(x[-ind2] == 3) if (length(x[-ind2]) < 4){ return(list(result, spl)) } result[8] = shannon2(intr[-c(o[1], o[2])], norm = norm) return(list(result, spl)) } E_Intruder <- function (clans, x) { cp = drop(clans %*% as.numeric(x == 1)) ci = drop(clans %*% as.numeric(x == 2)) homo = which(cp == 0 & ci > 0) l = length(homo) if (l > 0) { HG = clans[homo, , drop = FALSE] lhg = rep(TRUE, l) rsh = rowSums(HG) Z = tcrossprod(HG)>0 Z = Z * rsh zmax = apply(Z,2,max) lhg = !(zmax > rsh) LHG = HG[lhg, , drop = FALSE] return(LHG) } return(NULL) } E_Intruder_2 <- function (clans, x, native=NULL) { contr = attr(x, "contr") d = dim(contr) if(d[1]>d[2])contr[(d[2]+1):d[1],]=0 cp = clans %*% contr[as.numeric(x),] homo = which(rowSums(cp > 0) == 1) l = length(homo) if (l > 0) { HG = clans[homo, , drop = FALSE] lhg = rep(TRUE, l) rsh = rowSums(HG) Z = tcrossprod(HG)>0 Z = Z * rsh zmax = apply(Z,2,max) lhg = !(zmax > rsh) LHG = HG[lhg, , drop = FALSE] return(LHG) } return(NULL) } getDiv <- function(tree, x, native=NULL){ clans = getClans(tree) labels = tree$tip.label x = subset(x, labels) LHG = E_Intruder_2(clans, subset(x,,1)) if(!is.null(native)){ ll = match(native, attr(x, "allLevels")) ind = (as.numeric(x) %in% ll) } if(!is.null(native)){ rs = rowSums(clans) intr = clans %*% ind clans = clans[intr==0,] d = which.max(rs[intr==0]) tree2 = drop.tip(tree, tip=labels[which(clans[d, ]==1)]) } else tree2=NULL list(c(shannon(rowSums(LHG)), summary(factor(attr(x, "allLevels"))[as.numeric(subset(x,,1))]), parsimony(tree, x)), tree2 ) } getDiversity <- function (tree, x, norm = TRUE, var.names = NULL, labels="new") { k = 1 if(class(tree) == "multiPhylo") k = length(tree) l = attr(x, "nr") tmp = matrix(0, k * l, 12) tnam = 1 if (class(tree) == "multiPhylo") { tnam = names(tree) if (is.null(tnam)) tnam = 1:length(tree) } if(is.null(var.names)) var.names = 1:l PM = data.frame("t1", "a", stringsAsFactors = FALSE) colnames(PM) = c("Tree", "Var") PM = PM[FALSE,] PM[1 :(k*l), ] = NA perfect = names(x) L = vector("list",k*l) m = 1 o = 1 ok= 0 for (i in 1:k) { if (class(tree) == "multiPhylo") tmptree = tree[[i]] else tmptree = tree if (is.rooted(tmptree)) tmptree = unroot(tmptree) clans = getClans(tmptree) for (j in 1:l) { TMP = getE(tmptree, getRows(x, j), clans, norm = norm) tmp[m, ] = TMP[[1]] L[[m]] = TMP[[2]] # if class =splits else NULL PM[m, 1] = tnam[i] PM[m, 2] = var.names[j] m = m + 1 } } tnam = rep(tnam, each = l) dnam = var.names dnam = rep(dnam, k) pscore = as.numeric(sankoff(tree, x, site = "site")) res = data.frame(tnam, dnam, tmp, pscore) if(labels=="old")names(res) = c("tree", "variable", "E tree", "# natives", "# intruder", "# unknown", "E clan", "# intruder", "# unknown", "E slice", "# intruder", "# unknown", "bs 1", "bs 2", "p-score") else{ names(res) = c("tree", "variable", "E clan", "# natives", "# intruder", "# unknown", "E slice", "# intruder", "# unknown", "E melange", "# intruder", "# unknown", "bs 1", "bs 2", "p-score") warning("The variable names have changed") } attr(res, "Perfect") = L class(res) = c("clanistics", "data.frame") res } summary.clanistics <- function(object, ...){ res <- matrix(FALSE, nrow(object), 5) res[,1] = object[,4]>0 & object[,"p-score"]==0 # "natives" res[,2] = object[,5]>0 & object[,"p-score"]==0 # "intruder" res[,3] = object[,"p-score"]==1 res[,4] = ( (object[,"p-score"]==2) & (object[,7]==0) & (!is.na(object[,7])) ) | ( (object[,"p-score"]==2) & (object[,4]==2) & (is.na(object[,7])) ) res[,5] = object[,"p-score"]>=2 & (object[,7]>0) & (!is.na(object[,7])) res[] = as.numeric(res) tmp = data.frame(factor(object[,"variable"]), res) colnames(tmp) = c("Variable", "Natives_only", "Intruder_only", "Clan", "Slice", "Melange") # colnames(res) = c("Natives only", "Intruder only", "Clan", "Melange") class(tmp) <- c("summary.clanistics", "data.frame") tmp } print.summary.clanistics <- function(x, ...){ print(aggregate(x[,-1], list(Variable=x[,1]), sum), ...) } compareSplits <- function(res, nam1, nam2){ wide <- reshape(res[, c("tree", "E tree", "variable")], v.names="E tree", idvar="tree", timevar="variable", direction="wide") wideI <- reshape(res[, c("tree", "# natives", "variable")], v.names="# natives", idvar="tree", timevar="variable", direction="wide") for(i in 2:dim(wide)[2])colnames(wide)[i] = strsplit(colnames(wide)[i],"E tree.")[[1]][2] for(i in 2:dim(wide)[2])colnames(wideI)[i] = strsplit(colnames(wideI)[i],"# natives.")[[1]][2] ntrees = wide[,1] splits = attr(res, "Perfect") dat = attr(attr(res, "Perfect"), "data") res = matrix(NA, length(ntrees), length(nam1)*length(nam2)) for(m in 1:ntrees){ k=1 trnam=ntrees[m] for(i in nam1){ E1 = wide[m, i] for(j in nam2){ E2 = wide[m, j] if(!is.na(E1) & !is.na(E2)){ if(E1 == E2){ # if(E1 == 0 & E2 == 0){ if( (wideI[m, i] >0) & (wideI[m, j]) >0){ ind1 = which(dat[,1]==trnam & dat[,2]==i) sp1 = splits[[ind1]] ind2 = which(dat[,1]==trnam & dat[,2]==j) sp2 = splits[[ind2]] if(length(ind1)>0 & length(ind2)>0 )res[m, k] = drop(compatible3(sp1, sp2)) } } } k=k+1 } } } res } diversity <- function(tree, X){ # from kknn contr.dummy <- function (n, contrasts = TRUE) { if (length(n) <= 1) { if (is.numeric(n) && length(n) == 1 && n > 1) levels <- 1:n else stop("contrasts are not defined for 0 degrees of freedom") } else levels <- n lenglev <- length(levels) cont <- array(0, c(lenglev, lenglev), list(levels, levels)) cont[col(cont) == row(cont)] <- 1 cont } l = dim(X)[2] m <- ifelse(class(tree)=="multiPhylo", length(tree), 1) contr = as.list(rep("contr.dummy", l)) names(contr) = names(X) tmp = model.matrix(~.-1, X, contrast=contr) tmp1 <- phyDat.default(tmp, levels=c(1,0), compress = FALSE) attr(tmp1, "varnames") = colnames(tmp) fd = sankoff(tree,tmp1,site = "site") fd = matrix(fd, ncol=m) if(m>1){ if(is.null(names(tree))) tnames <- paste("tree", 1:m, sep=".") else tnames <- names(tree) } else tnames = "tree" dimnames(fd) = list(colnames(tmp), tnames) res = stack(data.frame(fd)) if(m>1)nt = rep(sapply(tree, function(x)length(x$tip)), each=dim(fd)[1]) else nt = rep(length(tree$tip), each=dim(fd)[1]) if(m>1)res2 = as.vector(sapply(tree, function(x,y)colSums(y[x$tip,,drop=FALSE]) , y=tmp)) else res2 = colSums(tmp[tree$tip,,drop=FALSE]) result <- data.frame(tree = res[,2], variable=rep(colnames(tmp),m), pscore=res[,1], ntips=nt, natives=res2) result } phangorn/R/cladePar.R0000644000175100001440000000141012507002037014133 0ustar hornikuserscladePar = function(tree, node, edge.color="red", tip.color=edge.color, edge.width = 1, edge.lty = 1, x=NULL, plot=FALSE, ...){ if(is.null(x)){ m = max(tree$edge) x=list(edge=data.frame(color=rep("black",m), width = rep(1, m), lty = rep(1, m), stringsAsFactors = FALSE),tip=rep("black", length(tree$tip))) } ind = Descendants(tree,node,"all") x$edge$color[ind] = edge.color x$edge$width[ind] = edge.width x$edge$lty[ind] = edge.lty x[[2]][Descendants(tree, node, "tips")[[1]]] = tip.color if(plot){ tree=reorder(tree) plot(tree, edge.color=x$edge$color[tree$edge[,2]], edge.width = x$edge$width[tree$edge[,2]], edge.lty = x$edge$lty[tree$edge[,2]], tip.color=x[[2]],...) } else return(x) } phangorn/R/hadamard.R0000644000175100001440000001164612507002037014175 0ustar hornikusersdec2Bin = function (x) { res = NULL i = 1L while (x > 0) { if (x%%2L) res = c(res, i) x = x%/%2L i = i + 1L } res } # returns binary (0, 1) vector of length k dec2bin <- function (x, k=ceiling(log2(x))) { i = 1L res = integer(k) while (x > 0) { if (x%%2L) res[i] = 1L x = x%/%2L i = i + 1L } res } # double factorial: log version "ldfactorial" <- function(x){ x = (x+1)/2 res = lgamma(2*x)-(lgamma(x)+(x-1)*log(2)) res } # double factorial "dfactorial" <- function(x){exp(ldfactorial(x))} # # Hadamard Conjugation # hadamard <- function(x){ res=1 while(x>0){ res=rbind(cbind(res,res),cbind(res,-res)) x=x-1 } res } fhm <- function(v){ n = length(v) n = log2(n) res = .C("C_fhm", v = as.double(v), n = as.integer(n))$v # res } seq2split = function(s){ n=length(s) res= fhm(log(fhm(s)))/n res } split2seq = function(q){ n=length(q) res= fhm(exp(fhm(q)))/n res } distanceHadamard <- function (dm, eps = 0.001) { if (class(dm) == "dist") { n <- attr(dm, "Size") Labels = attr(dm, "Labels") } if (class(dm) == "matrix") { n <- dim(dm)[1] Labels <- colnames(dm) dm <- dm[lower.tri(dm)] } ns <- 2^(n - 1) if (n > 23) stop("Hadamard conjugation works only efficient for n < 24") result <- .Call("dist2spectra", dm, as.integer(n), as.integer(ns), PACKAGE = "phangorn") weights = -fhm(result)/2^(n - 2) if(eps>0){ weights = weights[-1] ind2 = which(weights>eps) n2 = length(ind2) splits = vector("list", n2) for(i in 1:n2)splits[[i]] = dec2Bin(ind2[i]) attr(splits, "weights") = weights[ind2] attr(splits, "labels") = Labels attr(splits, 'dm') = dm class(splits)='splits' return(splits) } res <- data.frame(distance = result, edges = weights, index = 0:(ns - 1)) attr(res, "Labels") <- Labels res } h4st = function(obj, levels=c('a','c','g','t')){ if (is.matrix(obj)) obj = as.data.frame(t(obj)) if (class(obj) == "phyDat") obj = as.data.frame(t(as.character(obj))) # if(is.matrix(obj)) obj = as.data.frame(t(obj)) # DNA = as.data.frame(obj) # DNA = t(as.character(obj)) n = dim(obj)[1] p = dim(obj)[2] if(p>11) stop("4-state Hadamard conjugation works only efficient for n < 12") DNAX = matrix(0,n,p) DNAY = matrix(0,n,p) DNAX[obj==levels[1]]=0 DNAX[obj==levels[2]]=1 DNAX[obj==levels[3]]=1 DNAX[obj==levels[4]]=0 DNAY[obj==levels[1]]=0 DNAY[obj==levels[2]]=1 DNAY[obj==levels[3]]=0 DNAY[obj==levels[4]]=1 DNAY = DNAY - DNAY[,p] DNAX = DNAX - DNAX[,p] DNAY = abs(DNAY[,-p]) DNAX = abs(DNAX[,-p]) dy = DNAY %*% (2^(0:(p-2))) dx = DNAX %*% (2^(0:(p-2))) INDEX = dx + 2^(p-1) * dy blub = table(INDEX) index = as.numeric(rownames(blub)) + 1 sv = numeric(4^(p-1)) sv[index] = blub qv = matrix(seq2split(sv),2^(p-1),2^(p-1)) sv = matrix(sv,2^(p-1),2^(p-1)) # q = cbind(transversion = qv[-1,1], transition.1 = diag(qv)[-1], transition.2 = qv[1,-1]) transversion <- transition.1 <- transition.2 <- allSplits(p, colnames(obj)) attr(transversion,"weights") = qv[-1,1] attr(transition.1,"weights") = diag(qv)[-1] attr(transition.2,"weights") = qv[1,-1] # result = list(q = q, qv = qv, sv=sv, n=sum(sv), names=names(obj)) result = list(transversion = transversion, transition.1=transition.1, transition.2 = transition.2, qv = qv, sv=sv, n=sum(sv), names=names(obj)) result } h2st <- function (obj, eps=0.001) { if (class(obj) != "phyDat") stop("Error") if (attr(obj,"nc") != 2)stop("Error") nr = attr(obj, "nr") #n p = length(obj) #p weight = attr(obj, "weight") if (p > 23) stop("Hadamard conjugation works only efficient for n < 24") DNAX = matrix(0, nr, p-1) for(i in 1:(p-1)) DNAX[,i] = obj[[i]]-1 DNAX[obj[[p]]==2,] = 1 - DNAX[obj[[p]]==2,] index = DNAX %*% (2^(0:(p - 2))) + 1 sv = numeric(2^(p - 1)) for(i in 1:nr)sv[index[i]] = sv[index[i]]+ weight[i] qv = seq2split(sv) if(eps>0){ qv = qv[-1] ind2 = which(qv>eps) indT= c(2L^(0:(p-2)), 2L^(p-1)-1) ind2 = union(ind2, indT) n2 = length(ind2) splits = vector("list", n2) for(i in 1:n2)splits[[i]] = dec2Bin(ind2[i]) attr(splits, "weights") = qv[ind2] attr(splits, "labels") = names(obj) class(splits)='splits' return(splits) } result = data.frame(edges = qv, splits = sv, index = 0:(2^(p - 1) - 1)) attr(result, "Labels") = names(obj) result } phangorn/R/modelTest.R0000644000175100001440000001703512543062270014377 0ustar hornikusersmodelTest2 <- function (object, tree = NULL, model = c("JC", "F81", "K80", "HKY", "SYM", "GTR"), G = TRUE, I = TRUE, k = 4, freq=FALSE, control = pml.control(epsilon = 1e-08, maxit = 10, trace = 1), multicore = FALSE, mc.cores = getOption("mc.cores", 1L)) { if (class(object) == "phyDat") data = object if (class(object) == "pml") { data = object$data if (is.null(tree)) tree = object$tree } if(attr(data, "type")=="DNA") type = c("JC", "F81", "K80", "HKY", "TrNe", "TrN", "TPM1", "K81", "TPM1u", "TPM2", "TPM2u", "TPM3", "TPM3u", "TIM1e", "TIM1", "TIM2e", "TIM2", "TIM3e", "TIM3", "TVMe", "TVM", "SYM", "GTR") if(attr(data, "type")=="AA") type = .aamodels model = match.arg(model, type, TRUE) env = new.env() assign("data", data, envir=env) if (is.null(tree)) tree = NJ(dist.hamming(data)) else{ tree <- nnls.phylo(tree, dist.ml(data)) # may need something faster for trees > 500 taxa } trace <- control$trace control$trace = trace - 1 fit = pml(tree, data) fit = optim.pml(fit, control = control) l = length(model) if(attr(fit$data, "type")=="DNA")freq=FALSE n = 1L + sum(I + G + (G & I) + freq + (freq & I) + (freq & G) + (freq & G & I)) nseq = sum(attr(data, "weight")) fitPar = function(model, fit, G, I, k, freq) { m = 1 res = matrix(NA, n, 6) res = as.data.frame(res) colnames(res) = c("Model", "df", "logLik", "AIC", "AICc", "BIC") data.frame(c("Model", "df", "logLik", "AIC", "AICc", "BIC")) calls = vector("list", n) trees = vector("list", n) fittmp = optim.pml(fit, model = model, control = control) res[m, 1] = model res[m, 2] = fittmp$df res[m, 3] = fittmp$logLik res[m, 4] = AIC(fittmp) res[m, 5] = AICc(fittmp) res[m, 6] = AIC(fittmp, k = log(nseq)) calls[[m]] = fittmp$call trees[[m]] = fittmp$tree m = m + 1 if (I) { if(trace>0)print(paste(model, "+I", sep = "")) fitI = optim.pml(fittmp, model = model, optInv = TRUE, control = control) res[m, 1] = paste(model, "+I", sep = "") res[m, 2] = fitI$df res[m, 3] = fitI$logLik res[m, 4] = AIC(fitI) res[m, 5] = AICc(fitI) res[m, 6] = AIC(fitI, k = log(nseq)) calls[[m]] = fitI$call trees[[m]] = fitI$tree m = m + 1 } if (G) { if(trace>0)print(paste(model, "+G", sep = "")) fitG = update(fittmp, k = k) fitG = optim.pml(fitG, model = model, optGamma = TRUE, control = control) res[m, 1] = paste(model, "+G", sep = "") res[m, 2] = fitG$df res[m, 3] = fitG$logLik res[m, 4] = AIC(fitG) res[m, 5] = AICc(fitG) res[m, 6] = AIC(fitG, k = log(nseq)) calls[[m]] = fitG$call trees[[m]] = fitG$tree m = m + 1 } if (G & I) { if(trace>0)print(paste(model, "+G+I", sep = "")) fitGI = update(fitI, k = k) fitGI = optim.pml(fitGI, model = model, optGamma = TRUE, optInv = TRUE, control = control) res[m, 1] = paste(model, "+G+I", sep = "") res[m, 2] = fitGI$df res[m, 3] = fitGI$logLik res[m, 4] = AIC(fitGI) res[m, 5] = AICc(fitGI) res[m, 6] = AIC(fitGI, k = log(nseq)) calls[[m]] = fitGI$call trees[[m]] = fitGI$tree m = m + 1 } if (freq) { if(trace>0)print(paste(model, "+F", sep = "")) fitF = optim.pml(fittmp, model = model, optBf = TRUE, control = control) res[m, 1] = paste(model, "+F", sep = "") res[m, 2] = fitF$df res[m, 3] = fitF$logLik res[m, 4] = AIC(fitF) res[m, 5] = AICc(fitF) res[m, 6] = AIC(fitF, k = log(nseq)) calls[[m]] = fitF$call trees[[m]] = fitF$tree m = m + 1 } if (freq & I) { if(trace>0)print(paste(model, "+I+F", sep = "")) fitIF <- update(fitF, inv = fitI$inv) fitIF = optim.pml(fitIF, model = model, optBf = TRUE, optInv = TRUE, control = control) res[m, 1] = paste(model, "+I+F", sep = "") res[m, 2] = fitIF$df res[m, 3] = fitIF$logLik res[m, 4] = AIC(fitIF) res[m, 5] = AICc(fitIF) res[m, 6] = AIC(fitIF, k = log(nseq)) calls[[m]] = fitIF$call trees[[m]] = fitIF$tree m = m + 1 } if (freq & G) { if(trace>0)print(paste(model, "+G+F", sep = "")) fitGF <- update(fitF, k=k, shape=fitG$shape) fitGF = optim.pml(fitGF, model = model, optBf = TRUE, optGamma = TRUE, control = control) res[m, 1] = paste(model, "+G+F", sep = "") res[m, 2] = fitGF$df res[m, 3] = fitGF$logLik res[m, 4] = AIC(fitGF) res[m, 5] = AICc(fitGF) res[m, 6] = AIC(fitGF, k = log(nseq)) calls[[m]] = fitGF$call trees[[m]] = fitGF$tree m = m + 1 } if (freq & G & I) { if(trace>0)print(paste(model, "+G+I+F", sep = "")) fitGIF <- update(fitIF, k=k) fitGIF = optim.pml(fitGIF, model = model, optBf = TRUE, optInv = TRUE, , optGamma = TRUE, control = control) res[m, 1] = paste(model, "+G+I+F", sep = "") res[m, 2] = fitGIF$df res[m, 3] = fitGIF$logLik res[m, 4] = AIC(fitGIF) res[m, 5] = AICc(fitGIF) res[m, 6] = AIC(fitGIF, k = log(nseq)) calls[[m]] = fitGIF$call trees[[m]] = fitGIF$tree m = m + 1 } list(res, trees, calls) } eval.success <- FALSE if (!eval.success & multicore) { # !require(parallel) || # if (.Platform$GUI != "X11") { # warning("package 'parallel' not found or GUI is used, \n analysis is performed in serial") # } # else { RES <- mclapply(model, fitPar, fit, G, I, k, freq, mc.cores=mc.cores) eval.success <- TRUE # } } if (!eval.success) RES <- lapply(model, fitPar, fit, G, I, k, freq) # res <- RES <- lapply(model, fitPar, fit, G, I, k, freq) RESULT = matrix(NA, n * l, 6) RESULT = as.data.frame(RESULT) colnames(RESULT) = c("Model", "df", "logLik", "AIC", "AICc", "BIC") for (i in 1:l) RESULT[((i - 1) * n + 1):(n * i), ] = RES[[i]][[1]] for(i in 1:l){ for(j in 1:n){ mo = RES[[i]][[1]][j,1] tname = paste("tree_", mo, sep = "") tmpmod = RES[[i]][[3]][[j]] tmpmod["tree"] = call(tname) if(!is.null(tmpmod[["k"]]))tmpmod["k"] = k if(attr(data, "type")=="AA") tmpmod["model"] = RES[[i]][[1]][1,1] assign(tname, RES[[i]][[2]][[j]], envir=env) assign(mo, tmpmod, envir=env) } } attr(RESULT, "env") = env RESULT } phangorn/R/sysdata.rda0000644000175100001440000004601512507002037014447 0ustar hornikusers}w@U0M,T;*R *̱R,PDDi .H RWMz^>޾U?$dI9G~2fEf:ߑZa8f<Ҍ48gnށXn_ojo;?ӮO{{{ g[w ~0ԟWk?@ >v9t~ [{al>ߟg tr?so˯[?ϯMw߉~O~s;G_cï~-O?ί!;;'Y|wÏZ?QGn8?_?zg?޿[UƉW=J{??s35?ߔ[Sj.:_ڞ_ߥMCu[<~~ 6]O~Tl,?Ӯ/O{oVO;9:~Ow?O{8U_ӿKQ>*OkX>8U":, ߿ @Go.Z?J?K?~~{Vz:(;_?}[g_Rl>8_ϯo|x?v TU8Y+gӿK}|}+z^nl_._ev;Q:Ut~T^|gߓOo|+YvGK-7jҩR JCCF3+4P,Y:B_wngf1,%\ʷ݅OLGxi! Gg?+ֆ vP(?T v腶Is:@:9&A{ ;QGbZZksv6fH>MS-1昱`8=Yy o&Ptʙs΋jiWJ𾷮4EzAr'DiӇ9-\k/eͻVA~C+ZR]yRM2B~'MfZmUC3w@ q E+.OSeMejFVy޻£VP'!y0GƤcu. >dR?KmŹ,9; Wnq!~uQ`pKsAC{l0;r> k PSvST ;xkea:ţ419R$ VΗO 4ȞEÚ-^λt %[̞C{"SxvA!xبvDK {g tBPP|-Y8I~YvT:{½ȵ⟙Vf0炵3h~Ω(|5v{I0nyr}~=a(qKTmOޒW2RպBӫ_*-Ç5qB53!XiTCGO"r/q79n U,.Y|5->un@ !-Vv'b}Q~+@ÑE N y2.Q,Hm G.c2ޢ!Ѹ-rjuzgI B ]̕3`wޫx,Aqcp s]Cb> $B-}; 7xj.Vzei!G Bq}x-m,bdDcHпlI]c Tw,Z]_m{4!t5dﾙvLQ8 l T( bo~82 B-E Zs?%V6&)﵀35ưdg@ e##Xp5;od? MӀKb9p xd-${o\| >9"-R@3kSK;}3/U ţGր͉yZGJi)? O6ύc f_罟\8m-5?#£DZ ?]G 9?)$t=,c\ bA3C^o~x"}uF,^ZG:ha[76.)bWݞUŵ WO$]~i\qX-4sYe@}c' 0ЮL0(=|ޜ` wK%Nr64 I;{:LKR]렢5rFbT"Q({y*T &h Bǖk P^X`jDˀ Ԕ9 Hozj&5GB+AQQ?m~v^L9 !)ٴWz͈7v:EёCe$jʫ[rkH>sx]HKt-}v1uЦ*DHc;19ʷI>#ng*wd&U3m%i po.&5gc'M']aS2i>l7#maK4 uό ꉘMZ!?1<؋-!t<"'W\W8Ze9[// ?Xd&UaҏM;U$@8mbO*dh#Th>Tb9k :!bd"i )RJ fTIN}RqvHz N  W`:[Ez3&nY6!/4pFÜs{'TWV_懌f׮Ah38{9,rBA U>1xܺ8*d,!x$<7ܮ -R lAoUOtH z9}WD %ByZ֓lzJ;&B8(^5֏u>h~PCפ)d}Pa! R\x"wޕC0)-LP&ۉʇ&'% ruow;A2CQ5k1w]MVd%v VMSCS~*& uGJf Тkq0.*[Zj쓄hCpDgL|UoUnѩ;fb!zJ^mȱY;iUG蘔/hUdAȽ w6̣z2(>yi\< i$q7m+n^ 4ד;‰Ƴ,zNm2|Ϻ܀j:A*/1˸Oנ" <5ERTE@NWh+ʑbҵb/LW7A.E)~;x)wtKy ȬSགaN$?~S}Lƹ~)G l\L~1W=AhǏSkb-foٿL!\UP*_A)RX>c" CwnDo3Dww %oCx (=UJ7 <^Y~) glOZĿO#ME s 2kbˉ85+ >"GgDB܎fIx̑Jz VABm|0>'*9v Qۅbra ZeEk]EH(EBvcb=e:ToK"%azx!liCqp@eټ̋.xH^}Vp ~i vVCs6Pn\ \ ^ܿ <_7$ _FH([Z2)*iSgNnͤ~mw }\ jJܵdPqe.]:2JW S2%!vϠ-J?!(]g>b6"h)8;?+ҏt1] 㮂]"ynEkt'<4`\DZ(΃#BU+$TF|O [ܾc(<F aCB$t<{5BxyU2VN+g$BB{d U*#rIG"1VNܞX.mb{,<4@r":Gn]/VAVk >x}7,񠋟#? w/⃝ zc2O= C{nBq_+0*wBq<)N?=r6CetDόɉ# WGx³F6c믍O:$܏!,IHkrSQ7A,Iu:(O񸠄>(L?n_윯 8hVI/>w,N4Si(^P7X8S2sCLv;9E"',#S"+ #|| Ǩ+yp6G^!~I E~w!k7*KBhMy225Ogl-Ri+'[4'3+oJ;~#_,?AQ& uZ|?ҡ+@N^ll\h͊◐E+[OslWT!56N(O#f, dxŅ%:Z$\- B=Y)p1&Ve_MCsIc-g{A% OvBF}80Ks!x#8</]Т[D]hF$g|y➀kèY?sfL lE~4 |D@eBVt%L;7عXh6>ORۏͧa'Lr*vNTrNs(x q}rqMDHEBev ?}yE\. jz)Bd"z;C##<3[p)8׋BZ*_=Y3 yh Dl.ϰiY 1xPa%˯1CUK[ AIs]gBvڐS$x0@x; BH3)82j~|D(Ύ\B+d2_ u:^V \DB>YNɽn$˟`#!JX^[#~x&B/c;-uķ!>tTzDrNFq)]F2TʩqT҂WGaH|}yHCd=1}<9F|#UDp#/7w; ی]~@qjcDC ~IMP9,)o68 DLE*~ЇgzBI rr? ɣC:QAxv$Ag(yT|!3ޥ*2|(]COZTL"_"<χivmzHRI ُ.υH.Aqd W;ƶ++x&!/GBr_CoON,'FajpOT%,5&]_h -! BdɅ +c[]VBPS_@9 `!V2x||D6M3pV`hs|)b[ xYl׍ˌ[58=y-d _5ޯNAZӪϘΧEdk pa״ʎ%ns@3ӧh\6xw]1{2(^`gs(ha+jƅ:CDɥ+lږx" IfO&y铹 x駠BZ6|V;noZ}K]a&CޏL R]9,@QsQr0`/*,w\S=uQg&m A;W @ Wp \Gn@xʗylޅmʴvΣY;/fSAmw+{fyP1}ԠCx7ޜ.LZA eli&s(CN^Yu Thjqjgݐ|=Zw_UtL ‚ǃ.U[gj{$`'19+2 *.Vdx@目&Lz 6|l_"?2S0xv(N~ )}]_>] Qt 3F`b&7\ڱ<nR%nFEwۀ%O+hZh_IDɼ7o޻LUB#4Zaq.!@w}$L(-ݛRt^ơZ#}d;Q$HX06 =~_#o$dB`@|YH# [GKH;IPm9F,dmt(&&̈́I=$}P0՟83,ENҒt7dLb5iO[=Rm3d\P{cqo eHSHyI;X}#դEwHzptGm<Ê@(O-e 2*>K]O[Xee!z$%'E/%!QD_刷6Q[*c)xK_ZLJE}Q-`l[ot t7{xl=([Oܾz"cė(0}ʢ8++>:wmn)7D_y2?1?_>@} %4t8vxїGt8wۢsxr\xˍi;6@z͞ė܏83r֣Gwm#, w^] ~# -I ҿ nsx:z mQ/~ /d8[S? 4 *Twp_YڶuK 1Nk\~ p }w0ŦY`I=vS`EuF TrP?֔EBWCy"k>{'V6yKMX!\Bo 7&>ɂj9*0N%X)GTi3I[38h. U OFSh-g+XϨ1rӘ;/_@ubzkc`NC{h4 P/25JzI69b5g3'<9bț:qmu=b.N]5vVCKɎ'ʡFx ~ɟUi]/P|NU޿Ņ&Μ"a.<4ZYx`bUʧr)u ixs ?pW-u_-*N'8]\]:6;,w>eERl '9N]%l=c˩?ࣾW:h4fJl}}\ d =OD{5s[ (!N̲)Kyd"bb2Ecǔ]\S(ŌRQS]tM!x˃Pc/6?4\f:<!?H~ZHSL "n K,5Swf6k)r/}Cv }-$r3"USmij_uJK']//]*}Κ /V:A)0;Jh&927jFOsĝSܕ&>wDޛln> ʉQr#L,9Aϕ61:J|oV 1Q@gK" 5QɌĵ7ƷGpEh":z_, YquTļI!\gyCAqMݳzPm@8{deF{ vZ4TV !\ 5JY0HB Lml19Ó7N|:>>S{Cl@fyޚ3SKaĜ%cu<*0EwvCj^Q>ѧ'C[Q"[e_ Op]\VˤkA;FX[ *jf5}+Mf|y؆0:V'ǛA'ȁM![AG\ABdbվ\U:/g.K r| wO<iG>B3^nJ~ZǩY_@yZr"x}] SG`tZc%_y/S87${{dJz:j8oȳPr2nȳ[~h\lܳd+R~` |Xj r>1tA"aokFC^»g 4_Lmhtiaa K]7; @U/Aé@!G^fJd+QyknBm!f@|;m6 ./\cixcݟX kOu[A50BfT['=x/BJ;u}i"N!9j&]{o:󲠓E5S( {s\ ; ϦSwp7g;4sW-PIx+Akfz#t^k-j- ml{ό נFPQfAZR⫐e=K Js'C|(Hf̎o %Vg&{$eS۵w@RP7~*(rs/^Z* wu_ZZ BG!a,#t/@D,Y“ u._PdS،P5"Eq_ 87<=t[Q'CJMrK (gunrUk쮀Ns.2.b Wz/Fp+^&ku3AQnԦp顒:h},ޙ+^0 u*;>nKR]*&a 1<-8a!J$xӐ7 ~7/0lue^E ~E:OhR74>;{b/{- R%DjWbO*(˩~K1w${r4IY eʴg䠭䮦[9uRqGmyAxa?Y(HKضD9Nwٰv$@k1BtAKqfʶV&Ա]!" [,y}'/y ˌVAOJ|dcVHltwxrmy`<"<*-/@ۙm⦡f^'  m V$@g@ު%[aPK Tn; IkJTBj6}a^3938y|1bfc~D4\IC/mLmP}%S;:*6]dV 9! sevC ߒ}d٫+ .V+RdRIwV~a|S sw;rXɾj2Z=>ΆV{MzZ?Ev KUM+!hrۛ,GwYB{`*9cʹ|nM4 \8. ?IL"y#ω `:8i"T~Μ'϶+BuUӠE5YջWemNY'z6f90| r> {P~3ot^ 1I9-%?-R[m Ao9TIy_8c9AS;iuTK^\"6i:q!8YkЪ׻5ZNY=r y ]<>X食Y4Fz6HszYN\Nj S EւO\΂g&V)o 6ko % '*»ԨQfϰ nyN]v#WN$ ]xJ4%=ond>Yl(WϢ Ο >>P jzAWx 9,K YzF4dsU^%L'LU$Zgm!8S%FP?|KY䙈qdeӃD9}Q V\P ڙשB{rױPovNȞ?1Wr ϼl+@ φ{n|y&9P_«@!J q_A]L+ȋUkHO5zyƾ yKgB>eaF|9bE5/⥉ħmf mXWDa'*z]#}w_գrk [ T#J*=lYyWoo5m7T9&NPfej #ճ~*%Β+5}u0$` ~Y+қ"" InFtÃ01rUI·`pkd b޳ qNayQ5Ib?1׬wD= mDq!O, (loQ~&uJKKdͬ30'J >Z]xdt=#@y"D5Y o@ Z.V\[w?ΆM&j8K) +lKo;> JO32|9`i{cbn릃K~dD-xWVY-:Ey3xt'm*OLX:ofGH@75wL>gރ3< gno 1cv׸Pl/w[|_Mp-5x`f5TgZ]<=B" <]e!C^}> DBŦ fC}dݝm 5 (?u}-DydSH0SVy C୐ c$@Aa+bS57ij 704)*!v|:~ǭ=4}aseVi9>F\e)ּe{fHtBץ4@ԖG*uZ1H;ާ7ޘm|M?BuN !# pz7*Ÿ (˅i!vW!~El+hP$r^ lzĥU oC&}KJYZsʦ5s6PMӪCeE }$GjBcc#GgT!IPx9Ib|XC0J<+c{TAߛݳo^JG3"9SDXJ ?Sm#3TX"ZWŸکQ/%24'2D/_kIvN\zr@d+^%s"EJZ/zy@i" hD=$g-.\^WgK ~)kC)qAz.: , RFO t w|^h^R<+Go@zAȧQ)A厃7ei"͞G}n9(J o>_״RԵM@*D;lEp twW6Arˍ#a M7!tݵNE硰`%Ƀ2ѣ_!礋]zbT~b1yW'RvUW`yK~ZG>~ZFtlO}j t?DpKz0 T!t > ܖ4M&ݐ8~j9u>>X{s{6g+u ?` 5q6&@q/? nyfM]EJHIVxI24 ;G DB,+qWcD'>sa+_, Kp|*-ꂪxYNtfh͛ƻF$XmkeCerj| 1ǎjC,ǐq&uVf6d>phangorn/R/treedist.R0000644000175100001440000002175112542607654014274 0ustar hornikusers# # tree distance functions # allKids <- function(phy){ nTips = as.integer(length(phy$tip)) lp=nrow(phy$edge) nNode = phy$Nnode .C("AllKids", as.integer(phy$edge[,2]), as.integer(phy$edge[,1]), as.integer(nTips), as.integer(nNode), as.integer(lp), integer(lp), integer(nNode+1L),integer(nNode)) } coph <- function(x){ if (is.null(attr(x, "order")) || attr(x, "order") == "cladewise") x <- reorder(x, "postorder") nTips = as.integer(length(x$tip.label)) parents = as.integer(x$edge[,1]) kids = as.integer(x$edge[,2]) lp= as.integer(length(parents)) nNode = as.integer(x$Nnode) m = as.integer(max(x$edge)) el = double(m) el[kids] = x$edge.length dm <- .C("C_cophenetic", kids, parents, as.double(el), lp, m, nTips, nNode, double(nTips*(nTips-1L)/2L))[[8]] attr(dm, "Size") <- nTips attr(dm, "Labels") <- x$tip.label attr(dm, "Diag") <- FALSE attr(dm, "Upper") <- FALSE class(dm) <- "dist" dm } cophenetic.splits <- function(x){ labels <- attr(x, "labels") X <- splits2design(x) dm <- as.vector(X%*%attr(x, "weight")) attr(dm, "Size") <- length(labels) attr(dm, "Labels") <- labels attr(dm, "Diag") <- FALSE attr(dm, "Upper") <- FALSE class(dm) <- "dist" dm } cophenetic.networx <- function(x){ spl <- attr(x, "splits") cophenetic.splits(spl) } SHORTwise <- function (x, nTips, delete=FALSE) { v <- 1:nTips l <- sapply(x, length) lv = floor(nTips/2) for (i in 1:length(x)) { if(l[i]>lv){ y <- x[[i]] x[[i]] <- v[-y] } if(l[i]==nTips/2){ y <- x[[i]] if (y[1] != 1) x[[i]] <- v[-y] } } if(any(l==nTips) && delete){ x=x[l!=nTips] } x } oneWise <- function (x, nTips=NULL) { if(is.null(nTips))nTips <- length(x[[1L]]) v <- 1:nTips for (i in 2:length(x)) { y <- x[[i]] if (y[1] != 1) x[[i]] <- v[-y] } x } treedist <- function (tree1, tree2, check.labels=TRUE) { tree1 = unroot(tree1) tree2 = unroot(tree2) if (check.labels) { ind <- match(tree1$tip.label, tree2$tip.label) if (any(is.na(ind)) | length(tree1$tip.label) != length(tree2$tip.label)) stop("trees have different labels") tree2$tip.label <- tree2$tip.label[ind] ind2 <- match(1:length(ind), tree2$edge[, 2]) tree2$edge[ind2, 2] <- order(ind) } tree1 = reorder(tree1, "postorder") tree2 = reorder(tree2, "postorder") symmetric.difference = NULL branch.score.difference = NULL path.difference = NULL quadratic.path.difference = NULL if(!is.binary.tree(tree1) | !is.binary.tree(tree2))warning("Trees are not binary!") bp1 = bip(tree1) bp2 = bip(tree2) bp1 <- SHORTwise(bp1, length(tree1$tip)) bp2 <- SHORTwise(bp2, length(tree2$tip)) bp1 <- sapply(bp1, paste, collapse = "_") bp2 <- sapply(bp2, paste, collapse = "_") l = length(tree1$tip.label) if (!is.null(tree1$edge.length) & !is.null(tree2$edge.length)) { dv1 = coph(tree1) dv2 = coph(tree2) quadratic.path.difference = sqrt(sum((dv1 - dv2)^2)) } RF = sum(match(bp1, bp2, nomatch=0L)==0L) + sum(match(bp2, bp1, nomatch=0L)==0L) symmetric.difference = RF #2 * (p - sum(r1)) if (!is.null(tree1$edge.length) & !is.null(tree2$edge.length)) { w1 = numeric(max(tree1$edge)) w2 = numeric(max(tree2$edge)) w1[tree1$edge[,2]] = tree1$edge.length w2[tree2$edge[,2]] = tree2$edge.length v1 = tree1$edge.length v2 = tree2$edge.length ind3 = match(bp1, bp2, nomatch=0L) ind4 = ind3[ind3>0] ind3 = which(ind3>0) s1 = sum((w1[ind3] - w2[ind4])^2) s2 = sum(w1[-ind3]^2) s3 = sum(w2[-ind4]^2) branch.score.difference = sqrt(s1 + s2 + s3) } tree1$edge.length = rep(1, nrow(tree1$edge)) tree2$edge.length = rep(1, nrow(tree2$edge)) dt1 = coph(tree1) dt2 = coph(tree2) path.difference = sqrt(sum((dt1 - dt2)^2)) result = c(symmetric.difference = symmetric.difference, branch.score.difference = branch.score.difference, path.difference = path.difference, quadratic.path.difference = quadratic.path.difference) result } mRF2 <- function(tree, trees, check.labels = TRUE){ if (class(trees) != "multiPhylo") stop("trees should be an object of class \"multiPhylo\"") if (class(tree) != "phylo") stop("trees should be an object of class \"phylo\"") trees <- .compressTipLabel(trees) tipLabel <- attr(trees, "TipLabel") if (check.labels) { ind <- match(tipLabel, tree$tip.label) if (any(is.na(ind)) | length(tipLabel) != length(tree$tip.label)) stop("trees have different labels") tree$tip.label <- tree$tip.label[ind] ind2 <- match(1:length(ind), tree$edge[, 2]) tree$edge[ind2, 2] <- order(ind) } nTips <- length(tipLabel) l <- length(trees) RF <- numeric(l) trees <- .uncompressTipLabel(trees) # n <- length(attr(trees, "TipLabel")) trees <- unclass(trees) if (any(sapply(trees, is.rooted))) { warning("Some trees are rooted. Unrooting all trees.\n") trees <- lapply(trees, unroot) } if (any(sapply(trees, function(x) !is.binary.tree(x)))) { warning("Some trees are not binary. Result may not what you expect!") } tree <- reorder(tree, "postorder") trees <- lapply(trees, reorder, "postorder") xx <- lapply(trees, bipart) xx <- lapply(xx, SHORTwise, nTips) xx <- lapply(xx,function(x)sapply(x, paste, collapse="_")) yy <- bipart(tree) yy <- SHORTwise(yy, nTips) yy <- sapply(yy, paste, collapse="_") for (i in 1:l){ # RF[i] <- 2 * sum(fmatch(xx[[i]], yy, nomatch=0L)==0L) RF[i] <- sum(match(xx[[i]], yy, nomatch=0L)==0L) + sum(match(yy, xx[[i]], nomatch=0L)==0L) } if(!is.null(names(trees)))names(RF) <- names(trees) return(RF) } mRF<-function(trees){ if (class(trees) != "multiPhylo") stop("trees should be an object of class \"multiPhylo\"") trees <- .compressTipLabel(trees) tipLabel <- attr(trees, "TipLabel") nTips <- length(tipLabel) l <- length(trees) RF <- numeric((l * (l - 1))/2) trees <- .uncompressTipLabel(trees) # n <- length(attr(trees, "TipLabel")) trees <- unclass(trees) if (any(sapply(trees, is.rooted))) { warning("Some trees are rooted. Unrooting all trees.\n") trees <- lapply(trees, unroot) } if (any(sapply(trees, function(x) !is.binary.tree(x)))) { warning("Some trees are not binary. Result may not what you expect!") } trees <- lapply(trees, reorder, "postorder") xx <- lapply(trees, bipart) xx <- lapply(xx, SHORTwise, nTips) xx <- lapply(xx,function(x)sapply(x, paste, collapse="_")) # returns list of character vectors k=1 for (i in 1:(l - 1)){ tmp = xx[[i]] for (j in (i + 1):l){ # RF[k] <- 2 * sum(fmatch(xx[[j]], tmp, nomatch=0L)==0L) RF[k] <- sum(match(xx[[j]], tmp, nomatch=0L)==0L) + sum(match(tmp, xx[[j]], nomatch=0L)==0L) k=k+1 } } attr(RF, "Size") <- l if(!is.null(names(trees)))attr(RF, "Labels") <- names(trees) attr(RF, "Diag") <- FALSE attr(RF, "Upper") <- FALSE class(RF) <- "dist" return(RF) } RF.dist <- function (tree1, tree2=NULL, check.labels = TRUE, rooted=FALSE) { if(class(tree1)=="multiPhylo" && is.null(tree2))return(mRF(tree1)) if(class(tree1)=="phylo" && class(tree2)=="multiPhylo")return(mRF2(tree1, tree2, check.labels)) if(class(tree2)=="phylo" && class(tree1)=="multiPhylo")return(mRF2(tree2, tree1, check.labels)) r1 = is.rooted(tree1) r2 = is.rooted(tree2) if(r1 != r2){ warning("one tree is unrooted, unrooted both") } if(!rooted){ if(r1) tree1<-unroot(tree1) if(r2) tree2<-unroot(tree2) } if (check.labels) { ind <- match(tree1$tip.label, tree2$tip.label) if (any(is.na(ind)) | length(tree1$tip.label) != length(tree2$tip.label)) stop("trees have different labels") tree2$tip.label <- tree2$tip.label[ind] # tree2$edge[match(ind, tree2$edge[, 2]), 2] <- 1:length(ind) ind2 <- match(1:length(ind), tree2$edge[, 2]) tree2$edge[ind2, 2] <- order(ind) } if(!r1 | !r2){ if(r1) tree1 = unroot(tree1) if(r2) tree2 = unroot(tree2) } if(!is.binary.tree(tree1) | !is.binary.tree(tree2))warning("Trees are not binary!") bp1 = bipart(tree1) bp2 = bipart(tree2) if(!rooted){ bp1 <- SHORTwise(bp1, length(tree1$tip)) bp2 <- SHORTwise(bp2, length(tree2$tip)) } RF = sum(match(bp1, bp2, nomatch=0L)==0L) + sum(match(bp2, bp1, nomatch=0L)==0L) RF } phangorn/R/distTree.R0000644000175100001440000003454412533340034014222 0ustar hornikusers# # UPGMA, NJ, UNJ, nnls # "upgma" <- function(D,method="average",...){ DD=as.dist(D) hc = hclust(DD,method=method,...) result = as.phylo(hc) result = reorder(result, "postorder") result } "wpgma" <- function(D,method="mcquitty",...){ DD=as.dist(D) hc = hclust(DD,method=method,...) result = as.phylo(hc) result = reorder(result, "postorder") result } NJ_old <- function(x) { x = as.matrix(x) labels <- attr(x, "Labels")[[1]] edge.length = NULL edge = NULL d = as.matrix(x) if (is.null(labels)) labels = colnames(d) l = dim(d)[1] m = l - 2 nam = 1L:l k = 2L * l - 2L while (l > 2) { r = rowSums(d)/(l - 2) i = 0 j = 0 tmp <- .C("out", as.double(d), as.double(r), as.integer(l), as.integer(i), as.integer(j)) e2 = tmp[[5]] e1 = tmp[[4]] l1 = d[e1, e2]/2 + (r[e1] - r[e2])/(2) l2 = d[e1, e2] - l1 edge.length = c(l1, l2, edge.length) edge = rbind(c(k, nam[e2]), edge) edge = rbind(c(k, nam[e1]), edge) nam = c(nam[c(-e1, -e2)], k) dnew = (d[e1, ] + d[e2, ] - d[e1, e2])/2 d = cbind(d, dnew) d = rbind(d, c(dnew, 0)) d = d[-c(e1, e2), -c(e1, e2)] k = k - 1L l = l - 1L } edge.length = c(d[2, 1], edge.length) attr(edge.length,"names") = NULL result = list(edge = rbind(c(nam[2], nam[1]), edge), edge.length = edge.length, tip.label = labels, Nnode = m) class(result) <- "phylo" reorder(result, "postorder") } NJ <- function(x) reorder(nj(x), "postorder") UNJ <- function(x) { x = as.matrix(x) labels <- attr(x, "Labels")[[1]] edge.length = NULL edge = NULL d = as.matrix(x) if (is.null(labels)) labels = colnames(d) l = dim(d)[1] n = l nam = as.character(1:l) m=l-2 nam = 1:l k = 2*l-2 w = rep(1,l) while (l > 2) { r = rowSums(d)/(l - 2) i = 0 j = 0 tmp <- .C("out", as.double(d), as.double(r), as.integer(l), as.integer(i), as.integer(j)) e2 = tmp[[5]] e1 = tmp[[4]] l1 = d[e1, e2]/2 + sum((d[e1,-c(e1,e2)] - d[e2,-c(e1,e2)])*w[-c(e1,e2)])/(2*(n-w[e1]-w[e2])) l2 = d[e1, e2]/2 + sum((d[e2,-c(e1,e2)] - d[e1,-c(e1,e2)])*w[-c(e1,e2)])/(2*(n-w[e1]-w[e2])) edge.length = c(l1, l2, edge.length) edge = rbind(c(k, nam[e2]), edge) edge = rbind(c(k, nam[e1]), edge) nam = c(nam[c(-e1, -e2)], k) dnew = (w[e1]*d[e1, ] + w[e2]*d[e2, ] - w[e1]*l1 - w[e2]*l2)/(w[e1] + w[e2]) d = cbind(d, dnew) d = rbind(d, c(dnew, 0)) d = d[-c(e1, e2), -c(e1, e2)] w = c(w, w[e1] + w[e2]) w = w[-c(e1, e2)] k = k - 1 l = l - 1 } edge.length=c(d[2,1],edge.length) result = list(edge = rbind(c(nam[2], nam[1]), edge), edge.length=edge.length, tip.label = labels, Nnode=m) class(result) <- "phylo" reorder(result) } PNJ <- function (data) { q <- l <- r <- length(data) weight <- attr(data,"weight") height = NULL parentNodes <- NULL childNodes <- NULL nam <- names(data) tip.label <- nam edge = 1:q z = 0 D = matrix(0, q, q) for (i in 1:(l - 1)) { for (j in (i + 1):l) { w = (data[[i]] * data[[j]]) %*% c(1, 1, 1, 1) D[i, j] = sum(weight[w==0]) } } while (l > 1) { l = l - 1 z = z + 1 d = D + t(D) if(l>1) r = rowSums(d)/(l-1) if(l==1) r = rowSums(d) M = d - outer(r,r,"+") diag(M) = Inf e=which.min(M) e0=e%%length(r) e1 = ifelse(e0==0, length(r), e0) e2= ifelse(e0==0, e%/%length(r), e%/%length(r) + 1) ind = c(e1,e2) len = d[e]/2 nam = c(nam[-ind], as.character(-l)) parentNodes = c(parentNodes,-l,-l) childNodes = c(childNodes,edge[e1],edge[e2]) height = c(height, len, len) edge = c(edge[-ind], -l) w = (data[[e1]] * data[[e2]]) %*% c(1, 1, 1, 1) w = which(w == 0) newDat = data[[e1]] * data[[e2]] newDat[w, ] = data[[e1]][w, ] + data[[e2]][w, ] data = data[-c(e1,e2)] data[[l]] = newDat if (l > 1) { D = as.matrix(D[, -ind]) D = D[-ind, ] dv = numeric(l - 1) for (i in 1:(l - 1)) { w = (data[[i]] * data[[l]]) %*% c(1, 1, 1, 1) dv[i] = sum(weight[w==0]) } D = cbind(D, dv) D = rbind(D, 0) } } tree <- list(edge = cbind(as.character(parentNodes),as.character(childNodes)),tip.label=tip.label) class(tree) <- "phylo" tree <- old2new.phylo(tree) reorder(tree) } # # Distance Matrix methods # # as.Matrix, sparse = TRUE, designTree <- function(tree, method="unrooted", sparse=FALSE, ...){ if (!is.na(pmatch(method, "all"))) method <- "unrooted" METHOD <- c("unrooted", "rooted") method <- pmatch(method, METHOD) if (is.na(method)) stop("invalid method") if (method == -1) stop("ambiguous method") if(!is.rooted(tree) & method==2) stop("tree has to be rooted") if(method==1){ X <- designUnrooted(tree,...) if(sparse) X = Matrix(X) } if(method==2) X <- designUltra(tree, sparse=sparse,...) X } # splits now work designUnrooted = function (tree, order = NULL) { if(inherits(tree, "phylo")){ if (is.rooted(tree)) tree = unroot(tree) p = bipartition(tree) } if(inherits(tree, "splits")) p <- as.matrix(tree) if (!is.null(order)) p = p[, order] m = dim(p)[2] ind = rowSums(p) p=p[ind!=m,] n = dim(p)[1] res = matrix(0, (m - 1) * m/2, n) k = 1 for (i in 1:(m - 1)) { for (j in (i + 1):m) { res[k, ] = p[, i] != p[, j] k = k + 1 } } if(inherits(tree, "phylo"))colnames(res) = paste(tree$edge[, 1], tree$edge[, 2], sep = "<->") res } designUltra <- function (tree, sparse=TRUE) { if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree = reorder(tree, "postorder") leri = allChildren(tree) bp = bip(tree) n = length(tree$tip) l = tree$Nnode nodes = integer(l) k = 1L u=numeric( n * (n - 1)/2) v=numeric( n * (n - 1)/2) m = 1L for (i in 1:length(leri)) { if (!is.null(leri[[i]])) { if(length(leri[[i]])==2)ind = getIndex(bp[[leri[[i]][1] ]], bp[[leri[[i]][2] ]], n) else { ind=NULL le=leri[[i]] nl = length(le) for(j in 1:(nl-1)) ind =c(ind, getIndex(bp[[le[j] ]], unlist(bp[ le[(j+1):nl] ]), n)) } li = length(ind) v[m: (m+li-1)]=k u[m: (m+li-1)]=ind nodes[k]=i m = m+li k = k + 1L } } if(sparse) X = sparseMatrix(i=u,j=v, x=2L) else{ X = matrix(0L, n * (n - 1)/2, l) X[cbind(u,v)]=2L } colnames(X) = nodes attr(X, "nodes") = nodes X } designUnrooted2 <- function (tree, sparse=TRUE) { if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree = reorder(tree, "postorder") leri = allChildren(tree) bp = bip(tree) n = length(tree$tip) l = tree$Nnode nodes = integer(l) nTips = as.integer(length(tree$tip)) k = nTips u=numeric( n * (n - 1)/2) v=numeric( n * (n - 1)/2) z=numeric( n * (n - 1)/2) y=numeric( n * (n - 1)/2) p=1L m = 1L for (i in 1:length(leri)) { if (!is.null(leri[[i]])) { if(length(leri[[i]])==2){ ind = getIndex(bp[[leri[[i]][1] ]], bp[[leri[[i]][2] ]], n) ytmp = rep(bp[[leri[[i]][1] ]], each = length(bp[[leri[[i]][2] ]])) ztmp = rep(bp[[leri[[i]][2] ]], length(bp[[leri[[i]][1] ]])) } else { # browser() ind=NULL le=leri[[i]] nl = length(le) ytmp=NULL ztmp=NULL for(j in 1:(nl-1)){ bp1 = bp[[le[j] ]] bp2 = unlist(bp[le[(j+1):nl] ]) ind =c(ind, getIndex(bp1, unlist(bp2), n)) ytmp = c(ytmp, rep(bp1, each = length(bp2))) ztmp = c(ztmp, rep(bp2, length(bp1))) } } li = length(ind) v[m: (m+li-1)]=k u[m: (m+li-1)]=ind y[m: (m+li-1)]=ytmp z[m: (m+li-1)]=ztmp nodes[p]=i m = m+li k = k + 1L p = p + 1L } } jj = c(y,z) #[ind],v) ii = c(u,u) #[ind],u) ind = (jj < nTips) jj = c(jj[ind], v) ii = c(ii[ind], u) l1 = length(u) l2 = sum(ind) x= rep(c(-1L,2L), c(l2, l1)) X = sparseMatrix(i=ii,j=jj, x=x) if(!sparse){ X = as.matrix(X) } nodes = c(1:(nTips-1L), nodes) colnames(X) = nodes attr(X, "nodes") = nodes X } nnls.tree <- function(dm, tree, rooted=FALSE, trace=1){ if(is.rooted(tree) & rooted==FALSE){ tree = unroot(tree) warning("tree was rooted, I unrooted the tree!") } tree = reorder(tree, "postorder") dm = as.matrix(dm) k = dim(dm)[1] labels = tree$tip dm = dm[labels,labels] y = dm[lower.tri(dm)] #computing the design matrix from the tree if(rooted) X = designUltra(tree) else X = designUnrooted2(tree) lab = attr(X, "nodes") # na.action if(any(is.na(y))){ ind = which(is.na(y)) X = X[-ind,,drop=FALSE] y= y[-ind] } # LS solution Dmat <- crossprod(X) # cross-product computations dvec <- crossprod(X, y) betahat <- as.vector(solve(Dmat, dvec)) bhat = numeric(max(tree$edge)) bhat[as.integer(lab)] = betahat betahat = bhat[tree$edge[,1]] - bhat[tree$edge[,2]] if(!any(betahat<0)){ if(!rooted){ RSS = sum((y-(X%*%betahat))^2) if(trace)print(paste("RSS:", RSS)) attr(tree, "RSS") = RSS } tree$edge.length = betahat return(tree) } # non-negative LS n = dim(X)[2] l = nrow(tree$edge) Amat = matrix(0, n, l) lab = attr(X, "nodes") # vielleicht solve.QP.compact ind1 = match(tree$edge[,1], lab) Amat[cbind(ind1, 1:l)] = 1 ind2 = match(tree$edge[,2], lab) Amat[cbind(ind2, 1:l)] = -1 betahat <- quadprog::solve.QP(as.matrix(Dmat),as.vector(dvec),Amat)$sol # quadratic programing solving if(!rooted){ RSS = sum((y-(X%*%betahat))^2) if(trace)print(paste("RSS:", RSS)) attr(tree, "RSS") = RSS } bhat = numeric(max(tree$edge)) bhat[as.integer(lab)] = betahat betahat = bhat[tree$edge[,1]] - bhat[tree$edge[,2]] tree$edge.length = betahat tree } nnls.phylo <- function(x, dm, rooted=FALSE, trace=0){ nnls.tree(dm, x, rooted, trace=trace) } nnls.splits <- function(x, dm, trace=0){ labels=attr(x, "labels") dm = as.matrix(dm) k = dim(dm)[1] dm = dm[labels,labels] y = dm[lower.tri(dm)] x = SHORTwise(x, k) l <- sapply(x, length) if(any(l==0)) x = x[-which(l==0)] X = splits2design(x) if(any(is.na(y))){ ind = which(is.na(y)) X = X[-ind,,drop=FALSE] y= y[-ind] } X = as.matrix(X) n = dim(X)[2] int = sapply(x, length) Amat = diag(n) # (int) betahat <- nnls(X, y) ind = (betahat$x > 1e-8) | int==1 x = x[ind] RSS <- betahat$deviance attr(x, "weights") = betahat$x[ind] if(trace)print(paste("RSS:", RSS)) attr(x, "RSS") = RSS x } nnls.splitsOld <- function(x, dm, trace=0){ labels=attr(x, "labels") dm = as.matrix(dm) k = dim(dm)[1] dm = dm[labels,labels] y = dm[lower.tri(dm)] x = SHORTwise(x, k) l <- sapply(x, length) if(any(l==0)) x = x[-which(l==0)] X = splits2design(x) if(any(is.na(y))){ ind = which(is.na(y)) X = X[-ind,,drop=FALSE] y= y[-ind] } Dmat <- crossprod(X) # cross-product computations dvec <- crossprod(X, y) betahat <- as.vector(solve(Dmat, dvec)) if(!any(betahat<0)){ RSS = sum((y-(X%*%betahat))^2) if(trace)print(paste("RSS:", RSS)) attr(x, "RSS") = RSS attr(x, "weights") = betahat return(x) } n = dim(X)[2] int = sapply(x, length) # int = as.numeric(int==1)# (int>1) Amat = diag(n) # (int) betahat <- quadprog::solve.QP(as.matrix(Dmat),as.vector(dvec),Amat)$sol # quadratic programing solving RSS = sum((y-(X%*%betahat))^2) ind = (betahat > 1e-8) | int==1 x = x[ind] attr(x, "weights") = betahat[ind] if(trace)print(paste("RSS:", RSS)) attr(x, "RSS") = RSS x } nnls.networx <- function(x, dm){ spl <- attr(x, "splits") spl2 <- nnls.splits(spl, dm) weight <- attr(spl, "weight") weight[] <- 0 weight[match(spl2, spl)] = attr(spl2, "weight") attr(attr(x, "splits"), "weight") <- weight x$edge.length = weight[x$splitIndex] x } designSplits <- function (x, splits = "all", ...) { if (!is.na(pmatch(splits, "all"))) splits <- "all" if(inherits(x, "splits")) return(designUnrooted(x)) SPLITS <- c("all", "star") #,"caterpillar") splits <- pmatch(splits, SPLITS) if (is.na(splits)) stop("invalid splits method") if (splits == -1) stop("ambiguous splits method") if(splits==1) X <- designAll(x) if(splits==2) X <- designStar(x) return(X) } # add return splits=FALSE designAll <- function(n, add.split=FALSE){ Y = matrix(0L, n*(n-1)/2, n) k = 1 for(i in 1:(n-1)){ for(j in (i+1):n){ Y[k,c(i,j)]=1L k=k+1L } } m <- n-1L X <- matrix(0L, m+1, 2^m) for(i in 1:m) X[i, ] <- rep(rep(c(0L,1L), each=2^(i-1)),2^(m-i)) X <- X[,-1] if(!add.split) return((Y%*%X)%%2) list(X=(Y%*%X)%%2,Splits=t(X)) } designStar = function(n){ res=NULL for(i in 1:(n-1)) res = rbind(res,cbind(matrix(0,(n-i),i-1),1,diag(n-i))) res } phangorn/R/SOWH.R0000644000175100001440000000602612507002037013210 0ustar hornikusersSOWH.test <- function(x, n=100, restricted=list(optNni=FALSE), optNni=TRUE, trace = 1, ...){ res = matrix(NA, n, 2) extras <- match.call(expand.dots = FALSE)$... optU = list (optNni = optNni, optBf = FALSE, optQ = FALSE, optInv = FALSE, optGamma = FALSE, optEdge = TRUE, optRate = FALSE, optRooted = FALSE, model = NULL) if(!is.null(extras)){ namAll = names(extras) for(i in 1: length(extras))optU[[namAll[i]]] = extras[[i]] } optR = optU namR = names(restricted) for(i in 1: length(namR))optR[[namR[i]]] = restricted[[i]] restr <- optim.pml(x, optNni = optR$optNni, optBf = optR$optBf, optQ = optR$optQ, optInv = optR$optInv, optGamma = optR$optGamma, optEdge = optR$optEdge, optRate = optR$optRate, optRooted = optR$optRooted, model = optR$model, pml.control(trace = trace-1L)) unrestr <- optim.pml(restr, optNni = optU$optNni, optBf = optU$optBf, optQ = optU$optQ, optInv = optU$optInv, optGamma = optU$optGamma, optEdge = optU$optEdge, optRate = optU$optRate, optRooted = optU$optRooted, model = optU$model, pml.control(trace = trace-1L)) for(i in 1:n){ if(trace>0) cat("iteration: ", i, "\n") newData <- simSeq(restr) restrTmp <- update(restr, data=newData) unrestrTmp <- restrTmp # update(unrestr, data=newData) restrTmp <- optim.pml(restrTmp, optNni = optR$optNni, optBf = optR$optBf, optQ = optR$optQ, optInv = optR$optInv, optGamma = optR$optGamma, optEdge = optR$optEdge, optRate = optR$optRate, optRooted = optR$optRooted, model = optR$model, pml.control(trace = trace-1L)) unrestrTmp <- optim.pml(unrestrTmp, optNni = optU$optNni, optBf = optU$optBf, optQ = optU$optQ, optInv = optU$optInv, optGamma = optU$optGamma, optEdge = optU$optEdge, optRate = optU$optRate, optRooted = optU$optRooted, model = optU$model, pml.control(trace = trace-1L)) res[i, 1] <- logLik(restrTmp) res[i, 2] <- logLik(unrestrTmp) } result = list("LL"=res, "restr" = restr, "unrestr" = unrestr) class(result) = "SOWH" result } print.SOWH <- function(x, digits = 4L, ...){ resLL = logLik(x$restr) unresLL = logLik(x$unrestr) diffLL = unresLL - resLL pval <- sum( (x$LL[,2] - x$LL[,1]) > diffLL) / nrow(x$LL) res = c(resLL, unresLL, diffLL, pval) names(res) = c("ln L restr", "ln L unrestr", "Diff ln L", "p-value") print(res, digits=digits) invisible(x) } summary.SOWH <- function(object, digits = 4L, plot=TRUE, ...){ resLL = logLik(object$restr) unresLL = logLik(object$unrestr) diffLL = unresLL - resLL pval <- sum( (object$LL[,2] - object$LL[,1]) > diffLL) / nrow(object$LL) res = c(resLL, unresLL, diffLL, pval) names(res) = c("ln L restr", "ln L unrestr", "Diff ln L", "p-value") print(res, digits=digits) if(plot){ d = object$LL[,2] - object$LL[,1] hist( d, freq=FALSE, xlim=c(0, 1.2 * max(d, diffLL))) abline(v=diffLL, col="red") } invisible(object) } phangorn/R/phylo.R0000644000175100001440000041246212547243145013603 0ustar hornikusers# # Maximum likelihood estimation # discrete.gamma <- function (alpha, k) { if (k == 1) return(1) quants <- qgamma((1:(k - 1))/k, shape = alpha, rate = alpha) diff( c(0, pgamma(quants * alpha, alpha + 1),1)) * k } optimQ <- function (tree, data, Q=rep(1,6), subs=rep(1,length(Q)), trace = 0, ...) { m = length(Q) n = max(subs) ab = numeric(n) # ab = log(Q[match(1:n, subs)]) for(i in 1:n) ab[i]=log(Q[which(subs==i)[1]]) fn = function(ab, tree, data, m, n, subs,...) { Q = numeric(m) for(i in 1:n)Q[subs==i] = ab[i] pml.fit(tree, data, Q = exp(Q),...)# Q^2, ...) } res = optim(par = ab, fn = fn, gr = NULL, method = "L-BFGS-B", lower = -Inf, upper = 10, control = list(fnscale = -1, maxit = 25, trace = trace), tree = tree, data = data, m=m, n=n, subs=subs,...) Q = rep(1, m) for(i in 1:n) Q[subs==i] = exp(res[[1]][i]) res[[1]] = Q res } optimCodon <- function (tree, data, Q=rep(1,1830), subs=rep(1,length(Q)), syn = rep(0, length(Q)), trace = 0L, ab = c(0,0), optK=TRUE, optW=TRUE, ...) { m = length(Q) n = 1L # max(subs) fn = function(ab, tree, data, m, n, subs, syn, optK, optW, ...) { Q = numeric(m) Q[subs==1] = 0 # transversion if(optK) Q[subs==2] = ab[1] # transition else Q[subs==2] = 0 if(optW) Q[syn==1] = Q[syn==1] + ab[2] # ab[n+1] dnds Q[syn<0] = -Inf pml.fit(tree, data, Q = exp(Q),...)# Q^2, ...) } res = optim(par = ab, fn = fn, gr = NULL, method = "L-BFGS-B", lower = -Inf, upper = Inf, control = list(fnscale = -1, maxit = 25, trace = trace), tree = tree, data = data, m=m, n=n, subs=subs, syn=syn, optK=optK, optW=optW, ...) ab = exp(res[[1]]) Q[subs==1] = 1 # transversion if(optK) Q[subs==2] = ab[1] # transition else{ Q[subs==2] = 1 ab[1] = 1 } if(optW) Q[syn==1] = Q[syn==1] * ab[2] # dnds else ab[2] = 1 Q[syn<0] = 0 res[[5]] = ab res[[1]] = Q res } subsChoice <- function(type=c("JC", "F81", "K80", "HKY", "TrNe", "TrN", "TPM1", "K81", "TPM1u", "TPM2", "TPM2u", "TPM3", "TPM3u", "TIM1e", "TIM1", "TIM2e", "TIM2", "TIM3e", "TIM3", "TVMe", "TVM", "SYM", "GTR")){ type = match.arg(type) switch(type, JC = list(optQ=FALSE, optBf=FALSE, subs=c(0, 0, 0, 0, 0, 0)), F81 = list(optQ=FALSE, optBf=TRUE, subs=c(0, 0, 0, 0, 0, 0)), K80 = list(optQ=TRUE, optBf=FALSE, subs=c(0, 1, 0, 0, 1, 0)), HKY = list(optQ=TRUE, optBf=TRUE, subs=c(0, 1, 0, 0, 1, 0)), TrNe = list(optQ=TRUE, optBf=FALSE, subs=c(0, 1, 0, 0, 2, 0)), TrN = list(optQ=TRUE, optBf=TRUE, subs=c(0, 1, 0, 0, 2, 0)), TPM1 = list(optQ=TRUE, optBf=FALSE, subs=c(0, 1, 2, 2, 1, 0)), K81 = list(optQ=TRUE, optBf=FALSE, subs=c(0, 1, 2, 2, 1, 0)), TPM1u = list(optQ=TRUE, optBf=TRUE, subs=c(0, 1, 2, 2, 1, 0)), TPM2 = list(optQ=TRUE, optBf=FALSE, subs=c(1, 2, 1, 0, 2, 0)), TPM2u = list(optQ=TRUE, optBf=TRUE, subs=c(1, 2, 1, 0, 2, 0)), TPM3 = list(optQ=TRUE, optBf=FALSE, subs=c(1, 2, 0, 1, 2, 0)), TPM3u = list(optQ=TRUE, optBf=TRUE, subs=c(1, 2, 0, 1, 2, 0)), TIM1e = list(optQ=TRUE, optBf=FALSE, subs=c(0, 1, 2, 2, 3, 0)), TIM1 = list(optQ=TRUE, optBf=TRUE, subs=c(0, 1, 2, 2, 3, 0)), TIM2e = list(optQ=TRUE, optBf=FALSE, subs=c(1, 2, 1, 0, 3, 0)), TIM2 = list(optQ=TRUE, optBf=TRUE, subs=c(1, 2, 1, 0, 3, 0)), TIM3e = list(optQ=TRUE, optBf=FALSE, subs=c(1, 2, 0, 1, 3, 0)), TIM3 = list(optQ=TRUE, optBf=TRUE, subs=c(1, 2, 0, 1, 3, 0)), TVMe = list(optQ=TRUE, optBf=FALSE, subs=c(1, 2, 3, 4, 2, 0)), TVM = list(optQ=TRUE, optBf=TRUE, subs=c(1, 2, 3, 4, 2, 0)), SYM = list(optQ=TRUE, optBf=FALSE, subs=c(1, 2, 3, 4, 5, 0)), GTR = list(optQ=TRUE, optBf=TRUE, subs=c(1, 2, 3, 4, 5, 0)) ) } modelTest <- function (object, tree = NULL, model = c("JC", "F81", "K80", "HKY", "SYM", "GTR"), G = TRUE, I = TRUE, k = 4, control = pml.control(epsilon = 1e-08, maxit = 10, trace = 1), multicore = FALSE) { if (class(object) == "phyDat") data = object if (class(object) == "pml") { data = object$data if (is.null(tree)) tree = object$tree } if(attr(data, "type")=="DNA") type = c("JC", "F81", "K80", "HKY", "TrNe", "TrN", "TPM1", "K81", "TPM1u", "TPM2", "TPM2u", "TPM3", "TPM3u", "TIM1e", "TIM1", "TIM2e", "TIM2", "TIM3e", "TIM3", "TVMe", "TVM", "SYM", "GTR") if(attr(data, "type")=="AA") type = .aamodels model = match.arg(model, type, TRUE) env = new.env() assign("data", data, envir=env) if (is.null(tree)) tree = NJ(dist.hamming(data)) else{ tree <- nnls.phylo(tree, dist.ml(data)) # may need something faster for trees > 500 taxa } trace <- control$trace control$trace = trace - 1 fit = pml(tree, data) fit = optim.pml(fit, control = control) l = length(model) n = 1L + sum(I + G + (G & I)) nseq = sum(attr(data, "weight")) fitPar = function(model, fit, G, I, k) { m = 1 res = matrix(NA, n, 6) res = as.data.frame(res) colnames(res) = c("Model", "df", "logLik", "AIC", "AICc", "BIC") data.frame(c("Model", "df", "logLik", "AIC", "AICc", "BIC")) calls = vector("list", n) trees = vector("list", n) fittmp = optim.pml(fit, model = model, control = control) res[m, 1] = model res[m, 2] = fittmp$df res[m, 3] = fittmp$logLik res[m, 4] = AIC(fittmp) res[m, 5] = AICc(fittmp) res[m, 6] = AIC(fittmp, k = log(nseq)) calls[[m]] = fittmp$call trees[[m]] = fittmp$tree m = m + 1 if (I) { if(trace>0)print(paste(model, "+I", sep = "")) fitI = optim.pml(fittmp, model = model, optInv = TRUE, control = control) res[m, 1] = paste(model, "+I", sep = "") res[m, 2] = fitI$df res[m, 3] = fitI$logLik res[m, 4] = AIC(fitI) res[m, 5] = AICc(fitI) res[m, 6] = AIC(fitI, k = log(nseq)) calls[[m]] = fitI$call trees[[m]] = fitI$tree m = m + 1 } if (G) { if(trace>0)print(paste(model, "+G", sep = "")) fitG = update(fittmp, k = k) fitG = optim.pml(fitG, model = model, optGamma = TRUE, control = control) res[m, 1] = paste(model, "+G", sep = "") res[m, 2] = fitG$df res[m, 3] = fitG$logLik res[m, 4] = AIC(fitG) res[m, 5] = AICc(fitG) res[m, 6] = AIC(fitG, k = log(nseq)) calls[[m]] = fitG$call trees[[m]] = fitG$tree m = m + 1 } if (G & I) { if(trace>0)print(paste(model, "+G+I", sep = "")) fitGI = optim.pml(fitG, model = model, optGamma = TRUE, optInv = TRUE, control = control) res[m, 1] = paste(model, "+G+I", sep = "") res[m, 2] = fitGI$df res[m, 3] = fitGI$logLik res[m, 4] = AIC(fitGI) res[m, 5] = AICc(fitGI) res[m, 6] = AIC(fitGI, k = log(nseq)) calls[[m]] = fitGI$call trees[[m]] = fitGI$tree m = m + 1 } list(res, trees, calls) } eval.success <- FALSE if (!eval.success & multicore) { # !require(parallel) || if (.Platform$GUI != "X11") { warning("package 'parallel' not found or GUI is used, \n analysis is performed in serial") } else { RES <- mclapply(model, fitPar, fit, G, I, k) eval.success <- TRUE } } if (!eval.success) res <- RES <- lapply(model, fitPar, fit, G, I, k) RESULT = matrix(NA, n * l, 6) RESULT = as.data.frame(RESULT) colnames(RESULT) = c("Model", "df", "logLik", "AIC", "AICc", "BIC") for (i in 1:l) RESULT[((i - 1) * n + 1):(n * i), ] = RES[[i]][[1]] for(i in 1:l){ for(j in 1:n){ mo = RES[[i]][[1]][j,1] tname = paste("tree_", mo, sep = "") tmpmod = RES[[i]][[3]][[j]] tmpmod["tree"] = call(tname) if(!is.null(tmpmod[["k"]]))tmpmod["k"] = k if(attr(data, "type")=="AA") tmpmod["model"] = RES[[i]][[1]][1,1] assign(tname, RES[[i]][[2]][[j]], envir=env) assign(mo, tmpmod, envir=env) } } attr(RESULT, "env") = env RESULT } optimGamma = function(tree, data, shape=1, k=4,...){ fn = function(shape, tree, data, k,...)pml.fit(tree, data, shape=shape, k=k,...) res = optimize(f=fn, interval = c(0.1, 500), lower = 0.1, upper = 500, maximum = TRUE, tol = .01, tree=tree, data=data, k=k,...) res } optimInv = function(tree, data, inv=0.01, INV=NULL, ll.0=NULL,...){ fn = function(inv, tree, data,...)pml.fit(tree, data, inv=inv, INV=INV, ll.0=NULL,...) res = optimize(f=fn, interval = c(0,1), lower = 0, upper = 1, maximum = TRUE, tol = .0001, tree=tree, data=data,...) res } # changed to c(-10,10) from c(-5,5) optimRate <- function(tree, data, rate=1, ...){ fn <- function(rate, tree, data, ...) pml.fit(tree, data, rate=exp(rate), ...) res <- optimize(f = fn, interval = c(-10, 10), tree = tree, data = data, ..., maximum = TRUE) res[[1]] <- exp(res[[1]]) res } optimBf = function(tree, data, bf=c(.25,.25,.25,.25), trace=0,...){ l=length(bf) nenner = 1/bf[l] lbf = log(bf * nenner) lbf = lbf[-l] fn = function(lbf, tree, data,...){ bf = exp(c(lbf,0)) bf = bf/sum(bf) pml.fit(tree, data, bf=bf, ...) } res = optim(par=lbf, fn=fn, gr=NULL, method="Nelder-Mead", control=list(fnscale=-1, maxit=500, trace=trace),tree=tree, data=data,...) bf = exp(c(res[[1]],0)) bf = bf/sum(bf) result = list(bf=bf, loglik = res[[2]]) result } optimW = function(fit,...){ w = fit$w g = fit$g siteLik = fit$siteLik k = length(w) l = dim(siteLik[[1]])[1] x=matrix(0,l,k) for(i in 1:k)x[,i] = rowSums(siteLik[[i]]) weight = fit$weight nenner = 1/w[k] eta = log(w * nenner) eta = eta[-k] fn = function(eta,x,g,weight){ eta = c(eta,0) p = exp(eta)/sum(exp(eta)) res = x%*%p res = sum(weight*log(res)) * (1 + abs(sum(p*g) - 1)) res } res = optim(eta, fn = fn, method = "Nelder-Mead", control=list(fnscale=-1, reltol = 1e-12),gr=NULL, x=x,g=g, weight=weight) p = exp(c(res$par,0)) p = p/sum(p) result = list(par = p, value = res$value) result } #predict.pml <- function(object, newdata,...) sum(object$site * newdata) logLik.pml <- function(object,...){ res <- object$logLik attr(res,"df") <- object$df class(res) <- "logLik" res } AICc <- function (object, ...) UseMethod("AICc") AICc.pml <- function(object, ...){ n = sum(object$weight) k = object$df # if(k>=(n-1))return(NULL) res = AIC(object) res + (2*k*(k+1))/(n-k-1) } anova.pml <- function (object, ...) { X <- c(list(object), list(...)) df <- sapply(X, "[[", "df") ll <- sapply(X, "[[", "logLik") dev <- c(NA, 2 * diff(ll)) ddf <- c(NA, diff(df)) table <- data.frame(ll, df, ddf, dev, pchisq(dev, ddf, lower.tail = FALSE)) dimnames(table) <- list(1:length(X), c("Log lik.", "Df", "Df change", "Diff log lik.", "Pr(>|Chi|)")) structure(table, heading = "Likelihood Ratio Test Table", class = c("anova", "data.frame")) } #vcov.pml <- function(object, obs=FALSE,...){ # if(obs) FI = score4(object)[[2]] # else FI = score(object,FALSE)[[2]] # l = dim(FI)[1] # res = try(solve(FI)) # if(class(res) == "try-error"){ # cat("Covariance is ill-conditioned !! \n") # res = solve(FI + diag(l)* 1e-8) # } # res #} vcov.pml <- function(object, ...){ FI = score(object,FALSE)[[2]] l = dim(FI)[1] res = try(solve(FI)) if(class(res) == "try-error"){ cat("Covariance is ill-conditioned !! \n") res = solve(FI + diag(l)* 1e-8) } res } getd2P <- function(el, eig=edQt(), g=1.0){ n <- length(eig$values) res <- .Call("getd2PM",eig,as.integer(n),as.double(el),as.double(g)) attr(res,"dim") <- c(length(g),length(el)) res } getdP <- function(el, eig=edQt(), g=1.0){ n <- length(eig$values) res <- .Call("getdPM",eig,as.integer(n),as.double(el),as.double(g)) attr(res,"dim") <- c(length(g),length(el)) res } # version without transformation (used for vcov) getdP2 <- function(el, eig=edQt(), g=1.0){ n <- length(eig$values) res <- .Call("getdPM2",eig,as.integer(n),as.double(el),as.double(g)) attr(res,"dim") <- c(length(g),length(el)) res } # version without transformation getd2P2 <- function(el, eig=edQt(), g=1.0){ n <- length(eig$values) res <- .Call("getd2PM2",eig,as.integer(n),as.double(el),as.double(g)) attr(res,"dim") <- c(length(g),length(el)) res } getP <- function(el, eig=edQt(), g=1.0){ n <- length(eig$values) res <- .Call("getPM", eig, as.integer(n), as.double(el), as.double(g)) attr(res, "dim") <- c(length(g), length(el)) res } lli <- function (data, tree=NULL, ...) { contrast <- attr(data, "contrast") nr <- attr(data, "nr") nc <- attr(data, "nc") nco <- as.integer(dim(contrast)[1]) if(!is.null(tree)) data <- subset(data, tree$tip.label) .Call("invSites", data, as.integer(nr), as.integer(nc), contrast, as.integer(nco)) } edQt <- function (Q = c(1, 1, 1, 1, 1, 1), bf = c(0.25, 0.25, 0.25, 0.25)) { l = length(bf) res = matrix(0, l, l) res[lower.tri(res)] = Q res = res + t(res) res = res * bf res2 = res * rep(bf, each = l) diag(res) = -colSums(res) res = res/sum(res2) e = eigen(res, FALSE) e$inv = solve.default(e$vec) e } edQ <- function(Q=c(1,1,1,1,1,1), bf=c(0.25,.25,.25,.25)){ l=length(bf) res = matrix(0, l, l) res[lower.tri(res)] = Q res = res+t(res) res = res * rep(bf,each=l) diag(res) = -rowSums(res) res2 = res * rep(bf,l) diag(res2)=0 res = res/sum(res2) e = eigen(res, FALSE) e$inv = solve.default(e$vec) e } edQ2 <- function(Q){ res = Q l=dim(Q)[1] diag(res) = 0 diag(res) = -rowSums(res) e = eigen(res, FALSE) e$inv = solve.default(e$vec) e } pml.free <- function(){ .C("ll_free") # rm(.INV, .iind, envir = parent.frame()) } pml.init <- function(data, k=1L){ nTips <- length(data) nr <- attr(data, "nr") nc <- attr(data, "nc") .C("ll_init", as.integer(nr), as.integer(nTips), as.integer(nc), as.integer(k)) INV <- lli(data) #, tree # .iind <<- which((INV %*% rep(1, nc)) > 0) # .INV <<- Matrix(INV, sparse=TRUE) assign(".iind", which((INV %*% rep(1, nc)) > 0), envir=parent.frame()) assign(".INV", Matrix(INV, sparse=TRUE), envir=parent.frame()) } pml.free2 <- function(){.C("ll_free2")} pml.init2 <- function(data, k=1L){ nTips <- length(data) nr <- attr(data, "nr") nc <- attr(data, "nc") weight <- attr(data, "weight") .C("ll_init2", as.integer(unlist(data, use.names=FALSE)), as.double(weight), as.integer(nr), as.integer(nTips), as.integer(nc), as.integer(k)) } fn.quartet <- function(old.el, eig, bf, dat, g=1, w=1, weight, ll.0) { l= length(dat[,1]) ll = ll.0 res = vector("list", 2*l) tmp1 = NULL tmp2 = NULL attr(res,"dim") = c(l,2) for(j in 1:l){ P = getP(old.el, eig, g[j]) tmp1 = (dat[[j,1]] %*% P[[1]]) *(dat[[j,2]] %*% P[[2]]) tmp2 = (dat[[j,3]] %*% P[[3]]) * (dat[[j,4]] %*% P[[4]]) res[[j,1]] = tmp1 * (tmp2 %*% P[[5]]) res[[j,2]] = tmp2 ll = ll + res[[j,1]] %*% (w[j]*bf) } l0 = sum(weight * log(ll)) list(ll=l0,res=res) } fn.quartet2 <- function (old.el, eig, bf, dat1, dat2, dat3, dat4, g = 1, w = 1, weight, ll.0, contrast, ext) { l = length(w) ll = ll.0 res = vector("list", 2 * l) tmp1 = NULL tmp2 = NULL attr(res, "dim") = c(l, 2) for (j in 1:l) { P = getP(old.el, eig, g[j]) if (ext[1] == FALSE && ext[2] == FALSE) tmp1 = (dat1[[j]] %*% P[[1]]) * (dat2[[j]] %*% P[[2]]) if (ext[1] == FALSE && ext[2] == TRUE) tmp1 = (dat1[[j]] %*% P[[1]]) * (contrast %*% P[[2]])[dat2, ] if (ext[1] == TRUE && ext[2] == FALSE) tmp1 = (contrast %*% P[[1]])[dat1, ] * (dat2[[j]] %*% P[[2]]) if (ext[1] == TRUE && ext[2] == TRUE) tmp1 = (contrast %*% P[[1]])[dat1, ] * (contrast %*% P[[2]])[dat2, ] if (ext[3] == FALSE && ext[4] == FALSE) tmp2 = (dat3[[j]] %*% P[[3]]) * (dat4[[j]] %*% P[[4]]) if (ext[3] == FALSE && ext[4] == TRUE) tmp2 = (dat3[[j]] %*% P[[3]]) * (contrast %*% P[[4]])[dat4, ] if (ext[3] == TRUE && ext[4] == FALSE) tmp2 = (contrast %*% P[[3]])[dat3, ] * (dat4[[j]] %*% P[[4]]) if (ext[3] == TRUE && ext[4] == TRUE) tmp2 = (contrast %*% P[[3]])[dat3, ] * (contrast %*% P[[4]])[dat4, ] res[[j, 1]] = tmp1 * (tmp2 %*% P[[5]]) res[[j, 2]] = tmp2 ll = ll + res[[j, 1]] %*% (w[j] * bf) } l0 = sum(weight * log(ll)) list(ll = l0, res = res) } optim.quartet2 <- function (old.el, eig, bf, dat1, dat2, dat3, dat4, g = 1, w = 1, weight, ll.0 = weight * 0, control = list(eps = 1e-08, maxit = 5, trace = 0), llcomp = -Inf, evi, contrast, contrast2, ext = c(FALSE, FALSE, FALSE, FALSE)) { eps = 1 iter = 0 while (eps > control$eps && iter < control$maxit) { tmp <- fn.quartet2(old.el = old.el, eig = eig, bf = bf, dat1 = dat1, dat2 = dat2, dat3 = dat3, dat4 = dat4, g = g, w = w, weight = weight, ll.0 = ll.0, contrast=contrast, ext = ext) old.ll = tmp$ll el1 <- fs3(old.el[1], eig, tmp$res[, 1], dat1, weight, g = g, w = w, bf = bf, ll.0 = ll.0, contrast=contrast, contrast2=contrast2, evi=evi, ext = ext[1], getA=TRUE, getB=FALSE) el2 <- fs3(old.el[2], eig, el1[[2]], dat2, weight, g = g, w = w, bf = bf, ll.0 = ll.0, contrast=contrast, contrast2=contrast2, evi=evi, ext = ext[2], getA=TRUE, getB=FALSE) el5 <- fs3(old.el[5], eig, el2[[2]], tmp$res[, 2], weight, g = g, w = w, bf = bf, ll.0 = ll.0, contrast=contrast, contrast2=contrast2, evi=evi, ext = 0L, getA=FALSE, getB=TRUE) el3 <- fs3(old.el[3], eig, el5[[3]], dat3, weight, g = g, w = w, bf = bf, ll.0 = ll.0, contrast=contrast, contrast2=contrast2, evi=evi, ext = ext[3], getA=TRUE, getB=FALSE) el4 <- fs3(old.el[4], eig, el3[[2]], dat4, weight, g = g, w = w, bf = bf, ll.0 = ll.0, contrast=contrast, contrast2=contrast2, evi=evi, ext = ext[4], getA=FALSE, getB=FALSE) old.el[1] = el1[[1]] old.el[2] = el2[[1]] old.el[3] = el3[[1]] old.el[4] = el4[[1]] old.el[5] = el5[[1]] iter = iter + 1 ll = el4[[4]] eps = (old.ll - ll)/ll if (ll < llcomp) return(list(old.el, ll)) old.ll = ll } list(old.el, ll) } pml.nni <- function (tree, data, w, g, eig, bf, ll.0, ll, ...) { k = length(w) INDEX <- indexNNI(tree) rootEdges <- attr(INDEX,"root") .dat <- NULL data = getCols(data, tree$tip) parent = tree$edge[,1] child = tree$edge[,2] weight = attr(data, "weight") datp = rnodes(tree, data, w, g, eig, bf) contrast <- attr(data, "contrast") contrast2 <- contrast %*% eig[[2]] evi = (t(eig[[3]]) * bf) nTips = length(tree$tip.label) evector <- numeric(max(parent)) evector[child] <- tree$edge.length m <- dim(INDEX)[1] loglik = numeric(2*m) edgeMatrix <- matrix(0, 2*m, 5) l = length(datp[, 1]) for(i in 1:m){ ei = INDEX[i,] el0 = evector[INDEX[i,]] ext = ei[1:4] < nTips+1L if (!(ei[5] %in% rootEdges)) dat1 = datp[, ei[1], drop = FALSE] else{ if(ext[1]) dat1 = data[[ ei[1] ]] else dat1 = .dat[, ei[1], drop=FALSE] } if(ext[2]) dat2 = data[[ ei[2] ]] else dat2 = .dat[, ei[2], drop=FALSE] if(ext[3]) dat3 = data[[ ei[3] ]] else dat3 = .dat[, ei[3], drop=FALSE] if(ext[4]) dat4 = data[[ ei[4] ]] else dat4 = .dat[, ei[4], drop=FALSE] new1 <- optim.quartet2(el0[c(1, 3, 2, 4, 5)], eig, bf, dat1, dat3, dat2, dat4, g, w, weight, ll.0, llcomp=ll, evi=evi, contrast=contrast, contrast2=contrast2, ext=ext[c(1, 3, 2, 4)]) new2 <- optim.quartet2(el0[c(1, 4, 3, 2, 5)], eig, bf, dat1, dat4, dat3, dat2, g, w, weight, ll.0, llcomp=ll, evi=evi, contrast=contrast, contrast2=contrast2, ext=ext[c(1, 4, 3, 2)]) loglik[(2*i)-1]=new1[[2]] loglik[(2*i)]=new2[[2]] edgeMatrix[(2*i)-1,]=new1[[1]] edgeMatrix[(2*i),]=new2[[1]] } swap <- 0 eps0 <- 1e-6 candidates <- loglik > ll + eps0 nr <- as.integer(attr(data, "nr")) nc <- as.integer(attr(data, "nc")) nTips <- as.integer(length(tree$tip.label)) # on.exit(.C("ll_free")) # .C("ll_init", nr, nTips, nc, as.integer(k)) while(any(candidates)){ ind = which.max(loglik) loglik[ind]=-Inf if( ind %% 2 ) swap.edge = c(2,3) else swap.edge = c(2,4) tree2 <- changeEdge(tree, INDEX[(ind+1)%/%2,swap.edge], INDEX[(ind+1)%/%2,], edgeMatrix[ind,]) test <- pml.fit(tree2, data, bf = bf, k=k, g=g, w=w, eig=eig, ll.0=ll.0, ...) if(test <= ll + eps0) candidates[ind] = FALSE if(test > ll + eps0) { ll = test swap=swap+1 tree <- tree2 indi <- which(rep(colSums(apply(INDEX,1,match,INDEX[(ind+1)%/%2,],nomatch=0))>0,each=2)) candidates[indi] <- FALSE loglik[indi] <- -Inf } } list(tree=tree, ll=ll, swap=swap) } rnodes <- function (tree, data, w, g, eig, bf) { if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") data = getCols(data, tree$tip) q = length(tree$tip.label) node <- tree$edge[, 1] edge <- tree$edge[, 2] m = length(edge) + 1 # max(edge) l = length(w) dat = vector(mode = "list", length = m*l) dim(dat) <- c(l,m) tmp = length(data) # for(i in 1:length(w))dat[i,1:tmp]=new2old.phyDat(data) # # dat[1,1:tmp] <- data vielleicht gebraucht el <- tree$edge.length P <- getP(el, eig, g) nr <- as.integer(attr(data, "nr")) nc <- as.integer(attr(data, "nc")) node = as.integer(node - min(node)) edge = as.integer(edge - 1) nTips = as.integer(length(tree$tip)) mNodes = as.integer(max(node) + 1) contrast = attr(data, "contrast") nco = as.integer(dim(contrast)[1]) for(i in 1:l)dat[i,(q + 1):m] <- .Call("LogLik2", data, P[i,], nr, nc, node, edge, nTips, mNodes, contrast, nco) parent <- tree$edge[, 1] child <- tree$edge[, 2] nTips = min(parent) - 1 datp = vector("list", m) dat2 = vector("list", m * l) dim(dat2) <- c(l,m) for(i in 1:l){ datp[(nTips + 1)] = dat[i,(nTips + 1)] for (j in (m - 1):1) { if (child[j] > nTips){ tmp2 = (datp[[parent[j]]]/(dat[[i,child[j]]] %*% P[[i,j]])) datp[[child[j]]] = (tmp2 %*% P[[i,j]]) * dat[[i,child[j]]] dat2[[i, child[j]]] = tmp2 } } } assign(".dat", dat, envir = parent.frame(n = 1)) dat2 } score <- function (fit, transform=TRUE) { tree = fit$tree child <- tree$edge[, 2] l = length(child) sc = numeric(l) weight = as.numeric(fit$weight) f <- drop(exp(fit$site)) dl = dl(fit, transform) dl = dl/f sc = colSums(weight * dl) F = crossprod(dl*weight,dl) names(sc) = child dimnames(F) = list(child, child) result = list(sc = sc, F = F) result } # wird noch in partition models verwendet optim.quartet <- function (old.el, eig, bf, dat, g = 1, w = 1, weight, ll.0 = weight * 0, control = list(eps = 1e-08, maxit = 5, trace = 0), llcomp=-Inf) { eps = 1 iter = 0 evi = (t(eig[[3]]) * bf) while (eps > control$eps && iter < control$maxit) { tmp <- fn.quartet(old.el = old.el, eig = eig, bf = bf, dat = dat, g = g, w = w, weight = weight, ll.0 = ll.0) old.ll = tmp$ll el1 <- fs(old.el[1], eig, tmp$res[, 1], dat[, 1], weight, g = g, w = w, bf = bf, ll.0 = ll.0, evi, getA=TRUE, getB=FALSE) el2 <- fs(old.el[2], eig, el1[[2]], dat[, 2], weight, g = g, w = w, bf = bf, ll.0 = ll.0, evi, getA=TRUE, getB=FALSE) el5 <- fs(old.el[5], eig, el2[[2]], tmp$res[, 2], weight, g = g, w = w, bf = bf, ll.0 = ll.0, evi, getA=FALSE, getB=TRUE) el3 <- fs(old.el[3], eig, el5[[3]], dat[, 3], weight, g = g, w = w, bf = bf, ll.0 = ll.0, evi, getA=TRUE, getB=FALSE) el4 <- fs(old.el[4], eig, el3[[2]], dat[, 4], weight, g = g, w = w, bf = bf, ll.0 = ll.0, evi, getA=FALSE, getB=FALSE) old.el[1] = el1[[1]] old.el[2] = el2[[1]] old.el[3] = el3[[1]] old.el[4] = el4[[1]] old.el[5] = el5[[1]] iter = iter + 1 ll = el4[[4]] eps = (old.ll - ll) / ll if(ll 0") if (!is.numeric(maxit) || maxit <= 0) stop("maximum number of iterations must be > 0") list(epsilon = epsilon, maxit = maxit, trace = trace) } optim.pml <- function (object, optNni = FALSE, optBf = FALSE, optQ = FALSE, optInv = FALSE, optGamma = FALSE, optEdge = TRUE, optRate = FALSE, optRooted=FALSE, control = pml.control(epsilon = 1e-8, maxit = 10, trace = 1L), model = NULL, subs = NULL, ...) { extras <- match.call(expand.dots = FALSE)$... pmla <- c("wMix", "llMix") wMix <- object$wMix llMix <- object$llMix if(is.null(llMix)) llMix=0 if (!is.null(extras)) { names(extras) <- pmla[pmatch(names(extras), pmla)] existing <- match(pmla, names(extras)) if (!is.na(existing[1])) wMix <- eval(extras[[existing[1]]], parent.frame()) if (!is.na(existing[2])) llMix <- eval(extras[[existing[2]]], parent.frame()) } tree = object$tree call = object$call if(optNni) { if(!is.binary.tree(tree)) tree = multi2di(tree) optEdge = TRUE } if(is.rooted(tree)) { if(optRooted==FALSE && optEdge==TRUE){ tree = unroot(tree) attr(tree, "order") <- NULL tree = reorder(tree, "postorder") warning("I unrooted the tree", call. = FALSE) } } if(is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") if(any(tree$edge.length < 1e-08)) { tree$edge.length[tree$edge.length < 1e-08] <- 1e-08 # save to change to new update.pml object <- update.pml(object, tree = tree) } if(optEdge & optRate) { warning("You can't optimise edges and rates at the same time, only edges are optimised!", call. = FALSE) optRate = FALSE } if(optRooted){ optEdge = FALSE if(!is.rooted(tree)) stop("Tree must be rooted!") if(!is.ultrametric(tree)) stop("Tree must be ultrametric!") } trace <- control$trace data = object$data data = subset(data, tree$tip.label) type <- attr(data, "type") if (type == "AA" & !is.null(model)){ object = update(object, model=model) } if (type == "CODON") { dnds <- object$dnds tstv <- object$tstv if(!is.null(model)){ if(model == "codon0") optQ = FALSE else optQ = TRUE } } Q = object$Q if(is.null(subs)) subs = c(1:(length(Q) - 1), 0) bf = object$bf eig = object$eig inv = object$inv k = object$k if(k==1 & optGamma){ optGamma = FALSE message('only one rate class, ignored optGamma') } shape = object$shape w = object$w g = object$g if (type == "DNA" & !is.null(model)) { tmp = subsChoice(model) optQ = tmp$optQ if (!optQ) Q = rep(1, 6) optBf = tmp$optBf if (!optBf) bf = c(0.25, 0.25, 0.25, 0.25) subs = tmp$subs } ll0 <- object$logLik INV <- object$INV ll.0 <- object$ll.0 rate <- object$rate ll = ll0 ll1 = ll0 opti = TRUE nr <- as.integer(attr(data, "nr")) nc <- as.integer(attr(data, "nc")) nTips <- as.integer(length(tree$tip.label)) # on.exit(.C("ll_free")) # .C("ll_init", nr, nTips, nc, as.integer(k)) .INV <- .iind <- NULL on.exit({ pml.free() # rm(.INV, .iind) }) pml.init(data, k) if (optEdge) { res <- optimEdge(tree, data, eig=eig, w=w, g=g, bf=bf, rate=rate, ll.0=ll.0, INV=INV, control = pml.control(epsilon = 1e-07, maxit = 5, trace=trace - 1)) if(trace > 0) cat("optimize edge weights: ", ll, "-->", res[[2]], "\n") if (res[[2]] > ll){ ll <- res[[2]] tree <- res[[1]] } } if(optRooted){ res <- optimRooted(tree, data, eig=eig, w=w, g=g, bf=bf, rate=rate, ll.0=ll.0, INV=INV, control = pml.control(epsilon = 1e-07, maxit = 10, trace = trace-1)) if(trace > 0) cat("optimize edge weights: ", ll, "-->", res[[2]], "\n") if(res[[2]] > ll){ ll <- res[[2]] tree <- res[[1]] } } rounds = 1 while (opti) { if (optBf) { res = optimBf(tree, data, bf = bf, inv = inv, Q = Q, w = w, g = g, INV = INV, rate = rate, k = k, llMix = llMix) bf = res[[1]] eig = edQt(Q = Q, bf = bf) if (inv > 0) ll.0 <- as.matrix(INV %*% (bf * inv)) if (wMix > 0) ll.0 <- ll.0 + llMix if (trace > 0) cat("optimize base frequencies: ", ll, "-->", res[[2]], "\n") ll = res[[2]] } if (optQ) { if(type=="CODON"){ if(is.null(model)) model <- "codon1" model <- match.arg(model, c("codon0", "codon1", "codon2", "codon3")) ab <- c(tstv, dnds) res <- switch(model, codon1 = optimCodon(tree,data, Q=rep(1,1830), subs=.sub, syn=.syn, bf = bf, w = w, g = g, inv = inv, INV = INV, ll.0 = ll.0, rate = rate, k = k, ab=log(ab), optK=TRUE, optW = TRUE), codon2 = optimCodon(tree,data, Q=rep(1,1830), subs=.sub, syn=.syn, bf = bf, w = w, g = g, inv = inv, INV = INV, ll.0 = ll.0, rate = rate, k = k, ab=log(ab), optK=FALSE, optW = TRUE), codon3 = optimCodon(tree,data, Q=rep(1,1830), subs=.sub, syn=.syn, bf = bf, w = w, g = g, inv = inv, INV = INV, ll.0 = ll.0, rate = rate, k = k, ab=log(ab), optK=TRUE, optW = FALSE)) tmp <- res[[5]] m = length(tmp) dnds = tmp[m] if(m>1) tstv <- tmp[1] } else res = optimQ(tree, data, Q = Q, subs = subs, bf = bf, w = w, g = g, inv = inv, INV = INV, ll.0 = ll.0, rate = rate, k = k) Q = res[[1]] eig = edQt(Q = Q, bf = bf) if (trace > 0) cat("optimize rate matrix: ", ll, "-->", res[[2]], "\n") ll = res[[2]] } if(optInv) { res = optimInv(tree, data, inv = inv, INV = INV, Q = Q, bf = bf, eig = eig, k = k, shape = shape, rate = rate) inv = res[[1]] w = rep(1/k, k) g = discrete.gamma(shape, k) w = (1 - inv) * w if (wMix > 0) w <- (1 - wMix) * w g = g/(1 - inv) g <- g * rate ll.0 = as.matrix(INV %*% (bf * inv)) if (wMix > 0) ll.0 <- ll.0 + llMix if (trace > 0) cat("optimize invariant sites: ", ll, "-->", res[[2]], "\n") ll = res[[2]] } if(optGamma) { res = optimGamma(tree, data, shape = shape, k = k, inv = inv, INV = INV, Q = Q, bf = bf, eig = eig, ll.0 = ll.0, rate = rate) shape = res[[1]] w = rep(1/k, k) g = discrete.gamma(shape, k) if (inv > 0) { w = (1 - inv) * w g = g/(1 - inv) } if (wMix > 0) w <- (1 - wMix) * w g <- g * rate if (trace > 0) cat("optimize shape parameter: ", ll, "-->", res[[2]], "\n") ll = res[[2]] } if(optRate) { res = optimRate(tree, data, rate = rate, inv = inv, INV = INV, Q = Q, bf = bf, eig = eig, k = k, shape = shape, w = w, ll.0 = ll.0) if (res[[2]] > ll)rate = res[[1]] g = discrete.gamma(shape, k) w = rep(1/k, k) if (inv > 0) { w = (1 - inv) * w g = g/(1 - inv) } if (wMix > 0) w <- (1 - wMix) * w g <- g * rate if (trace > 0) cat("optimize rate: ", ll, "-->", res[[2]], "\n") ll = res[[2]] } if (optEdge) { res <- optimEdge(tree, data, eig=eig, w=w, g=g, bf=bf, rate=rate, ll.0=ll.0, control = pml.control(epsilon = 1e-08, maxit = 5, trace=trace - 1)) if (trace > 0) cat("optimize edge weights: ", ll, "-->", res[[2]], "\n") if (res[[2]] > ll){ ll <- res[[2]] tree <- res[[1]] } } if(optRooted){ res <- optimRooted(tree, data, eig=eig, w=w, g=g, bf=bf, rate=rate, ll.0=ll.0, INV=INV, control = pml.control(epsilon = 1e-07, maxit = 10, trace = trace-1)) if(trace > 0) cat("optimize edge weights: ", ll, "-->", res[[2]], "\n") if (res[[2]] > ll){ ll <- res[[2]] tree <- res[[1]] } } if(optNni) { swap = 0 iter = 1 while (iter < 4) { if(optEdge){ tmp <- pml.nni(tree, data, w, g, eig, bf, ll.0, ll, ...) swap = swap + tmp$swap res <- optimEdge(tmp$tree, data, eig=eig, w=w, g=g, bf=bf, rate=rate, ll.0=ll.0, control = pml.control(epsilon = 1e-08, maxit = 3, trace=0)) ll2 = res[[2]] tree <- res[[1]] } else{ tmp <- rooted.nni(tree, data, eig=eig, w=w, g=g, bf=bf, rate=rate, ll.0=ll.0, INV=INV, ...) swap = swap + tmp$swap res <- optimRooted(tmp$tree, data, eig=eig, w=w, g=g, bf=bf, rate=rate, ll.0=ll.0, INV=INV, control = pml.control(epsilon = 1e-07, maxit = 5, trace = trace-1)) tree <- tmp$tree ll2 = tmp$logLik } if (trace > 0) cat("optimize topology: ", ll, "-->", ll2, "\n") ll = ll2 iter = iter + 1 if (tmp$swap == 0) { iter = 4 } } if (trace > 0) cat(swap, "\n") if (swap > 0) rounds = 1 if (swap == 0) optNni = FALSE } rounds = rounds + 1 if(rounds > control$maxit) opti <- FALSE if (( ll1 - ll ) / ll < control$eps) #abs(ll1 - ll) opti <- FALSE ll1 = ll } if(type=="CODON"){ object$dnds = dnds object$tstv = tstv } tmp <- pml.fit(tree, data, bf, shape = shape, k = k, Q = Q, levels = attr(data, "levels"), inv = inv, rate = rate, g = g, w = w, eig = eig, INV = INV, ll.0 = ll.0, llMix = llMix, wMix = wMix, site = TRUE) df <- ifelse(optRooted, tree$Nnode, length(tree$edge.length)) # length(tree$edge.length) if (type == "CODON") { df <- df + (k > 1) + (inv > 0) + length(unique(bf)) - 1 + (dnds != 1) + (tstv != 1) } else df = df + (k > 1) + (inv > 0) + length(unique(bf)) - 1 + length(unique(Q)) - 1 object = list(logLik = tmp$loglik, inv = inv, k = k, shape = shape, Q = Q, bf = bf, rate = rate, siteLik = tmp$siteLik, weight = attr(data, "weight"), g = g, w = w, eig = eig, data = data, model = model, INV = INV, ll.0 = ll.0, tree = tree, lv = tmp$resll, call = call, df = df, wMix = wMix, llMix = llMix) if (type == "CODON") { object$dnds <- dnds object$tstv <- tstv } class(object) = "pml" extras = pairlist(bf = bf, Q = Q, inv = inv, shape = shape, rate = rate)[c(optBf, optQ, optInv, optGamma, optRate)] if (length(extras)) { existing <- !is.na(match(names(extras), names(call))) for (a in names(extras)[existing]) call[[a]] <- extras[[a]] if (any(!existing)) { call <- c(as.list(call), extras[!existing]) call <- as.call(call) } } object$call = call object } fs <- function (old.el, eig, parent.dat, child.dat, weight, g=g, w=w, bf=bf, ll.0=ll.0, evi, getA=TRUE, getB=TRUE) { if (old.el < 1e-8) old.el <- 1e-8 lg = length(parent.dat) P <- getP(old.el, eig, g) nr = as.integer(length(weight)) nc = as.integer(length(bf)) eve = eig[[2]] dad <- .Call("getDAD", parent.dat, child.dat, P, nr, nc) X <- .Call("getPrep", dad, child.dat, eig[[2]], evi, nr, nc) .Call("FS4", eig, as.integer(length(bf)), as.double(old.el), as.double(w), as.double(g), X, child.dat, dad, as.integer(length(w)), as.integer(length(weight)), as.double(bf), as.double(weight), as.double(ll.0), as.integer(getA), as.integer(getB)) } fs3 <- function (old.el, eig, parent.dat, child, weight, g=g, w=w, bf=bf, ll.0=ll.0, contrast, contrast2, evi, ext=TRUE, getA=TRUE, getB=TRUE) # child.dat { if (old.el < 1e-8) old.el <- 1e-8 lg = length(parent.dat) P <- getP(old.el, eig, g) nr = as.integer(length(weight)) nc = as.integer(length(bf)) if(ext==FALSE){ child.dat <- child eve = eig[[2]] dad <- .Call("getDAD", parent.dat, child.dat, P, nr, nc) X <- .Call("getPrep", dad, child.dat, eig[[2]], evi, nr, nc) } else { nco = as.integer(nrow(contrast)) dad <- .Call("getDAD2", parent.dat, child, contrast, P, nr, nc, nco) child.dat <- vector("list", lg) for (i in 1:lg)child.dat[[i]] <- contrast[child, , drop=FALSE] X <- .Call("getPrep2", dad, child, contrast2, evi, nr, nc, nco) } .Call("FS4", eig, as.integer(length(bf)), as.double(old.el), as.double(w), as.double(g), X, child.dat, dad, as.integer(length(w)), as.integer(length(weight)), as.double(bf), as.double(weight), as.double(ll.0), as.integer(getA), as.integer(getB)) } optimEdge <- function (tree, data, eig=eig, w=w, g=g, bf=bf, rate=rate, ll.0=ll.0, control = pml.control(epsilon = 1e-08, maxit = 10, trace=0), ...) { if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") nTips <- length(tree$tip) el <- tree$edge.length tree$edge.length[el < 1e-08] <- 1e-08 oldtree = tree k = length(w) data = subset(data, tree$tip) loglik = pml.fit2(tree, data, bf=bf, g=g, w=w, eig=eig, ll.0=ll.0, k=k) start.ll <- old.ll <- loglik contrast <- attr(data, "contrast") contrast2 <- contrast %*% eig[[2]] evi = (t(eig[[3]]) * bf) weight <- attr(data, "weight") eps = 1 iter = 0 treeP = tree tree = reorder(tree) child = tree$edge[, 2] parent = tree$edge[, 1] m <- max(tree$edge) pvec <- integer(m) pvec[child] <- parent EL = numeric(m) EL[child] = tree$edge.length n = length(tree$edge.length) nr = as.integer(length(weight)) nc = as.integer(length(bf)) nco = as.integer(nrow(contrast)) eve = eig[[2]] lg = k rootNode = getRoot(tree) ScaleEPS = 1.0/4294967296.0 anc = Ancestors(tree, 1:m, "parent") anc0 = as.integer(c(0L, anc)) while (eps > control$eps && iter < control$maxit) { blub3 <- .Call("extractScale", as.integer(rootNode), w, g, as.integer(nr), as.integer(nc), as.integer(nTips)) rowM = apply(blub3, 1, min) blub3 = (blub3-rowM) blub3 = ScaleEPS ^ (blub3) EL <- .Call("optE", as.integer(parent), as.integer(child), as.integer(anc0), eig, evi, EL, w, g, as.integer(nr), as.integer(nc), as.integer(nTips), as.double(contrast), as.double(contrast2), nco, blub3, data, as.double(weight), as.double(ll.0)) iter = iter + 1 # tree$edge.length = EL[tree$edge[,2]] treeP$edge.length = EL[treeP$edge[,2]] newll <- pml.fit2(treeP, data, bf=bf, g=g, w=w, eig=eig, ll.0=ll.0, k=k) eps = ( old.ll - newll ) / newll if( eps <0 ) return(list(oldtree, old.ll)) oldtree = treeP if(control$trace>1) cat(old.ll, " -> ", newll, "\n") old.ll = newll # loli = parent[1] } if(control$trace>0) cat(start.ll, " -> ", newll, "\n") list(tree=treeP, logLik=newll, c(eps, iter)) } # bf raus C naeher # data=data, k=k, g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV) pml.move <- function(EDGE, el, data, g, w, eig, k, nTips, bf){ node <- EDGE[, 1] edge <- EDGE[, 2] root <- as.integer(node[length(node)]) # el <- as.double(tree$edge.length) nr = as.integer(attr(data, "nr")) nc = as.integer(attr(data, "nc")) node = as.integer(node - nTips - 1L) edge = as.integer(edge - 1L) contrast = attr(data, "contrast") nco = as.integer(dim(contrast)[1]) tmp <- .Call("PML3", dlist=data, as.double(el), as.double(w), as.double(g), nr, nc, k, eig, as.double(bf), node, edge, nTips, root, nco, contrast, N=as.integer(length(edge))) return(NULL) } # # pmlPart + pmlCluster # optimPartQ <- function (object, Q = c(1, 1, 1, 1, 1, 1), ...) { l = length(Q) Q = Q[-l] Q = sqrt(Q) fn = function(Q, object, ...) { result <- 0 Q = c(Q^2, 1) n <- length(object) for (i in 1:n) result <- result + update(object[[i]], Q = Q, ...)$logLik result } res = optim(par = Q, fn = fn, gr = NULL, method = "L-BFGS-B", lower = 0, upper = Inf, control = list(fnscale = -1, maxit = 25), object = object, ...) res[[1]] = c(res[[1]]^2, 1) res } optimPartQGeneral <- function (object, Q = c(1, 1, 1, 1, 1, 1), subs=rep(1,length(Q)), ...) { m = length(Q) n = max(subs) ab = numeric(n) for(i in 1:n) ab[i]=log(Q[which(subs==i)[1]]) fn = function(ab, object, m, n, subs, ...) { Q = numeric(m) for(i in 1:n)Q[subs==i] = ab[i] Q = exp(Q) result = 0 for (i in 1:length(object)) result <- result + update(object[[i]], Q = Q, ...)$logLik result } res = optim(par = ab, fn = fn, gr = NULL, method = "L-BFGS-B", lower = -Inf, upper = Inf, control = list(fnscale = -1, maxit = 25), object = object, m=m, n=n, subs=subs, ...) Q = rep(1, m) for(i in 1:n) Q[subs==i] = exp(res[[1]][i]) res[[1]] = Q res } optimPartBf <- function (object, bf = c(0.25, 0.25, 0.25, 0.25), ...) { l = length(bf) nenner = 1/bf[l] lbf = log(bf * nenner) lbf = lbf[-l] fn = function(lbf, object, ...) { result <- 0 bf = exp(c(lbf, 0)) bf = bf/sum(bf) n <- length(object) for (i in 1:n) result <- result + update(object[[i]], bf = bf, ...)$logLik result } res = optim(par = lbf, fn = fn, gr = NULL, method = "Nelder-Mead", control = list(fnscale = -1, maxit = 500), object, ...) print(res[[2]]) bf = exp(c(res[[1]], 0)) bf = bf/sum(bf) } optimPartInv <- function (object, inv = 0.01, ...) { fn = function(inv, object, ...) { result <- 0 n <- length(object) for (i in 1:n) result <- result + update(object[[i]], inv = inv, ...)$logLik result } res = optimize(f = fn, interval = c(0, 1), lower = 0, upper = 1, maximum = TRUE, tol = 1e-04, object, ...) # print(res[[2]]) res[[1]] } optimPartGamma <- function (object, shape = 1, ...) { fn = function(shape, object, ...) { result <- 0 n <- length(object) for (i in 1:n) result <- result + update(object[[i]], shape = shape, ...)$logLik result } res = optimize(f = fn, interval = c(0, 100), lower = 0, upper = 100, maximum = TRUE, tol = 0.01, object, ...) res } dltmp <- function (fit, i=1, transform=transform) # i = weights { tree = fit$tree data = getCols(fit$data, tree$tip) if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") q = length(tree$tip.label) node <- tree$edge[, 1] edge <- tree$edge[, 2] m = length(edge) + 1 # max(edge) dat = vector(mode = "list", length = m) eig = fit$eig w = fit$w[i] g = fit$g[i] bf = fit$bf el <- tree$edge.length P <- getP(el, eig, g) nr <- as.integer(attr(data, "nr")) nc <- as.integer(attr(data, "nc")) node = as.integer(node - min(node)) edge = as.integer(edge - 1) nTips = as.integer(length(tree$tip)) mNodes = as.integer(max(node) + 1) contrast = attr(data, "contrast") nco = as.integer(dim(contrast)[1]) dat[(q + 1):m] <- .Call("LogLik2", data, P, nr, nc, node, edge, nTips, mNodes, contrast, nco) result = dat[[q+1]] %*% (bf * w) parent <- tree$edge[, 1] child <- tree$edge[, 2] nTips = min(parent) - 1 datp = vector("list", m) el = tree$edge.length if (transform) dP = getdP(tree$edge.length, eig, g) else dP = getdP2(tree$edge.length, eig, g) datp[(nTips + 1)] = dat[(nTips + 1)] l = length(child) dl = matrix(0, nr, l) for (j in (m - 1):1) { # tips have factor format, internal edges are matrices if (child[j] > nTips){ tmp2 = (datp[[parent[j]]]/(dat[[child[j]]] %*% P[[j]])) dl[, j] = (tmp2 * (dat[[child[j]]] %*% dP[[j]])) %*% (w * bf) datp[[child[j]]] = (tmp2 %*% P[[j]]) * dat[[child[j]]] } else{ tmp2 = (datp[[parent[j]]]/((contrast %*% P[[j]])[data[[child[j]]],] )) dl[, j] = (tmp2 * ((contrast %*% dP[[j]])[data[[child[j]]],]) ) %*% (w * bf) } } dl } dl <- function(x, transform = TRUE){ w = x$w l=length(x$w) dl = dltmp(x, 1, transform) i=2 while(i < (l+1)){ dl = dl + dltmp(x, i, transform) i = i + 1 } dl } # add control and change edge optimPartEdge <- function (object, ...) { tree <- object[[1]]$tree theta <- object[[1]]$tree$edge.length n <- length(object) l <- length(theta) nrv <- numeric(n) for (i in 1:n) nrv[i] = attr(object[[i]]$data, "nr") cnr <- cumsum(c(0, nrv)) weight = numeric(sum(nrv)) dl <- matrix(NA, sum(nrv), l) for (i in 1:n) weight[(cnr[i] + 1):cnr[i + 1]] = attr(object[[i]]$data, "weight") ll0 = 0 for (i in 1:n) ll0 = ll0 + object[[i]]$logLik eps = 1 scalep =1 k = 1 while (eps > 0.001 & k<50) { if(scalep==1){ for (i in 1:n) { lv = drop(exp(object[[i]]$site)) dl[(cnr[i] + 1):cnr[i + 1], ] = dl(object[[i]], TRUE)/lv } sc = colSums(weight * dl) F = crossprod(dl * weight, dl) + diag(l)*1e-10 # add small ridge penalty for numerical stability } thetaNew = log(theta) + scalep * solve(F, sc) tree$edge.length = as.numeric(exp(thetaNew)) for (i in 1:n) object[[i]] <- update(object[[i]], tree = tree) ll1 = 0 for (i in 1:n) ll1 = ll1 + object[[i]]$logLik eps <- ll1 - ll0 if (eps < 0 || is.nan(eps)) { scalep = scalep/2 eps = 1 thetaNew = log(theta) ll1 = ll0 } else scalep = 1 theta = exp(thetaNew) ll0 <- ll1 k=k+1 } object } makePart <- function(fit, rooted, weight=~index+genes){ if(class(fit)=="phyDat"){ x <- fit dm <- dist.ml(x) if(!rooted) tree <- NJ(dm) else tree <- upgma(dm) fit <- pml(tree, x, k=4) } dat <- fit$data if(class(weight)[1]=="formula") weight <- xtabs(weight, data=attr(dat, "index")) fits <- NULL for(i in 1:dim(weight)[2]){ ind <- which(weight[,i] > 0) dat2 <- getRows(dat, ind) attr(dat2, "weight") <- weight[ind,i] fits[[i]] <- update(fit, data = dat2) } names(fits) = colnames(fits) fits } multiphyDat2pmlPart <- function(x, rooted=FALSE, ...){ fun <- function(x, ...){ dm <- dist.ml(x) if(!rooted) tree <- NJ(dm) else tree <- upgma(dm) fit <- pml(tree, x, ...) } fits <- lapply(x@dna, fun, ...) fits } pmlPart2multiPhylo <- function(x){ res <- lapply(x$fits, FUN=function(x)x$tree) class(res) <- "multiPhylo" res } plot.pmlPart<- function(x, ...){ plot(pmlPart2multiPhylo(x), ...) } pmlPart <- function (formula, object, control=pml.control(epsilon=1e-8, maxit=10, trace=1), model=NULL, rooted=FALSE, ...) { call <- match.call() form <- phangornParseFormula(formula) opt <- c("nni", "bf", "Q", "inv", "shape", "edge", "rate") optAll <- match(opt, form$left) optPart <- match(opt, form$right) AllNNI <- !is.na(optAll[1]) AllBf <- !is.na(optAll[2]) AllQ <- !is.na(optAll[3]) AllInv <- !is.na(optAll[4]) AllGamma <- !is.na(optAll[5]) AllEdge <- !is.na(optAll[6]) PartNni <- !is.na(optPart[1]) PartBf <- !is.na(optPart[2]) PartQ <- !is.na(optPart[3]) PartInv <- !is.na(optPart[4]) PartGamma <- !is.na(optPart[5]) PartEdge <- !is.na(optPart[6]) PartRate <- !is.na(optPart[7]) if(class(object)=="multiphyDat"){ if(AllNNI || AllEdge) object <- do.call(cbind.phyDat, object@dna) else fits <- multiphyDat2pmlPart(object, rooted=rooted, ...) } if(class(object)=="pml") fits <- makePart(object, rooted=rooted, ...) if(class(object)=="phyDat") fits <- makePart(object, rooted=rooted, ...) if(class(object)=="pmlPart") fits <- object$fits if(class(object)=="list") fits <- object trace = control$trace epsilon = control$epsilon maxit = control$maxit p <- length(fits) # if(length(model) epsilon & m < maxit) { loli = 0 if(any(c(PartNni, PartBf, PartInv, PartQ, PartGamma, PartEdge, PartRate))){ for (i in 1:p) { fits[[i]] = optim.pml(fits[[i]], optNni=PartNni, optBf=PartBf, optQ=PartQ, optInv=PartInv, optGamma=PartGamma, optEdge=PartEdge, optRate=PartRate, optRooted=rooted, control = pml.control(maxit = 3, epsilon = 1e-8, trace-1), model=model[i]) } } if (AllQ) { Q = fits[[1]]$Q subs = c(1:(length(Q)-1), 0) newQ <- optimPartQGeneral(fits, Q=Q, subs=subs) for (i in 1:p) fits[[i]] <- update(fits[[i]], Q = newQ[[1]]) } if (AllBf) { bf = fits[[1]]$bf newBf <- optimPartBf(fits, bf=bf) for (i in 1:p) fits[[i]] <- update(fits[[i]], bf = newBf) } if (AllInv) { inv = fits[[1]]$inv newInv <- optimPartInv(fits, inv=inv) for (i in 1:p) fits[[i]] <- update(fits[[i]], inv = newInv) } if (AllGamma) { shape = fits[[1]]$shape newGamma <- optimPartGamma(fits, shape=shape)[[1]] for (i in 1:p) fits[[i]] <- update(fits[[i]], shape = newGamma) } if (AllNNI){ fits <- optimPartNNI(fits,AllEdge) if(trace>0) cat(attr(fits,"swap"), " NNI operations performed") } if (AllEdge) fits <- optimPartEdge(fits) if (PartRate){ tree = fits[[1]]$tree rate=numeric(p) wp =numeric(p) for(i in 1:p){ wp[i]=sum(fits[[i]]$weight) rate[i] <- fits[[i]]$rate } ratemult = sum(wp) / sum(wp*rate) tree$edge.length = tree$edge.length/ratemult for(i in 1:p)fits[[i]] = update(fits[[i]], tree=tree, rate=rate[i]*ratemult) } loli <- 0 for (i in 1:p) loli <- loli + fits[[i]]$log eps = (logLik - loli)/loli if(trace>0) cat("loglik:", logLik, "-->", loli, "\n") logLik <- loli m = m + 1 } df <- matrix(1, 6 ,2) colnames(df) <- c("#df", "group") rownames(df) <- c("Edge", "Shape", "Inv", "Bf", "Q", "Rate") df[1,1] <- length(fits[[1]]$tree$edge.length) df[2,1] <- fits[[1]]$k > 1 df[3,1] <- fits[[1]]$inv > 0 df[4,1] <- length(unique(fits[[1]]$bf)) - 1 df[5,1] <- length(unique(fits[[1]]$Q)) - 1 df[6,1] <- 0 # rates if(PartEdge) df[1,2] = p if(PartGamma) df[2,2] = p if(PartInv) df[3,2] = p if(PartBf) df[4,2] = p if(PartQ) df[5,2] = p if(PartRate) df[6,1] = p-1 attr(logLik, "df") = sum(df[,1]*df[,2]) object <- list(logLik = logLik, fits = fits, call = call, df=df) class(object) <- "pmlPart" object } bip <- function (obj) { if (is.null(attr(obj, "order")) || attr(obj, "order") == "cladewise") obj <- reorder(obj, "postorder") maxP = max(obj$edge) nTips = length(obj$tip) res <- .Call("C_bip", as.integer(obj$edge[, 1]), as.integer(obj$edge[, 2]), as.integer(nTips), as.integer(maxP)) res } bipart <- function(obj){ if (is.null(attr(obj, "order")) || attr(obj, "order") == "cladewise") obj <- reorder(obj, "postorder") maxP = max(obj$edge) nTips = length(obj$tip) res <- .Call("C_bipart", as.integer(obj$edge[,1]) , as.integer(obj$edge[,2]), as.integer(nTips), as.integer(maxP)) #, as.integer(obj$Nnode)) # attr(res, "nodes") = unique(obj$edge[,1]) res } bipartition <- function (tree) { if(is.rooted(tree))tree <- unroot(tree) if(is.null(attr(tree,"order")) || attr(tree, "order")=="cladewise") tree <- reorder(tree, "postorder") bp <- bipart(tree) nTips = length(tree$tip) l = length(bp) m = length(bp[[l]]) k = length(tree$edge[, 1]) result = matrix(0L, l, m) res = matrix(0L, k, m) for (i in 1:l) result[i, bp[[i]]] = 1L result = result[-l, ,drop=FALSE] for (i in 1:nTips) res[(tree$edge[, 2] == i), i] = 1L # res[tree$edge[, 2] > nTips, ] = result res[ match(unique(tree$edge[,1]),tree$edge[,2])[-l], ] = result colnames(res) = tree$tip.label rownames(res) = tree$edge[,2] res[res[, 1] == 1, ] = 1L - res[res[, 1] == 1, ] res } pmlCluster.fit <- function (formula, fit, weight, p = 4, part = NULL, control=pml.control(epsilon=1e-8, maxit=10, trace=1), ...) { call <- match.call() form <- phangornParseFormula(formula) opt <- c("nni", "bf", "Q", "inv", "shape", "edge", "rate") optAll <- match(opt, form$left) optPart <- match(opt, form$right) AllNNI <- !is.na(optAll[1]) AllBf <- !is.na(optAll[2]) AllQ <- !is.na(optAll[3]) AllInv <- !is.na(optAll[4]) AllGamma <- !is.na(optAll[5]) AllEdge <- !is.na(optAll[6]) PartNni <- !is.na(optPart[1]) PartBf <- !is.na(optPart[2]) PartQ <- !is.na(optPart[3]) PartInv <- !is.na(optPart[4]) PartGamma <- !is.na(optPart[5]) PartEdge <- !is.na(optPart[6]) PartRate <- !is.na(optPart[7]) nrw <- dim(weight)[1] ncw <- dim(weight)[2] if (is.null(part)){ part = rep(1:p, length=ncw) part = sample(part) } Part = part Gtrees = vector("list", p) dat <- fit$data attr(fit$orig.data, "index") <- attr(dat, "index") <- NULL for (i in 1:p) Gtrees[[i]] = fit$tree fits = vector("list", p) for (i in 1:p) fits[[i]] = fit trace = control$trace eps = 0 m = 1 logLik = fit$log trees = list() weights = matrix(0, nrw, p) lls = matrix(0, nrw, p) loli = fit$log oldpart = part eps2 = 1 iter = 0 swap = 1 while (eps < ncw || abs(eps2) > control$eps) { df2 = 0 if(any(c(PartNni, PartBf, PartInv, PartQ, PartGamma, PartEdge, PartRate))){ for (i in 1:p) { weights[, i] = rowSums(weight[, which(part == i), drop = FALSE]) ind <- which(weights[, i] > 0) dat2 <- getRows(dat, ind) attr(dat2, "weight") <- weights[ind, i] fits[[i]] <- update(fits[[i]], data = dat2) fits[[i]] = optim.pml(fits[[i]], PartNni, PartBf, PartQ, PartInv, PartGamma, PartEdge, PartRate, control = pml.control(epsilon = 1e-8, maxit = 3, trace-1)) lls[, i] = update(fits[[i]], data = dat)$site Gtrees[[i]] = fits[[i]]$tree } } if (AllQ) { Q = fits[[1]]$Q subs = c(1:(length(Q)-1), 0) newQ <- optimPartQGeneral(fits, Q=Q, subs=subs)[[1]] for (i in 1:p) fits[[i]] <- update(fits[[i]], Q = newQ) df2 = df2 + length(unique(newQ)) - 1 } if (AllBf) { bf = fits[[1]]$bf newBf <- optimPartBf(fits, bf=bf) for (i in 1:p) fits[[i]] <- update(fits[[i]], bf = newBf) df2 = df2 + length(unique(newBf)) - 1 } if (AllInv) { inv = fits[[1]]$inv newInv <- optimPartInv(fits, inv=inv) for (i in 1:p) fits[[i]] <- update(fits[[i]], inv = newInv) #there was an Error df2 = df2 + 1 } if (AllGamma) { shape = fits[[1]]$shape newGamma <- optimPartGamma(fits, shape=shape)[[1]] for (i in 1:p) fits[[i]] <- update(fits[[i]], shape = newGamma) df2 = df2 + 1 } if (AllNNI) { fits <- optimPartNNI(fits, AllEdge) if(trace>0)cat(attr(fits, "swap"), " NNI operations performed") swap <- attr(fits, "swap") } if (AllEdge) { fits <- optimPartEdge(fits) df2 = df2 + length(fits[[1]]$tree$edge.length) } if (PartRate) { tree = fits[[1]]$tree rate = numeric(p) wp = numeric(p) for (i in 1:p) { wp[i] = sum(fits[[i]]$weight) rate[i] <- fits[[i]]$rate } ratemult = sum(wp)/sum(wp * rate) tree$edge.length = tree$edge.length/ratemult for (i in 1:p) fits[[i]] = update(fits[[i]], tree = tree, rate = rate[i] * ratemult) } for (i in 1:p) lls[, i] = update(fits[[i]], data = dat)$site trees[[m]] = Gtrees LL = t(weight) %*% lls # choose partitions which change tmp =(LL[cbind(1:ncw,part)] - apply(LL, 1, max))/colSums(weight) fixi = numeric(p) for(i in 1:p){ tmpi = which(part == i) fixi[i] = tmpi[which.max(tmp[tmpi])] } oldpart = part # restrict the number of elements changing groups # If more than 25% would change, only the 25% with the highest increase per site change if( sum(tmp==0)/length(tmp) < .75){ medtmp = quantile(tmp, .25) medind = which(tmp<=medtmp) part[medind] = apply(LL[medind,], 1, which.max) } else part = apply(LL, 1, which.max) # force groups to have at least one member part[fixi] = 1:p Part = cbind(Part, part) eps = sum(diag(table(part, oldpart))) eps2 = loli loli = sum(apply(LL, 1, max)) eps2 = (eps2 - loli)/loli logLik = c(logLik, loli) if(trace>0) print(loli) Part = cbind(Part, part) df2 = df2 + df2 if (eps == ncw & swap == 0) AllNNI = FALSE m = m + 1 if (eps == ncw) iter = iter + 1 if (iter == 3) break } df <- matrix(1, 6, 2) colnames(df) <- c("#df", "group") rownames(df) <- c("Edge", "Shape", "Inv", "Bf", "Q", "Rate") df[1, 1] <- length(fits[[1]]$tree$edge.length) df[2, 1] <- fits[[1]]$k - 1 df[3, 1] <- fits[[1]]$inv > 0 df[4, 1] <- length(unique(fits[[1]]$bf)) - 1 df[5, 1] <- length(unique(fits[[1]]$Q)) - 1 df[6, 1] <- 0 if (PartEdge) df[1, 2] = p if (PartGamma) df[2, 2] = p if (PartInv) df[3, 2] = p if (PartBf) df[4, 2] = p if (PartQ) df[5, 2] = p if (PartRate) df[6, 1] = p - 1 attr(logLik, "df") = sum(df[, 1] * df[, 2]) res = list(logLik = logLik, Partition = Part, trees = trees) # intermediate results result <- list(logLik = loli, fits = fits, Partition = part, df = df, res = res, call = call) class(result) <- c("pmlPart") result } pmlCluster <- function (formula, fit, weight, p = 1:5, part = NULL, nrep = 10, control = pml.control(epsilon = 1e-08, maxit = 10, trace = 1), ...) { call <- match.call() form <- phangornParseFormula(formula) if(any(p==1)){ opt2 <- c("nni", "bf", "Q", "inv", "shape", "edge") tmp1 <- opt2 %in% form$left tmp1 <- tmp1 | (opt2 %in% form$right) fit <- optim.pml(fit, tmp1[1], tmp1[2], tmp1[3], tmp1[4], tmp1[5], tmp1[6]) } p=p[p!=1] if(length(p)==0)return(fit) n = sum(weight) k=2 BIC = matrix(0, length(p)+1, nrep) BIC[1,] = AIC(fit, k = log(n)) LL = matrix(NA, length(p)+1, nrep) LL[1,] = logLik(fit) P = array(dim=c(length(p)+1, nrep, dim(weight)[2])) tmpBIC = Inf choice = c(1,1) for(j in p){ tmp=NULL for(i in 1:nrep){ tmp = pmlCluster.fit(formula, fit, weight, p=j, part=part, control=control,...) P[k,i,] = tmp$Partition BIC[k,i] = AIC(tmp, k = log(n)) LL[k,i] = logLik(tmp) if(BIC[k,i]0] type <- attr(x$data, "type") levels <- attr(x$data, "levels") nc <- attr(x$data, "nc") ll0 = sum(w*log(w/sum(w))) cat("\nunconstrained loglikelihood:", ll0, "\n") if(x$inv > 0)cat("Proportion of invariant sites:",x$inv,"\n") if(x$k >1){ cat("Discrete gamma model\n") cat("Number of rate categories:",x$k,"\n") cat("Shape parameter:",x$shape,"\n") } if(type=="AA") cat("Rate matrix:",x$model, "\n") if(type=="DNA"){ cat("\nRate matrix:\n") QM = matrix(0, nc, nc, dimnames = list(levels,levels)) QM[lower.tri(QM)] = x$Q QM = QM+t(QM) print(QM) cat("\nBase frequencies: \n") bf = x$bf names(bf) = levels cat(bf, "\n") } if(type=="CODON") { cat("dn/ds:",x$dnds, "\n") cat("ts/tv:",x$tstv, "\n") } if(type=="USER" & length(x$bf)<11){ cat("\nRate matrix:\n") QM = matrix(0, nc, nc, dimnames = list(levels,levels)) QM[lower.tri(QM)] = x$Q QM = QM+t(QM) print(QM) cat("\nBase frequencies: \n") bf = x$bf names(bf) = levels cat(bf, "\n") } } optEdgeMulti <- function (object, control = pml.control(epsilon = 1e-8, maxit = 10, trace=1), ...) { tree <- object$tree theta <- object$tree$edge.length weight <- attr(object$data, "weight") ll0 = object$logLik eps = 1 iter = 0 iter2 = 0 scale = 1 # l = length(theta) while (abs(eps) > control$eps && iter < control$maxit) { dl = score(object) thetaNew = log(theta) + scale * solve(dl[[2]], dl[[1]]) #+ diag(l)*1e-10 newtheta = exp(thetaNew) tree$edge.length = as.numeric(newtheta) object <- update(object, tree = tree) ll1 = object$logLik eps <- ( ll0 - ll1 ) / ll1 if(eps < 0){ newtheta = theta scale = scale / 2 tree$edge.length = as.numeric(theta) ll1 = ll0 iter2 <- iter2+1 } else{ scale=1 iter2 = 0 } theta = newtheta if(iter2==0 && control$trace>0) cat("loglik: ",ll1,"\n") ll0 <- ll1 if(iter2==10)iter2=0 if(iter2==0)iter <- iter+1 } object <- update(object, tree = tree) object } # add data for internal use parent.frame(n) for higher nestings update.pmlNew <- function (object, ..., evaluate = TRUE){ call <- object$call if (is.null(call)) stop("need an object with call component") extras <- match.call(expand.dots = FALSE)$... if (length(extras)) { existing <- !is.na(match(names(extras), names(call))) for (a in names(extras)[existing]) call[[a]] <- extras[[a]] if (any(!existing)) { call <- c(as.list(call), extras[!existing]) call <- as.call(call) } } if (evaluate) eval(call, object, parent.frame()) else call } update.pml <- function (object, ...) { extras <- match.call(expand.dots = FALSE)$... pmla <- c("tree", "data", "bf", "Q", "inv", "k", "shape", "rate", "model", "wMix", "llMix", "...") names(extras) <- pmla[pmatch(names(extras), pmla[-length(pmla)])] call = object$call if (length(extras)) { existing <- !is.na(match(names(extras), names(call))) for (a in names(extras)[existing]) call[[a]] <- extras[[a]] if (any(!existing)) { call <- c(as.list(call), extras[!existing]) call <- as.call(call) } } existing <- match(pmla, names(extras)) updateEig <- FALSE updateRates <- FALSE if (is.na(existing[1])) tree <- object$tree else tree <- eval(extras[[existing[1]]], parent.frame()) if(is.null(attr(tree,"order")) || attr(tree,"order")=="cladewise")tree <- reorder(tree, "postorder") if (is.na(existing[2])){ data <- object$data INV <- object$INV } else{ data <- eval(extras[[existing[2]]], parent.frame()) ll.0 <- numeric(attr(data,"nr")) INV <- Matrix(lli(data, tree), sparse=TRUE) } nr <- as.integer(attr(data, "nr")) nc <- as.integer(attr(data, "nc")) if (is.na(existing[3])) bf <- object$bf else { bf <- eval(extras[[existing[3]]], parent.frame()) updateEig <- TRUE } if (is.na(existing[4])) Q <- object$Q else { Q <- eval(extras[[existing[4]]], parent.frame()) updateEig <- TRUE } # model <- object$model type <- attr(object$data, "type") model<-NULL if (type == "AA") { if(!is.na(existing[9]) ){ # model <- match.arg(eval(extras[[existing[9]]], parent.frame()), c("WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa", "mtREV24")) model <- match.arg(eval(extras[[existing[9]]], parent.frame()), .aamodels) getModelAA(model, bf = is.na(existing[3]), Q = is.na(existing[4])) updateEig <- TRUE } # else model <- object$model } if(is.na(existing[5])) inv <- object$inv else{ inv <- eval(extras[[existing[5]]], parent.frame()) updateRates <- TRUE } if(is.na(existing[6])) k <- object$k else{ k <- eval(extras[[existing[6]]], parent.frame()) updateRates <- TRUE } if(is.na(existing[7])) shape <- object$shape else{ shape <- eval(extras[[existing[7]]], parent.frame()) updateRates <- TRUE } rate <- ifelse(is.na(existing[8]), object$rate, eval(extras[[existing[8]]], parent.frame())) wMix <- ifelse(is.na(existing[10]), object$wMix, eval(extras[[existing[10]]], parent.frame())) if(is.na(existing[11])) llMix <- object$llMix else llMix <- eval(extras[[existing[11]]], parent.frame()) levels <- attr(data, "levels") weight <- attr(data, "weight") if(updateEig)eig <- edQt(bf = bf, Q = Q) else eig <- object$eig g <- discrete.gamma(shape, k) g <- rate * g if (inv > 0) g <- g/(1 - inv) ll.0 <- as.matrix(INV %*% (bf * inv)) if(wMix>0) ll.0 <- ll.0 + llMix w = rep(1/k, k) if (inv > 0) w <- (1 - inv) * w if (wMix > 0) w <- wMix * w m <- 1 resll <- matrix(0, nr, k) nTips = as.integer(length(tree$tip.label)) data <- subset(data, tree$tip.label) on.exit(.C("ll_free")) .C("ll_init", nr, nTips, nc, as.integer(k)) tmp <- pml.fit(tree, data, bf, shape = shape, k = k, Q = Q, levels = attr(data, "levels"), inv = inv, rate = rate, g = g, w = w, eig = eig, INV = INV, ll.0 = ll.0, llMix = llMix, wMix = wMix, site = TRUE) df <- ifelse(is.ultrametric(tree), tree$Nnode, length(tree$edge.length)) if (type == "CODON") { df <- df + (k > 1) + (inv > 0) + length(unique(bf)) - 1 } else df = df + (k > 1) + (inv > 0) + length(unique(bf)) - 1 + length(unique(Q)) - 1 result = list(logLik = tmp$loglik, inv = inv, k = k, shape = shape, Q = Q, bf = bf, rate = rate, siteLik = tmp$siteLik, weight = weight, g = g, w = w, eig = eig, data = data, model = model, INV = INV, ll.0 = ll.0, tree = tree, lv = tmp$resll, call = call, df = df, wMix = wMix, llMix = llMix) if (type == "CODON") { result$dnds <- 1 result$tstv <- 1 } class(result) = "pml" result } optimMixQ <- function(object, Q=c(1, 1, 1, 1, 1, 1), omega,...){ l = length(Q) Q = Q[-l] Q = sqrt(Q) fn = function(Q, object, omega,...) { Q = c(Q^2, 1) weight <- object[[1]]$weight n <- length(omega) p <- length(weight) result <- numeric(p) for(i in 1:n)result <- result + as.numeric(update(object[[i]], Q=Q, ...)$lv) * omega[i] result <- sum(weight %*% log(result)) result } res = optim(par=Q, fn=fn, gr=NULL, method="L-BFGS-B", lower=0, upper=Inf, control=list(fnscale = -1, maxit=25), object=object, omega=omega,...) res[[1]] = c(res[[1]]^2, 1) res } optimMixBf <- function(object, bf=c(.25,.25,.25,.25), omega,...){ l = length(bf) nenner = 1/bf[l] lbf = log(bf * nenner) lbf = lbf[-l] fn = function(lbf, object, omega,...) { bf = exp(c(lbf,0)) bf = bf/sum(bf) weight <- object[[1]]$weight n <- length(omega) p <- length(weight) result <- numeric(p) for(i in 1:n)result <- result + as.numeric(update(object[[i]], bf=bf, ...)$lv) * omega[i] result <- sum(weight %*% log(result)) result } res = optim(par=lbf, fn=fn, gr=NULL, method="Nelder-Mead", control=list(fnscale=-1, maxit=500), object, omega=omega,...) # print(res[[2]]) bf = exp(c(res[[1]],0)) bf = bf/sum(bf) } optimMixInv <- function(object, inv=0.01, omega,...){ fn = function(inv, object, omega,...) { n <- length(omega) weight <- object[[1]]$weight p <- length(weight) result <- numeric(p) for(i in 1:n)result <- result + as.numeric(update(object, inv=inv, ...)$lv) * omega[i] result <- sum(weight %*% log(result)) result } res = optimize(f=fn, interval = c(0,1), lower = 0, upper = 1, maximum = TRUE, tol = .0001, object, omega=omega,...) # print(res[[2]]) res[[1]] } optimMixRate <- function (fits, ll, weight, omega, rate=rep(1,length(fits))) { r <- length(fits) rate0 <- rate[-r] fn<-function(rate, fits, ll, weight, omega){ r <- length(fits) rate <- c(rate, (1- sum(rate *omega[-r]))/omega[r]) for (i in 1:r) fits[[i]]<-update(fits[[i]], rate = rate[i]) for (i in 1:r) ll[, i] <- fits[[i]]$lv sum(weight*log(ll%*%omega)) } ui=diag(r-1) ui <- rbind(-omega[-r], ui) ci <- c(-1, rep(0, r-1)) res <- constrOptim(rate0, fn, grad=NULL, ui=ui, ci=ci, mu = 1e-04, control = list(fnscale=-1), method = "Nelder-Mead", outer.iterations = 50, outer.eps = 1e-05, fits=fits, ll=ll, weight=weight, omega=omega) rate <- res[[1]] res[[1]] <- c(rate, (1- sum(rate *omega[-r]))/omega[r]) res } optW <- function (ll, weight, omega,...) { k = length(omega) nenner = 1/omega[1] eta = log(omega * nenner) eta = eta[-1] fn = function(eta, ll, weight) { eta = c(0,eta) p = exp(eta)/sum(exp(eta)) res = sum(weight * log(ll %*% p)) res } if(k==2)res = optimize(f =fn , interval =c(-3,3) , lower = -3, upper = 3, maximum = TRUE, tol = .Machine$double.eps^0.25, ll = ll, weight = weight) else res = optim(eta, fn = fn, method = "L-BFGS-B", lower=-5, upper=5,control = list(fnscale = -1, maxit=25), gr = NULL, ll = ll, weight = weight) p = exp(c(0,res[[1]])) p = p/sum(p) result = list(par = p, value = res[[2]]) result } optimMixEdge <- function(object, omega, trace=1,...){ tree <- object[[1]]$tree theta <- object[[1]]$tree$edge.length weight = as.numeric(attr(object[[1]]$data,"weight")) n <- length(omega) p <- length(weight) q <- length(theta) lv1 = numeric(p) for(i in 1:n) lv1 = lv1 + as.numeric(object[[i]]$lv) * omega[i] ll0 <- sum(weight * log(lv1)) eps=1 iter <- 0 scalep <- 1 if(trace>0) cat(ll0) while(abs(eps)>.001 & iter<10){ dl <- matrix(0,p,q) for(i in 1:n)dl <- dl + dl(object[[i]],TRUE) * omega[i] dl <- dl/lv1 sc = colSums(weight * dl) F = crossprod(dl * weight, dl)+diag(q)*1e-6 blub <- TRUE iter2 <- 0 while(blub & iter2<10){ thetaNew = log(theta) + scalep * solve(F, sc) tree$edge.length = as.numeric(exp(thetaNew)) for(i in 1:n)object[[i]] <- update(object[[i]],tree=tree) lv1 = numeric(p) for(i in 1:n) lv1 = lv1 + as.numeric(object[[i]]$lv) * omega[i] ll1 <- sum(weight * log(lv1)) eps <- ll1 - ll0 if (eps < 0 || is.nan(eps)) { scalep = scalep/2 eps = 1 thetaNew = log(theta) ll1 = ll0 iter2 <- iter2+1 } else{ scalep = 1; theta = exp(thetaNew) blub=FALSE } } iter <- iter+1 ll0 <- ll1 } tree$edge.length <- theta for(i in 1:n)object[[i]] <- update(object[[i]],tree=tree) if(trace>0) cat("->", ll1, "\n") object } pmlMix <- function (formula, fit, m = 2, omega = rep(1/m, m), control=pml.control(epsilon=1e-8, maxit=20, trace=1), ...) { call <- match.call() form <- phangornParseFormula(formula) opt <- c("nni", "bf", "Q", "inv", "shape", "edge", "rate") optAll <- match(opt, form$left) optPart <- match(opt, form$right) AllBf <- !is.na(optAll[2]) AllQ <- !is.na(optAll[3]) AllInv <- !is.na(optAll[4]) AllGamma <- !is.na(optAll[5]) AllEdge <- !is.na(optAll[6]) MixNni <- !is.na(optPart[1]) MixBf <- !is.na(optPart[2]) MixQ <- !is.na(optPart[3]) MixInv <- !is.na(optPart[4]) MixGamma <- !is.na(optPart[5]) MixEdge <- !is.na(optPart[6]) MixRate <- !is.na(optPart[7]) if (class(fit) == "list") fits <- fit else { fits <- vector("list", m) for (i in 1:m) fits[[i]] <- fit } dat <- fits[[1]]$data p = attr(dat, "nr") weight = attr(dat, "weight") r = m ll = matrix(0, p, r) for (i in 1:r) ll[, i] = fits[[i]]$lv for (i in 1:r){ pl0 <- ll[, -i, drop = FALSE] %*% omega[-i] fits[[i]] <- update(fits[[i]], llMix = pl0, wMix = omega[i]) } if(MixRate) rate <- rep(1,r) llstart = sum(weight * log(ll %*% omega)) llold <- llstart ll0 <- llstart ll3 <- llstart eps0 <- 1 iter0 <- 0 trace = control$trace while (eps0 > control$eps & iter0 < control$maxit) { #while (eps0 > 1e-6 & iter0 < 20) { eps1 <- 100 iter1 <- 0 if (AllQ) { newQ <- optimMixQ(fits, Q = fits[[1]]$Q, omega = omega)[[1]] for (i in 1:m) fits[[i]] <- update(fits[[i]], Q = newQ) } if (AllBf) { newBf <- optimMixBf(fits, bf = fits[[1]]$bf, omega = omega) for (i in 1:m) fits[[i]] <- update(fits[[i]], bf = newBf) } if (AllInv) { newInv <- optimMixInv(fits, inv = fits[[1]]$inv, omega = omega) for (i in 1:m) fits[[i]] <- update(fits[[i]], Inv = newInv) } if (AllEdge) fits <- optimMixEdge(fits, omega, trace=trace-1) for (i in 1:r) ll[, i] <- fits[[i]]$lv while ( abs(eps1) > 0.001 & iter1 < 3) { if(MixRate){ rate <- optimMixRate(fits, ll, weight, omega, rate)[[1]] for (i in 1:r) fits[[i]] <- update(fits[[i]], rate=rate[i]) for (i in 1:r) ll[, i] <- fits[[i]]$lv } for (i in 1:r){ pl0 <- ll[, -i, drop = FALSE] %*% omega[-i] fits[[i]] <- update(fits[[i]], llMix = pl0, wMix = omega[i]) } for (i in 1:r) { pl0 <- ll[, -i, drop = FALSE] %*% omega[-i] fits[[i]] <- optim.pml(fits[[i]], MixNni, MixBf, MixQ, MixInv, MixGamma, MixEdge, optRate=FALSE, control = pml.control(epsilon = 1e-8, maxit = 3, trace-1), llMix = pl0, wMix = omega[i]) ll[, i] <- fits[[i]]$lv res = optW(ll, weight, omega) omega = res$p if(MixRate){ blub <- sum(rate*omega) rate <- rate / blub tree <- fits[[1]]$tree tree$edge.length <- tree$edge.length*blub for (i in 1:r) fits[[i]]<-update(fits[[i]], tree=tree, rate = rate[i]) for (i in 1:r) ll[, i] <- fits[[i]]$lv } for (i in 1:r){ pl0 <- ll[, -i, drop = FALSE] %*% omega[-i] fits[[i]] <- update(fits[[i]], llMix = pl0, wMix = omega[i]) } } ll1 = sum(weight * log(ll %*% omega)) res = optW(ll, weight, omega) omega = res$p if(MixRate){ blub <- sum(rate*omega) rate <- rate / blub tree <- fits[[1]]$tree tree$edge.length <- tree$edge.length*blub for (i in 1:r) fits[[i]]<-update(fits[[i]], tree=tree, rate = rate[i]) if(trace>0) print(rate) for (i in 1:r) ll[, i] <- fits[[i]]$lv } for (i in 1:r){ pl0 <- ll[, -i, drop = FALSE] %*% omega[-i] fits[[i]] <- update(fits[[i]], llMix = pl0, wMix = omega[i]) } ll2 = sum(weight * log(ll %*% omega)) eps1 = llold - ll2 iter1 <- iter1 + 1 llold = ll2 } ll1 <- sum(weight * log(ll %*% omega)) eps0 <- (ll3 - ll1) / ll1 ll3 <- ll1 iter0 <- iter0 + 1 if(trace>0) print(iter0) } parameter <- c(AllBf=AllBf, AllQ=AllQ, AllInv=AllInv, AllGamma=AllGamma, AllEdge=AllEdge, MixNni=MixNni, MixBf=MixBf, MixQ=MixQ, MixInv=MixInv, MixGamma=MixGamma, MixEdge=MixEdge, MixRate=MixRate) df <- matrix(1, 6 ,2) colnames(df) <- c("#df", "group") rownames(df) <- c("Edge", "Shape", "Inv", "Bf", "Q", "Rate") df[1,1] <- length(fits[[1]]$tree$edge.length) # df[2,1] <- fits[[1]]$k - 1 df[2,1] <- fits[[1]]$k > 1 df[3,1] <- fits[[1]]$inv > 0 df[4,1] <- length(unique(fits[[1]]$bf)) - 1 df[5,1] <- length(unique(fits[[1]]$Q)) - 1 df[6,1] <- 0 if(MixEdge) df[1,2] = r if(MixGamma) df[2,2] = r if(MixInv) df[3,2] = r if(MixBf) df[4,2] = r if(MixQ) df[5,2] = r if(MixRate) df[6,1] = r-1 attr(logLik, "df") = sum(df[,1]*df[,2]) converge <- c(iter=iter0, eps=eps0) result <- list(logLik = ll1, omega = omega, fits = fits, call = call, converge=converge, parameter=parameter, df=df) class(result) <- "pmlMix" result } print.pmlMix <- function(x,...){ nc <- attr(x$fits[[1]]$data, "nc") nr <- attr(x$fits[[1]]$data, "nr") levels <- attr(x$fits[[1]]$data, "levels") r <- length(x$fits) w <- x$fits[[1]]$weight w <- w[w>0] type <- attr(x$fits[[1]]$data, "type") nc <- attr(x$fits[[1]]$data, "nc") ll0 = sum(w*log(w/sum(w))) bf <- matrix(0,r,nc) dimnames(bf) <- list(1:r, levels) Q <- matrix(0, r, nc*(nc-1)/2) dimnames(Q) <- list(1:r, NULL) rate <- numeric(r) inv <- x$fits[[1]]$inv shape <- numeric(r) for(i in 1:r){ bf[i, ] <- x$fits[[i]]$bf Q[i, ] <- x$fits[[i]]$Q rate[i] <- x$fits[[i]]$rate shape[i] <- x$fits[[i]]$shape } cat("\nloglikelihood:", x$logLik, "\n") cat("\nunconstrained loglikelihood:", ll0, "\n") cat("AIC: ", AIC(x), " BIC: ", AIC(x, k=log(nr)), "\n\n") cat("\nposterior:", x$omega ,"\n") if(inv > 0)cat("Proportion of invariant sites:",inv,"\n") cat("\nRates:\n") cat(rate,"\n") cat("\nBase frequencies: \n") print(bf) cat("\nRate matrix:\n") print(Q) } logLik.pmlMix <- function (object, ...) { res <- object$logLik attr(res, "df") <- sum(object$df[,1] * object$df[,2]) class(res) <- "logLik" res } print.pmlPart <- function(x,...){ df <- x$df nc <- attr(x$fits[[1]]$data, "nc") levels <- attr(x$fits[[1]]$data, "levels") r <- length(x$fits) nc <- attr(x$fits[[1]]$data, "nc") nr <- attr(x$fits[[1]]$data, "nr") k <- x$fits[[1]]$k lbf=x$df["Bf",2] bf <- matrix(0, lbf, nc) if(lbf>1)dimnames(bf) <- list(1:r, levels) lQ = x$df["Q",2] Q <- matrix(0, lQ, nc*(nc-1)/2) if(lQ>1)dimnames(Q) <- list(1:r, NULL) type <- attr(x$fits[[1]]$data, "type") loli <- numeric(r) rate <- numeric(r) shape <- numeric(r) sizes <- numeric(r) inv <- numeric(r) for(i in 1:r){ loli[i] <- x$fits[[i]]$logLik if(i <= lbf)bf[i, ] <- x$fits[[i]]$bf if(i <= lQ)Q[i, ] <- x$fits[[i]]$Q rate[i] <- x$fits[[i]]$rate shape[i] <- x$fits[[i]]$shape inv[i] <- x$fits[[i]]$inv sizes[i] <- sum(attr(x$fits[[i]]$data,"weight")) } cat("\nloglikelihood:", x$logLik, "\n") cat("\nloglikelihood of partitions:\n ", loli, "\n") cat("AIC: ", AIC(x), " BIC: ", AIC(x, k=log(sum(sizes))), "\n\n") cat("Proportion of invariant sites:",inv,"\n") cat("\nRates:\n") cat(rate,"\n") if(k>1){ cat("\nShape parameter:\n") cat(shape,"\n") } if(type=="AA") cat("Rate matrix:",x$fits[[1]]$model, "\n") else{ cat("\nBase frequencies: \n") print(bf) cat("\nRate matrix:\n") print(Q) } } logLik.pmlPart <- function (object, ...) { res <- object$logLik attr(res, "df") <- sum(object$df[,1] * object$df[,2]) class(res) <- "logLik" res } pmlPen <- function(object, lambda, ...){ if(class(object)=="pmlPart") return(pmlPartPen(object, lambda,...)) if(class(object)=="pmlMix") return(pmlMixPen(object, lambda,...)) else stop("object has to be of class pmlPart or pmlMix") } pmlPartPen <- function(object, lambda, control=pml.control(epsilon=1e-8, maxit=20, trace=1),...){ fits <- object$fits m <- length(fits) K = -diag(length(fits[[1]]$tree$edge.length)) Ktmp=K for(i in 1:(m-1))Ktmp = cbind(Ktmp,K) KM = Ktmp for(i in 1:(m-1))KM = rbind(KM,Ktmp) diag(KM) = m-1 theta=NULL l = length(fits[[1]]$tree$edge.length) loglik = 0 for(i in 1:m){ theta = c(theta,fits[[i]]$tree$edge.length) loglik = loglik + fits[[i]]$logLik } print(loglik) pen = - 0.5 * lambda * t(theta)%*%KM%*%theta loglik = loglik - 0.5 * lambda * t(theta)%*%KM%*%theta eps=1 H = matrix(0, m * l, m * l) iter=0 trace = control$trace while( abs(eps)>control$eps & iter0)print(loglik1) loglik0 = loglik1 pen = - 0.5 * lambda * t(theta)%*%KM%*%theta loglik1 = loglik1 - 0.5 * lambda * t(thetanew)%*%KM%*%thetanew eps = (loglik - loglik1) / loglik1 loglik = loglik1 theta = exp(thetanew) iter = iter+1 if(trace>0)print(iter) } df = sum( diag(solve(H + lambda* KM, H))) object$df[1,1] = df object$df[1,2] = 1 object$fits = fits object$logLik = loglik0 attr(object$logLik, "df") = sum(object$df[,1]*object$df[,2]) object$logLik.pen = loglik attr(object$logLik.pen, "df") = sum(object$df[,1]*object$df[,2]) object } pmlMixPen = function (object, lambda, optOmega=TRUE, control=pml.control(epsilon=1e-8, maxit=20, trace=1), ...) { fits <- object$fits m <- length(fits) K = -diag(length(fits[[1]]$tree$edge.length)) tree <- fits[[1]]$tree Ktmp = K for (i in 1:(m - 1)) Ktmp = cbind(Ktmp, K) KM = Ktmp for (i in 1:(m - 1)) KM = rbind(KM, Ktmp) diag(KM) = m - 1 theta = NULL l = length(fits[[1]]$tree$edge.length) omega <- object$omega dat <- fits[[1]]$data nr = attr(dat, "nr") weight = drop(attr(dat, "weight")) ll = matrix(0, nr, m) for (i in 1:m) ll[, i] = fits[[i]]$lv lv = drop(ll %*% omega) loglik = sum(weight * log(lv)) for (i in 1:m) theta = c(theta, fits[[i]]$tree$edge.length) pen = - 0.5 * lambda * t(theta) %*% KM %*% theta loglik = loglik + pen print(loglik) eps0 = 1 dl <- matrix(0, nr, m * l) iter0 = 0 trace = control$trace while (abs(eps0) > control$eps & iter0 < control$maxit) { eps = 1 iter = 0 while (abs(eps) > 0.01 & iter < 5) { for (i in 1:m) { dl[, (1:l) + l * (i - 1)] <- dl(fits[[i]], TRUE) * omega[i] } dl <- dl/lv sc = colSums(weight * dl) - lambda * KM %*% log(theta) H = crossprod(dl * weight, dl) thetanew = log(theta) + solve(H + lambda * KM, sc) for (i in 1:m) fits[[i]]$tree$edge.length = exp(thetanew[(1:l) + (i - 1) * l]) for (i in 1:m) { tree$edge.length = exp(thetanew[(1:l) + (i - 1) * l]) fits[[i]] = update.pml(fits[[i]], tree = tree) ll[, i] = fits[[i]]$lv } lv = drop(ll %*% omega) loglik1 = sum(weight * log(lv)) pen = - 0.5 * lambda * t(thetanew) %*% KM %*% thetanew loglik1 = loglik1 + pen eps = abs(loglik1 - loglik) theta = exp(thetanew) loglik <- loglik1 iter = iter + 1 } if(optOmega){ res = optWPen(ll, weight, omega, pen) omega = res$p for (i in 1:m) { pl0 <- ll[, -i, drop = FALSE] %*% omega[-i] fits[[i]] <- update(fits[[i]], llMix = pl0, wMix = omega[i]) } } lv = drop(ll %*% omega) loglik1 = sum(weight * log(lv)) loglik0 =loglik1 loglik1 = loglik1 - 0.5 * lambda * t(thetanew) %*% KM %*% thetanew eps0 = (loglik - loglik1) / loglik1 theta = exp(thetanew) loglik <- loglik1 iter0 = iter0 + 1 if(trace>0) print(loglik) } for (i in 1:m) { pl0 <- ll[, -i, drop = FALSE] %*% omega[-i] fits[[i]] <- update(fits[[i]], llMix = pl0, wMix = omega[i]) } df = sum(diag(solve(H + lambda * KM, H))) penalty <- list(lambda=lambda, K=KM, thetanew=thetanew, ploglik=loglik) object$omega = omega object$df[1, 1] = df object$df[1, 2] = 1 object$fits = fits object$logLik = loglik0 object$penalty = penalty object } optWPen = function (ll, weight, omega, pen, ...) { k = length(omega) nenner = 1/omega[1] eta = log(omega * nenner) eta = eta[-1] fn = function(eta, ll, weight, pen) { eta = c(0, eta) p = exp(eta)/sum(exp(eta)) res = sum(weight * log(ll %*% p)) + pen res } if (k == 2) res = optimize(f = fn, interval = c(-3, 3), lower = -3, upper = 3, maximum = TRUE, tol = .Machine$double.eps^0.25, ll = ll, weight = weight, pen = pen) else res = optim(eta, fn = fn, method = "L-BFGS-B", lower = -5, upper = 5, control = list(fnscale = -1, maxit = 25), gr = NULL, ll = ll, weight = weight, pen=pen) p = exp(c(0, res[[1]])) p = p/sum(p) result = list(par = p, value = res[[2]]) result } optNNI <- function(fit, INDEX){ tree = fit$tree ll.0 <- fit$ll.0 loli <- fit$logLik bf = fit$bf eig = fit$eig k = fit$k w = fit$w g = fit$g rootEdges <- attr(INDEX, "root") .dat <- NULL parent = tree$edge[, 1] child = tree$edge[, 2] data = getCols(fit$data, tree$tip) datp <- rnodes(tree, data, w, g, eig, bf) # nicht elegant, spaeter auch raus tmp = length(tree$tip.label) for(i in 1:length(w)).dat[i,1:tmp]=new2old.phyDat(data) # datp = rnodes(fit) # raus evector <- numeric(max(parent)) evector[child] <- tree$edge.length m <- dim(INDEX)[1] k = min(parent) loglik = numeric(2 * m) edgeMatrix <- matrix(0, 2 * m, 5) for (i in 1:m) { ei = INDEX[i, ] el0 = evector[INDEX[i, ]] l = length(datp[, 1]) weight = fit$weight datn = vector("list", 4 * l) attr(datn, "dim") = c(l, 4) datn <- .dat[, ei[1:4], drop = FALSE] if (!(ei[5] %in% rootEdges)) datn[, 1] = datp[, ei[1], drop = FALSE] new1 <- optim.quartet(el0[c(1, 3, 2, 4, 5)], eig, bf, datn[, c(1, 3, 2, 4), drop = FALSE], g, w, weight, ll.0, llcomp = fit$log) new2 <- optim.quartet(el0[c(1, 4, 3, 2, 5)], eig, bf, datn[, c(1, 4, 3, 2), drop = FALSE], g, w, weight, ll.0, llcomp = fit$log) loglik[(2 * i) - 1] = new1[[2]] loglik[(2 * i)] = new2[[2]] edgeMatrix[(2 * i) - 1, ] = new1[[1]] edgeMatrix[(2 * i), ] = new2[[1]] } list(loglik=loglik, edges = edgeMatrix) } optimPartNNI <- function (object, AllEdge=TRUE,...) { tree <- object[[1]]$tree INDEX <- indexNNI(tree) l = length(object) loglik0 = 0 for(i in 1:l)loglik0 = loglik0 + logLik(object[[i]]) l = length(object) TMP=vector("list", l) for(i in 1:l){ TMP[[i]] = optNNI(object[[i]], INDEX) } loglik=TMP[[1]][[1]] for(i in 2:l)loglik=loglik+TMP[[i]][[1]] swap <- 0 candidates <- loglik > loglik0 while (any(candidates)) { ind = which.max(loglik) loglik[ind] = -Inf if (ind%%2) swap.edge = c(2, 3) else swap.edge = c(2, 4) tree2 <- changeEdge(tree, INDEX[(ind + 1)%/%2, swap.edge], INDEX[(ind + 1)%/%2, ], TMP[[1]][[2]][ind, ]) tmpll = 0 for(i in 1:l){ if(!AllEdge)tree2 <- changeEdge(object[[i]]$tree, INDEX[(ind + 1)%/%2, swap.edge], INDEX[(ind + 1)%/%2, ], TMP[[i]][[2]][ind, ]) tmpll <- tmpll + update(object[[i]], tree = tree2)$logLik } if (tmpll < loglik0) candidates[ind] = FALSE if (tmpll > loglik0) { swap = swap + 1 tree <- tree2 indi <- which(rep(colSums(apply(INDEX, 1, match, INDEX[(ind + 1)%/%2, ], nomatch = 0)) > 0, each = 2)) candidates[indi] <- FALSE loglik[indi] <- -Inf for(i in 1:l){ if(!AllEdge)tree2 <- changeEdge(object[[i]]$tree, INDEX[(ind + 1)%/%2, swap.edge], INDEX[(ind + 1)%/%2, ], TMP[[i]][[2]][ind, ]) object[[i]] <- update(object[[i]], tree = tree2) } loglik0 = 0 for(i in 1:l)loglik0 = loglik0 + logLik(object[[i]]) cat(loglik0, "\n") } } if(AllEdge)object <- optimPartEdge(object) attr(object,"swap") = swap object } SH.test <- function (..., B = 10000, data = NULL) { fits <- list(...) p = 1 if (inherits(fits[[1]],"pmlPart")) # class(fits[[1]]) == "pmlPart") { fits = fits[[1]]$fits p = length(fits) } k = length(fits) if (is.null(data)) data = fits[[1]]$data res = NULL for (h in 1:p) { if (p > 1) data = fits[[h]]$data weight = attr(data, "weight") lw = length(weight) siteLik = matrix(0, lw, k) for (i in 1:k) siteLik[, i] = update(fits[[i]], data = data)$site ntree = k Lalpha <- drop(crossprod(siteLik, weight)) Talpha <- max(Lalpha) - Lalpha M <- matrix(NA, k, B) # S <- matrix(NA, k, B) wvec <- rep(1L:lw, weight) size = length(wvec) for (i in 1:B) { boot = tabulate(sample(wvec, replace=TRUE), nbins=lw) M[, i] <- crossprod(siteLik, boot) } M <- M - rowMeans(M) # for (i in 1:B) for (j in 1:ntree) S[j, i] <- max(M[j, i] - M[, i]) S = matrix(apply(M,2,min), k, B, byrow=TRUE) S = M - S count <- numeric(ntree) for (j in 1:ntree) count[j] <- sum(S[j, ] > Talpha[j]) count <- count/B trees <- 1:k if (p == 1) res = cbind(trees, Lalpha, Talpha, count) else res = rbind(res, cbind(h, trees[-h], Lalpha[-h], Talpha[-h], count[-h])) } if (p == 1) colnames(res) <- c("Trees", "ln L", "Diff ln L", "p-value") else colnames(res) <- c("Partition", "Trees", "ln L", "Diff ln L", "p-value") res } # # Bootstrap functions # multicore support # bootstrap.pml = function (x, bs = 100, trees = TRUE, multicore=FALSE, ...) { data = x$data weight = attr(data, "weight") v = rep(1:length(weight), weight) BS = vector("list", bs) for (i in 1:bs) BS[[i]] = tabulate(sample(v, replace = TRUE), length(weight)) pmlPar <- function(weights, fit, trees = TRUE, ...) { data = fit$data ind <- which(weights > 0) data <- getRows(data, ind) attr(data, "weight") <- weights[ind] fit = update(fit, data = data) fit = optim.pml(fit, ...) if (trees) { tree = fit$tree return(tree) } attr(fit, "data") = NULL fit } eval.success <- FALSE if (!eval.success & multicore) { # !require(parallel) || if (.Platform$GUI!="X11") { warning("package 'parallel' not found or GUI is used, bootstrapping is performed in serial") } else { res <- mclapply(BS, pmlPar, x, trees = trees, ...) eval.success <- TRUE } } if (!eval.success) res <- lapply(BS, pmlPar, x, trees = trees, ...) if (trees) { class(res) = "multiPhylo" res = .compressTipLabel(res) # save memory } res } bootstrap.phyDat <- function (x, FUN, bs = 100, mc.cores=1L, ...) { weight = attr(x, "weight") v = rep(1:length(weight), weight) BS = vector("list", bs) for(i in 1:bs)BS[[i]]=tabulate(sample(v, replace=TRUE),length(weight)) fitPar <- function(weights, data, ...){ ind <- which(weights > 0) data <- getRows(data, ind) attr(data, "weight") <- weights[ind] FUN(data,...) } res <- mclapply(BS, fitPar, x, ..., mc.cores = mc.cores) if(class(res[[1]]) == "phylo"){ class(res) <- "multiPhylo" res = .compressTipLabel(res) # save memory } res } matchEdges = function(tree1, tree2){ bp1 = bip(tree1) bp2 = bip(tree2) l = length(tree1$tip) fn = function(x, y){ if(x[1]==1)return(x) else return(y[-x]) } bp1[] = lapply(bp1, fn, 1:l) bp2[] = lapply(bp2, fn, 1:l) match(bp1, bp2) } checkLabels <- function(tree, tip){ ind <- match(tip, tree$tip.label) tree$tip.label <- tree$tip.label[ind] ind2 <- match(1:length(ind), tree$edge[, 2]) tree$edge[ind2, 2] <- order(ind) tree } plotBS <- function (tree, BStrees, type = "unrooted", bs.col = "black", bs.adj = NULL, p=80, ...) { # prop.clades raus?? prop.clades <- function(phy, ..., part = NULL, rooted = FALSE) { if (is.null(part)) { obj <- list(...) if (length(obj) == 1 && class(obj[[1]]) != "phylo") obj <- unlist(obj, recursive = FALSE) if (!identical(phy$tip, obj[[1]]$tip)) obj[[1]] = checkLabels(obj[[1]], phy$tip) part <- prop.part(obj, check.labels = TRUE) } bp <- prop.part(phy) if (!rooted) { bp <- postprocess.prop.part(bp) part <- postprocess.prop.part(part) } n <- numeric(phy$Nnode) for (i in seq_along(bp)) { for (j in seq_along(part)) { if (identical(bp[[i]], part[[j]])) { n[i] <- attr(part, "number")[j] done <- TRUE break } } } n } type <- match.arg(type, c("phylogram", "cladogram", "fan", "unrooted", "radial")) if (type == "phylogram" | type == "cladogram") { if (!is.rooted(tree) & !is.null(tree$edge.length)) tree2 = midpoint(tree) else tree2=tree plot(tree2, type = type, ...) } else plot(tree, type = type, ...) BStrees <- .uncompressTipLabel(BStrees) x = prop.clades(tree, BStrees) x = round((x/length(BStrees)) * 100) tree$node.label = x label = c(rep(0, length(tree$tip)), x) ind <- get("last_plot.phylo", envir = .PlotPhyloEnv)$edge[, 2] if (type == "phylogram" | type == "cladogram") { root = getRoot(tree) label = c(rep(0, length(tree$tip)), x) label[root] = 0 ind2 = matchEdges(tree2, tree) label = label[ind2] ind = which(label > p) # browser() if (is.null(bs.adj)) bs.adj = c(1, 1) if(length(ind)>0)nodelabels(text = label[ind], node = ind, frame = "none", col = bs.col, adj = bs.adj, ...) } else { if (is.null(bs.adj)) bs.adj = c(0.5, 0.5) ind2 = which(label[ind]>p) if(length(ind2>0))edgelabels(label[ind][ind2],ind2, frame = "none", col = bs.col, adj = bs.adj, ...) } invisible(tree) } pml.fit2 <- function (tree, data, bf = rep(1/length(levels), length(levels)), shape = 1, k = 1, Q = rep(1, length(levels) * (length(levels) - 1)/2), levels = attr(data, "levels"), inv = 0, rate = 1, g = NULL, w = NULL, eig = NULL, INV = NULL, ll.0 = NULL, llMix = NULL, wMix = 0, ..., site=FALSE) { weight <- as.double(attr(data, "weight")) nr <- as.integer(attr(data, "nr")) nc <- as.integer(attr(data, "nc")) nTips <- as.integer(length(tree$tip.label)) k <- as.integer(k) m = 1 if (is.null(eig)) eig = edQt(bf = bf, Q = Q) if (is.null(w)) { w = rep(1/k, k) if (inv > 0) w <- (1 - inv) * w if (wMix > 0) w <- (1 - wMix) * w } if (is.null(g)) { g = discrete.gamma(shape, k) if (inv > 0) g <- g/(1 - inv) g <- g * rate } # inv0 <- inv if(any(g<.gEps)){ for(i in 1:length(g)){ if(g[i]<.gEps){ inv <- inv+w[i] } } w <- w[g>.gEps] g <- g[g>.gEps] # kmax <- k k <- length(w) } if (is.null(INV)) INV <- Matrix(lli(data, tree), sparse=TRUE) if (is.null(ll.0)){ ll.0 <- numeric(attr(data,"nr")) } if(inv>0) ll.0 <- as.matrix(INV %*% (bf * inv)) if (wMix > 0) ll.0 <- ll.0 + llMix node <- tree$edge[, 1] edge <- tree$edge[, 2] root <- as.integer(node[length(node)]) el <- as.double(tree$edge.length) node = as.integer(node - nTips - 1L) # min(node)) edge = as.integer(edge - 1L) contrast = attr(data, "contrast") nco = as.integer(dim(contrast)[1]) # dlist=data, nr, nc, weight, k ausserhalb definieren # pmlPart einbeziehen resll <- .Call("PML3", dlist=data, el, as.double(w), as.double(g), nr, nc, k, eig, as.double(bf), node, edge, nTips, root, nco, contrast, N=as.integer(length(edge))) # sort(INV@i)+1L ind = which(ll.0>0) # automatic in INV gespeichert sca = .Call("rowMax", resll, length(weight), as.integer(k)) + 1 # nr statt length(weight) lll = resll - sca lll <- exp(lll) lll <- (lll%*%w) lll[ind] = lll[ind] + exp(log(ll.0[ind])-sca[ind]) siteLik <- lll siteLik <- log(siteLik) + sca # needs to change if(wMix >0) siteLik <- log(exp(siteLik) * (1-wMix) + llMix ) loglik <- sum(weight * siteLik) if(!site) return(loglik) resll = exp(resll) return(list(loglik=loglik, siteLik=siteLik, resll=resll)) } pml.fit4 <- function (tree, data, bf = rep(1/length(levels), length(levels)), shape = 1, k = 1, Q = rep(1, length(levels) * (length(levels) - 1)/2), levels = attr(data, "levels"), inv = 0, rate = 1, g = NULL, w = NULL, eig = NULL, INV = NULL, ll.0 = NULL, llMix = NULL, wMix = 0, ..., site=FALSE) { weight <- as.double(attr(data, "weight")) nr <- as.integer(attr(data, "nr")) nc <- as.integer(attr(data, "nc")) nTips <- as.integer(length(tree$tip.label)) k <- as.integer(k) m = 1 if (is.null(eig)) eig = edQt(bf = bf, Q = Q) if (is.null(w)) { w = rep(1/k, k) if (inv > 0) w <- (1 - inv) * w if (wMix > 0) w <- (1 - wMix) * w } if (is.null(g)) { g = discrete.gamma(shape, k) if (inv > 0) g <- g/(1 - inv) g <- g * rate } # inv0 <- inv if(any(g<.gEps)){ for(i in 1:length(g)){ if(g[i]<.gEps){ inv <- inv+w[i] } } w <- w[g>.gEps] g <- g[g>.gEps] # kmax <- k k <- length(w) } # .iind <- get(".iind", parent.frame()) # .INV <- get(".INV", parent.frame()) # if(is.null(ll.0)) if (is.null(ll.0)){ ll.0 <- numeric(attr(data,"nr")) } if(inv>0) ll.0 <- as.matrix(INV %*% (bf * inv)) # if(inv>0) # ll.0 <- as.matrix(.INV %*% (bf * inv)) node <- tree$edge[, 1] edge <- tree$edge[, 2] root <- as.integer(node[length(node)]) el <- as.double(tree$edge.length) node = as.integer(node - nTips - 1L) # min(node)) edge = as.integer(edge - 1L) contrast = attr(data, "contrast") nco = as.integer(dim(contrast)[1]) siteLik <- .Call("PML4", dlist=data, el, as.double(w), as.double(g), nr, nc, k, eig, as.double(bf), node, edge, nTips, root, nco, contrast, N=as.integer(length(edge))) # if(inv>0) siteLik[.iind] = log(exp(siteLik[.iind]) + ll.0[.iind]) ind = which(ll.0>0) # if(!is.null(ll.0)) siteLik[.iind] = log(exp(siteLik[.iind]) + ll.0[.iind]) if(!is.null(ll.0)) siteLik[ind] = log(exp(siteLik[ind]) + ll.0[ind]) if(wMix >0) siteLik <- log(exp(siteLik) * (1-wMix) + llMix ) loglik <- sum(weight * siteLik) if(!site) return(loglik) return(list(loglik=loglik, siteLik=siteLik)) #, resll=resll } pml.fit <- function (tree, data, bf = rep(1/length(levels), length(levels)), shape = 1, k = 1, Q = rep(1, length(levels) * (length(levels) - 1)/2), levels = attr(data, "levels"), inv = 0, rate = 1, g = NULL, w = NULL, eig = NULL, INV = NULL, ll.0 = NULL, llMix = NULL, wMix = 0, ..., site=FALSE) { weight <- as.double(attr(data, "weight")) nr <- as.integer(attr(data, "nr")) nc <- as.integer(attr(data, "nc")) nTips <- as.integer(length(tree$tip.label)) k <- as.integer(k) m = 1 if (is.null(eig)) eig = edQt(bf = bf, Q = Q) if (is.null(w)) { w = rep(1/k, k) if (inv > 0) w <- (1 - inv) * w if (wMix > 0) w <- (1 - wMix) * w } if (is.null(g)) { g = discrete.gamma(shape, k) if (inv > 0) g <- g/(1 - inv) g <- g * rate } # inv0 <- inv if(any(g<.gEps)){ for(i in 1:length(g)){ if(g[i]<.gEps){ inv <- inv+w[i] } } w <- w[g>.gEps] g <- g[g>.gEps] # kmax <- k k <- length(w) } if (is.null(INV)) INV <- Matrix(lli(data, tree), sparse=TRUE) if (is.null(ll.0)){ ll.0 <- numeric(attr(data,"nr")) } if(inv>0) ll.0 <- as.matrix(INV %*% (bf * inv)) if (wMix > 0) ll.0 <- ll.0 + llMix node <- tree$edge[, 1] edge <- tree$edge[, 2] root <- as.integer(node[length(node)]) el <- as.double(tree$edge.length) node = as.integer(node - nTips - 1L) # min(node)) edge = as.integer(edge - 1L) contrast = attr(data, "contrast") nco = as.integer(dim(contrast)[1]) # dlist=data, nr, nc, weight, k ausserhalb definieren # pmlPart einbeziehen resll <- .Call("PML0", dlist=data, el, as.double(w), as.double(g), nr, nc, k, eig, as.double(bf), node, edge, nTips, root, nco, contrast, N=as.integer(length(edge))) # sort(INV@i)+1L ind = which(ll.0>0) # automatic in INV gespeichert sca = .Call("rowMax", resll, length(weight), as.integer(k)) + 1 # nr statt length(weight) lll = resll - sca lll <- exp(lll) lll <- (lll%*%w) lll[ind] = lll[ind] + exp(log(ll.0[ind])-sca[ind]) siteLik <- lll siteLik <- log(siteLik) + sca # needs to change if(wMix >0) siteLik <- log(exp(siteLik) * (1-wMix) + llMix ) loglik <- sum(weight * siteLik) if(!site) return(loglik) resll = exp(resll) return(list(loglik=loglik, siteLik=siteLik, resll=resll)) } pml <- function (tree, data, bf = NULL, Q = NULL, inv = 0, k = 1, shape = 1, rate = 1, model=NULL, ...) { call <- match.call() extras <- match.call(expand.dots = FALSE)$... pmla <- c("wMix", "llMix") existing <- match(pmla, names(extras)) wMix <- ifelse(is.na(existing[1]), 0, eval(extras[[existing[1]]], parent.frame()) ) llMix <- ifelse(is.na(existing[2]), 0, eval(extras[[existing[2]]], parent.frame()) ) if(class(tree)!="phylo") stop("tree must be of class phylo") if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") if(any(tree$edge.length < 0)) { tree$edge.length[tree$edge.length < 0] <- 1e-08 message("negative edges length changed to 0!") } if (class(data)[1] != "phyDat") stop("data must be of class phyDat") if(is.null(tree$edge.length)) stop("tree must have edge weights") if(any(is.na(match(tree$tip, attr(data, "names"))))) stop("tip labels are not in data") data <- subset(data, tree$tip.label) # needed levels <- attr(data, "levels") weight <- attr(data, "weight") nr <- attr(data, "nr") type <- attr(data,"type") if(type=="AA" & !is.null(model)){ model <- match.arg(model, .aamodels) getModelAA(model, bf=is.null(bf), Q=is.null(Q)) } if(type=="CODON") Q <- as.numeric(.syn > 0) if (is.null(bf)) bf <- rep(1/length(levels), length(levels)) if (is.null(Q)) Q <- rep(1, length(levels) * (length(levels) - 1)/2) m <- 1 eig <- edQt(bf = bf, Q = Q) w <- rep(1/k, k) if (inv > 0) w <- (1 - inv) * w if (wMix > 0) w <- wMix * w g <- discrete.gamma(shape, k) if (inv > 0) g <- g/(1 - inv) g <- rate * g inv0 <- inv kmax <- k if(any(g<.gEps)){ for(i in 1:length(g)){ if(g[i]<.gEps){ inv <- inv+w[i] } } w <- w[g>.gEps] g <- g[g>.gEps] k <- length(w) } INV <- Matrix(lli(data, tree), sparse=TRUE) ll.0 <- as.matrix(INV %*% (bf * inv)) if(wMix>0) ll.0 <- ll.0 + llMix nr <- as.integer(attr(data, "nr")) nc <- as.integer(attr(data, "nc")) nTips <- as.integer(length(tree$tip.label)) on.exit(.C("ll_free")) .C("ll_init", nr, nTips, nc, as.integer(k)) tmp <- pml.fit(tree, data, bf, shape = shape, k = k, Q = Q, levels = attr(data, "levels"), inv = inv, rate = rate, g = g, w = w, eig = eig, INV = INV, ll.0 = ll.0, llMix = llMix, wMix = wMix, site=TRUE) df <- ifelse(is.ultrametric(tree), tree$Nnode, length(tree$edge.length)) if(type=="CODON"){ df <- df + (kmax>1) + (inv0 > 0) + length(unique(bf)) - 1 } else df = df + (kmax>1) + (inv0 > 0) + length(unique(bf)) - 1 + length(unique(Q)) - 1 result = list(logLik = tmp$loglik, inv = inv, k = kmax, shape = shape, Q = Q, bf = bf, rate = rate, siteLik = tmp$siteLik, weight = weight, g = g, w = w, eig = eig, data = data, model=model, INV = INV, ll.0 = ll.0, tree = tree, lv = tmp$resll, call = call, df=df, wMix=wMix, llMix=llMix) if(type=="CODON"){ result$dnds <- 1 result$tstv <- 1 } class(result) = "pml" result } optimRooted <- function(tree, data, eig=eig, w=w, g=g, bf=bf, rate=rate, ll.0=ll.0, INV=INV, control = pml.control(epsilon = 1e-08, maxit = 25, trace=0), ...){ tree$edge.length[tree$edge.length < 1e-08] <- 1e-08 # nicht richtig nTips = as.integer(length(tree$tip.label)) k = length(w) # optimising rooted triplets optRoot0 <- function(t, tree, data, g, w, eig, bf, ll.0, k){ l = length(tree$edge.length) tree$edge.length[1:(l-1)] = tree$edge.length[1:(l-1)] + t tree$edge.length[l] = tree$edge.length[l] - t loglik = pml.fit4(tree, data, bf=bf, g=g, w=w, eig=eig, INV=INV, ll.0=ll.0, k=k) # loglik } # optim edges leading to the root optRoot2 <- function(t, tree, data, g, w, eig, bf, ll.0, k){ tree$edge.length = tree$edge.length + t #c(el1+t, el2-t) loglik = pml.fit4(tree, data, bf=bf, g=g, w=w, eig=eig, INV=INV, ll.0=ll.0, k=k) #, INV=INV loglik } # scale whole tree scaleEdges = function(t=1, trace=0, tree, data, ...){ fn = function(t, tree, data,...){ tree$edge.length = tree$edge.length*t pml.fit4(tree, data, ...) } optimize(f=fn, interval=c(0.25,4), tree=tree, data=data, ..., maximum = TRUE, tol = .00001) } parent = tree$edge[, 1] child = tree$edge[, 2] anc <- Ancestors(tree, 1:max(tree$edge), "parent") sibs <- Siblings(tree, 1:max(tree$edge)) allKids <- cvector <- allChildren(tree) rootNode = getRoot(tree) child2 = orderNNI(tree, nTips) #(cvector, rootNode, nTips, TRUE) lengthList <- edgeList <- vector("list", max(tree$edge)) for(i in tree$edge[,2]){ pa <- anc[i] kids <- sibs[[i]] if(pa!=rootNode){ edgeList[[i]] <- cbind(pa, c(anc[pa], kids)) lengthList[[i]] <- c(pa, kids) } else{ edgeList[[i]] <- cbind(pa, kids) lengthList[[i]] <- kids } } treeList <- vector("list", max(child2)) for(i in child2){ pa <- anc[i] kids <- allKids[[i]] treeList[[i]] <- cbind(i, c(kids, pa)) } ll <- pml.fit4(tree, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) #, INV=INV # if(control$trace>2)cat("ll", ll, "\n") eps=10 iter = 1 EL = numeric(max(tree$edge)) EL[tree$edge[, 2]] = tree$edge.length eps0 =1e-8 tmp <- scaleEdges(t, trace=0, tree, data, bf = bf, k=k, ll.0=ll.0, eig = eig, w=w, g=g) # if(control$trace>2)cat("scale", tmp[[2]], "\n") t = tmp[[1]] tree$edge.length = tree$edge.length*t el = tree$edge.length EL[tree$edge[, 2]] = tree$edge.length ll2 <- pml.fit4(tree, data, bf=bf, k=k, eig=eig, INV=INV, ll.0=ll.0, w=w, g=g) tmptree = tree while(eps>control$eps && iter < control$maxit){ ll2 <- pml.fit4(tree, data, bf=bf, k=k, eig=eig, INV=INV, ll.0=ll.0, w=w, g=g) loli <- rootNode children <- allKids[[rootNode]] kidsEl <- EL[children] minEl = min(kidsEl) kidsEl = kidsEl - minEl tmptree$edge = cbind(rootNode, children) tmptree$edge.length = kidsEl t <- optimize(f=optRoot2,interval=c(1e-8,3), tmptree, data=data, k=k, g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, maximum=TRUE) optRoot2(t[[1]], tmptree, data=data, k=k, g=g, w=w, eig=eig, bf=bf, ll.0=ll.0) # if(control$trace>2)cat("optRoot", t[[2]], "\n") ll3 = t[[2]] EL[children] = kidsEl + t[[1]] tree$edge.length = EL[tree$edge[, 2]] ll2 <- pml.fit4(tree, data, bf=bf, k=k, eig=eig, INV=INV, ll.0=ll.0, w=w, g=g) for(i in 1:length(child2)){ dad = child2[i] # if(dad>nTips ){ # kann raus pa = anc[dad] while(loli != pa){ tmpKids= cvector[[loli]] tmpEdge = cbind(loli, tmpKids) pml.move(tmpEdge, EL[tmpKids], data, g, w, eig, k, nTips, bf) loli=anc[loli] } pml.move(edgeList[[dad]], EL[lengthList[[dad]]], data, g, w, eig, k, nTips, bf) children <- allKids[[dad]] kidsEl <- EL[children] minEl = min(kidsEl) maxEl = EL[dad] EDGE = treeList[[dad]] tmptree$edge = EDGE tmptree$edge.length = c(kidsEl, maxEl) t0 = optRoot0(0, tmptree, data, g, w, eig, bf, ll.0, k) t = optimize(f=optRoot0, interval=c(-minEl+eps0,maxEl-eps0), tmptree, data=data, g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, k=k, maximum=TRUE) # if(control$trace>2) cat("edge", t[[2]], "\n") if(!is.nan(t[[2]]) & t[[2]] > ll3){ optRoot0(t[[1]], tmptree, data=data, g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, k=k) EL[children] = kidsEl+t[[1]] EL[dad] = maxEl-t[[1]] ll3 = t[[2]] } else optRoot0(0, tmptree, data, g, w, eig, bf, ll.0, k) loli = dad # } } tree$edge.length = EL[tree$edge[, 2]] ll2 <- pml.fit(tree, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) eps = (ll - ll2) / ll2 if(control$trace>1) cat("optimRooted: ", ll, " -> ", ll2, "\n") ll=ll2 iter = iter+1 } list(tree=tree, logLik=ll, c(eps=eps, iter=iter)) } # copy node likelihoods from C to R getNodeLogLik = function(data, i, j=1L){ nr = attr(data, "nr") nc = attr(data, "nc") ntips = length(data) .Call("getLL", as.integer(i), as.integer(j-1L), as.integer(nr), as.integer(nc), as.integer(ntips)) } # copy scaling parameters from C to R getSC = function(data, k=1L){ nr = attr(data, "nr") ntips = length(data) .Call("getSCM", as.integer(k), as.integer(nr), as.integer(ntips)) } index.nni <- function (ch, cvector, pvector, root) { p1 = pvector[ch] k12 = cvector[[ch]] k3 = cvector[[p1]] k3 = k3[k3 != ch] kids = c(k12, k3, ch) parents = c(ch, ch, p1, p1) if (p1 != root){ k4 = pvector[p1] kids = c(kids, k4) parents = c(parents, p1) } cbind(parents, kids) } orderNNI <- function (tree, nTips){ res = reorder(tree)$edge[,2] res = res[res>nTips] res } rooted.nni <- function(tree, data, eig, w, g, bf, rate, ll.0, INV, control = pml.control(epsilon = 1e-08, maxit = 25, trace=0), ...){ ind0 = which(ll.0>0) contrast = attr(data, "contrast") tree$edge.length[tree$edge.length < 1e-08] <- 1e-08 nTips = as.integer(length(tree$tip.label)) k = length(w) if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder.phylo(tree, "postorder") if(!is.rooted(tree))stop("tree must be rooted") attr(tree, "order") = NULL weight = attr(data , "weight") nr = as.integer(attr(data , "nr")) nc = as.integer(attr(data , "nc")) getEL1 <- function(t, nh){ el = numeric(4) if(nh[1] > nh[2]){ el[2] = nh[1] -nh[2] tnh = nh[1] + t[1] } else{ el[1] = nh[2] -nh[1] tnh = nh[2] + t[1] } el[1:2] = el[1:2] + t[1] if(tnh > nh[3]) el[3] = el[3] + tnh - nh[3] else el[4] = el[4] - tnh + nh[3] el[3:4] = el[3:4] + t[2] el } optRootU <- function(t, tree, data, bf, g, w, eig, ll.0, k, INV, nh){ tree$edge.length = getEL1(t, nh) pml.fit4(tree, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) # pml.fit(tree, data, bf=bf, g=g, w=w, eig=eig, ll.0=ll.0, k=k, INV=INV) } getEL2 = function(t, nh){ el = numeric(5) eps= 1e-6 nh12.min = max(nh[1:2]) + eps nh123.min = max(nh12.min, nh[3]) + eps l1 = nh[5] - nh123.min - eps el[5] = l1 * t[1] + eps nh123 = nh[5] - el[5] l2 = nh123 - nh12.min - eps nh12 = nh12.min + l2 * t[2] el[1] = nh12 - nh[1] el[2] = nh12 - nh[2] el[3] = nh123 - nh[3] el[4] = nh123 - nh12 el } optEdgeU <- function(t, tree, data, bf, g, w, eig, ll.0, k, INV, nh){ tree$edge.length = getEL2(t, nh) # pml.fit(tree, data, bf=bf, g=g, w=w, eig=eig, ll.0=ll.0, k=k, INV=INV) pml.fit4(tree, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) } child = tree$edge[, 2] parent = tree$edge[, 1] # ll <- pml.fit(tree, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) ll <- pml.fit4(tree, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) llstart <- ll eps=.00001 iter = 1 EL = numeric(max(tree$edge)) EL[tree$edge[,2]] = tree$edge.length change = numeric(length(parent)) + 1 rootNode = getRoot(tree) anc = Ancestors(tree, 1:max(tree$edge), "parent") cvector = allChildren(tree) sibs <- Siblings(tree, 1:max(tree$edge)) child2 = orderNNI(tree, nTips) while(iter < 2){ ll2 <- pml.fit(tree, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) nh=nodeHeight(tree) loli <- rootNode pa <-rootNode nchanges = 0 ind=1 i <- 1 tree1 <- tree2 <- tree3 <- tree for(i in 1:length(child2)){ ch <- child2[i] dad <- anc[ch] if(ch>nTips){ EL[tree$edge[,2]] = tree$edge.length pa <- ifelse(dad==rootNode, rootNode ,anc[dad]) # should avoid unnecessary movements while(loli != dad && loli!=rootNode){ if(loli==pa){ tmpKids <- sibs[[dad]] tmpEdge <- cbind(pa, c(anc[pa], tmpKids)) pml.move(tmpEdge, EL[c(pa, tmpKids)], data, g, w, eig, k, nTips, bf) # cat("move from pa to dad \n") loli = dad } else{ # cat("move loli up", loli, "dad", dad, "pa", pa, "ch", ch, "\n") tmpKids = cvector[[loli]] tmpEdge = cbind(loli, tmpKids) pml.move(tmpEdge, EL[tmpKids], data, g, w, eig, k, nTips, bf) loli=anc[loli] } } if(loli == rootNode && dad!= loli){ # update all nodes pml.fit(tree, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) # cat("move down loli", loli, "dad", dad, "pa", pa, "ch", ch, "\n") gd <- rev(Ancestors(tree, ch, "all")) tmpKids <- sibs[[gd[2]]] tmpEdge <- cbind(rootNode, tmpKids) pml.move(tmpEdge, EL[tmpKids], data, g, w, eig, k, nTips, bf) gd = gd[-1] while(length(gd)>1){ tmpKids <- sibs[[gd[2]]] tmpEdge = cbind(gd[1], c(anc[gd[1]],tmpKids)) pml.move(tmpEdge, EL[c(gd[1],tmpKids)], data, g, w, eig, k, nTips, bf) gd = gd[-1] } loli=dad } X1 <- index.nni(ch, cvector, anc, rootNode) # if(loli!=rootNode){ # tmpKids <- c(ch, sibs[[ch]]) # tmpEdge <- cbind(dad, c(pa, tmpKids)) # tree1$edge <- tmpEdge # tree1$edge.length = EL[c(dad, tmpKids)] # ll0 = pml.fit(tree1, data, bf=bf, g=g, w=w, eig=eig, ll.0=ll.0, k=k, INV=INV) # cat("triplet", ll0, "\n") # } if(loli!=rootNode){ tree1$edge <- X1 tree1$edge.length = abs(nh[X1[,1]] - nh[X1[,2]]) # ll0 = pml.fit(tree1, data, bf=bf, g=g, w=w, eig=eig, ll.0=ll.0, k=k, INV=INV) ll0 <- pml.fit4(tree1, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) # cat("quartet", ll0, ch, dad, "\n") } if(dad == rootNode){ ll0 = pml.fit(tree, data, bf=bf, g=g, w=w, eig=eig, ll.0=ll.0, k=k, INV=INV) # cat("at root", ll0, ch, dad, "\n") ind2 = c(1,3,2,4) ind3 = c(3,2,1,4) X2 = X3 = X1 X2[,2] = X1[ind2, 2] X3[,2] = X1[ind3, 2] tree1$edge = X1 tree2$edge = X2 tree3$edge = X3 edge1 <- X1[,2] edge1[4] = dad res1 =optim(par = c(.1,.1), optRootU, gr=NULL, tree=tree1, data=data, nh=nh[X1[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k, method = "L-BFGS-B", lower = 1e-8, upper = 5, control = list(fnscale=-1)) res2 =optim(par = c(.1,.1), optRootU, gr=NULL, tree=tree2, data=data, nh=nh[X2[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k, method = "L-BFGS-B", lower = 1e-8, upper = 5, control = list(fnscale=-1)) res3 =optim(par = c(.1,.1), optRootU, gr=NULL, tree=tree3, data=data, nh=nh[X3[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k, method = "L-BFGS-B", lower = 1e-8, upper = 5, control = list(fnscale=-1)) ind = which.max(c(res1[[2]], res2[[2]], res3[[2]])) if(control$trace>2) cat("root", c(res1[[2]], res2[[2]], res3[[2]]), "\n") if(ind==1){ ll2 = res1[[2]] optRootU(t=res1[[1]], tree=tree1, data=data, nh=nh[X1[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k) tmpEL = getEL1(res1[[1]], nh[X1[,2]]) tree = changeEdgeLength(tree, X1[,2], tmpEL) } if(ind==2){ ll2 = res2[[2]] optRootU(t=res2[[1]], tree=tree2, data=data, nh=nh[X2[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k) tmpEL = getEL1(res2[[1]], nh[X2[,2]]) tree <- changeEdge(tree, X1[c(2,3),2]) tree = changeEdgeLength(tree, X2[,2], tmpEL) } if(ind==2){ ll2 = res3[[2]] optRootU(t=res3[[1]], tree=tree3, data=data, nh=nh[X3[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k) tmpEL = getEL1(res3[[1]], nh[X3[,2]]) tree <- changeEdge(tree, X1[c(1,3),2]) tree = changeEdgeLength(tree, X3[,2], tmpEL) } } else{ loli = dad ind2 = c(1,3,2,4,5) ind3 = c(3,2,1,4,5) X2 = X3 = X1 X2[,2] = X1[ind2, 2] X3[,2] = X1[ind3, 2] tree1$edge = X1 tree2$edge = X2 tree3$edge = X3 tt = c(.3,.5) res1 =optim(par = tt, optEdgeU, gr=NULL, tree=tree1, data, nh=nh[X1[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k, method = "L-BFGS-B", lower = 1e-4, upper = 1-1e-4, control = list(fnscale=-1)) res2 =optim(par = tt, optEdgeU, gr=NULL, tree=tree2, data, nh=nh[X2[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k, method = "L-BFGS-B", lower = 1e-4, upper = 1-1e-4, control = list(fnscale=-1)) res3 =optim(par = tt, optEdgeU, gr=NULL, tree=tree3, data, nh=nh[X3[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k, method = "L-BFGS-B", lower = 1e-4, upper = 1-1e-4, control = list(fnscale=-1)) ind = which.max(c(res1[[2]], res2[[2]], res3[[2]])) if(control$trace>2) cat("edge", ch, ":", c(res1[[2]], res2[[2]], res3[[2]]), "\n") ll3 = max(c(res1[[2]], res2[[2]], res3[[2]])) if( (ll3 - 1e-5*ll3) < ll2){ loli = rootNode # ll2 <- pml.fit(tree, data, bf=bf, eig=eig, ll.0=ll.0, w=w, g=g) ll2 <- pml.fit4(tree, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) nh=nodeHeight(tree) EL[tree$edge[,2]] = tree$edge.length ind=0 } else{ if(ind==1){ ll2 = res1[[2]] optEdgeU(res1[[1]], tree=tree1, data, nh=nh[X1[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k) tmpEL = getEL2(res1[[1]], nh[X1[,2]]) tmpE = X1[,2] tmpE[5] = X1[5,1] tree = changeEdgeLength(tree, tmpE, tmpEL) } if(ind==2){ ll2 = res2[[2]] optEdgeU(res2[[1]], tree=tree2, data, nh=nh[X2[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k) tmpEL = getEL2(res2[[1]], nh[X2[,2]]) tmpE = X2[,2] tmpE[5] = X1[5,1] tree <- changeEdge(tree, X1[c(2,3),2]) tree = changeEdgeLength(tree, tmpE, tmpEL) } if(ind==3){ ll2 = res3[[2]] optEdgeU(res3[[1]], tree=tree3, data, nh=nh[X3[,2]], g=g, w=w, eig=eig, bf=bf, ll.0=ll.0, INV=INV, k=k) tmpEL = getEL2(res3[[1]], nh[X3[,2]]) tmpE = X3[,2] tmpE[5] = X1[5,1] tree <- changeEdge(tree, X1[c(1,3),2]) tree = changeEdgeLength(tree, tmpE, tmpEL) } } } nh=nodeHeight(tree) EL[tree$edge[,2]] = tree$edge.length loli = dad if(ind>1){ # print("NNI swap") nchanges = nchanges+1 anc = Ancestors(tree, 1:max(tree$edge), "parent") cvector = allChildren(tree) sibs <- Siblings(tree, 1:max(tree$edge)) } } } # ll2 <- pml.fit(tree, data, bf=bf, g=g, w=w, eig=eig, ll.0=ll.0, k=k, INV=INV) ll2 <- pml.fit4(tree, data, bf=bf, k=k, eig=eig, ll.0=ll.0, INV=INV, w=w, g=g) eps = (ll - ll2) / ll2 if(control$trace>1) cat(ll, " -> ", ll2, "\n") if(control$trace>1) cat("swap:", nchanges) ll=ll2 iter = iter+1 } list(tree=tree, logLik=ll, iter=iter, swap=nchanges) } phangorn/R/neighborNet.R0000644000175100001440000001212012543036240014667 0ustar hornikusers# computes all n(n-1)/2 cyclic splits cyclicSplits <- function(k, labels=NULL){ k = as.integer(k) l = (k-1L) %/% 2L res <- vector("list", k*(k-1L)/2) res[1:k] = 1L:k ind = k if(k>3){ fun = function(x,y){ tmp = (1L:y)+x tmp %% (k+1L) + tmp %/% (k+1L) } if(k>4){ for(i in 2:l){ res[(ind+1):(ind+k)] <- lapply(0L:(k-1L), fun, i) ind <- ind+k } } if((k%%2L)==0){ m <- k%/%2 res[(ind+1):(ind+m)] <- lapply(0L:(m-1L), fun, m) } } if(is.null(labels)) labels=(as.character(1:k)) attr(res, 'labels') =labels attr(res, "cycle") = 1:k class(res)="splits" res } distC <- function(d, CL){ l=length(CL) res = matrix(0, l, l) for(i in 1:(l-1)){ for(j in (i+1):l) res[i,j] = mean.default(d[CL[[i]], CL[[j]]]) } res + t(res) } reduc <- function(d, x, y, z){ u <- 2/3* d[x, ] + d[y,]/3 v <- 2/3* d[z, ] + d[y,]/3 uv <- (d[x,y] + d[x,z] + d[y,z])/3 d[x, ] <- u d[, x] <- u d[z, ] <- v d[, z] <- v d[y, ] <- 0 d[, y] <- 0 d[x, z] <- d[z, x] <- uv diag(d) <- 0 d } # computes ordering getOrderingNN <- function (x) { x = as.matrix(x) labels <- attr(x, "Labels") if (is.null(labels)) labels = colnames(x) d = x #as.matrix(x) l = dim(d)[1] CL = vector("list", l) CL[1:l] <- ORD <- 1:l lCL <- length(CL) ord <- CL while (lCL>1){ i = 0 j = 0 # browser() DM = distC(d, CL) l = nrow(DM) if(l>2){ r = rowSums(DM)/(l - 2) tmp <- .C("out", as.double(DM), as.double(r), as.integer(l), as.integer(i), as.integer(j), PACKAGE = "phangorn") e1 = tmp[[4]] e2 = tmp[[5]] } else {e1 = 1 e2=2} n1 <- length(CL[[e1]]) n2 <- length(CL[[e2]]) if(n1==1 & n2==1){ newCL <- c(CL[[e1]], CL[[e2]]) newOrd = newCL CL = c(CL[-c(e1,e2)], list(newCL)) ord <- c(ord[-c(e1,e2)], list(newCL)) lCL <- lCL - 1L } else{ CLtmp = c(as.list(CL[[e1]]), as.list(CL[[e2]]), CL[-c(e1,e2)]) ltmp =length(CLtmp) DM2 = distC(d, CLtmp) if(ltmp>2) rtmp = rowSums(DM2)/(ltmp - 2) DM2 = DM2 - outer(rtmp, rtmp, "+") TMP = DM2[1:n1, (n1+1):(n1+n2)] #browser() # dtmp = d[CL[[e1]], CL[[e2]]] # rtmp = numeric(n1+n2) # for(ii in 1:(n1+n2)){ # for(jj in 1:ltmp){if(ii!=jj) rtmp[ii]=rtmp[ii] + mean.default(d[CLtmp[[ii]], CLtmp[[jj]]]) # } # } #browser() # rtmp = rtmp/(ltmp-2) # TMP2 = dtmp + rep(rtmp[1:n1],n2) + rep(rtmp[(n1+1):(n1+n2)], each=n1) #browser() blub = which.min(TMP) # print(blub) #print("blub") if(n1==2 & n2==1){ if(blub == 2){ newCL <- c(CL[[e1]][1], CL[[e2]]) newOrd <- c(CL[[e1]], ord[[e2]]) d <- reduc(d, CL[[e1]][1], CL[[e1]][2], CL[[e2]]) } else{ newCL <- c(CL[[e2]], CL[[e1]][2]) newOrd <- c(ord[[e2]], ord[[e1]]) d <- reduc(d, CL[[e2]], CL[[e1]][1], CL[[e1]][2]) } } if(n1==1 & n2==2){ if(blub==1){ newCL <- c(CL[[e1]], CL[[e2]][2]) newOrd <- c(CL[[e1]], ord[[e2]]) d <- reduc(d, CL[[e1]], CL[[e2]][1], CL[[e2]][2]) } else{ newCL <- c(CL[[e2]][1], CL[[e1]]) newOrd <- c(ord[[e2]], ord[[e1]]) d <- reduc(d, CL[[e2]][1], CL[[e2]][2], CL[[e1]]) } } if(n1==2 & n2==2){ if(blub==1){ newCL <- c(CL[[e1]][2], CL[[e2]][2]) newOrd <- c(rev(ord[[e1]]), ord[[e2]]) d <- reduc(d, CL[[e1]][2], CL[[e1]][1], CL[[e2]][1]) d <- reduc(d, CL[[e1]][2], CL[[e2]][1], CL[[e2]][2]) } if(blub==2){ newCL <- c(CL[[e1]][1], CL[[e2]][2]) newOrd <- c(ord[[e1]], ord[[e2]]) d <- reduc(d, CL[[e1]][1], CL[[e1]][2], CL[[e2]][1]) d <- reduc(d, CL[[e1]][1], CL[[e2]][1], CL[[e2]][2]) } if(blub==3){ newCL <- c(CL[[e1]][2], CL[[e2]][1]) newOrd <- c(rev(ord[[e1]]), rev(ord[[e2]])) d <- reduc(d, CL[[e1]][2], CL[[e1]][1], CL[[e2]][2]) d <- reduc(d, CL[[e1]][2], CL[[e2]][2], CL[[e2]][1]) } if(blub==4){ newCL <- c(CL[[e1]][1], CL[[e2]][1]) newOrd <- c(ord[[e1]], rev(ord[[e2]])) d <- reduc(d, CL[[e1]][1], CL[[e1]][2], CL[[e2]][2]) d <- reduc(d, CL[[e1]][1], CL[[e2]][2], CL[[e2]][1]) } } CL <- c(CL[-c(e1,e2)], list(newCL)) ord <- c(ord[-c(e1,e2)], list(newOrd)) lCL <- lCL - 1L } } newOrd } # neighborNet <- function(x, ord=NULL){ x = as.matrix(x) labels <- attr(x, "Labels")[[1]] if (is.null(labels)) labels = colnames(x) l <- length(labels) #browser() if(is.null(ord))ord <- getOrderingNN(x) spl <- cyclicSplits(l, labels[ord]) spl <- nnls.splits(spl, x) # nnls.split mit nnls statt quadprog attr(spl, "cycle") <- 1:l as.networx(spl) } phangorn/R/Densi.R0000644000175100001440000001607412507002037013476 0ustar hornikusersgetAges <- function(x){ fun=function(x) max(node.depth.edgelength(x)) height=NULL if(class(x)=="phylo") height <- fun(x) if(class(x)=="multiPhylo"){ if(!is.null(attr(x, "TipLabel"))){ x = unclass(x) x = .uncompressTipLabel(x) x = unclass(x) height = sapply(x, fun) } else{ x = unclass(x) height = sapply(x, fun) } } height } # from phytools code by Liam Revell with a few changes my.supertree<-function(trees,method=c("pratchet","optim.parsimony"), trace=0, ...){ # set method method<-method[1] # some minor error checking if(!class(trees)=="multiPhylo") stop("trees must be object of class 'multiPhylo.'") # compute matrix representation phylogenies X<-list() # list of bipartitions characters<-0 # number of characters for(i in 1:length(trees)){ temp<-prop.part(trees[[i]]) # find all bipartitions # create matrix representation of trees[[i]] in X[[i]] X[[i]]<-matrix(0,nrow=length(trees[[i]]$tip),ncol=length(temp)-1) for(j in 1:ncol(X[[i]])) X[[i]][c(temp[[j+1]]),j]<-1 rownames(X[[i]])<-attr(temp,"labels") # label rows if(i==1) species<-trees[[i]]$tip.label else species<-union(species,trees[[i]]$tip.label) # accumulate labels characters<-characters+ncol(X[[i]]) # count characters } XX<-matrix(data="?",nrow=length(species),ncol=characters,dimnames=list(species)) j<-1 for(i in 1:length(X)){ # copy each of X into supermatrix XX XX[rownames(X[[i]]),c(j:((j-1)+ncol(X[[i]])))]<-X[[i]][1:nrow(X[[i]]),1:ncol(X[[i]])] j<-j+ncol(X[[i]]) } # compute contrast matrix for phangorn contrast<-matrix(data=c(1,0,0,1,1,1),3,2,dimnames=list(c("0","1","?"),c("0","1")),byrow=TRUE) # convert XX to phyDat object XX<-phyDat(XX,type="USER",contrast=contrast) # estimate supertree if(method=="pratchet"){ if(hasArg(start)){ start<-list(...)$start if(class(start)=="phylo"){ supertree<-pratchet(XX,all=TRUE, trace=0, ...) } else { if(start=="NJ") start<-NJ(dist.hamming(XX)) else if(start=="random") start<-rtree(n=length(XX),tip.label=names(XX)) else { warning("do not recognize that option for start; using random starting tree") tree<-rtree(n=length(XX),tip.label=names(XX)) } args<-list(...) args$start<-start args$data<-XX args$all<-TRUE supertree<-do.call(pratchet,args) } } else supertree<-pratchet(XX,all=TRUE, trace=0, ...) if(class(supertree)=="phylo") if(trace>0)message(paste("The MRP supertree, optimized via pratchet(),\nhas a parsimony score of ", attr(supertree,"pscore")," (minimum ",characters,")",sep="")) else if(class(supertree)=="multiPhylo") if(trace>0)message(paste("pratchet() found ",length(supertree)," supertrees\nwith a parsimony score of ", attr(supertree[[1]],"pscore")," (minimum ",characters,")",sep="")) } else if(method=="optim.parsimony"){ if(hasArg(start)){ start<-list(...)$start if(class(start)=="phylo"){ supertree<-optim.parsimony(tree=start,data=XX, trace=0, ...) } else { if(start=="NJ") start<-NJ(dist.hamming(XX)) else if(start=="random") start<-rtree(n=length(XX),tip.label=names(XX)) else { warning("do not recognize that option for tree; using random starting tree") start<-rtree(n=length(XX),tip.label=names(XX)) } supertree<-optim.parsimony(tree=start,data=XX,...) } } else { if(trace>0)message("no input starting tree or option for optim.parsimony; using random addition tree") start<-random.addition(XX) # rtree(n=length(XX),tip.label=names(XX)) supertree<-optim.parsimony(tree=start,data=XX, trace=0, ...) } if(class(supertree)=="phylo") if(trace>0)message(paste("The MRP supertree, optimized via optim.parsimony(),\nhas a parsimony score of ", attr(supertree,"pscore")," (minimum ",characters,")",sep="")) else if(class(supertree)=="multiPhylo") if(trace>0)message(paste("optim.parsimony() found ",length(supertree)," supertrees\nwith a parsimony score of ", attr(supertree[[1]],"pscore")," (minimum ",characters,")",sep="")) } return(supertree) } # we want a rooted supertree superTree = function(tree, method="optim.parsimony", rooted=TRUE, ...){ fun = function(x){ x=reorder(x, "postorder") nTips = length(x$tip) x$edge[x$edge>nTips] = x$edge[x$edge>nTips] + 2L l=nrow(x$edge) oldroot = x$edge[l,1L] x$edge=rbind(x$edge,matrix(c(rep(nTips+2,2),oldroot,nTips+1),2L,2L)) x$edge.length=c(x$edge.length, 100, 100) x$tip.label=c(x$tip.label, "ZZZ") x$Nnode=x$Nnode+1L x } if(!is.null(attr(tree, "TipLabel")))tree = .uncompressTipLabel(tree) tree = unclass(tree) if(rooted) tree = lapply(tree, fun) class(tree)="multiPhylo" res = my.supertree(tree, method=method, ...) if(rooted){ if(class(res)=="multiPhylo"){ res = lapply(res, root, "ZZZ") res = lapply(res, drop.tip, "ZZZ") class(res) = "multiPhylo" } else{ res = root(res, "ZZZ") res = drop.tip(res, "ZZZ") } } if(class(res)=="multiPhylo"){ fun = function(x){ x$edge.length <- rep(.1, nrow(x$edge)) x } res <- lapply(res, fun) res <- lapply(res, reorder, "postorder") class(res) = "multiPhylo" } else{ res$edge.length = rep(.1, nrow(res$edge)) res <- reorder(res, "postorder") } res } densiTree <- function(x, type="cladogram", alpha=1/length(x), consensus=NULL, optim=FALSE, scaleX=FALSE, col=1, width=1, cex=.8, ...) { if(class(x)!="multiPhylo")stop("x must be of class multiPhylo") compressed <- ifelse(is.null(attr(x, "TipLabel")), FALSE, TRUE) if(is.null(consensus))consensus <- superTree(x) consensus = reorder(consensus, "postorder") e2 = reorder(consensus)$edge[,2] nTip = as.integer(length(consensus$tip)) tiporder = e2[e2<=nTip] maxBT = max(getAges(x)) if(scaleX) maxBT=1.0 label = rev(pretty(c(maxBT,0))) maxBT = max(label) xy = plotPhyloCoor(consensus, ...) yy = xy[,2] plot.new() tl = which.max(nchar(consensus$tip.label)) sw <- strwidth(consensus$tip.label[tl],cex=cex) * 1.1 plot.window(xlim=c(0, 1.0+sw), ylim=c(0, nTip+1)) axis(side=1,at=seq(0,1.0, length.out=length(label)), labels=label) text(x=rep(1.0,Ntip(consensus)),y=yy[1:nTip],labels=consensus$tip.label,pos=4,cex=cex) tip.order = yy[1:nTip] for (treeindex in 1:length(x)) { tmp <- reorder(x[[treeindex]], "postorder") xy <- plotPhyloCoor(tmp, tip.order=tiporder, ...) xx = xy[,1] yy = xy[,2] if(scaleX) xx <- xx/max(xx) else xx <- xx/maxBT xx <- xx + (1.0 - max(xx)) e1=tmp$edge[,1] e2=tmp$edge[,2] if(type=="cladogram") cladogram.plot(tmp$edge, xx, yy, edge.color=adjustcolor(col, alpha.f=alpha), edge.width=width, edge.lty=1) if(type=="phylogram"){ Ntip <- min(e1)-1L Nnode <- tmp$Nnode phylogram.plot(tmp$edge, Ntip, Nnode, xx, yy, TRUE, edge.color=adjustcolor(col, alpha.f=alpha), edge.width=width, 1) } } } phangorn/R/networx.R0000644000175100001440000012352112547300402014137 0ustar hornikusers# # splits format, networx, Matrix, lento plot # as.splits <- function (x, ...){ if(inherits(x, "splits")) return(x) UseMethod("as.splits") } as.Matrix <- function (x, ...){ if (class(x) == "Matrix") return(x) UseMethod("as.Matrix") } as.matrix.splits <- function(x, zero.print = 0L, one.print=1L, ...){ m = length(x) labels = attr(x, "labels") n = length(labels) res = matrix(zero.print, m, n) for(i in 1:m)res[i,x[[i]]]=one.print dimnames(res) = list(names(x), labels) res } as.Matrix.splits <- function(x, ...){ labels = attr(x, "labels") l = length(x) j = unlist(x) i = rep(1:l, sapply(x, length)) sparseMatrix(i,j, x = rep(1L, length(i)), dimnames = list(NULL, labels)) # included x und labels } print.splits <- function (x, maxp = getOption("max.print"), zero.print = ".", one.print="|", ...) { x.orig <- x cx <- as.matrix(x, zero.print = zero.print, one.print=one.print) print(cx, quote = FALSE, right = TRUE, max = maxp) invisible(x.orig) } "[.splits" = function(x, i){ tmp = attributes(x) result = unclass(x)[i] if(!is.null(tmp$weights)) tmp$weights = tmp$weights[i] if(!is.null(tmp$confidences)) tmp$confidences = tmp$confidences[i] if(!is.null(tmp$intervals)) tmp$intervals = tmp$intervals[i] if(!is.null(tmp$data)) tmp$data = tmp$data[i,, drop=FALSE] attributes(result) = tmp result } orderSplitLabel = function(x, order){ label = attr(x, "labels") nTips = length(label) ord = match(label, order) for(i in 1:length(x)) x[[i]] = sort(ord[x[[i]]]) attr(x, "labels") = order x } presenceAbsence <- function(x, y){ X <- as.splits(x) Y <- as.splits(y) labels <- attr(X, "labels") if(class(x)[1] == "phylo") X <- X[x$edge[,2]] if(class(y)[1] == "phylo") Y <- Y[y$edge[,2]] Y <- orderSplitLabel(Y, labels) nTips <- length(labels) X <- oneWise(X, nTips) Y <- oneWise(Y, nTips) res <- match(X, Y) res <- !is.na(res) if(inherits(x, "networx")){ res <- res[x$splitIndex] } res } optCycle <- function(splits, tree){ tips = tree$tip.label tree = reorder(tree) nodes = sort(unique(tree$edge[,1])) M = as.matrix(splits) l = as.integer(nrow(M)) m = as.integer(ncol(M)) tmp = tree$edge[,2] tmp = tmp[tmp<=m] start <- .C("countCycle", M[, tmp], l, m, integer(1))[[4]] best = start eps = 1 if(eps>0){ for(i in 1:length(nodes)){ tmptree = rotate(tree, nodes[i]) tmp = tmptree$edge[,2] tmp = tmp[tmp<=m] tmpC <- .C("countCycle", M[, tmp], l, m, integer(1))[[4]] if(tmpC < best){ best <- tmpC tree = tmptree } } eps = start - best } tree # list(best, tree) } countCycles <- function(splits, tree=NULL, ord=NULL){ M = as.matrix(splits) l = as.integer(nrow(M)) m = as.integer(ncol(M)) if(!is.null(tree)) ord = getOrdering(tree) res <- .C("countCycle2", M[, ord], l, m, integer(l))[[4]] res } c.splits <- function (..., recursive=FALSE) { x <- list(...) n <- length(x) match.names <- function(a, b) { if (any(!(a %in% b))) stop("names do not match previous names") } if (n == 1) return(x[[1]]) labels <- attr(x[[1]], "labels") cycle <- attr(x[[1]], "cycle") for (i in 2:n) { match.names(labels, attr(x[[i]], "labels")) } res = structure(NextMethod("c"), class=c("splits", "prop.part")) attr(res, "labels") = labels attr(res, "weight") = as.vector(sapply(x, attr, "weight")) attr(res, "cycle") = cycle res } # computes splits from phylo as.splits.phylo <- function(x, ...){ result = bip(x) if(!is.null(x$edge.length)){ edge.weights = numeric(max(x$edge)) edge.weights[x$edge[,2]] = x$edge.length attr(result, "weights") = edge.weights } attr(result, "labels") <- x$tip class(result) = c('splits', 'prop.part') result } # computes splits from multiPhylo object (e.g. bootstrap, MCMC etc.) as.splits.multiPhylo <- function(x, ...){ if(class(x)=="multiPhylo")x = .uncompressTipLabel(x) lx = length(x) if(class(x)=="multiPhylo")class(x)='list' # prop.part allows not yet multiPhylo firstTip = x[[1]]$tip[1] x = lapply(x, root, firstTip) # old trick splits <- prop.part(x) class(splits)='list' weights = attr(splits, 'number') lab = attr(splits,'labels') attr(splits,'labels') <- attr(splits, 'number') <- NULL l = length(lab) splitTips = vector('list', l) for(i in 1:l) splitTips[[i]] = i result = c(splitTips,splits) attr(result, "weights") = c(rep(lx, l), weights) attr(result, "confidences") <- attr(result, "weights") attr(result, "labels") <- lab class(result) = c('splits', 'prop.part') result } as.splits.prop.part <- function(x, ...){ if(is.null(attr(x, "number"))) attr(x, "weights") = rep(1, length(x)) else{ attr(x, "weights") = attr(x, "number") attr(x, "confidences") = attr(x, "number") } class(x) = c('splits', 'prop.part') x } as.splits.networx <- function(x, ...){ if(!is.null(attr(x, "splits")))attr(x, "splits") else warning("No split object included!") } as.prop.part.splits <- function(x, ...){ attr(x, "number") = attr(x, "weights") attr(x, "weights") = NULL class(x) = c('prop.part') x } as.phylo.splits <- function (x, result = "phylo", ...) { result <- match.arg(result, c("phylo", "all")) labels = attr(x, "labels") nTips = length(labels) weights = attr(x, "weights") nTips = length(labels) x = SHORTwise(x, nTips) dm = as.matrix(compatible(x)) rs = rowSums(dm) ind = which(rs == 0) if (any(rs > 0)) { tmp = which(rs > 0) candidates = tmp[order(rs[tmp])] for (i in candidates) { if (sum(dm[ind, i]) == 0) ind = c(ind, i) } } splits = x[ind] weights = weights[ind] l = length(ind) res = matrix(0L, l, nTips) for (i in 1:l) res[i, splits[[i]]] = 1L dm2 = (crossprod(res * weights, 1 - res)) dm2 = dm2 + t(dm2) dimnames(dm2) = list(labels, labels) tree <- di2multi(NJ(dm2), tol = 1e-08) attr(tree, "order") = NULL tree <- reorder(tree) tree <- optCycle(x, tree) tree <- reorder(tree, "postorder") if (result == "phylo") return(tree) # tree = reroot(tree, Ancestors(tree, 1, "parent")) spl = as.splits(tree) spl = SHORTwise(spl, nTips) spl <- spl[tree$edge[,2]] list(tree = tree, index = tree$edge[, 2], split = spl, rest = x[-ind]) } # computes compatible splits compatible <- function(obj){ labels = attr(obj, "labels") if(!inherits(obj, "splits"))stop("obj needs to be of class splits") l = length(labels) n = length(obj) bp = matrix(0L, n, l) for(i in 1:n)bp[i,obj[[i]]] = 1L bp[bp[, 1] == 0L, ] = 1L - bp[bp[, 1] == 0L, ] k=1 res = matrix(0L, n, n) tmp1 = tcrossprod(bp) #sum(bp[i,]* bp[j,]) tmp2 = tcrossprod(1L - bp) #sum((1L - bp[i,])*(1L - bp[j,])) tmp3 = tcrossprod(bp, 1L - bp) #sum(bp[i,]*(1L - bp[j,])) tmp4 = tcrossprod(1L - bp, bp) #sum((1L - bp[i,])*bp[j,]) res[(tmp1 * tmp2 * tmp3 * tmp4)>0]=1L k = k+1 res = res[lower.tri(res)] attr(res, "Size") <- n attr(res, "Diag") <- FALSE attr(res, "Upper") <- FALSE class(res) <- "dist" return(res) } compatible2 <- function (obj1, obj2=NULL) { if (!inherits(obj1, "splits")) stop("obj needs to be of class splits") labels = attr(obj1, "labels") l = length(labels) n = length(obj1) bp1 = as.matrix(obj1) bp1[bp1[, 1] == 0L, ] = 1L - bp1[bp1[, 1] == 0L, ] if(!is.null(obj2)){ m = length(obj2) bp2 = as.matrix(obj2) labels2 = attr(obj2, "labels") bp2 = bp2[, match(labels2, labels), drop=FALSE] bp2[bp2[, 1] == 0L, ] = 1L - bp2[bp2[, 1] == 0L, ] } else bp2 = bp1 if(is.null(obj2)) res = matrix(0L, n, n) else res = matrix(0L, n, m) tmp1 = tcrossprod(bp1, bp2) tmp2 = tcrossprod(1L - bp1, 1L - bp2) tmp3 = tcrossprod(bp1, 1L - bp2) tmp4 = tcrossprod(1L - bp1, bp2) res[(tmp1 * tmp2 * tmp3 * tmp4) > 0] = 1L if(is.null(obj2)){ res = res[lower.tri(res)] attr(res, "Size") <- n attr(res, "Diag") <- FALSE attr(res, "Upper") <- FALSE class(res) <- "dist" } return(res) } compatible3 <- function(x, y=NULL) { if (!inherits(x, "splits")) stop("x needs to be of class splits") if(is.null(y)) y <- x if (!inherits(y, "splits")) stop("y needs to be of class splits") xlabels = attr(x, "labels") ylabels = attr(y, "labels") if(identical(xlabels, ylabels)) labels = xlabels else labels = intersect(xlabels, ylabels) nx = length(x) ny = length(y) bp1 = as.matrix(x)[,labels, drop=FALSE] bp2 = as.matrix(y)[,labels, drop=FALSE] rs1 = rowSums(bp1) rs2 = rowSums(bp2) res = matrix(0L, nx, ny) tmp1 = tcrossprod(bp1, bp2) res = matrix(0L, nx, ny) for(i in 1:nx){ for(j in 1:ny){ if(tmp1[i, j]==rs1[i]) res[i,j] = 1 if(tmp1[i, j]==rs2[j]) res[i,j] = 2 if(tmp1[i, j]==rs1[i] & tmp1[i, j]==rs2[j])res[i,j] = 3 } } if(is.null(y)){ res = res[lower.tri(res)] attr(res, "Size") <- length(x) attr(res, "Diag") <- FALSE attr(res, "Upper") <- FALSE class(res) <- "dist" } return(res) } # # splits # splitsNetwork <- function(dm, splits=NULL, gamma=.1, lambda=1e-6, weight=NULL){ dm = as.matrix(dm) k = dim(dm)[1] if(!is.null(splits)){ tmp = which(sapply(splits, length)==k) splits = splits[-tmp] lab = attr(splits, "labels") dm = dm[lab, lab] } if(is.null(splits)){ X2 = designAll(k, TRUE) X=X2[[1]] } else X = as.matrix(splits2design(splits)) y = dm[lower.tri(dm)] if(is.null(splits))ind = c(2^(0:(k-2)),2^(k-1)-1) else ind = which(sapply(splits, length)==1) # y2 = lm(y~X[,ind]-1)$res n = dim(X)[2] ridge <- lambda * diag(n) ridge[ind,ind] <- 0 if(!is.null(weight)) Dmat <- crossprod(X * sqrt(weight)) + ridge else Dmat <- crossprod(X) + ridge if(!is.null(weight)) dvec <- crossprod(X * sqrt(weight),y * sqrt(weight)) else dvec <- crossprod(X, y) # Dmat <- as.matrix(Dmat) # dvec <- as.vector(dvec) ind1 <- rep(1,n) ind1[ind] <- 0 Amat <- cbind(ind1,diag(n)) bvec <- c(gamma, rep(0,n)) solution <- quadprog::solve.QP(Dmat,dvec,Amat,bvec=bvec, meq=1)$sol ind2 <- which(solution>1e-8) n2 <- length(ind2) ind3 = which(duplicated(c(ind2, ind), fromLast = TRUE)[1:n2]) ridge2 <- lambda * diag(n2) ridge2[ind3,ind3] <- 0 if(!is.null(weight)) Dmat <- crossprod(X[, ind2] * sqrt(weight)) + ridge2 else Dmat <- crossprod(X[, ind2]) + ridge2 if(!is.null(weight)) dvec <- crossprod(X[, ind2] * sqrt(weight),y * sqrt(weight)) else dvec <- crossprod(X[, ind2], y) Amat2 <- diag(n2) bvec2 <- rep(0, n2) solution2 <- quadprog::solve.QP(Dmat, dvec, Amat2)$sol RSS1 = sum((y-X[,ind2]%*%solution[ind2])^2) RSS2 = sum((y-X[,ind2]%*%solution2)^2) if(is.null(splits)){ splits = vector("list", length(ind2)) for(i in 1:length(ind2))splits[[i]] = which(X2[[2]][ind2[i],]==1) } else splits = splits[ind2] attr(splits, "weights") = solution[ind2] attr(splits, "unrestricted") = solution2 attr(splits, "stats") = c(df=n2, RSS_p = RSS1, RSS_u=RSS2) attr(splits,"labels") =dimnames(dm)[[1]] class(splits)='splits' return(splits) } allSplits = function(k, labels=NULL){ result <- lapply(1:(2^(k-1)-1),dec2Bin) if(is.null(labels)) labels=(as.character(1:k)) attr(result, 'labels') =labels class(result)='splits' result } allCircularSplits <- function(k, labels=NULL){ k = as.integer(k) l = (k-1L) %/% 2L res <- vector("list", k*(k-1L)/2) res[1:k] = 1L:k ind = k if(k>3){ fun = function(x,y){ tmp = (1L:y)+x tmp %% (k+1L) + tmp %/% (k+1L) } for(i in 2:l){ res[(ind+1):(ind+k)] <- lapply(0L:(k-1L), fun, i) ind <- ind+k } if((k%%2L)==0){ m <- k%/%2 res[(ind+1):(ind+m)] <- lapply(0L:(m-1L), fun, m) } } if(is.null(labels)) labels=(as.character(1:k)) attr(res, 'labels') =labels class(res)="splits" res } getIndex = function(left, right, n){ if(n1) # & l X[k,j]){ Vstop = ord[j-1] ordStop = j-1 } } fromTo <- ordStart:ordStop if(ordStart>ordStop) fromTo <- c(ordStart:nTips, 1:ordStop) fromTo = ord[fromTo] # print(fromTo) g = graph(t(res$edge), directed=FALSE) isChild = (rsY == (Y %*% X[k,]))[index] sp2 = NULL sp0 = NULL for(i in 2:length(fromTo)){ sptmp = get.shortest.paths(g, fromTo[i-1], fromTo[i], output=c("epath"))$epath[[1]] sp2 = c(sp2, sptmp[-c(1, length(sptmp))]) sp0 = c(sp0, sptmp) } sp0 = unique(sp0) if(length(sp2)>0){ # blub = which(dm[index[sp2], ind[k]]>0) TMP = rowSums(dm2[index[sp2], 1:k, drop=FALSE]) blub = which(TMP>0) sp2 = sp2[blub] } if(length(sp2)==0){ isChild = (rsY == (Y %*% X[k,]))[index] sp0 = which(isChild == TRUE) edge1 = unique(as.vector(res$edge[sp0,])) edge2 = as.vector(res$edge[-sp0,]) asdf = edge1 %in% edge2 sp = edge1[asdf] } if(length(sp2)>0) sp = unique(as.vector(t(res$edge[sp2,]))) parent = res$edge[,1] child = res$edge[,2] j = ord[which(X[k,]==1)] anc = unique(parent[match(j, child)]) maxVert = max(parent) l = length(sp) newVert = (maxVert+1) : (maxVert+l) sp01 = setdiff(sp0, sp2) for(i in 1:l) res$edge[sp01,][res$edge[sp01,]==sp[i]] = newVert[i] newindex = rep(ind[k], l) if(length(sp)>1)newindex = c(index[sp2], newindex) index = c(index, newindex) # connect new and old vertices newEdge = matrix(cbind(sp, newVert), ncol=2) if(length(sp)>1){ # copy edges qwer = match(as.vector(res$edge[sp2,]), sp) newEdge = rbind(matrix(newVert[qwer], ncol=2), newEdge) } res$edge = rbind(res$edge, newEdge) res$Nnode = max(res$edge) - nTips res$splitIndex = index res$edge.length <- rep(1, nrow(res$edge)) class(res) = c("networx", "phylo") attr(res, "order") = NULL #browser() } res$Nnode = max(res$edge) - nTips res$splitIndex = index res$edge.length = weight[index] # ausserhalb attr(res, "splits") = x class(res) = c("networx", "phylo") attr(res, "order") = NULL res } as.networx <- function (x, ...) { if (inherits(x, "networx")) return(x) UseMethod("as.networx") } getOrdering <- function(x){ tree = as.phylo(x) nTips = length(tree$tip) ord = reorder(tree)$edge[,2] ord = ord[ord<=nTips] ind = which(ord == 1L) if(ind>1) ord = c(ord[ind:nTips], ord[c(1:(ind-1L))]) ord } addTrivialSplits <- function(obj){ label <- attr(obj, "label") nTips <- length(label) weight <- attr(obj, "weights") if(is.null(weight)) weight = rep(1, length(obj)) STree = stree(nTips, tip.label = attr(obj, "labels")) STree$edge.length=NULL spRes <- as.splits(STree)[STree$edge[,2]] tmpIndex = match(spRes, SHORTwise(obj, nTips)) if(any(is.na(tmpIndex))){ l.na = sum(is.na(tmpIndex)) obj <- c(obj, spRes[is.na(tmpIndex)]) weight = c(weight, rep(0, l.na)) attr(obj, "weights") <- weight } obj } as.networx.splits <- function(x, planar=FALSE, ...){ label <- attr(x, "label") x = addTrivialSplits(x) nTips <- length(label) weight <- attr(x, "weights") if(is.null(weight)) weight = rep(1, length(x)) attr(x, "weights") <- weight x <- oneWise(x, nTips) l <- sapply(x, length) if(any(l==nTips))x <- x[l!=nTips] # get rid of trivial splits ext <- sum(l==1 | l==(nTips-1)) if(!is.null(attr(x, "cycle"))){ c.ord <- attr(x, "cycle") } else c.ord <- getOrdering(x) attr(x, "cycle") = c.ord dm <- as.matrix(compatible2(x)) # which splits are in circular ordering circSplits = which(countCycles(x, ord=c.ord)==2) if(length(circSplits) == length(x)) planar=TRUE tmp = circNetwork(x, c.ord) attr(tmp, "order") = NULL if(planar){ return(reorder(tmp)) } ll <- sapply(x, length) ind <- tmp$splitIndex # match(sp, x) ind2 = union(ind, which(ll==0)) # which(duplicated(x)) ind2 = union(ind2, which(ll==nTips)) ord <- order(colSums(dm)) ord <- setdiff(ord, ind2) if(length(ord)>0){ for(i in 1:length(ord)){ tmp = addEdge(tmp, x, ord[i]) tmp$edge.length = weight[tmp$splitIndex] tmp$Nnode = max(tmp$edge) - nTips class(tmp) = c("networx", "phylo") } } tmp$Nnode = max(tmp$edge) - nTips tmp$edge.length = weight[tmp$splitIndex] attr(x, "cycle") <- c.ord attr(tmp, "splits") = x class(tmp) = c("networx", "phylo") tmp <- reorder(tmp) tmp } #as.igraph.networx <- function(x, directed=FALSE){ # graph(t(x$edge), directed=directed) #} consensusNet <- function (obj, prob = 0.3, ...) { l = length(obj) spl = as.splits(obj) w = attr(spl, "weights") ind = (w/l) > prob spl = spl[ind] attr(spl, "confidences") = round((w/l)[ind]*100) # attr(spl, "weights") = w[ind] res = as.networx(spl) res$edge.labels = as.character(res$edge.length / l * 100) res$edge.labels[res$edge[,2]<=length(res$tip.label)] = "" reorder(res) } addConfidences <- function (obj, phy) UseMethod("addConfidences") addConfidences.splits <- function(obj, phy){ tiplabel <- attr(obj, "label") obj = addTrivialSplits(obj) ind <- match(tiplabel, phy$tip.label) if (any(is.na(ind)) | length(tiplabel) != length(phy$tip.label)) stop("trees have different labels") phy$tip.label <- phy$tip.label[ind] ind2 <- match(1:length(ind), phy$edge[, 2]) phy$edge[ind2, 2] <- order(ind) spl <- as.splits(phy) nTips <- length(tiplabel) spl <- SHORTwise(spl, nTips) ind <- match(SHORTwise(obj, nTips), spl) pos <- which(ind > nTips) confidences <- character(length(obj)) confidences[pos] <- phy$node.label[ind[pos] - nTips] attr(obj, "confidences") <- confidences obj } addConfidences.networx <- function(obj, phy){ spl <- attr(obj, "splits") spl <- addConfidences(spl, phy) attr(obj, "splits") <- spl obj } addConfidences.phylo <- function(obj, phy){ conf = attr(addConfidences(as.splits(obj), phy), "confidences") nTips = length(obj$tip.label) obj$node.label = conf[-c(1:nTips)] obj } reorder.networx <- function (x, order = "cladewise", ...) { order <- match.arg(order, c("cladewise", "postorder")) if (!is.null(attr(x, "order"))) if (attr(x, "order") == order) return(x) g <- graph(t(x$edge)) if(order == "cladewise") neword <- topological.sort(g, "out") else neword <- topological.sort(g, "in") neworder <- order(match(x$edge[,1], neword)) x$edge <- x$edge[neworder, ] if (!is.null(x$edge.length)) x$edge.length <- x$edge.length[neworder] if (!is.null(x$edge.labels)) x$edge.labels <- x$edge.labels[neworder] if (!is.null(x$splitIndex))x$splitIndex <- x$splitIndex[neworder] attr(x, "order") <- order x } coords <- function(obj, dim="3D"){ # if(is.null(attr(obj,"order")) || (attr(obj, "order")=="postorder") ) # obj = reorder.networx(obj) l = length(obj$edge.length) ind1 = which(!duplicated(obj$splitIndex)) n = max(obj$edge) adj = Matrix::spMatrix(n, n, i = obj$edge[,2], j = obj$edge[,1], x = rep(1, length(obj$edge.length))) g = graph.adjacency(adj, "undirected") ########## # add this # g2 <- graph(t(obj$edge), directed=FALSE) # g2 <- set.edge.attribute(g, "weight", value=rep(1, nrow(obj$edge)) if(dim=="3D"){ coord <- layout.kamada.kawai(g, dim=3) k = matrix(0, max(obj$split), 3) for(i in ind1){ tmp = coord[obj$edge[i, 2],] - coord[obj$edge[i, 1],] k[obj$split[i], ] = kart2kugel(tmp[1], tmp[2], tmp[3]) } k[obj$split[ind1],1] = obj$edge.length[ind1] res = matrix(0, vcount(g), 3) for(i in 1:l){# unique(obj$split) j = obj$edge[i,1] m = obj$edge[i,2] p = obj$split[i] res[m,] = res[j,] + kugel2kart(k[p,1], k[p,2], k[p,3]) } } else{ coord <- layout.kamada.kawai(g, dim=2) k = matrix(0, max(obj$split), 2) for(i in ind1){ tmp = coord[obj$edge[i, 2],] - coord[obj$edge[i, 1],] k[obj$split[i], ] = kart2kreis(tmp[1], tmp[2]) } k[obj$split[ind1],1] = obj$edge.length[ind1] res = matrix(0, vcount(g), 2) for(i in 1:l){# unique(obj$split) j = obj$edge[i,1] m = obj$edge[i,2] p = obj$split[i] res[m,] = res[j,] + kreis2kart(k[p,1], k[p,2]) } } res } kart2kugel <- function(x,y,z){ r = sqrt(x*x+y*y+z*z) alpha = atan(sqrt(x*x+y*y) / z) if(z<0) alpha = alpha+pi beta = atan(y/x) if(x<0) beta = beta+pi c(r,alpha,beta) } kart2kreis <- function(x,y){ r = sqrt(x*x+y*y) alpha = atan(y/x) if(x<0) alpha = alpha+pi c(r,alpha) } kreis2kart <- function(r,alpha){ c(r*cos(alpha), r*sin(alpha)) } kugel2kart <- function(r,alpha,beta){ x = r * sin(alpha) * cos(beta) y = r * sin(alpha) * sin(beta) z = r * cos(alpha) c(x,y,z) } edgeLabels <- function(xx,yy,zz=NULL, edge){ XX <- (xx[edge[, 1]] + xx[edge[, 2]])/2 YY <- (yy[edge[, 1]] + yy[edge[, 2]])/2 if(!is.null(zz)){ ZZ <- (zz[edge[, 1]] + zz[edge[, 2]])/2 return(cbind(XX, YY, ZZ)) } cbind(XX, YY) } .check.pkg <- function (pkg) { if (pkg %in% rownames(installed.packages())) { require(pkg, character.only = TRUE) return(TRUE) } else return(FALSE) } plot.networx = function(x, type="3D", use.edge.length = TRUE, show.tip.label=TRUE, show.edge.label=FALSE, edge.label=NULL, show.node.label = FALSE, node.label=NULL, show.nodes=FALSE, tip.color = "blue", edge.color="grey", edge.width = 3, edge.lty = 1, font = 3, cex = 1, ...){ type = match.arg(type, c("3D", "2D")) if(use.edge.length==FALSE) x$edge.length[] = 1 x = reorder(x) nTips = length(x$tip.label) conf = attr(attr(x, "splits"),"confidences") index = x$splitIndex if(is.null(edge.label) & !is.null(conf))edge.label = conf[index] if(is.null(node.label))node.label = as.character(1:max(x$edge)) if(show.tip.label)node.label[1:nTips] = "" chk <- FALSE if(type=="3D") chk <- requireNamespace("rgl", quietly = TRUE) #.check.pkg("rgl") if(!chk && type=="3D"){ warning("type=\"3D\" requires the package \"rgl\"\n, plotting =\"2D\" instead!\n") type="2D" } if(type=="3D") { coord <- coords(x, dim="3D") plotRGL(coord, x, show.tip.label=show.tip.label, show.edge.label=show.edge.label, edge.label = edge.label, show.node.label = show.node.label, node.label=node.label, show.nodes=show.nodes, tip.color = tip.color, edge.color=edge.color, edge.width = edge.width, font = font, cex = cex) } else{ coord <- coords(x, dim="2D") plot2D(coord, x, show.tip.label=show.tip.label, show.edge.label=show.edge.label, edge.label = edge.label, show.node.label = show.node.label, node.label=node.label, show.nodes=show.nodes, tip.color = tip.color, edge.color=edge.color, edge.width = edge.width, edge.lty=edge.lty,font = font, cex = cex, add=FALSE) } } plotRGL <- function(coords, net, show.tip.label=TRUE, show.edge.label=FALSE, edge.label=NULL, show.node.label=FALSE, node.label=NULL, show.nodes=FALSE, tip.color = "blue", edge.color="grey", edge.width = 3, font = 3, cex = par("cex"), ...){ # chk <- .check.pkg("rgl") # if(!chk) open3d <- segments3d <- spheres3d <- rgl.texts <- function(...)NULL open3d <- rgl::open3d segments3d <- rgl::segments3d spheres3d <- rgl::spheres3d rgl.texts <- rgl::rgl.texts edge = net$edge x = coords[,1] y = coords[,2] z = coords[,3] nTips = length(net$tip.label) segments3d(x[t(edge)],y[t(edge)],z[t(edge)], col=edge.color, lwd=edge.width) radius=0 if(show.nodes){ radius = sqrt((max(x)-min(x))^2 + (max(y)-min(y))^2 + (max(z)-min(z))^2) / 200 spheres3d(x[1:nTips], y[1:nTips],z[1:nTips], radius=2*radius, color="cyan") spheres3d(x[-c(1:nTips)], y[-c(1:nTips)],z[-c(1:nTips)], radius=radius, color="magenta") } if(show.tip.label){ rgl.texts(x[1:nTips]+2.05*radius,y[1:nTips],z[1:nTips],net$tip.label, color=tip.color, cex=cex, font=font) } if(show.edge.label){ ec = edgeLabels(x, y, z, edge) if(is.null(edge.label)) edge.label = net$splitIndex #else edge.label = net$splitIndex rgl.texts(ec[,1], ec[,2], ec[,3], edge.label, color=tip.color, cex=cex, font=font) } if(show.node.label){ rgl.texts(x, y, z, node.label, color=tip.color, cex=cex, font=font) } } plot2D <- function(coords, net, show.tip.label=TRUE, show.edge.label=FALSE, edge.label=NULL, show.node.label=FALSE, node.label=NULL, tip.color = "blue", edge.color="grey", edge.width = 3, edge.lty=1, font = 3, cex = par("cex"), add=FALSE, ...){ edge = net$edge label = net$tip.label xx = coords[,1] yy = coords[,2] nTips = length(label) # cex=1 xlim <- range(xx) ylim <- range(yy) if(show.tip.label){ offset <- max(nchar(label)) * 0.018 * cex * diff(xlim) xlim = c(xlim[1]-offset, xlim[2]+offset) ylim = c(ylim[1]-0.03 * cex * diff(ylim), ylim[2]+0.03 * cex * diff(ylim)) } if(!add){ plot.new() plot.window(xlim, ylim, asp=1) } cladogram.plot(edge, xx, yy, edge.color, edge.width, edge.lty) if(show.tip.label){ ind=match(1:nTips, edge[,2]) pos = rep(4, nTips) XX <- xx[edge[ind, 1]] - xx[edge[ind, 2]] pos[XX>0] = 2 YY <- yy[edge[ind, 1]] - yy[edge[ind, 2]] pos2 <- rep(3, nTips) pos2[YY>0] = 1 pos[abs(YY)>abs(XX)] <- pos2[abs(YY)>abs(XX)] text(xx[1:nTips], yy[1:nTips], labels=label, pos=pos, col=tip.color, cex=cex, font=font) } if(show.edge.label){ ec = edgeLabels(xx,yy, edge=edge) if(is.null(edge.label))edge.label = net$splitIndex text(ec[,1], ec[,2], labels=edge.label, col=tip.color, cex=cex, font=font) } if(show.node.label){ text(xx, yy, labels=node.label, col=tip.color, cex=cex, font=font) } } lento <- function (obj, xlim = NULL, ylim = NULL, main = "Lento plot", sub = NULL, xlab = NULL, ylab = NULL, bipart=TRUE, trivial=FALSE, ...) { if (class(obj) == "phylo") obj = as.splits(obj) if (class(obj) == "multiPhylo") obj = as.splits(obj) labels = attr(obj, "labels") l = length(labels) if(!trivial){ triv = sapply(obj, length) ind = logical(length(obj)) ind[(triv >1) & (triv < (l-1))] = TRUE obj = obj[ind] } CM = compatible(obj) support = attr(obj, "weights") if (is.null(support)) support = rep(1, length(obj)) conflict = -as.matrix(CM) %*% support n = length(support) if (is.null(ylim)) { eps = (max(support) - min(conflict)) * 0.05 ylim = c(min(conflict) - eps, max(support) + eps) } if (is.null(xlim)) { xlim = c(0, n + 1) } ord = order(support, decreasing = TRUE) support = support[ord] conflict = conflict[ord] plot.new() plot.window(xlim, ylim) title(main = main, sub = sub, xlab = xlab, ylab = ylab, ...) segments(0:(n - 1), support, y1 = conflict, ...) segments(1:n, support, y1 = conflict, ...) segments(0:(n - 1), support, x1 = 1:n, ...) segments(0:(n - 1), conflict, x1 = 1:n, ...) abline(h = 0) axis(2, ...) aty = diff(ylim)/(l+1) at = min(ylim) + (1:l) * aty if(bipart){ Y = rep(at, n) X = rep((1:n)-.5, each=l) Circles = matrix(1, l, n) for(i in 1:n) Circles[obj[[ord[i]]],i] = 19 # axis(4, labels=labels, at=at) text(x=n+.1,y=at, labels, pos=4, ...) points(X,Y,pch = as.numeric(Circles), col = rgb(0,0,0,.5), ...) } invisible(cbind(support, conflict)) } write.splits = function (x, file = "", zero.print = ".", one.print = "|", print.labels = TRUE, ...) { labels = attr(x, "labels") x.orig <- x cx <- as.matrix(x, zero.print = zero.print, one.print = one.print) w = FALSE if (!is.null(attr(x, "names"))) { nam = TRUE vnames = format(attr(x, "names")) } nam = FALSE if (!is.null(attr(x, "weights"))) { w = TRUE weight = format(attr(x, "weights")) } d = FALSE if (!is.null(attr(x, "data"))) { d = TRUE data = attr(x, "data") } if(print.labels){for(i in 1:length(labels)) cat(labels[i], "\n", file = file, append = TRUE)} if (w) cat("weight", "\t", file = file, append = TRUE) if (d) cat(paste(colnames(data), "\t"), file = file, append = TRUE) cat("\n", file = file, append = TRUE) #"Matrix", for (i in 1:length(x)) { if (nam) cat(vnames[i], "\t", file = file, append = TRUE) if (d) cat(paste(data[i, ], "\t"), file = file, append = TRUE) if (w) cat(weight[i], "\t", file = file) cat("\n", paste(cx[i, ], collapse = ""),"\n", file = file, append = TRUE) } } write.nexus.splits <- function (obj, file = "", weights=NULL) { if(is.null(weights))weight <- attr(obj, "weights") taxa.labels <- attr(obj, "labels") ntaxa = length(taxa.labels) nsplits = length(obj) if (is.null(weight)) weight = numeric(nsplits) + 100 cat("#NEXUS\n\n", file = file) cat("[Splits block for Spectronet or Splitstree]\n", file = file, append = TRUE) cat("[generated by phangorn:\n", file = file, append = TRUE) cat(format(citation("phangorn"), "text"), "]\n\n", file = file, append = TRUE) cat(paste("BEGIN TAXA;\n\tDIMENSIONS NTAX=", ntaxa, ";\n", sep = ""), file = file, append = TRUE) cat("\tTAXLABELS", paste(taxa.labels, sep = " "), ";\nEND;\n\n", file = file, append = TRUE) cat(paste("BEGIN SPLITS;\n\tDIMENSIONS NSPLITS=", nsplits, ";\n", sep = ""), file = file, append = TRUE) format = "\tFORMAT labels=left weights=yes" fcon = fint = flab = FALSE if(!is.null(attr(obj, "confidences"))){ format = paste(format, "confidences=yes") fcon=TRUE conf = attr(obj, "confidences") if(storage.mode(conf) == "character"){ conf[conf==""] = "0" attr(obj, "confidences") = conf } } else format = paste(format, "confidences=no") if(!is.null(attr(obj, "intervals"))){ format = paste(format, "intervals=yes") fint=TRUE } else format = paste(format, "intervals=no") if(!is.null(attr(obj, "splitlabels"))) flab=TRUE format = paste(format, ";\n", sep = "") cat(format, file = file, append = TRUE) cat("\tMATRIX\n", file = file, append = TRUE) obj = oneWise(obj, ntaxa) for (i in 1:nsplits){ slab <- ifelse(flab, attr(obj, "splitlabels")[i], i) scon <- ifelse(fcon, paste(attr(obj, "confidences")[i], "\t"), "") sint <- ifelse(fint, paste(attr(obj, "intervals")[i], "\t"), "") cat("\t\t", slab, "\t", weight[i], "\t", scon, sint, paste(obj[[i]], collapse=" "), ",\n", file = file, append = TRUE, sep = "") } cat("\t;\nEND;\n", file = file, append = TRUE) } read.nexus.splits <- function(file) { X <- scan(file = file, what = "", sep = "\n", quiet = TRUE) semico <- grep(";", X) X=gsub("\\[(.*?)\\]", "", X) # get rid of comments i1 <- grep("TAXLABELS", X, ignore.case = TRUE) taxlab <- TRUE if (taxlab) { end <- semico[semico > i1][1] x <- X[(i1 + 1):end] # assumes there's a 'new line' after "TRANSLATE" ## x <- gsub("TRANSLATE", "", x, ignore.case = TRUE) x <- unlist(strsplit(x, "[,; \t]")) x <- x[nzchar(x)] x <- gsub("['\"]", "", x) xntaxa <- length(x) } sp <- grep("SPLITS;", X, ignore.case = TRUE) spEnd <- grep("END;", X, ignore.case = TRUE) spEnd <- spEnd[spEnd>sp][1] dims <- grep("DIMENSION", X, ignore.case = TRUE) cyc <- grep("CYCLE", X, ignore.case = TRUE) matr <- grep("MATRIX", X, ignore.case = TRUE) format <- grep("FORMAT", X, ignore.case = TRUE) start <- matr[matr>sp][1] + 1 end <- semico[semico>start][1] -1 format <- format[(format>sp) & (format0){ tmp = X[format] tmp = gsub("\\;", "", tmp) tmp = gsub("\\s+", "", tmp) flab = grepl("labels=left", tmp, ignore.case = TRUE) fwei = grepl("weights=yes", tmp, ignore.case = TRUE) fcon = grepl("confidences=yes", tmp, ignore.case = TRUE) fint = grepl("intervals=yes", tmp, ignore.case = TRUE) # = as.numeric(na.omit(as.numeric(strsplit(tmp, " ")[[1]]))) ind = cumsum(c(flab, fwei, fcon, fint)) mformat = sum(c(flab, fwei, fcon, fint)) } if(fint)intervals = numeric(end - start + 1) if(fcon)confidences = numeric(end - start + 1) if(flab)labels = vector("character", end - start + 1) for(i in start:end){ tmp = X[i] tmp = sub("\\s+", "", tmp) tmp = strsplit(tmp, "\t")[[1]] if(flab)labels[j] = as.numeric(tmp[ind[1]]) if(fwei)weights[j] = as.numeric(tmp[ind[2]]) if(fcon)confidences[j] = as.numeric(tmp[ind[3]]) if(fint)intervals[j] = as.numeric(tmp[ind[4]]) tmp = tmp[length(tmp)] tmp = gsub("\\,", "", tmp) res[[j]] = as.integer(na.omit(as.numeric(strsplit(tmp, " ")[[1]]))) j=j+1 } if(length(cyc)>0){ tmp = X[cyc] tmp = gsub("\\;", "", tmp) tmp = gsub("CYCLE", "", tmp, ignore.case = TRUE) tmp = sub("\\s+", "", tmp) cyc = as.integer(na.omit(as.numeric(strsplit(tmp, " ")[[1]]))) } attr(res, "labels") = x attr(res, "weights") = weights if(fint)attr(res, "intervals") = intervals if(fcon)attr(res, "confidences") = confidences if(flab)attr(res, "splitlabels") = labels attr(res, "cycle") = cyc class(res) = c("splits", "prop.part") res } # # ancestral sequences ML # ancestral.pml <- function (object, type=c("ml", "bayes")) { call <- match.call() type <- match.arg(type) pt <- match.arg(type, c("ml", "bayes")) tree = object$tree INV <- object$INV inv <- object$inv data = getCols(object$data, tree$tip) if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") q = length(tree$tip.label) node <- tree$edge[, 1] edge <- tree$edge[, 2] m = length(edge) + 1 # max(edge) w = object$w g = object$g l = length(w) nr <- attr(data, "nr") nc <- attr(data, "nc") dat = vector(mode = "list", length = m*l) result = vector(mode = "list", length = m) dim(dat) <- c(l,m) x = attributes(data) label = as.character(1:m) nam = tree$tip.label label[1:length(nam)] = nam x[["names"]] = label tmp = length(data) result = new2old.phyDat(data) eig = object$eig bf = object$bf el <- tree$edge.length P <- getP(el, eig, g) nr <- as.integer(attr(data, "nr")) nc <- as.integer(attr(data, "nc")) node = as.integer(node - min(node)) edge = as.integer(edge - 1) nTips = as.integer(length(tree$tip)) mNodes = as.integer(max(node) + 1) contrast = attr(data, "contrast") nco = as.integer(dim(contrast)[1]) for(i in 1:l)dat[i,(q + 1):m] <- .Call("LogLik2", data, P[i,], nr, nc, node, edge, nTips, mNodes, contrast, nco, PACKAGE = "phangorn") parent <- tree$edge[, 1] child <- tree$edge[, 2] nTips = min(parent) - 1 for(i in 1:l){ for (j in (m - 1):1) { if (child[j] > nTips){ tmp2 = (dat[[i, parent[j]]]/(dat[[i,child[j]]] %*% P[[i,j]])) dat[[i, child[j]]] = (tmp2 %*% P[[i,j]]) * dat[[i, child[j]]] } } } for (j in unique(parent)) { tmp <- matrix(0, nr, nc) if(inv>0) tmp = as.matrix(INV) * inv for(i in 1:l){ tmp = tmp + w[i] * dat[[i, j]] } if (pt == "bayes") tmp = tmp * rep(bf, each=nr) tmp = tmp / rowSums(tmp) result[[j]] = tmp } attributes(result) = x attr(result, "call") <- call result } fast.tree = function(tree, node){ parent = c(node, Ancestors(tree, node)) children = Descendants(tree, parent, 'children') l = sapply(children, length) edge = cbind(rep(parent, l), unlist(children)) obj = list(edge=edge, Nnode=sum(l>0), tip.label=as.character(edge[is.na(match(edge[,2], edge[,1])),2])) class(obj) = 'phylo' obj } # schneller ??? fast.tree2 = function(tree, node){ parent = c(node, Ancestors(tree, node)) edge = tree$edge ind = match(edge[,1], parent) edge=edge[which(!is.na(ind)),] obj = list(edge=edge, Nnode=length(parent), tip.label=as.character(edge[is.na(match(edge[,2], edge[,1])),2])) class(obj) = 'phylo' obj } phangorn/R/phyDat.R0000644000175100001440000007270512536055173013703 0ustar hornikusers# # Data structures for ML and MP # fast.table <- function (data) { if(!is.data.frame(data)) data = as.data.frame(data, stringsAsFactors = FALSE) da = do.call("paste", c(data, sep = "\r")) ind = !duplicated(da) levels = da[ind] cat <- factor(da,levels = levels) nl <- length(levels(cat)) bin <- (as.integer(cat) - 1) pd <- nl bin <- bin[!is.na(bin)] if (length(bin)) bin <- bin + 1 y <- tabulate(bin, pd) result=list(index = bin, weights = y, data = data[ind,]) result } phyDat.default <- function (data, levels = NULL, return.index = TRUE, contrast = NULL, ambiguity = "?", compress=TRUE, ...) { if (is.matrix(data)) nam = row.names(data) else nam = names(data) if(is.null(nam))stop("data object must contain taxa names") if (class(data) == "DNAbin") data = as.character(data) if (is.matrix(data)) data = as.data.frame(t(data), stringsAsFactors = FALSE) if (is.vector(data))data = as.data.frame(t(data), stringsAsFactors = FALSE) else data = as.data.frame(data, stringsAsFactors = FALSE) if(length(data[[1]])==1) compress=FALSE if(compress){ ddd = fast.table(data) data = ddd$data weight = ddd$weight index = ddd$index } else{ p = length(data[[1]]) weight = rep(1, p) index = 1:p } q = length(data) p = length(data[[1]]) tmp <- vector("list", q) if (!is.null(contrast)) { levels = colnames(contrast) all.levels = rownames(contrast) rownames(contrast) = NULL } else { if (is.null(levels)) stop("Either argument levels or contrast has to be supplied") l = length(levels) contrast = diag(l) all.levels = levels if (!is.null(ambiguity)) { all.levels = c(all.levels, ambiguity) k = length(ambiguity) if (k > 0) contrast = rbind(contrast, matrix(1, k, l)) } } att = attributes(data) data = lapply(data, match, all.levels) # avoid unlist attributes(data) = att row.names(data) = as.character(1:p) data = na.omit(data) aaa = match(index, attr(data, "na.action")) index = index[is.na(aaa)] index = match(index, unique(index)) rn = as.numeric(rownames(data)) attr(data, "na.action") = NULL weight = weight[rn] p = dim(data)[1] names(data) = nam attr(data, "row.names") = NULL attr(data, "weight") = weight attr(data, "nr") = p attr(data, "nc") = length(levels) if (return.index) attr(data, "index") = index attr(data, "levels") = levels attr(data, "allLevels") = all.levels attr(data, "type") = "USER" attr(data, "contrast") = contrast class(data) = "phyDat" data } phyDat.DNA = function (data, return.index = TRUE) { if (is.matrix(data)) nam = row.names(data) else nam = names(data) if (class(data) == "DNAbin") data = as.character(data) if (is.matrix(data)) data = as.data.frame(t(data), stringsAsFactors = FALSE) else data = as.data.frame(data, stringsAsFactors = FALSE) data = data.frame(tolower(as.matrix(data)), stringsAsFactors = FALSE) ac = c("a", "c", "g", "t", "u", "m", "r", "w", "s", "y", "k", "v", "h", "d", "b", "n", "?", "-") AC = matrix(c(c(1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 1), c(0, 1, 0, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1), c(0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1), c(0, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1)), 18, 4, dimnames = list(NULL, c("a", "c", "g", "t"))) ddd = fast.table(data) data = ddd$data index = ddd$index q = length(data) p = length(data[[1]]) d = dim(data) att = attributes(data) data = match(unlist(data), ac) attr(data, "dim") = d data = as.data.frame(data, stringsAsFactors=FALSE) attributes(data) = att row.names(data) = as.character(1:p) data = na.omit(data) rn = as.numeric(rownames(data)) aaa = match(index, attr(data, "na.action")) index = index[is.na(aaa)] index = match(index, unique(index)) rn = as.numeric(rownames(data)) attr(data, "na.action") = NULL weight = ddd$weight[rn] p = dim(data)[1] names(data) = nam attr(data, "row.names") = NULL attr(data, "weight") = weight attr(data, "nr") = p attr(data, "nc") = 4 if (return.index) attr(data, "index") = index attr(data, "levels") = c("a", "c", "g", "t") attr(data, "allLevels") = ac attr(data, "type") = "DNA" attr(data, "contrast") = AC class(data) = "phyDat" data } phyDat.AA <- function (data, return.index = TRUE) { if(is.matrix(data)) nam = row.names(data) else nam = names(data) if (class(data) == "DNAbin") data = as.character(data) if (is.matrix(data)) data = as.data.frame(t(data), stringsAsFactors = FALSE) else data = as.data.frame(data, stringsAsFactors = FALSE) data = data.frame(tolower(as.matrix(data)), stringsAsFactors = FALSE) aa <- c("a", "r", "n", "d", "c", "q", "e", "g", "h", "i", "l", "k", "m", "f", "p", "s", "t", "w", "y", "v") aa2 <- c("a", "r", "n", "d", "c", "q", "e", "g", "h", "i", "l", "k", "m", "f", "p", "s", "t", "w", "y", "v", "b", "z", "x", "-", "?") AA <- diag(20) AA <- rbind(AA, matrix(0, 5, 20)) AA[21, 3] <- AA[21, 4] <- 1 # Aspartate or Asparagine AA[22, 6] <- AA[22, 7] <- 1 # AA[23:25, ] = 1 dimnames(AA) <- list(aa2, aa) ddd = fast.table(data) data = ddd$data index = ddd$index q = length(data) p = length(data[[1]]) tmp <- vector("list", q) d = dim(data) att = attributes(data) data = match(unlist(data), aa2) attr(data, "dim") = d data = as.data.frame(data, stringsAsFactors=FALSE) attributes(data) = att row.names(data) = as.character(1:p) data = na.omit(data) rn = as.numeric(rownames(data)) aaa = match(index, attr(data, "na.action")) index = index[is.na(aaa)] index = match(index, unique(index)) rn = as.numeric(rownames(data)) attr(data, "na.action") = NULL weight = ddd$weight[rn] p = dim(data)[1] names(data) = nam attr(data, "row.names") = NULL attr(data, "weight") = weight attr(data, "nr") = p attr(data, "nc") = 20 if (return.index) attr(data, "index") = index attr(data, "levels") = aa attr(data, "allLevels") = aa2 attr(data, "type") = "AA" attr(data, "contrast") = AA class(data) = "phyDat" data } phyDat.codon <- function (data, return.index = TRUE) { if(is.matrix(data)) nam = row.names(data) else nam = names(data) if (class(data) == "DNAbin") data = as.character(data) if (is.matrix(data)) data = as.data.frame(t(data), stringsAsFactors = FALSE) else data = as.data.frame(data, stringsAsFactors = FALSE) data = data.frame(tolower(as.matrix(data)), stringsAsFactors = FALSE) data[data=="u"] = "t" splseq = function (seq, frame = 0) { starts <- seq(from = frame + 1, to = length(seq), by = 3L) sapply(starts, function(x) paste(seq[x:(x + 2L)], collapse="")) } data = sapply(data, splseq) ddd = fast.table(data) codon = c("aaa", "aac", "aag", "aat", "aca", "acc", "acg", "act", "aga", "agc", "agg", "agt", "ata", "atc", "atg", "att", "caa", "cac", "cag", "cat", "cca", "ccc", "ccg", "cct", "cga", "cgc", "cgg", "cgt", "cta", "ctc", "ctg", "ctt", "gaa", "gac", "gag", "gat", "gca", "gcc", "gcg", "gct", "gga", "ggc", "ggg", "ggt", "gta", "gtc", "gtg", "gtt", "tac", "tat", "tca", "tcc", "tcg", "tct", "tgc", "tgg", "tgt", "tta", "ttc", "ttg", "ttt") # ohne Stopcodons "taa", "tag", "tga", CODON <- diag(61) dimnames(CODON) <- list(codon, codon) data = ddd$data index = ddd$index q = length(data) p = length(data[[1]]) tmp <- vector("list", q) d = dim(data) att = attributes(data) data = match(unlist(data), codon) attr(data, "dim") = d data = as.data.frame(data, stringsAsFactors=FALSE) attributes(data) = att row.names(data) = as.character(1:p) data = na.omit(data) rn = as.numeric(rownames(data)) aaa = match(index, attr(data, "na.action")) index = index[is.na(aaa)] index = match(index, unique(index)) rn = as.numeric(rownames(data)) attr(data, "na.action") = NULL weight = ddd$weight[rn] p = dim(data)[1] names(data) = nam attr(data, "row.names") = NULL attr(data, "weight") = weight attr(data, "nr") = p attr(data, "nc") = 61 if (return.index) attr(data, "index") = index attr(data, "levels") = codon attr(data, "allLevels") = codon attr(data, "type") = "CODON" attr(data, "contrast") = CODON class(data) = "phyDat" data } as.phyDat <- function (x, ...){ if (class(x) == "phyDat") return(x) UseMethod("as.phyDat") } as.phyDat.DNAbin <- function(x,...) phyDat.DNA(x,...) as.phyDat.alignment <- function (x, type="DNA",...) { x$seq <- tolower(x$seq) data <- sapply(x$seq, strsplit, "") names(data) <- x$nam if(type=="DNA") dat <- phyDat.DNA(data,...) if(type=="AA") dat <- phyDat.AA(data, ...) if(type=="CODON") dat <- phyDat.codon(data, ...) if(type=="USER") dat <- phyDat.default(data, ...) dat } #as.alignment.phyDat <- function(x, ...) as.alignment(as.character(x)) phyDat2alignment <- function(x){ z = as.character(x) nam = rownames(z) type = attr(x, "type") seq <- switch(type, DNA = tolower(apply(z, 1, paste, collapse="")), AA = toupper(apply(z, 1, paste, collapse=""))) names(seq) <- NULL res <- list(nb=length(seq), nam=nam, seq=seq, com=NA) class(res) = "alignment" res } as.phyDat.matrix <- function (x, ...) phyDat(data=x, ...) as.phyDat.data.frame <- function (x, ...) phyDat(data=x, ...) acgt2ry <- function(obj){ ac = c("a", "c", "g", "t", "u", "m", "r", "w", "s", "y", "k", "v", "h", "d", "b", "n", "?", "-") AC = matrix(c(c(1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 1, 1, 1), c(0, 1, 0, 0, 0, 1, 0, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1), c(0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1), c(0, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1)), 18, 4, dimnames = list(NULL, c("a", "c", "g", "t"))) ry = AC[c(7,10),] RY = AC %*% t(ry) RY[RY==2] = 1 dimnames(RY) = list(NULL, c("r", "y")) attr(obj, "levels") = c("r", "y") attr(obj, "nc") = 2 attr(obj, "type") = "USER" attr(obj, "contrast") = RY obj=phyDat.default(as.character(obj, allLevels=FALSE), levels = c("r", "y"), ambiguity = NULL) obj } as.character.phyDat <- function (x, allLevels=TRUE, ...) { nr <- attr(x, "nr") nc <- attr(x, "nc") type <- attr(x, "type") if (type == "DNA") { labels <- c("a", "c", "g", "t", "u", "m", "r", "w", "s", "y", "k", "v", "h", "d", "b", "n", "?", "-") } if (type == "AA") { labels <- c("a", "r", "n", "d", "c", "q", "e", "g", "h", "i", "l", "k", "m", "f", "p", "s", "t", "w", "y", "v", "b", "z", "x", "-", "?") } if (type == "USER") { #levels if(allLevels)labels = attr(x, "allLevels") else{ tmp = attr(x, "levels") contrast = attr(x, "contrast") # contrast=AC contrast[contrast>0] = 1 ind = which(rowSums(contrast)==1) contrast[rowSums(contrast)>1,] = 0 labels = rep(NA, length(attr(x, "allLevels"))) labels[ind] = tmp[contrast%*%c(1:length(tmp))] } } result = matrix(NA, nrow = length(x), ncol = nr) for (i in 1:length(x)) result[i, ] <- labels[x[[i]]] if (is.null(attr(x, "index"))) index = rep(1:nr, attr(x, "weight")) else { index = attr(x, "index") if (is.data.frame(index)) index <- index[, 1] } result = result[, index, drop = FALSE] rownames(result) = names(x) result } # replace as.character.phyDat 20 Zeilen weniger as.character.phyDat2 <- function (x, ...) { nr <- attr(x, "nr") nc <- attr(x, "nc") type <- attr(x, "type") labels = attr(x, "allLevels") result = matrix(NA, nrow = length(x), ncol = nr) for (i in 1:length(x)) result[i, ] <- labels[x[[i]]] if (is.null(attr(x, "index"))) index = rep(1:nr, attr(x, "weight")) else { index = attr(x, "index") if (is.data.frame(index)) index <- index[, 1] } result = result[, index, drop = FALSE] rownames(result) = names(x) result } #as.data.frame.phyDat <- function(x, ...){ # data.frame(t(as.character(x, ...)), stringsAsFactors=FALSE) #} # much faster # TODO as stringsAsFactors=FALSE # result[[i]] <- x[[i]] + factor levels setzen # as.data.frame.phyDatOld <- function(x, ...){ nr <- attr(x, "nr") nc <- attr(x, "nc") labels <- attr(x, "allLevels") result <- vector("list", length(x)) for (i in 1:length(x)) result[[i]] <- labels[x[[i]]] attr(result, "names") <- names(x) attr(result, "row.names") <- 1:nr attr(result, "class") <- "data.frame" result } as.data.frame.phyDat <- function(x, ...){ nr <- attr(x, "nr") nc <- attr(x, "nc") labels <- attr(x, "allLevels") result <- vector("list", length(x)) if (is.null(attr(x, "index"))) index = rep(1:nr, attr(x, "weight")) else { index = attr(x, "index") if (is.data.frame(index)) index <- index[, 1] } for (i in 1:length(x)) result[[i]] <- labels[x[[i]][index]] attr(result, "names") <- names(x) attr(result, "row.names") <- 1:length(index) attr(result, "class") <- "data.frame" result } #as.DNAbin.phyDat <- function(x,...) { # if(attr(x, "type")=="DNA") return(as.DNAbin(as.character(x, ...))) # else stop("x must be a nucleotide sequence") #} # quite abit faster as.DNAbin.phyDat <- function (x, ...) { if(attr(x, "type")=="DNA"){ nr <- attr(x, "nr") ac = attr(x, "allLevels") result = matrix(as.raw(0), nrow = length(x), ncol = nr) # from ape ._cs_ cs <- c("a", "g", "c", "t", "r", "m", "w", "s", "k", "y", "v", "h", "d", "b", "n", "-", "?") # from ape ._bs_ bs <- as.raw(c(136, 72, 40, 24, 192, 160, 144, 96, 80, 48, 224, 176, 208, 112, 240, 4, 2)) ord <- match(ac, cs) ord[5] <- 4 for (i in 1:length(x)){ ind <- ord[x[[i]]] result[i,] <- bs[ind] } if (is.null(attr(x, "index"))) index = rep(1:nr, attr(x, "weight")) else { index = attr(x, "index") if (is.data.frame(index)) index <- index[, 1] } result = result[, index, drop = FALSE] rownames(result) = names(x) class(result) <- "DNAbin" return(result) } else stop("x must be a nucleotide sequence") } phyDat <- function (data, type="DNA", levels=NULL, return.index = TRUE,...) { if (class(data) == "DNAbin") type <- "DNA" pt <- match.arg(type, c("DNA", "AA", "CODON", "USER")) if(pt=="DNA") dat <- phyDat.DNA(data, return.index=return.index,...) if(pt=="AA") dat <- phyDat.AA(data, return.index=return.index, ...) if(pt=="CODON") dat <- phyDat.codon(data, return.index=return.index, ...) if(pt=="USER") dat <- phyDat.default(data, levels = levels, return.index=return.index, ...) dat } print.phyDat = function (x, ...) { cat(length(x), "sequences with",sum(attr(x,"weight")), "character and",attr(x,"nr"),"different site patterns.\n") cat("The states are",attr(x,"levels"), "\n") } c.phyDat <- function(...){ object <- as.list(substitute(list(...)))[-1] x <- list(...) n <- length(x) match.names <- function(a,b){ if(any(!(a %in% b)))stop("names do not match previous names") } if (n == 1) return(x[[1]]) type <- attr(x[[1]], "type") nr = numeric(n) nr[1] <- sum(attr(x[[1]], "weight")) levels <- attr(x[[1]], "levels") snames <- names(x[[1]]) objNames<-as.character(object) if(any(duplicated(objNames))) objNames <- paste(objNames,1:n,sep="") tmp <- as.character(x[[1]]) for(i in 2:n){ match.names(snames,names(x[[i]])) x[[i]] <- getCols(x[[i]],snames) nr[i] <- sum(attr(x[[i]], "weight")) tmp <- cbind(tmp, as.character(x[[i]])) } if (type == "DNA") dat <- phyDat.DNA(tmp, return.index = TRUE) if (type == "AA") dat <- phyDat.AA(tmp, return.index = TRUE) if (type == "USER") dat <- phyDat.default(tmp, levels = levels, return.index = TRUE) if (type == "CODON") dat <- phyDat.codon(tmp, return.index = TRUE) attr(dat,"index") <- data.frame(index=attr(dat,"index"), genes=rep(objNames, nr)) dat } # new cbind.phyDat cbindPD <- function(..., gaps="-"){ object <- as.list(substitute(list(...)))[-1] x <- list(...) n <- length(x) if (n == 1) return(x[[1]]) type <- attr(x[[1]], "type") nr = numeric(n) ATTR <- attributes(x[[1]]) nr[1] <- sum(attr(x[[1]], "weight")) levels <- attr(x[[1]], "levels") allLevels <- attr(x[[1]], "allLevels") gapsInd <- match(gaps, allLevels) snames <- vector("list", n) # names(x[[1]]) vec = numeric(n+1) wvec = numeric(n+1) objNames<-as.character(object) if(any(duplicated(objNames))) objNames <- paste(objNames,1:n,sep="") # tmp <- as.character(x[[1]]) for(i in 1:n){ snames[[i]] = names(x[[i]]) nr[i] <- attr(x[[i]], "nr") vec[i+1] = attr(x[[i]], "nr") wvec[i+1] = sum(attr(x[[i]], "weight")) } vec = cumsum(vec) wvec = cumsum(wvec) snames = unique(unlist(snames)) weight <- numeric(vec[n+1]) index <- numeric(wvec[n+1]) ATTR$names <- snames ATTR$nr <- vec[n+1] tmp = matrix(gapsInd, vec[n+1], length(snames), dimnames = list(NULL, snames)) tmp <- as.data.frame(tmp) for(i in 1:n){ nam = names(x[[i]]) tmp[(vec[i]+1):vec[i+1], nam] <- x[[i]][nam] weight[(vec[i]+1):vec[i+1]] <- attr(x[[i]], "weight") index[(wvec[i]+1):wvec[i+1]] <- attr(x[[i]], "index") } ATTR$index <- index ATTR$weight <- weight attributes(tmp) <- ATTR tmp } cbind.phyDat <- function(..., gaps="-"){ object <- as.list(substitute(list(...)))[-1] x <- list(...) n <- length(x) if (n == 1) return(x[[1]]) type <- attr(x[[1]], "type") nr = numeric(n) nr[1] <- sum(attr(x[[1]], "weight")) levels <- attr(x[[1]], "levels") snames <- vector("list", n) # names(x[[1]]) vec = numeric(n+1) objNames<-as.character(object) if(any(duplicated(objNames))) objNames <- paste(objNames,1:n,sep="") tmp <- as.character(x[[1]]) for(i in 1:n){ snames[[i]] = names(x[[i]]) #match.names(snames,names(x[[i]])) nr[i] <- sum(attr(x[[i]], "weight")) vec[i+1] = sum(attr(x[[i]], "weight")) } vec = cumsum(vec) snames = unique(unlist(snames)) tmp = matrix(gaps, length(snames), vec[n+1], dimnames = list(snames, NULL)) for(i in 1:n){ nam = names(x[[i]]) tmp[nam,(vec[i]+1):vec[i+1] ] <- as.character(x[[i]]) } if (type == "DNA") dat <- phyDat.DNA(tmp, return.index = TRUE) if (type == "AA") dat <- phyDat.AA(tmp, return.index = TRUE) if (type == "USER") dat <- phyDat.default(tmp, levels = levels, return.index = TRUE) if (type == "CODON") dat <- phyDat.codon(tmp, return.index = TRUE) attr(dat,"index") <- data.frame(index=attr(dat,"index"), genes=rep(objNames, nr)) dat } write.phyDat <- function(x, file, format="phylip",...){ if(format=="fasta") write.dna(as.character(x), file, format="fasta", ...) if(format=="phylip") write.dna(as.character(x), file, format="sequential", ...) if(format=="nexus"){ type = attr(x, "type") if(type=="DNA") write.nexus.data(as.list(as.data.frame(x)), file, format = "dna",...) else write.nexus.data(as.list(as.data.frame(x)), file, format = "protein", ...) } } read.phyDat <- function(file, format="phylip", type="DNA", ...){ if(format=="nexus") data=read.nexus.data(file, ...) else { if(format=="phylip")format="interleaved" #"sequential" if (type == "DNA" || type == "CODON"){ data = read.dna(file, format, as.character = TRUE, ...) } if (type == "AA") data = read.aa(file, format=format, ...) # raus } phyDat(data, type, return.index = TRUE) } baseFreq <- function(obj, freq=FALSE, drop.unused.levels = FALSE){ if (class(obj) != "phyDat") stop("data must be of class phyDat") labels <- attr(obj, "allLevels") weight <- attr(obj,"weight") n <- length(obj) res <- numeric(length(labels)) D = diag(length(labels)) for(i in 1:n)res <- res + colSums(D[obj[[i]],, drop=FALSE]*weight) if(!freq)res <- res/sum(res) names(res) <- labels if(drop.unused.levels) return(res[res>0]) res } phylo <- function(edge, tip, edge.length=NULL){ res <- list(edge=edge, tip.label=tip, edge.length=edge.length) class(res)="phylo" res } getCols <- function (data, cols) { attrib = attributes(data) attr(data, "class") <- "list" data = data[cols] if (is.character(cols)) attrib$names = cols else attrib$names = attrib$names[cols] attributes(data) = attrib attr(data, "class") <- "phyDat" data } # allows negative indexing subset(dat,,-c(3:5)) getRows <- function (data, rows, site.pattern = TRUE) { index <- attr(data, "index") if(is.data.frame(index))index = index[,1] if(!site.pattern){ # & all(rows>0) weight = tabulate(index[rows]) ind = which(weight>0) rows = ind # rows[ind] weight = weight[ind] } for (i in 1:length(data)){ if(is.matrix(data[[i]]))data[[i]] = data[[i]][rows,] else data[[i]] = data[[i]][rows] } attr(data, "weight") = attr(data, "weight")[rows] if(!site.pattern) attr(data, "weight") = weight attr(data, "nr") = length(attr(data, "weight")) attr(data, "index") = NULL data } subset.phyDat <- function (x, subset, select, site.pattern = TRUE,...) { if (!missing(subset)) x <- getCols(x, subset) if (!missing(select)){ # if(!site.pattern){ # if(is.data.frame(attr(x, "index"))) select <- attr(x, "index")[select,1] # else select <- attr(x, "index")[select] # } if(any(is.na(select))) return(NULL) x <- getRows(x, select, site.pattern=site.pattern) } x } unique.phyDat <- function(x, incomparables=FALSE, ...) getCols(x, !duplicated(x)) allSitePattern <- function(n,levels=c("a","c","g","t"), names=NULL){ l=length(levels) X=vector("list", n) if(is.null(names))names(X) = paste("t",1:n, sep="") else names(X)=names for(i in 1:n) X[[i]] = rep(rep(levels, each=l^(i-1)),l^(n-i)) X = as.data.frame(X) phyDat.default(X, levels, compress=FALSE) } constSitePattern <- function(n,levels=c("a","c","g","t"), names=NULL){ l=length(levels) X=matrix(0, l,n) X = matrix(rep(levels, each=n), n, l) if(is.null(names))rownames(X) = paste("t",1:n, sep="") else rownames(X)=names phyDat.default(X, levels) } write.phylip <- function(data, weight, file=""){ n = sum(weight) m = dim(data)[2] cat(m,n,"\n",file = file) for(i in 1:m) cat(colnames(data)[i]," ",toupper(rep(data[,i],weight)),"\n", sep="", file=file, append=TRUE) } read.FASTA.AA <- function (file) { if (length(grep("^(ht|f)tp:", file))) { url <- file file <- tempfile() download.file(url, file) } sz <- file.info(file)$size x <- readBin(file, "raw", sz) icr <- which(x == as.raw(13)) if (length(icr)) x <- x[-icr] res <- .Call("rawStream2phyDat", x) aa <- c("a", "r", "n", "d", "c", "q", "e", "g", "h", "i", "l", "k", "m", "f", "p", "s", "t", "w", "y", "v") aa2 <- c("a", "r", "n", "d", "c", "q", "e", "g", "h", "i", "l", "k", "m", "f", "p", "s", "t", "w", "y", "v", "b", "z", "x", "-", "?") AA <- diag(20) AA <- rbind(AA, matrix(0, 5, 20)) AA[21, 3] <- AA[21, 4] <- 1 # Aspartate or Asparagine AA[22, 6] <- AA[22, 7] <- 1 # AA[23:25, ] = 1 dimnames(AA) <- list(aa2, aa) ddd = fast.table(res) data = ddd$data names(data) <- sub("^ +", "", names(data)) row.names(data) = NULL attr(data, "row.names") = NULL attr(data, "weight") = ddd$weight attr(data, "nr") = length(ddd$weight) attr(data, "nc") = 20 attr(data, "index") = as.integer(ddd$index) attr(data, "levels") = aa attr(data, "allLevels") = aa2 attr(data, "type") = "AA" attr(data, "contrast") = AA class(data) = "phyDat" data } # throw out read.aa <- function (file, format = "interleaved", skip = 0, nlines = 0, comment.char = "#", seq.names = NULL) { getTaxaNames <- function(x) { x <- sub("^ +", "", x) x <- sub(" +$", "", x) x <- sub("^['\"]", "", x) x <- sub("['\"]$", "", x) x } format <- match.arg(format, c("interleaved", "sequential", "fasta")) phylip <- if (format %in% c("interleaved", "sequential")) TRUE else FALSE if (format == "fasta") { obj <- read.FASTA.AA(file) return(obj) } X <- scan(file = file, what = character(), sep = "\n", quiet = TRUE, skip = skip, nlines = nlines, comment.char = comment.char) if (phylip) { fl <- X[1] oop <- options(warn = -1) fl.num <- as.numeric(unlist(strsplit(gsub("^ +", "", fl), " +"))) options(oop) if (all(is.na(fl.num))) stop("the first line of the file must contain the dimensions of the data") if (length(fl.num) != 2) stop("the first line of the file must contain TWO numbers") else { n <- fl.num[1] s <- fl.num[2] } X <- X[-1] obj <- vector("character", n * s) dim(obj) <- c(n, s) } if (format == "interleaved") { fl <- X[1] fl <- unlist(strsplit(fl, NULL)) bases <- grep("[-AaRrNnDdCcQqEeGgHhIiLlKkMmFfPpSsTtWwYyVvBbZzXx?]", fl) z <- diff(bases) for (i in 1:length(z)) if (all(z[i:(i + 8)] == 1)) break start.seq <- bases[i] if (is.null(seq.names)) seq.names <- getTaxaNames(substr(X[1:n], 1, start.seq - 1)) X[1:n] <- substr(X[1:n], start.seq, nchar(X[1:n])) X <- gsub(" ", "", X) nl <- length(X) for (i in 1:n) obj[i, ] <- unlist(strsplit(X[seq(i, nl, n)], NULL)) } if (format == "sequential") { fl <- X[1] taxa <- character(n) j <- 1 for (i in 1:n) { bases <- grep("[-AaRrNnDdCcQqEeGgHhIiLlKkMmFfPpSsTtWwYyVvBbZzXx?]", unlist(strsplit(X[j], NULL))) z <- diff(bases) for (k in 1:length(z)) if (all(z[k:(k + 8)] == 1)) break start.seq <- bases[k] taxa[i] <- substr(X[j], 1, start.seq - 1) sequ <- substr(X[j], start.seq, nchar(X[j])) sequ <- gsub(" ", "", sequ) j <- j + 1 while (nchar(sequ) < s) { sequ <- paste(sequ, gsub(" ", "", X[j]), sep = "") j <- j + 1 } obj[i, ] <- unlist(strsplit(sequ, NULL)) } if (is.null(seq.names)) seq.names <- getTaxaNames(taxa) } if (format == "fasta") return(read.FASTA.AA(file)) # start <- grep("^ {0,}>", X) # taxa <- X[start] # n <- length(taxa) # obj <- vector("list", n) # if (is.null(seq.names)) { # taxa <- sub("^ {0,}>", "", taxa) # seq.names <- getTaxaNames(taxa) # } # start <- c(start, length(X) + 1) # for (i in 1:n) obj[[i]] <- unlist(strsplit(gsub(" ", # "", X[(start[i] + 1):(start[i + 1] - 1)]), NULL)) # } if (phylip) { rownames(obj) <- seq.names obj <- tolower(obj) } else { names(obj) <- seq.names obj <- lapply(obj, tolower) } obj } genlight2phyDat <- function(x, ambiguity=NA){ tmp <- as.matrix(x) lev <- na.omit(unique(as.vector(tmp))) phyDat(tmp, "USER", levels=lev, ambiguity=ambiguity) } phangorn/R/fitch.R0000644000175100001440000004230312527723651013541 0ustar hornikusersfitch <- function (tree, data, site="pscore") { if (class(data) != "phyDat") stop("data must be of class phyDat") levels <- attr(data, "levels") if(class(tree)=="multiPhylo"){ TL = attr(tree,"TipLabel") if (!is.null(TL)){ data <- subset(data, TL) nTips <- length(TL) weight <- attr(data, "weight") nr <- attr(data, "nr") m <- nr*(2L*nTips - 1L) } } data <- prepareDataFitch(data) d = attributes(data) data <- as.integer(data) attributes(data) <- d if(class(tree)=="phylo") return(fit.fitch(tree, data, site)) { if(is.null(attr(tree,"TipLabel"))){ tree = unclass(tree) return(sapply(tree, fit.fitch, data, site)) } else{ tree = unclass(tree) # tree = lapply(tree, reorder, "postorder") site = ifelse(site == "pscore", 1L, 0L) on.exit(.C("fitch_free")) .C("fitch_init", as.integer(data), as.integer(nTips*nr), as.integer(m), as.double(weight), as.integer(nr)) return(sapply(tree, fast.fitch, nr, site)) } } } fit.fitch <- function (tree, data, returnData = c("pscore", "site", "data")) { if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") returnData <- match.arg(returnData) nr = attr(data, "nr") node <- tree$edge[, 1] edge <- tree$edge[, 2] weight = attr(data, "weight") m = max(tree$edge) q = length(tree$tip) result <- .Call("FITCH", data[, tree$tip.label], as.integer(nr), as.integer(node), as.integer(edge), as.integer(length(edge)), as.double(weight), as.integer(m), as.integer(q)) if (returnData == "site") return(result[[2]]) pscore <- result[[1]] res = pscore if (returnData == "data") res <- list(pscore = pscore, dat = result[[3]], site = result[[2]]) res } # NNI fnodesNew2 <- function (EDGE, nTips, nr) { node <- EDGE[, 1] edge <- EDGE[, 2] n = length(node) m= as.integer(max(EDGE)+1L) m2 = 2L*n root0 <- as.integer(node[n]) .Call("FNALL_NNI", as.integer(nr), node, edge, as.integer(n), as.integer(m), as.integer(m2), as.integer(root0)) } # SPR und bab kompakter fnodesNew5 <- function (EDGE, nTips, nr) { node <- EDGE[, 1] edge <- EDGE[, 2] n = length(node) m= as.integer(max(EDGE)+1L) m2 = 2L*n root0 <- as.integer(node[n]) .Call("FNALL5", as.integer(nr), node, edge, as.integer(n), as.integer(m), as.integer(m2), as.integer(root0)) } random.addition <- function(data, method="fitch") { label <- names(data) nTips <- as.integer(length(label)) remaining <- as.integer(sample(nTips)) tree <- structure(list(edge = structure(c(rep(nTips+1L, 3), remaining[1:3]), .Dim = c(3L, 2L)), tip.label = label, Nnode = 1L), .Names = c("edge", "tip.label", "Nnode"), class = "phylo", order = "postorder") remaining <- remaining[-c(1:3)] if(nTips==3L) return(tree) nr <- attr(data, "nr") storage.mode(nr) <- "integer" n <- length(data) #- 1L data <- subset(data,,order(attr(data, "weight"), decreasing=TRUE)) data <- prepareDataFitch(data) weight <- attr(data, "weight") m = nr*(2L*nTips - 2L) on.exit(.C("fitch_free")) .C("fitch_init", as.integer(data), as.integer(nTips*nr), as.integer(m), as.double(weight), as.integer(nr)) storage.mode(weight) <- "double" for (i in remaining) { edge = tree$edge[,2] score = fnodesNew5(tree$edge, nTips, nr)[edge] score <- .Call("FITCHTRIP3", as.integer(i), as.integer(nr), as.integer(edge), as.double(score), as.double(Inf)) res = min(score) nt = which.min(score) tree = addOne(tree, i, nt) } attr(tree, "pscore") = res tree } fast.fitch <- function (tree, nr, ps = TRUE) { node <- tree$edge[, 1] edge <- tree$edge[, 2] m = max(tree$edge) .Call("FITCH345", as.integer(nr), as.integer(node), as.integer(edge), as.integer(length(edge)), as.integer(m), as.integer(ps)) } fitch.spr <- function(tree, data){ nTips = as.integer(length(tree$tip)) nr = attr(data, "nr") minp = fast.fitch(tree, nr, TRUE) for(i in 1:nTips){ treetmp = dropTip(tree, i) edge = treetmp$edge[,2] score = fnodesNew5(treetmp$edge, nTips, nr)[edge] score <- .Call("FITCHTRIP3", as.integer(i), as.integer(nr), as.integer(edge), as.double(score), as.double(minp)) if(min(score)= p0) candidates[ind] = FALSE if (test < p0) { p0 <- test swap = swap + 1 tree <- tree2 indi <- which(INDEX[5,] %in% INDEX[1:5, ind]) candidates[indi] <- FALSE pscore[indi] <- Inf } } list(tree = tree, pscore = p0, swap = swap) } optim.fitch <- function(tree, data, trace=1, rearrangements = "SPR", ...) { if(class(tree)!="phylo") stop("tree must be of class phylo") if(!is.binary.tree(tree)){ tree <- multi2di(tree) attr(tree, "order") <- NULL } if(is.rooted(tree)){ tree <- unroot(tree) attr(tree, "order") <- NULL } if(is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") if (class(data)[1] != "phyDat") stop("data must be of class phyDat") rt = FALSE nTips = as.integer(length(tree$tip)) nr = attr(data, "nr") pis <- parsinfo(data) p0 <- sum(attr(data, "weight")[pis[, 1]] * pis[, 2]) if (length(pis) > 0) data <- getRows(data, c(1:nr)[-pis[, 1]], TRUE) nr = attr(data, "nr") data <- subset(data,tree$tip,order(attr(data, "weight"), decreasing=TRUE)) dat <- prepareDataFitch(data) weight <- attr(data, "weight") m = nr*(2L*nTips - 2L) on.exit(.C("fitch_free")) .C("fitch_init", as.integer(dat), as.integer(nTips*nr), as.integer(m), as.double(weight), as.integer(nr)) tree$edge.length=NULL swap = 0 iter = TRUE pscore <- fast.fitch(tree, nr) while (iter) { res <- fitch.nni(tree, dat, ...) tree <- res$tree if(trace>1)cat("optimize topology: ", pscore + p0, "-->", res$pscore + p0, "\n") pscore = res$pscore swap = swap + res$swap if (res$swap == 0){ if(rearrangements=="SPR"){ tree <- fitch.spr(tree, dat) psc <- fast.fitch(tree, nr) if(trace>1)cat("optimize topology (SPR): ", pscore + p0 , "-->", psc + p0, "\n") if(pscore < psc+1e-6) iter=FALSE pscore <- psc } else iter = FALSE } } if(trace>0)cat("Final p-score",pscore + p0,"after ",swap, "nni operations \n") if(rt)tree <- ptree(tree, data) attr(tree, "pscore") = pscore + p0 tree } # branch and bound getOrder <- function (x) { label = names(x) dm = as.matrix(dist.hamming(x, FALSE)) ind = as.vector(which(dm == max(dm), arr.ind = TRUE)[1, ]) nTips = as.integer(length(label)) added = ind remaining <- c(1:nTips)[-ind] tree <- structure(list(edge = structure(c(rep(nTips+1L, 3), c(ind, 0L)), .Dim = c(3L, 2L)), tip.label = label, Nnode = 1L), .Names = c("edge", "tip.label", "Nnode"), class = "phylo", order = "postorder") l = length(remaining) res = numeric(l) nr <- attr(x, "nr") storage.mode(nr) <- "integer" n <- length(x) #- 1L data <- prepareDataFitch(x) weight <- attr(data, "weight") storage.mode(weight) <- "double" m = nr*(2L*nTips - 2L) on.exit(.C("fitch_free")) .C("fitch_init", as.integer(data), as.integer(nTips*nr), as.integer(m), as.double(weight), as.integer(nr)) for(i in 1:length(remaining)){ tree$edge[3,2]= remaining[i] res[i] = fast.fitch(tree, nr) } tmp = which.max(res) added = c(added, remaining[tmp]) remaining <- remaining[-tmp] tree$edge[,2]= added for (i in 4:(nTips - 1L)) { edge = tree$edge[,2] score0 = fnodesNew5(tree$edge, nTips, nr)[edge] l = length(remaining) res = numeric(l) nt = numeric(l) k = length(added)+1L for(j in 1:l){ score <- .Call("FITCHTRIP3", as.integer(remaining[j]), as.integer(nr), as.integer(edge), as.double(score0), as.double(Inf)) # score = score0[edge] + psc res[j] = min(score) nt[j] = which.min(score) } tmp = which.max(res) added = c(added, remaining[tmp]) tree = addOne(tree, remaining[tmp], nt[tmp]) remaining <- remaining[-tmp] } added = c(added, remaining) added } bab <- function (data, tree = NULL, trace = 1, ...) { o = order(attr(data, "weight"), decreasing = TRUE) data = subset(data, , o) nr <- attr(data, "nr") pis <- parsinfo(data) p0 <- sum(attr(data, "weight")[pis[, 1]] * pis[, 2]) if (length(pis) > 0) data <- getRows(data, c(1:nr)[-pis[, 1]], TRUE) tree <- pratchet(data, start = tree, trace = trace - 1, ...) data <- subset(data, tree$tip.label) nr <- as.integer(attr(data, "nr")) inord <- getOrder(data) lb <- lowerBound(data) nTips <- m <- length(data) nr <- as.integer(attr(data, "nr")) TMP <- matrix(0, m, nr) for (i in 4:m) { TMP[i, ] = lowerBound(subset(data, inord[1:i])) } weight <- as.double(attr(data, "weight")) data <- prepareDataFitch(data) m = nr*(2L*nTips - 2L) on.exit(.C("fitch_free")) .C("fitch_init", as.integer(data), as.integer(nTips*nr), as.integer(m), as.double(weight), as.integer(nr)) mmsAmb = 0 mmsAmb = TMP %*% weight mmsAmb = mmsAmb[nTips] - mmsAmb mms0 = 0 mms0 = mms0 + mmsAmb minPars = mms0[1] kPars = 0 if (trace) print(paste("lower bound:", p0 + mms0[1])) bound <- fast.fitch(tree, nr) if (trace) print(paste("upper bound:", bound + p0)) startTree <- structure(list(edge = structure(c(rep(nTips+1L, 3), as.integer(inord)[1:3]), .Dim = c(3L, 2L)), tip.label = tree$tip.label, Nnode = 1L), .Names = c("edge", "tip.label", "Nnode"), class = "phylo", order = "postorder") trees <- vector("list", nTips) trees[[3]] <- list(startTree$edge) for(i in 4:nTips) trees[[i]] <- vector("list", (2L*i) - 5L) # new # index M[i] is neues node fuer edge i+1 # index L[i] is length(node) tree mit i+1 L = as.integer( 2L*(1L:nTips) -3L ) M = as.integer( 1L:nTips + nTips - 1L ) PSC <- matrix(c(3,1,0), 1, 3) PSC[1,3] <- fast.fitch(startTree, nr) k = 4L Nnode = 1L npsc = 1 result <- list() while (npsc > 0) { a = PSC[npsc,1] b = PSC[npsc,2] PSC = PSC[-npsc,, drop=FALSE] tmpTree <- trees[[a]][[b]] edge = tmpTree[,2] score = fnodesNew5(tmpTree, nTips, nr)[edge] + mms0[a+1L] score <- .Call("FITCHTRIP3", as.integer(inord[a+1L]), as.integer(nr), as.integer(edge), as.double(score), as.double(bound)) ms = min(score) if(ms<=bound){ if((a+1L)0]=0L res[!(tmp0>(tmp1 - 1e-8))] = 10000000L apply(res, 1, which.min) } comp2 <- function(x, y){ res = matrix(rowSums(x), nrow(x), nrow(y)) tmp1 = matrix(rowSums(y), nrow(x), nrow(y), byrow=TRUE) tmp3 = tcrossprod(1-x, y) tmp0 = tcrossprod(x, y) tmp0[tmp3>0]=0L res[tmp0<2] = Inf apply(res, 2, which.min) } # single linkage of minimal coalescent times # extends speciesTree fom ape coalSpeciesTree <- function(tree, X, sTree=NULL){ if(is.null(X))return(speciesTree(tree)) trees = unclass(tree) States = lapply(tree, ancstat, X) NH = lapply(tree, nodeHeight) if(is.null(sTree)){ l <- attr(X, "nc") m <- choose(l, 2) SST <- matrix(0L, m, l) k <- 1 for(i in 1:(l-1)){ for(j in (i+1):l){ SST[k, i] <- SST[k,j] <- 1L k <- k+1 } } Y=matrix(Inf, length(NH), nrow(SST)) dm = rep(Inf, m) for(i in 1:length(NH)){ ind = comp2(States[[i]],SST) dm = pmin(dm, NH[[i]][ind]) # for(j in 1:length(ind))Y[i, ind[j]] = min(Y[i, ind[j]], NH[[i]][j]) } dm = structure(2*dm, Labels = attr(X, "levels"), Size = l, class = "dist", Diag = FALSE, Upper = FALSE) sTree <- upgma(dm, "single") # dm of pairwise states } else{ SST = ancstat(sTree, X) Y=matrix(Inf, length(NH), nrow(SST)) for(i in 1:length(NH)){ ind = comp(States[[i]],SST) for(j in 1:length(ind))Y[i, ind[j]] = min(Y[i, ind[j]], NH[[i]][j]) } STH = apply(Y, 2, min) sTree$edge.length = STH[sTree$edge[,1]] - STH[sTree$edge[,2]] } sTree } phangorn/R/simSeq.R0000644000175100001440000000542712507002037013675 0ustar hornikusers # # add codon models, change to phyDat statt 3* # simSeq <- function (x, ...) UseMethod("simSeq") simSeq.phylo = function(x, l=1000, Q=NULL, bf=NULL, rootseq=NULL, type = "DNA", model="USER", levels = NULL, rate=1, ancestral=FALSE, ...){ pt <- match.arg(type, c("DNA", "AA", "USER")) if (pt == "DNA") levels <- c("a", "c", "g", "t") if (pt == "AA") levels <- c("a", "r", "n", "d", "c", "q", "e", "g", "h", "i", "l", "k", "m", "f", "p", "s", "t", "w", "y", "v") if (pt == "USER") if(is.null(levels))stop("levels have to be supplied if type is USER") lbf = length(levels) if (type == "AA" & !is.null(model)) { # model <- match.arg(model, c("USER", "WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa", "mtREV24")) model <- match.arg(model, c("USER", .aamodels)) if(model!="USER")getModelAA(model, bf=is.null(bf), Q=is.null(Q)) } if(is.null(bf)) bf = rep(1/lbf,lbf) if(is.null(Q)) Q = rep(1,lbf*(lbf-1)/2) if(is.matrix(Q)) Q=Q[lower.tri(Q)] eig = edQt(Q, bf) m = length(levels) if(is.null(rootseq))rootseq = sample(levels, l, replace=TRUE, prob=bf) x = reorder(x) edge = x$edge nNodes = max(edge) res = matrix(NA, l, nNodes) parent <- as.integer(edge[, 1]) child <- as.integer(edge[, 2]) root <- as.integer(parent[!match(parent, child, 0)][1]) res[, root] = rootseq tl = x$edge.length for(i in 1:length(tl)){ from = parent[i] to = child[i] P = getP(tl[i], eig, rate)[[1]] for(j in 1:m){ ind = res[,from]==levels[j] res[ind,to] = sample(levels, sum(ind), replace=TRUE, prob=P[,j]) } } k = length(x$tip) label = c(x$tip, as.character((k+1):nNodes)) colnames(res)=label if(!ancestral)res = res[, x$tip, drop=FALSE] if(pt=="DNA") return(phyDat.DNA(as.data.frame(res), return.index=TRUE)) if(pt=="AA") return(phyDat.AA(as.data.frame(res), return.index=TRUE)) if(pt=="USER") return(phyDat.default(as.data.frame(res), levels = levels, return.index=TRUE)) } simSeq.pml <- function(x, ancestral=FALSE, ...){ g = x$g w = x$w if(x$inv>0){ w = c(x$inv, w) g = c(0.0, g) } n = length(w) res = vector("list", n) y = sample(n, sum(x$weight), replace=TRUE, prob=w) levels = attr(x$data, "levels") type = attr(x$data, "type") for(i in 1:n){ l = sum(y==i) res[[i]] = simSeq(x$tree, l, Q=x$Q, bf=x$bf, type=type, levels=levels, rate=g[i], ancestral=ancestral) } x = call("c.phyDat", quote(res[[1]])) if(n>1) x <- parse(text= paste("c(", "res[[1]]", paste0(",res[[", 2:n, "]]", collapse=""), ")")) eval(x) } phangorn/R/treeManipulation.R0000644000175100001440000007113412531115651015756 0ustar hornikusers# # tree manipulation # # from coalescenMCMC getIndexEdge <- function(tip, edge) ## 'integer(1)' mustn't be substituted by '0L' except if 'DUP = TRUE': .C("get_single_index_integer", as.integer(edge[, 2L]), as.integer(tip), integer(1L), PACKAGE = "phangorn", NAOK = TRUE)[[3L]] getIndexEdge2 <- function(node, edge) .C("get_two_index_integer", as.integer(edge[, 1L]), as.integer(node), integer(2L), PACKAGE = "phangorn", NAOK = TRUE)[[3L]] # no checks for postorder getRoot <- function (tree) { if(!is.null(attr(tree, "order")) && attr(tree, "order") == "postorder"){ return(tree$edge[nrow(tree$edge), 1]) } res = unique(tree$edge[, 1][!match(tree$edge[, 1], tree$edge[, 2], 0)]) if (length(res) == 1) return(res) else stop("There are apparently two root edges in your tree") } # renames root node reroot <- function (tree, node) { anc = Ancestors(tree, node, "all") l = length(anc) if(is.na(match(node,tree$edge[,1])))stop("node not in tree") if(l==0)return(tree) ind = match(c(node, anc[-l]), tree$edge[, 2]) tree$edge[ind, c(1, 2)] = tree$edge[ind, c(2, 1)] root = anc[l] tree$edge[tree$edge == root] = 0L tree$edge[tree$edge == node] = root tree$edge[tree$edge == 0L] = node # needed for unrooted trees tree <- collapse.singles(tree) attr(tree, "order") <- NULL reorder(tree, "postorder") } reroot2 <- function(tree, node) { if(node==getRoot(tree)) return(tree) anc = Ancestors(tree, node, "all") l = length(anc) ind = match(c(node, anc[-l]), tree$edge[, 2]) tree$edge[ind, c(1, 2)] = tree$edge[ind, c(2, 1)] reorderPruning(tree) } changeEdge = function (tree, swap, edge = NULL, edge.length = NULL) { attr(tree, "order") = NULL child <- tree$edge[, 2] tmp = numeric(max(child)) tmp[child] = 1:length(child) tree$edge[tmp[swap[1]], 2] = swap[2] tree$edge[tmp[swap[2]], 2] = swap[1] if (!is.null(edge)) { tree$edge.length[tmp[edge]] = edge.length } reorder(tree, "postorder") } changeEdgeLength = function (tree, edge, edge.length) { tree$edge.length[match(edge, tree$edge[,2])] = edge.length tree } # O(n) statt O(n^2) Speicher und Geschwindigkeit midpoint <- function(tree){ # distance from node to root node2root <- function(x){ x = reorder(x, "postorder") el = numeric(max(x$edge)) parents <- x$edge[, 1] child <- x$edge[, 2] el[child] = x$edge.length l = length(parents) res <- numeric(max(x$edge)) for(i in l:1){ res[child[i]] = el[child[i]] + res[parents[i]] } res } oldtree <- tree tree = unroot(tree) nTips = length(tree$tip) maxD1 = node2root(tree)[1:nTips] ind = which.max(maxD1) tmproot = Ancestors(tree, ind, "parent") tree = reroot(tree, tmproot) el = numeric(max(tree$edge)) el[tree$edge[,2]]=tree$edge.length maxdm = el[ind] tree$edge.length[tree$edge[,2]==ind] = 0 maxD1 = node2root(tree)[1:nTips] tree$edge.length[tree$edge[,2]==ind] = maxdm ind = c(ind, which.max(maxD1) ) maxdm = maxdm + maxD1[ind[2]] rn = max(tree$edge)+1 edge = tree$edge el = tree$edge.length children = tree$edge[,2] left = match(ind[1], children) tmp = Ancestors(tree, ind[2], "all") tmp= c(ind[2], tmp[-length(tmp)]) right = match(tmp, children) if(el[left]>= (maxdm/2)){ edge = rbind(edge, c(rn, ind[1])) edge[left,2] = rn el[left] = el[left] - (maxdm/2) el = c(el, maxdm/2) } else{ sel = cumsum(el[right]) i = which(sel>(maxdm/2))[1] edge = rbind(edge, c(rn, tmp[i])) edge[right[i],2] = rn eltmp = sel[i] - (maxdm/2) el = c(el, el[right[i]] - eltmp) el[right[i]] = eltmp } tree$edge.length = el tree$edge=edge tree$Nnode = tree$Nnode+1 attr(tree, "order") <- NULL tree <- reorder(reroot(tree, rn), "postorder") if(!is.null(oldtree$node.label))tree <- addConfidences.phylo(tree, oldtree) tree } pruneTree = function(tree, ..., FUN = ">="){ if(is.null(tree$node)) stop("no node labels") if(is.rooted(tree)) tree = unroot(tree) m = max(tree$edge) nTips = length(tree$tip) bs = rep(TRUE, m) bs[ (nTips+1) : m] = sapply(as.numeric(as.character(tree$node)), FUN,...) tree$edge.length[!bs[tree$edge[,2]]] = 0 reorder(di2multi(tree), "postorder") } # requires postorder # works fine with fit.fitch # for internal use in fitch.spr # pos statt i dropTip <- function(x, i, check.binary=FALSE, check.root=TRUE){ edge <- x$edge # edge1 <- edge[,1] # edge2 <- edge[,2] root <- getRoot(x) ch <- which(edge[,2] == i) pa <- edge[ch,1] edge = edge[-ch,] ind <- which(edge[,1] == pa) if(root == pa){ if(length(ind)==1){ edge = edge[-ind,] x$Nnode=x$Nnode-1L } if(length(ind)==2){ n = dim(edge)[1] newroot = edge[n-2L,1] newedge = edge[ind,2] if(newedge[1]==newroot)edge[n-1,] <- newedge else edge[n-1,] <- newedge[2:1] edge = edge[-n,] x$Nnode=x$Nnode-1L edge[edge==newroot] = root pa <- newroot } # todo handle unrooted trees } else{ nind <- which(edge[,2] == pa) # normal binary case if(length(ind)==1){ edge[nind,2] = edge[ind,2] edge <- edge[-ind,] x$Nnode <- x$Nnode-1L } } # edge[edge>pa] = edge[edge>pa] -1L x$edge <- edge x } # kind of works well too dropTip2 <- function(x, i, check.binary=FALSE, check.root=TRUE){ edge <- x$edge root <- getRoot(x) ch <- which(edge[,2] == i) pa <- edge[ch,1] edge = edge[-ch,] ind <- which(edge[,1] == pa) if(root == pa){ if(length(ind)==1){ edge = edge[-ind,] x$Nnode=x$Nnode-1L } if(length(ind)==2){ n = dim(edge)[1] newroot = edge[n-2L,1] newedge = edge[ind,2] if(newedge[1]==newroot)edge[n-1,] <- newedge else edge[n-1,] <- newedge[2:1] edge = edge[-n,] x$Nnode=x$Nnode-1L edge[edge==newroot] = root pa <- newroot } # todo handle unrooted trees } else{ nind <- which(edge[,2] == pa) # normal binary case if(length(ind)==1){ edge[nind,2] = edge[ind,2] edge <- edge[-ind,] x$Nnode <- x$Nnode-1L } } # # edge[edge>pa] = edge[edge>pa] -1L x$edge <- edge x } # like drop tip and returns two trees, # to be used in fitch.spr # ch = allKids(edge, nTips) descAll = function (x, node, nTips, ch) { edge = x[,1] m = max(x) isInternal = logical(m) isInternal[(nTips+1):m] = TRUE desc = function(node, isInternal) { if (!isInternal[node]) return(node) res = NULL while (length(node) > 0) { tmp = unlist(ch[node]) res = c(res, tmp) node = tmp[isInternal[tmp]] } res } desc(node, isInternal) } dropNode <- function(x, i, check.binary=FALSE, check.root=TRUE, all.ch=NULL){ edge <- x$edge root <- getRoot(x) ch <- which(edge[,2] == i) # getIndexEdge(tip, edge) nTips <- length(x$tip.label) pa <- edge[ch,1] if(i>nTips){ # kids <- Descendants(x, i, "all") if(is.null(all.ch)) all.ch=allChildren(x) kids <- descAll(edge, i, nTips, all.ch) ind <- match(kids,edge[,2]) edge2 <- edge[sort(ind),] edge <- edge[-c(ch, ind),] } else edge = edge[-ch,] if(nrow(edge)<3)return(NULL) ind <- which(edge[,1] == pa) if(root == pa){ if(length(ind)==1){ edge = edge[-ind,] x$Nnode=x$Nnode-1L } if(length(ind)==2){ n = dim(edge)[1] newroot = edge[n-2L,1] newedge = edge[ind,2] if(newedge[1]==newroot)edge[n-1,] <- newedge else edge[n-1,] <- newedge[2:1] edge = edge[-n,] x$Nnode=length(unique(edge[,1])) edge[edge==newroot] = root pa <- newroot } # todo handle unrooted trees } else{ nind <- which(edge[,2] == pa) # normal binary case if(length(ind)==1){ edge[nind,2] = edge[ind,2] edge <- edge[-ind,] x$Nnode <- length(unique(edge[,1])) } } # # edge[edge>pa] = edge[edge>pa] -1L x$edge <- edge y <- x y$edge <- edge2 y$Nnode <- length(unique(edge2[,1])) list(x, y, pa) } dropNodeNew <- function(edge, i, nTips, check.binary=FALSE, check.root=TRUE){ root <- edge[nrow(edge),2] ch <- which(edge[,2] == i) pa <- edge[ch,1] edge2=NULL # einfachere allChildren Variante 2*schneller allKids = function (edge, nTips) { parent = edge[, 1] children = edge[, 2] .Call("AllChildren", as.integer(children), as.integer(parent), as.integer(max(edge)), PACKAGE = "phangorn") } descAll = function (edge, node, nTips) { ch = allKids(edge, nTips) isInternal = logical(max(edge)) isInternal[unique(edge[, 1])] = TRUE desc = function(node, isInternal) { if (!isInternal[node]) return(node) res = NULL while (length(node) > 0) { tmp = unlist(ch[node]) res = c(res, tmp) node = tmp[isInternal[tmp]] } res } desc(node, isInternal) } if(i>nTips){ kids <- descAll(edge, i, nTips) ind <- match(kids,edge[,2]) edge2 <- edge[sort(ind),] edge <- edge[-c(ch, ind),] } else edge = edge[-ch,] if(nrow(edge)<3)return(NULL) ind <- which(edge[,1] == pa) if(root == pa){ if(length(ind)==1){ edge = edge[-ind,] } if(length(ind)==2){ n = dim(edge)[1] newroot = edge[n-2L,1] newedge = edge[ind,2] if(newedge[1]==newroot)edge[n-1,] <- newedge else edge[n-1,] <- newedge[2:1] edge = edge[-n,] edge[edge==newroot] = root pa <- newroot } # todo handle unrooted trees } else{ nind <- which(edge[,2] == pa) # normal binary case if(length(ind)==1){ edge[nind,2] = edge[ind,2] edge <- edge[-ind,] } } # # edge[edge>pa] = edge[edge>pa] -1L list(edge, edge2, pa) } dropTipNew <- function(edge, i, nTips, check.binary=FALSE, check.root=TRUE){ root <- edge[nrow(edge),2] ch <- which(edge[,2] == i) pa <- edge[ch,1] edge = edge[-ch,] ind <- which(edge[,1] == pa) if(root == pa){ if(length(ind)==1){ edge = edge[-ind,] } if(length(ind)==2){ n = dim(edge)[1] newroot = edge[n-2L,1] newedge = edge[ind,2] if(newedge[1]==newroot)edge[n-1,] <- newedge else edge[n-1,] <- newedge[2:1] edge = edge[-n,] edge[edge==newroot] = root pa <- newroot } # todo handle unrooted trees } else{ nind <- which(edge[,2] == pa) # normal binary case if(length(ind)==1){ edge[nind,2] = edge[ind,2] edge <- edge[-ind,] } } # edge[edge>pa] = edge[edge>pa] -1L edge } # postorder remained tip in 1:nTips addOne <- function (tree, tip, i){ edge = tree$edge parent = edge[,1] l = dim(edge)[1] m = max(edge)+1L p = edge[i,1] k = edge[i,2] edge[i, 2] = m ind = match(p, parent) if(ind==1) edge = rbind(matrix(c(m,m,k,tip), 2, 2), edge) else edge = rbind(edge[1:(ind-1), ], matrix(c(m,m,k,tip), 2, 2), edge[ind:l, ]) tree$edge = edge tree$Nnode = tree$Nnode+1 tree } addOneTree <- function (tree, subtree, i, node){ edge = tree$edge parent = edge[,1] l = dim(edge)[1] m = node #max(edge)+1L p = edge[i,1] k = edge[i,2] edge[i, 2] = m edge2 = subtree$edge ind = match(p, parent) r2 = edge2[nrow(edge2),1] if(ind==1) edge = rbind(edge2, matrix(c(m,m,r2,k), 2, 2), edge) else edge = rbind(edge[1:(ind-1), ], edge2, matrix(c(m,m,r2,k), 2, 2), edge[ind:l, ]) tree$edge = edge tree$Nnode = tree$Nnode + subtree$Nnode + 1L attr(tree, "order") = NULL tips1 = as.integer(length(tree$tip) + 1L) tmproot = getRoot(tree) if(tmproot!=tips1){ tree$edge[tree$edge==tmproot] = 0L tree$edge[tree$edge==tips1] = tmproot tree$edge[tree$edge==0L] = tips1 } tree <- reorder(tree, "postorder") if(tmproot!=tips1) tree <- unroot(tree) tree } reorderPruning <- function (x, ...) { parents <- as.integer(x$edge[, 1]) child <- as.integer(x$edge[, 2]) root <- as.integer(parents[!match(parents, child, 0)][1]) # unique out if (length(root) > 2) stop("more than 1 root found") n = length(parents) m = max(x$edge) # edge parents neworder = .C("C_reorder", parents, child, as.integer(n), as.integer(m), integer(n), as.integer(root-1L), PACKAGE = "phangorn")[[5]] x$edge = x$edge[neworder,] x$edge.length = x$edge.length[neworder] attr(x, "order") <- "pruningwise" x } add.tip <- function(phy, n, edgeLength=NULL, tip=""){ ind <- which(phy$edge[,2] == n) phy <- new2old.phylo(phy) edge <- matrix(as.numeric(phy$edge),ncol=2) k <- min(edge) l <- max(edge) phy$edge <- rbind(phy$edge, c(k-1,phy$edge[ind,2])) phy$edge <- rbind(phy$edge, c(k-1,l+1)) phy$edge[ind,2] = k-1 phy$edge.length[ind] = edgeLength[1] phy$edge.length <- c(phy$edge.length, edgeLength[-1]) phy$tip.label <- c(phy$tip.label, tip) phy <- old2new.phylo(phy) phy <- reorder(phy, "postorder") phy } nnin <- function (tree, n) { attr(tree, "order") = NULL tree1 = tree tree2 = tree edge = matrix(tree$edge, ncol = 2) parent = edge[, 1] child = tree$edge[, 2] k = min(parent) - 1 ind = which(child > k)[n] if(is.na(ind))return(NULL) p1 = parent[ind] p2 = child[ind] ind1 = which(parent == p1) ind1 = ind1[ind1 != ind][1] ind2 = which(parent == p2) e1 = child[ind1] e2 = child[ind2[1]] e3 = child[ind2[2]] tree1$edge[ind1, 2] = e2 tree1$edge[ind2[1], 2] = e1 tree2$edge[ind1, 2] = e3 tree2$edge[ind2[2], 2] = e1 if(!is.null(tree$edge.length)){ tree1$edge.length[c(ind1, ind2[1])] = tree$edge.length[c(ind2[1] ,ind1)] tree2$edge.length[c(ind1, ind2[2])] = tree$edge.length[c(ind2[2] ,ind1)] } tree1 <- reorder(tree1, "postorder") tree2 <- reorder(tree2, "postorder") # tree1$tip.label <- tree2$tip.label <- NULL result = list(tree1, tree2) result } nni <- function (tree) { tip.label <- tree$tip.label attr(tree, "order") = NULL k = min(tree$edge[, 1]) - 1 n = sum(tree$edge[, 2] > k) result = vector("list", 2*n) l=1 for (i in 1:n) { tmp = nnin(tree, i) tmp[[1]]$tip.label <- tmp[[2]]$tip.label <- NULL result[c(l, l+1)] = tmp l = l + 2 } attr(result, "TipLabel") <- tip.label class(result) <- "multiPhylo" result } allTrees <- function (n, rooted = FALSE, tip.label = NULL) { n <- as.integer(n) nt <- as.integer(round(dfactorial(2 * (n + rooted) - 5))) if ((n + rooted) > 10) { nt <- dfactorial(2 * (n + rooted) - 5) stop("That would generate ", round(nt), " trees, and take up more than ", round(nt/1000), " MB of memory!") } if (n < 2) { stop("A tree must have at least two taxa.") } if (!rooted && n == 2) { stop("An unrooted tree must have at least three taxa.") } if (rooted) { edge <- matrix(NA, 2*n-2, 2) edge[1:2,] <- c(n+1L, n+1L, 1L, 2L) } else { edge <- matrix(NA, 2*n-3, 2) edge[1:3,] <- c(n+1L, n+1L, n+1L, 1L, 2L, 3L) } edges <- list() edges[[1]] <- edge m=1 nedge = 1 trees <- vector("list", nt) if ((n + rooted) > 3) { i = 3L + (!rooted) pa = n + 2L nr = 2L + (!rooted) while(i < (n+1L)){ nedge = nedge+2 m2 = m * nedge newedges <- vector("list", m2) for (j in 1:m) { edge <- edges[[j]] l <- nr # nrow(edge) edgeA <- edge edgeB <- edge for (k in 1L:l) { edge = edgeA node <- edge[k, 1] edge[k, 1] <- pa edge[l + 1, ] <- c(pa, i) edge[l + 2, ] <- c(node, pa) newedges[[(j - 1) * (l + rooted) + k]] <- edge } if(rooted) { edgeB[] <- as.integer(sub(n+1L, pa, edgeB)) edge = edgeB edge[l + 1, ] <- c(n+1L, i) edge[l + 2, ] <- c(n+1L, pa) newedges[[j * (l + 1)]] <- edge } } # end for edges <- newedges m=m2 i = i + 1L pa = pa + 1L nr = nr + 2L } # end for m } # end if for (x in 1:m) { tree <- list(edge = edges[[x]]) tree$Nnode <- n - 2L + rooted class(tree) <- "phylo" trees[[x]] <- reorderPruning(tree) } attr(trees, "TipLabel") <- if (is.null(tip.label)) paste("t", 1:n, sep = "") else tip.label class(trees) <- "multiPhylo" trees } dn <- function (x){ if (!is.binary.tree(x) ) x <- multi2di(x, random = FALSE) x = reroot2(x, 1) n <- length(x$tip.label) n.node <- x$Nnode N <- n + n.node x <- reorderPruning(x) res <- matrix(NA, N, N) res[cbind(1:N, 1:N)] <- 0 res[x$edge] <- res[x$edge[, 2:1]] <- 1 for (i in seq(from = 1, by = 2, length.out = n.node)) { j <- i + 1 anc <- x$edge[i, 1] des1 <- x$edge[i, 2] des2 <- x$edge[j, 2] if (des1 > n) des1 <- which(!is.na(res[des1, ])) if (des2 > n) des2 <- which(!is.na(res[des2, ])) for (y in des1) res[y, des2] <- res[des2, y] <- res[anc, y] + res[anc, des2] if (anc != 1) { ind <- which(x$edge[, 2] == anc) nod <- x$edge[ind, 1] l <- length(ind) res[des2, nod] <- res[nod, des2] <- res[anc, des2] + l res[des1, nod] <- res[nod, des1] <- res[anc, des1] + l } } dimnames(res)[1:2] <- list(1:N) res } # replace with dist.nodes dn <- function(x){ # if (!is.binary.tree(x) ) x <- multi2di(x, random = FALSE) if(is.null(x$edge.length))x$edge.length=rep(1,nrow(x$edge)) else x$edge.length[] = 1 dist.nodes(x) } rSPR = function (tree, moves = 1, n = length(moves), k=NULL) { if (n == 1) { trees = tree for (i in 1:moves) trees = kSPR(trees, k=k) } else { trees = vector("list", n) if(length(moves)==1) moves = rep(moves, n) for (j in 1:n) { tmp = tree if(moves[j]>0){ for (i in 1:moves[j]) tmp = kSPR(tmp, k=k) } tmp$tip.label = NULL trees[[j]] = tmp } attr(trees, "TipLabel") <- tree$tip.label class(trees) <- "multiPhylo" } trees } kSPR = function(tree, k=NULL){ l <- length(tree$tip.label) root= getRoot(tree) distN = dn(tree)[-c(1:l), -c(1:l)] distN[upper.tri(distN)]=Inf dN = distN[lower.tri(distN)] tab = table(dN) tab[1] = tab[1] * 2 tab[-1] = tab[-1] * 8 if(is.null(k)) k = 1:length(tab) k = na.omit((1:length(tab))[k]) if(length(k)>1)k = sample((1:length(tab))[k], 1, prob=tab[k] / sum(tab[k]) ) if(k==1) return(rNNI(tree, 1, 1)) index = which(distN==k, arr.ind=TRUE) + l m = dim(index)[1] if(m==0)stop("k is chosen too big") ind = index[sample(m, 1),] s1 = sample(c(1,2),1) if(s1==1)res = (oneOf4(tree, ind[1], ind[2], sample(c(1,2),1), sample(c(1,2),1))) if(s1==2)res = (oneOf4(tree, ind[2], ind[1], sample(c(1,2),1), sample(c(1,2),1))) res=reroot2(res, root) reorderPruning(res) } oneOf4 = function(tree, ind1, ind2, from=1, to=1){ if (!is.binary.tree(tree)) stop("Sorry, trees must be binary!") tree=reroot2(tree, ind2) trees = vector('list', 8) kids1 = Children(tree, ind1) anc = Ancestors(tree, ind1, "all") l = length(anc) kids2 = Children(tree, ind2) kids2 = kids2[kids2!=anc[l-1]] child = tree$edge[,2] tmp = numeric(max(tree$edge)) tmp[child] = 1:length(child) edge = tree$edge edge[tmp[kids1[-from]],1] = Ancestors(tree, ind1, "parent") edge[tmp[kids2[to]],1] = ind1 edge[tmp[ind1]] = ind2 tree$edge=edge reorderPruning(tree) } # faster than kSPR rSPR_Old <- function(tree, moves=1, n=1){ k=length(tree$edge[,1]) if(n==1){ trees = tree for(i in 1:moves) trees = sprMove(trees,sample(k,1)) } else{ trees = vector("list", n) for(j in 1:n){ tmp = tree for(i in 1:moves) tmp = sprMove(tmp,sample(k,1)) tmp$tip.label=NULL trees[[j]] = tmp } attr(trees, "TipLabel") <- tree$tip.label class(trees) <- "multiPhylo" } trees } sprMove <- function(tree, m){ if (is.rooted(tree)) tree <- unroot(tree) #stop("Sorry trees must be unrooted") if(!is.binary.tree(tree))stop("Sorry trees must be binary!") reroot2 <- function(tree, node){ anc = Ancestors(tree, node, "all") l = length(anc) ind = match(c(node, anc[-l]), tree$edge[,2]) tree$edge[ind,c(1,2)] = tree$edge[ind,c(2,1)] tree } changeEdge <- function(tree, new, old){ tree$edge[tree$edge==old] = 0L tree$edge[tree$edge==new] = old tree$edge[tree$edge==0L] = new # needed for unrooted trees tree <- collapse.singles(tree) tree } edge = tree$edge k = max(edge) nTips = length(tree$tip) nEdges = 2*nTips-3 if(m > nEdges) stop("m to big") parent = edge[,1] child = edge[,2] pv = integer(k) pv[child] = parent cv = list() for(i in unique(parent)) cv[[i]] = child[parent==i] bp = bip(tree) root <- parent[!match(parent, child, 0)][1] ch = child[m] pa = parent[m] candidates = !logical(k) candidates[root] = FALSE candidates[cv[[ch]]] = FALSE candidates[cv[[pa]]] = FALSE candidates[pv[pa]] = FALSE candidates[pa] = FALSE ind = which(candidates) l = sample(ind,1) cr=FALSE if(!any(is.na(match(bp[[l]], bp[[ch]]))) ){ newroot = cv[[ch]] #[ 1] newroot = newroot[newroot>nTips][1] tree <- reroot2(tree, newroot) edge = tree$edge parent = tree$edge[,1] child = tree$edge[,2] pv = integer(k) pv[child] = parent cv = list() for(i in unique(parent)) cv[[i]] = child[parent==i] tmp = pa pa=ch ch=tmp cr = TRUE } if(pa==root){ cp = cv[[pa]] newroot = cp[cp!=ch] newroot = newroot[newroot>nTips][1] # if(length(newroot)==0)browser() #!newroot = cp[cp>nTips][1] tree = reroot2(tree, newroot) edge = tree$edge parent = tree$edge[,1] child = tree$edge[,2] pv = integer(k) pv[child] = parent cv = list() for(i in unique(parent)) cv[[i]] = child[parent==i] cr = TRUE } el = tree$edge.length cp = cv[[pa]] sib = cp[cp!=ch] edge[child==l,1] = pa edge[child==pa,1] = pv[l] edge[child==sib,1] = pv[pa] el[child==sib] = el[child==sib] + el[child==pa] el[child==l] = el[child==l] / 2 el[child==pa] = el[child==l] tree$edge=edge tree$edge.length = el if(cr) tree <- changeEdge(tree,root,newroot) tree <- reorder(tree, "postorder") tree } rNNI <- function (tree, moves = 1, n = length(moves)) { k = length(na.omit(match(tree$edge[, 2], tree$edge[, 1]))) if (n == 1) { trees = tree if(moves>0){ for (i in 1:moves) trees = nnin(trees, sample(k, 1))[[sample(2,1)]] } trees$tip.label <- tree$tip.label } else { trees = vector("list", n) if(length(moves)==1) moves = rep(moves, n) for (j in 1:n) { tmp = tree if(moves[j]>0){ for (i in 1:moves[j]) tmp = nnin(tmp, sample(k, 1))[[sample(2,1)]] } tmp$tip.label = NULL trees[[j]] = tmp } attr(trees, "TipLabel") <- tree$tip.label class(trees) <- "multiPhylo" } trees } # # some generic tree functions # allAncestors <- function(x){ x = reorder(x, "postorder") parents <- x$edge[, 1] child <- x$edge[, 2] l = length(parents) res <- vector("list",max(x$edge)) for(i in l:1){ pa = parents[i] res[[child[i]]] = c(pa, res[[pa]]) } res } Ancestors <- function (x, node, type = c("all", "parent")) { parents <- x$edge[, 1] child <- x$edge[, 2] pvector <- numeric(max(x$edge)) # parents pvector[child] <- parents type <- match.arg(type) if (type == "parent") return(pvector[node]) anc <- function(pvector, node){ res <- numeric(0) repeat { anc <- pvector[node] if (anc == 0) break res <- c(res, anc) node <- anc } res } if(length(node)==1) return(anc(pvector, node)) else allAncestors(x)[node] } allChildren <- function(x){ l = length(x$tip) if(l<20){ parent = x$edge[,1] children = x$edge[,2] res = vector("list", max(x$edge)) for(i in 1:length(parent)) res[[parent[i]]] = c(res[[parent[i]]], children[i]) return(res) } else{ if (is.null(attr(x, "order")) || attr(x, "order") == "cladewise") x <- reorder(x, "postorder") parent = x$edge[,1] children = x$edge[,2] res <- .Call("AllChildren", as.integer(children), as.integer(parent), as.integer(max(x$edge))) # , PACKAGE="phangorn" return(res) } } Children <- function(x, node){ if(length(node)==1)return(x$edge[x$edge[,1]==node,2]) allChildren(x)[node] } Descendants = function(x, node, type=c("tips","children","all")){ type <- match.arg(type) if(type=="children") return(Children(x, node)) if(type=="tips") return(bip(x)[node]) ch = allChildren(x) # out of the loop isInternal = logical(max(x$edge)) isInternal[ unique(x$edge[,1]) ] =TRUE desc = function(node, isInternal){ if(!isInternal[node])return(node) res = NULL while(length(node)>0){ tmp = unlist(ch[node]) res = c(res, tmp) node = tmp[isInternal[tmp]] } res } if(length(node)>1) return(lapply(node, desc, isInternal)) desc(node, isInternal) } Siblings = function (x, node, include.self = FALSE) { l = length(node) if(l==1){ v <- Children(x, Ancestors(x, node, "parent")) if (!include.self) v <- v[v != node] return(v) } else{ parents <- x$edge[, 1] child <- x$edge[, 2] pvector <- integer(max(x$edge)) # parents pvector[child] <- parents root <- as.integer(parents[!match(parents, child, 0)][1]) res = vector("list", l) ch = allChildren(x) if(include.self) return(ch[ pvector[node] ]) k = 1 for(i in node){ if(i != root){ tmp <- ch[[ pvector[i] ]] res[[k]] = tmp[tmp != i] } k=k+1 } } res } mrca.phylo <- function(x, node){ anc <- Ancestors(x, node, type = "all") res <- Reduce(intersect, anc)[1] res } # mrca.phylo <- getMRCA # 1090 rNNI_Old <- function(tree, moves=1, n=1){ k = length(na.omit(match(tree$edge[,2], tree$edge[,1]))) if(n==1){ trees = tree for(i in 1:moves) trees = nnin(trees,sample(k,1))[[sample(2,1)]] trees$tip.label <- tree$tip.label } else{ trees = vector("list", n) for(j in 1:n){ tmp = tree for(i in 1:moves) tmp = nnin(tmp, sample(k,1))[[sample(2,1)]] tmp$tip.label=NULL trees[[j]] = tmp } attr(trees, "TipLabel") <- tree$tip.label class(trees) <- "multiPhylo" } trees } phangorn/R/dist.p.R0000644000175100001440000000461312507002037013631 0ustar hornikusers dist.p <- function (x, cost="polymorphism", ignore.indels=TRUE) { if (class(x) != "phyDat") stop("x has to be element of class phyDat") l = length(x) weight <- attr(x, "weight") n <- length(attr(x, "allLevels")) d = numeric((l * (l - 1))/2) lev = attr(x, "allLevels") if(is.null(cost)){ cost <- 1 - diag(n) dimnames(cost) = list(lev, lev) } # if(cost=="polymorphism" && attr(x, "type")=="DNA"){ if(cost=="polymorphism"){ costLev = c('a','c','t','u','g','x','m','r','w','s','y','k','v','h','d','b','-','?','n') cost <- matrix(c( #a,c,t,u,g,X,m,r,w,s,y,k,v,h,d,b,-,?,n, 0,2,2,2,2,1,1,1,1,3,3,3,2,2,2,4,2,0,0, #a 2,0,2,2,2,1,1,3,3,1,1,3,2,2,4,2,2,0,0, #c 2,2,0,0,2,1,3,3,1,3,1,1,4,2,2,2,2,0,0, #t 2,2,0,0,2,1,3,3,1,3,1,1,4,2,2,2,2,0,0, #u 2,2,2,2,0,1,3,1,3,1,3,1,2,4,2,2,2,0,0, #g 1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,0,0, #X 1,1,3,3,3,1,0,2,2,2,2,4,1,1,3,3,3,0,0, #m 1,3,3,3,1,1,2,0,2,2,4,2,1,3,1,3,3,0,0, #r 1,3,1,1,3,1,2,2,0,4,2,2,3,1,1,3,3,0,0, #w 3,1,3,3,1,1,2,2,4,0,2,2,1,3,3,1,3,0,0, #s 3,1,1,1,3,1,2,4,2,2,0,2,3,1,3,1,3,0,0, #y 3,3,1,1,1,1,4,2,2,2,2,0,3,3,1,1,3,0,0, #k 2,2,4,4,2,1,1,1,3,1,3,3,0,2,2,2,4,0,0, #v 2,2,2,2,4,1,1,3,1,3,1,3,2,0,2,2,4,0,0, #h 2,4,2,2,2,1,3,1,1,3,3,1,2,2,0,2,4,0,0, #d 4,2,2,2,2,1,3,3,3,1,1,1,2,2,2,0,4,0,0, #b 2,2,2,2,2,1,3,3,3,3,3,3,4,4,4,4,0,0,0, #- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, #? 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0),#n ncol = 19,nrow=19,dimnames=list(costLev,costLev)) } lev1 = dimnames(cost)[[1]] if(any(is.na(match(lev, lev1)))) stop("Levels of x are not in levels of cost matrix!") if (ignore.indels) { cost["-",]=0 cost[,"-"]=0 } cost <- cost[lev, lev] k = 1 for (i in 1:(l - 1)) { for (j in (i + 1):l) { d[k] = sum(weight * cost[cbind(x[[i]], x[[j]])]) k = k + 1 } } attr(d, "Size") <- l if (is.list(x)) attr(d, "Labels") <- names(x) else attr(d, "Labels") <- colnames(x) attr(d, "Diag") <- FALSE attr(d, "Upper") <- FALSE attr(d, "call") <- match.call() attr(d, "method") <- "p" class(d) <- "dist" return(d) } phangorn/R/zzz.R0000644000175100001440000000056312507565027013302 0ustar hornikusers## zzz.R .packageName <- "phangorn" .aamodels <- c("WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa", "mtREV24", "VT","RtREV", "HIVw", "HIVb", "FLU","Blosum62","Dayhoff_DCMut","JTT_DCMut") # if g[i] is smaller .gEps inv is increased w[i] .gEps <- 1e-30 # .onLoad <- function(libname, pkgname) { # library.dynam("phangorn", pkgname, libname) #} phangorn/R/parsimony.R0000644000175100001440000006000612542606246014462 0ustar hornikusers# # Maximum Parsimony # rowMin = function(X){ d=dim(X) .Call("C_rowMin", X, as.integer(d[1]), as.integer(d[2]), PACKAGE = "phangorn") } sankoff.quartet <- function (dat, cost, p, l, weight) { erg <- .Call("sankoffQuartet", sdat = dat, sn = p, scost = cost, sk = l, PACKAGE = "phangorn") sum(weight * erg) } parsimony <- function(tree, data, method='fitch', ...){ if (class(data)[1] != "phyDat") stop("data must be of class phyDat") if(method=='sankoff') result <- sankoff(tree, data, ...) if(method=='fitch') result <- fitch(tree, data, ...) result } ancestral.pars <- function (tree, data, type = c("MPR", "ACCTRAN"), cost=NULL) { call <- match.call() type <- match.arg(type) if (type == "ACCTRAN") res = ptree(tree, data, retData = TRUE)[[2]] # if (type == "MPR") # res = mpr(tree, data) if (type == "MPR"){ res <- mpr(tree, data, cost=cost) attr(res, "call") = call return(res) } l = length(tree$tip) x = attributes(data) m = dim(res)[2] label = as.character(1:m) nam = tree$tip.label label[1:length(nam)] = nam x[["names"]] = label nc = attr(data, "nc") result = vector("list", m) Z = unique(as.vector(res)) tmp = t(sapply(Z, function(x)dec2bin(x, nc))) tmp = tmp / rowSums(tmp) # rownames(tmp) = Z dimnames(tmp) = list(Z, attr(data, "levels")) for(i in 1:m){ # tmp = t(sapply(res[,i], function(x, k=4)dec2bin(x, nc))) # result[[i]] = tmp / rowSums(tmp) no indices # test = match(res[,i], Z) sollte stimmen wegen fitch result[[i]] = tmp[as.character(res[,i]),,drop=FALSE] rownames(result[[i]]) = NULL } attributes(result) = x attr(result, "call") <- call result } pace <- ancestral.pars mpr.help = function (tree, data, cost=NULL) { tree<- reorder(tree, "postorder") if (class(data) != "phyDat") stop("data must be of class phyDat") levels <- attr(data, "levels") l = length(levels) if (is.null(cost)) { cost <- matrix(1, l, l) cost <- cost - diag(l) } weight = attr(data, "weight") p = attr(data, "nr") kl = TRUE i = 1 dat <- prepareDataSankoff(data) for (i in 1:length(dat)) storage.mode(dat[[i]]) = "double" tmp = fit.sankoff(tree, dat, cost, returnData='data') p0 = tmp[[1]] datf = tmp[[2]] datp = pnodes(tree, datf, cost) nr = attr(data, "nr") nc = attr(data, "nc") node <- tree$edge[, 1] edge <- tree$edge[, 2] node = as.integer(node - 1) edge = as.integer(edge - 1) res <- .Call("sankoffMPR", datf, datp, as.numeric(cost), as.integer(nr),as.integer(nc), node, edge, PACKAGE="phangorn") root = getRoot(tree) res[[root]] <- datf[[root]] res } mpr <- function(tree, data, cost=NULL){ data = subset(data, tree$tip.label) att = attributes(data) nr = att$nr nc = att$nc res <- mpr.help(tree,data,cost) l = length(tree$tip) m = length(res) label = as.character(1:m) nam = tree$tip.label label[1:length(nam)] = nam att[["names"]] = label ntips = length(tree$tip) contrast = att$contrast eps=5e-6 rm = apply(res[[ntips+1]], 1, min) RM = matrix(rm,nr, nc) + eps for(i in 1:ntips) res[[i]] = contrast[data[[i]],,drop=FALSE] for(i in (ntips+1):m) res[[i]][] = as.numeric(res[[i]] < RM) fun = function(X){ rs = apply(X, 1, sum) X / rs } res <- lapply(res, fun) attributes(res) = att res } plotAnc <- function (tree, data, i = 1, col=NULL, cex.pie=par("cex"), pos="bottomright", ...) { y = subset(data, , i) # args <- list(...) # CEX <- if ("cex" %in% names(args)) # args$cex # else par("cex") CEX = cex.pie xrad <- CEX * diff(par("usr")[1:2])/50 levels = attr(data, "levels") nc = attr(data, "nc") y = matrix(unlist(y[]), ncol = nc, byrow = TRUE) l = dim(y)[1] dat = matrix(0, l, nc) for (i in 1:l) dat[i, ] = y[[i]] plot(tree, label.offset = 1.1 * xrad, plot = FALSE, ...) lastPP <- get("last_plot.phylo", envir = .PlotPhyloEnv) XX <- lastPP$xx YY <- lastPP$yy xrad <- CEX * diff(lastPP$x.lim * 1.1)/50 par(new = TRUE) plot(tree, label.offset = 1.1 * xrad, plot = TRUE, ...) if(is.null(col)) col = rainbow(nc) if(length(col)!=nc) warning("Length of color vector differs from number of levels!") BOTHlabels(pie = y, XX = XX, YY = YY, adj = c(0.5, 0.5), frame = "rect", pch = NULL, sel = 1:length(XX), thermo = NULL, piecol = col, col = "black", bg = "lightblue", horiz = FALSE, width = NULL, height = NULL, cex=cex.pie) legend(pos, levels, text.col = col) } prepareDataFitch <- function (data) { lev <- attr(data, "levels") l <- length(lev) nr <- attr(data, "nr") nc <- length(data) contrast <- attr(data, "contrast") tmp = contrast %*% 2L^c(0L:(l - 1L)) tmp = as.integer(tmp) attrData <- attributes(data) nam <- attrData$names attrData$names <- NULL data = unlist(data, FALSE, FALSE) X = tmp[data] attributes(X) <- attrData attr(X, "dim") <- c(nr, nc) dimnames(X) <- list(NULL, nam) X } compressSites <- function(data){ attrData <- attributes(data) lev <- attr(data, "levels") LEV <- attr(data,"allLevels") l <- length(lev) nr <- attr(data, "nr") nc <- length(data) data = unlist(data, FALSE, FALSE) attr(data, "dim") <- c(nr, nc) uni <- match(lev, LEV) fun = function(x, uni) { u = unique.default(x) res= if(any(is.na(match(u, uni)))) return(x) match(x, u) } data = t(apply(data, 1, fun, uni)) ddd = fast.table(data) data = ddd$data class(data) = "list" attrData$weight = tapply(attrData$weight,ddd$index, sum) attrData$index=NULL attrData$nr <- length(attrData$weight) attrData$compressed <- TRUE attributes(data) <- attrData data } is.rooted2 = function(tree){ length(tree$edge[, 1][!match(tree$edge[, 1], tree$edge[, 2], 0)]) < 3 } # # Branch and bound # parsinfo <- function (x) { low = lowerBound(x) up = upperBound(x) ind = which(low==up) cbind(ind, low[ind]) } lowerBound <- function(x, cost=NULL){ tip <- names(x) att = attributes(x) nc = attr(x, "nc") nr = attr(x, "nr") contrast = attr(x, "contrast") rownames(contrast) = attr(x, "allLevels") colnames(contrast) = attr(x, "levels") attr(x, "weight") = rep(1, nr) attr(x, "index") = NULL y <- as.character(x) states <- apply(y, 2, unique.default) # duplicated function(x)x[duplicated(x)]="?" avoids looping if(nr==1) nst <- length(states) else nst <- sapply(states, length) res = numeric(nr) ust = sort(unique(nst)) if(is.null(cost))cost <- 1 - diag(nc) if(any(ust>1)){ ust = ust[ust>1] m <- max(ust) tips = paste("t", 1:m, sep="") # for(i in ust){ dat = matrix(unlist(states[nst==i]), nrow=i, dimnames=list(tips[1:i], NULL)) dat = phyDat(dat, type="USER", contrast=contrast) tree = stree(i) res[nst==i] = sankoffNew(tree, dat, cost=cost, site="site")[attr(dat, "index")] } } res } upperBound <- function(x, cost=NULL){ tree = stree(length(x), tip.label=names(x)) if(is.null(cost))cost <- 1 - diag(attr(x, "nc")) sankoffNew(tree, x, cost=cost, site="site") } CI <- function (tree, data, cost=NULL){ pscore = sankoffNew(tree, data, cost=cost) weight = attr(data, "weight") data = subset(data, tree$tip.label) m = lowerBound(data, cost=cost) sum(m * weight)/pscore } RI <- function (tree, data, cost=NULL) { pscore = sankoffNew(tree, data, cost=cost) data = subset(data, tree$tip.label) weight = attr(data, "weight") m = lowerBound(data, cost=cost) m = sum(m * weight) g = upperBound(data, cost=cost) g = sum(g * weight) (g - pscore)/(g - m) } # not used add.one <- function (tree, tip.name, i){ if (class(tree) != "phylo") stop("tree should be an object of class 'phylo.'") nTips = length(tree$tip) tmpedge = tree$edge m = max(tmpedge) l = nrow(tmpedge) trees <- vector("list", l) tmp = tree tmp$tip.label = c(tree$tip.label, tip.name) tmpedge[tmpedge > nTips] <- tmpedge[tmpedge > nTips] + 1L tmp$Nnode = tmp$Nnode + 1L tmp$edge.length <- NULL tmpedge = rbind(tmpedge, matrix(c(m + 2L, m + 2L, 0L, nTips + 1L), 2, 2)) edge = tmpedge edge[l + 1L, 2] <- edge[i, 2] edge[i, 2] <- m + 2L neworder = .C("C_reorder", edge[, 1], edge[, 2], as.integer(l + 2L), as.integer(m + 2L), integer(l + 2L), as.integer(nTips + 1L), PACKAGE = "phangorn")[[5]] tmp$edge <- edge[neworder, ] tmp } mmsNew0 <- function (x, Y) { w <- attr(x, "weight") names(w) = NULL m = length(x) data <- matrix(unlist(x[1:m]), ncol = m) l = nrow(data) v = Y[,1] + 1L # v = numeric(l) # for (i in 1:l) v[i] = length(.Internal(unique(data[i, ], # FALSE, FALSE))) result = matrix(NA, sum(w), 6) Res = matrix(NA, sum(w), m) Res2 = matrix(NA, sum(w), m) j = 1 res = 0 bin = as.integer(2L^c(0L:30L)) for (i in 1:(l - 1L)) { if (w[i] > 0) { v2 = v[i] + v[(i + 1L):l] - 2L v3 = integer(l - i) ind = which(w[(i + 1):l] > 0) V3 = matrix(NA, m, l - i) k = length(ind) V3[, ind] <- t(data[ind + i, , drop = FALSE]) + 100L * data[i, ] v3[ind] <- apply(V3[, ind, drop = FALSE], 2, function(x) { length(unique.default(x, FALSE, FALSE)) - 1L }) # length(.Internal(unique(x, FALSE, FALSE))) - 1L }) r = v3 - v2 while (any(r > 0) && w[i] > 0) { a = which.max(r) w0 = min(w[i], w[i + a]) if (w0 == 0) { r[a] = 0 } else { res = res + w0 * v3[a] w[i] = w[i] - w0 w[i + a] = w[i + a] - w0 result[j, ] = c(i, a + i, w0, r[a], v3[a], v2[a]) abc = V3[, a] Res[j, ] = bin[match(abc, unique(abc))] Res2[j, ] = match(abc, unique(abc)) r[a] = 0 j = j + 1 } } } } result = na.omit(result) mm = max(result[, 5]) Res = na.omit(Res) Res2 = na.omit(Res2) maxr = max(Res2) resm = apply(Res2, 1, function(x) { length(unique.default(x, FALSE, FALSE)) - 1L }) # length(.Internal(unique(x, FALSE, FALSE))) - 1L }) Res2 = t(Res2) Res2 = phyDat(Res2, type="USER", levels=1:maxr) names(Res2) = as.character(1:m) resm = lowerBound(Res2) ind = which(w > 0) # data = data[ind, ] tmp = matrix(0, attr(Res2, "nr"), m) for (i in 4:m) { tmp[, i] = resm - upperBound(subset(Res2, 1:i)) } tmp = tmp[attr(Res2, "index"), , drop=FALSE] tmp2 = Y[result[,1],] + Y[result[,2],] tmp3 = pmax(tmp, tmp2) # Res = rbind(Res, data[ind, ]) tmp = rbind(tmp3, Y[ind, ]) weight = c(result[, 3], w[ind]) res = t(tmp) %*% weight #res[m] - res res } # # Sankoff # #old2new.phyDat <- function(data){} # works only for nucleotides old2new.phyDat <- function(obj){ att <- attributes(obj) l = length(obj) contrast <- attr(obj, "contrast") nr <- attr(obj, "nr") X = matrix(rep(rowSums(contrast), each=nr),nrow=nr) res <- vector("list", l) for(i in 1:l){ # browser() tmp = X - tcrossprod(obj[[i]], contrast) res[[i]] = unlist(apply(tmp, 1, function(x)which(x<1e-6)[1])) } attributes(res) <- att res } old2new.phyDat <- function(obj){ att <- attributes(obj) l = length(obj) contrast <- attr(obj, "contrast") nr <- attr(obj, "nr") X = matrix(rep(rowSums(contrast), each=nr),nrow=nr) for(i in 1:l)obj[[i]][obj[[i]]>0] = 1 res <- vector("list", l) contrast[contrast==0]=1e6 for(i in 1:l){ tmp = tcrossprod(obj[[i]], contrast) - X res[[i]] = unlist(apply(tmp, 1, function(x)which(x<1e-6)[1])) } attributes(res) <- att res } new2old.phyDat <- function(data){ contrast = attr(data, "contrast") for(i in 1:length(data)) data[[i]] = contrast[data[[i]],,drop=FALSE] data } prepareDataSankoff <- function(data){ contrast = attr(data, "contrast") contrast[contrast == 0] = 1e+06 contrast[contrast == 1] <- 0 for (i in 1:length(data)) data[[i]] = contrast[data[[i]], , drop = FALSE] data } sankoff <- function (tree, data, cost = NULL, site = 'pscore') { if (class(data) != "phyDat") stop("data must be of class phyDat") data <- prepareDataSankoff(data) levels <- attr(data, "levels") l = length(levels) if (is.null(cost)) { cost <- matrix(1, l, l) cost <- cost - diag(l) } for (i in 1:length(data)) storage.mode(data[[i]]) = "double" if(class(tree)=="phylo") return(fit.sankoff(tree, data, cost, returnData =site)) if(class(tree)=="multiPhylo"){ if(is.null(tree$TipLabel))tree = unclass(tree) return(sapply(tree, fit.sankoff, data, cost, site)) } } fit.sankoff <- function (tree, data, cost, returnData = c("pscore", "site", "data")) { if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") returnData <- match.arg(returnData) node <- tree$edge[, 1] edge <- tree$edge[, 2] weight = attr(data, "weight") nr = p = attr(data, "nr") q = length(tree$tip.label) nc = l = attr(data, "nc") m = length(edge) + 1 dat = vector(mode = "list", length = m) dat[1:q] = data[tree$tip.label] node = as.integer(node - 1) edge = as.integer(edge - 1) nTips = as.integer(length(tree$tip)) mNodes = as.integer(max(node) + 1) tips = as.integer((1:length(tree$tip))-1) res <- .Call("sankoff3", dat, as.numeric(cost), as.integer(nr),as.integer(nc), node, edge, mNodes, tips, PACKAGE="phangorn") root <- getRoot(tree) erg <- .Call("C_rowMin", res[[root]], as.integer(nr), as.integer(nc), PACKAGE = "phangorn") if (returnData=='site') return(erg) pscore <- sum(weight * erg) result = pscore if (returnData=="data"){ result <- list(pscore = pscore, dat = res) } result } pnodes <- function (tree, data, cost) { if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") node <- tree$edge[, 1] edge <- tree$edge[, 2] nr = nrow(data[[1]]) nc = ncol(data[[1]]) node = as.integer(node - 1) edge = as.integer(edge - 1) .Call("pNodes", data, as.numeric(cost), as.integer(nr),as.integer(nc), node, edge, PACKAGE="phangorn") } indexNNI <- function(tree){ parent = tree$edge[, 1] child = tree$edge[, 2] ind = which(child %in% parent) Nnode = tree$Nnode edgeMatrix = matrix(0,(Nnode-1),5) pvector <- numeric(max(parent)) pvector[child] <- parent tips <- !logical(max(parent)) tips[parent] <- FALSE # cvector <- allCildren(tree) cvector <- vector("list",max(parent)) for(i in 1:length(parent)) cvector[[parent[i]]] <- c(cvector[[parent[i]]], child[i]) k=0 for(i in ind){ p1 = parent[i] p2 = child[i] e34 = cvector[[p2]] ind1 = cvector[[p1]] e12 = ind1[ind1 != p2] if(pvector[p1])e12=c(p1,e12) edgeMatrix[k+1, ] = c(e12,e34,p2) k=k+1 } # vielleicht raus attr(edgeMatrix, 'root') <-cvector[[min(parent)]] edgeMatrix } sankoff.nni = function (tree, data, cost, ...) { if(is.rooted(tree))tree<- reorder(unroot(tree), "postorder") INDEX <- indexNNI(tree) rootEdges <- attr(INDEX,"root") if (class(data) != "phyDat") stop("data must be of class phyDat") levels <- attr(data, "levels") l = length(levels) weight = attr(data, "weight") p = attr(data, "nr") kl = TRUE i = 1 tmp = fit.sankoff(tree, data, cost, returnData='data') p0 = tmp[[1]] datf = tmp[[2]] datp = pnodes(tree, datf, cost) parent = tree$edge[,1] child = tree$edge[,2] m <- dim(INDEX)[1] k = min(parent) pscore = numeric(2*m) for(i in 1:m){ ei = INDEX[i,] datn <- datf[ei[1:4]] if (!(ei[5] %in% rootEdges)) datn[1] = datp[ei[1]] pscore[(2*i)-1] <- sankoff.quartet(datn[ c(1, 3, 2, 4)], cost, p, l, weight) pscore[(2*i)] <- sankoff.quartet(datn[ c(1, 4, 3, 2)], cost, p, l, weight) } swap <- 0 candidates <- pscore < p0 while(any(candidates)){ ind = which.min(pscore) pscore[ind]=Inf if( ind %% 2 ) swap.edge = c(2,3) else swap.edge = c(2,4) tree2 <- changeEdge(tree, INDEX[(ind+1)%/%2,swap.edge]) test <- fit.sankoff(tree2, data, cost, 'pscore') if(test >= p0) candidates[ind] = FALSE if(test < p0) { p0 <- test swap=swap+1 tree <- tree2 candidates[ind] = FALSE indi <- which(rep(colSums(apply(INDEX,1,match,INDEX[(ind+1)%/%2,],nomatch=0))>0,each=2)) candidates[indi] <- FALSE pscore[indi] <- Inf } } list(tree = tree, pscore = p0, swap = swap) } optim.parsimony <- function(tree,data, method='fitch', cost=NULL, trace=1, rearrangements="SPR", ...){ if(method=='fitch') result <- optim.fitch(tree=tree, data=data, trace=trace, rearrangements=rearrangements, ...) if(method=='sankoff') result <- optim.sankoff(tree=tree, data=data, cost=cost, trace=trace, ...) result } pratchet <- function (data, start=NULL, method="fitch", maxit=1000, k=10, trace=1, all=FALSE, rearrangements="SPR", ...) { eps = 1e-08 # if(method=="fitch" && (is.null(attr(data, "compressed")) || attr(data, "compressed") == FALSE)) # data <- compressSites(data) trace = trace - 1 uniquetree <- function(trees) { k = 1 res = trees[[1]] result = list() result[[1]]=res k=2 trees = trees[-1] while (length(trees) > 0) { # test and replace # change RF to do this faster RF.dist(res, trees) class(tree) = "multiPhylo" # rf2 = RF.dist(res, trees, FALSE) rf = sapply(trees, RF.dist, res, FALSE) if(any(rf==0))trees = trees[-which(rf == 0)] if (length(trees) > 0) { res = trees[[1]] result[[k]] = res k=k+1 trees = trees[-1] } } result } if (is.null(start)) start = optim.parsimony(nj(dist.hamming(data)), data, trace = trace, method=method, rearrangements=rearrangements, ...) tree = start data = subset(data, tree$tip.label) attr(tree, "pscore") = parsimony(tree, data, method=method, ...) mp <- attr(tree, "pscore") if (trace >= 0) print(paste("Best pscore so far:",attr(tree, "pscore"))) FUN = function(data, tree, method, rearrangements, ...) optim.parsimony(tree, data = data, method=method, rearrangements=rearrangements, ...) result = list() result[[1]] = tree kmax = 1 for (i in 1:maxit) { bstrees <- bootstrap.phyDat(data, FUN, tree = tree, bs = 1, trace = trace, method=method, rearrangements=rearrangements, ...) trees <- lapply(bstrees, optim.parsimony, data, trace = trace, method=method, rearrangements=rearrangements, ...) if(class(result)=="phylo")m=1 else m = length(result) if(m>0) trees[2 : (1+m)] = result[1:m] pscores <- sapply(trees, function(data) attr(data, "pscore")) mp1 = min(pscores) if((mp1+eps) < mp) kmax=1 else kmax=kmax+1 mp=mp1 if (trace >= 0) print(paste("Best pscore so far:",mp)) ind = which(pscores < mp + eps) if (length(ind) == 1) { result = trees[ind] tree = result[[1]] } else { result = uniquetree(trees[ind]) l = length(result) tree = result[[sample(l, 1)]] } if(kmax == k) break() }# for if(!all) return(tree) if(length(result)==1) return(result[[1]]) class(result) = "multiPhylo" result } # pratchet optim.sankoff <- function(tree, data, cost=NULL, trace=1, ...) { if(class(tree)!="phylo") stop("tree must be of class phylo") if(is.rooted(tree))tree <- unroot(tree) if(is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "postorder") if (class(data)[1] != "phyDat") stop("data must be of class phyDat") rt = FALSE dat <- prepareDataSankoff(data) l <- attr(dat, "nc") if (is.null(cost)) { cost <- matrix(1, l, l) cost <- cost - diag(l) # rt = TRUE } tree$edge.length=NULL swap = 0 iter = TRUE pscore <- fit.sankoff(tree,dat,cost,'pscore') while (iter) { res <- sankoff.nni(tree,dat,cost,...) tree <- res$tree if(trace>1)cat("optimize topology: ", pscore , "-->", res$pscore, "\n") pscore = res$pscore swap = swap + res$swap if (res$swap == 0) iter = FALSE } if(trace>0)cat("Final p-score",pscore,"after ",swap, "nni operations \n") if(rt)tree <- ptree(tree, data) attr(tree, "pscore") = pscore tree } # # ACCTRAN # ptree <- function (tree, data, type = "ACCTRAN", retData = FALSE) { if (class(data) != "phyDat") stop("data must be of class phyDat") if (is.null(attr(tree, "order")) || attr(tree, "order") == "cladewise") tree <- reorder(tree, "pruningwise") # if (!is.binary.tree(tree)) # stop("Tree must be binary!") tmp = fitch(tree, data, site = "data") nr = attr(data, "nr") node <- tree$edge[, 1] edge <- tree$edge[, 2] weight = attr(data, "weight") m = length(edge) + 1 q = length(tree$tip) l = as.integer(length(edge)) nTips = length(tree$tip) dat = tmp[[2]] if (!is.rooted2(tree)) { root = getRoot(tree) ind = edge[node == root] rSeq = .C("fitchTriplet", integer(nr), dat[, ind[1]], dat[, ind[2]], dat[, ind[3]], as.integer(nr)) dat[, root] = rSeq[[1]] } result <- .C("ACCTRAN2", dat, as.integer(nr), numeric(nr), as.integer(node[l:1L]), as.integer(edge[l:1L]), l, as.double(weight), numeric(l), as.integer(nTips)) el = result[[8]][l:1L] if (!is.rooted2(tree)) { ind2 = which(node[] == root) dat = matrix(result[[1]], nr, max(node)) result <- .C("ACCTRAN3", result[[1]], as.integer(nr), numeric(nr), as.integer(node[(l - 3L):1L]), as.integer(edge[(l - 3L):1L]), l - 3L, as.double(weight), numeric(l), as.integer(nTips)) el = result[[8]][(l - 3L):1L] pars = .C("fitchTripletACC4", dat[, root], dat[, ind[1]], dat[, ind[2]], dat[, ind[3]], as.integer(nr), numeric(1), numeric(1), numeric(1), as.double(weight), numeric(nr), integer(nr)) el[ind2[1]] = pars[[6]] el[ind2[2]] = pars[[7]] el[ind2[3]] = pars[[8]] } else { result <- .C("ACCTRAN3", result[[1]], as.integer(nr), numeric(nr), as.integer(node[l:1L]), as.integer(edge[l:1L]), l, as.double(weight), numeric(l), as.integer(nTips)) el = result[[8]][l:1L] } tree$edge.length = el if (retData) return(list(tree, matrix(result[[1]], nr, max(node)))) tree } acctran <- function(tree, data) ptree(tree, data, type="ACCTRAN", retData=FALSE) parsimony.plot <- function(tree, ...){ x = numeric(max(tree$edge)) x[tree$edge[,2]] = tree$edge.length plot(tree, ...) ind <- get("last_plot.phylo", envir = .PlotPhyloEnv)$edge[, 2] edgelabels(prettyNum(x[ind]), frame = "none") } phangorn/vignettes/0000755000175100001440000000000012547505677014136 5ustar hornikusersphangorn/vignettes/phangorn.bib0000644000175100001440000004223212535402455016416 0ustar hornikusers@Manual{CRAN, title = {R: A Language and Environment for Statistical Computing}, author = {{R Core Team}}, organization = {R Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2015}, url = {http://www.R-project.org/}, } @Manual{Matrix, title = {Matrix: Sparse and Dense Matrix Classes and Methods}, author = {Douglas Bates and Martin Maechler}, year = {2015}, note = {R package version 1.2-0}, url = {http://CRAN.R-project.org/package=Matrix}, } @Manual{seqLogo, title = {seqLogo: Sequence logos for DNA sequence alignments}, author = {Oliver Bembom}, note = {R package version 1.34.0}, year = {2015} } @Manual{apex, title = {apex: Phylogenetic Methods for Multiple Gene Data}, author = {Thibaut Jombart and Zhian Namir Kamvar and Klaus Schliep and Rebecca Harris}, note = {R package version 1.0.1}, year = {2015} } @Manual{Turlach2013, title = {quadprog: Functions to solve Quadratic Programming Problems.}, author = {Berwin A. Turlach and Andreas Weingessel}, year = {2013}, note = {R package version 1.5-5}, url = {http://CRAN.R-project.org/package=quadprog}, } @Manual{rgl, title = {rgl: 3D Visualization Using OpenGL}, author = {Daniel Adler and Duncan Murdoch and {others}}, year = {2015}, note = {R package version 0.95.1247}, url = {http://CRAN.R-project.org/package=rgl}, } @article{Bouckaert2010, author = {Bouckaert, Remco R.}, title = {{DensiTree}: making sense of sets of phylogenetic trees}, volume = {26}, number = {10}, pages = {1372-1373}, year = {2010}, doi = {10.1093/bioinformatics/btq110}, URL = {http://bioinformatics.oxfordjournals.org/content/26/10/1372.abstract}, eprint = {http://bioinformatics.oxfordjournals.org/content/26/10/1372.full.pdf+html}, journal = {Bioinformatics} } @article{Cavalli1967, author = {Cavalli-Sforza, L.L. and Edwards, A.W.F.}, year = {1967}, title = {Phylogenetic analysis: models and estimation procedures}, journal = {American Journal of Human Genetics}, volume = {19}, pages = {233--257} } @Article{Huson2006, Author = "D.H. Huson and D. Bryant", Title = "Application of Phylogenetic Networks in Evolutionary Studies", Journal = "Molecular Biology and Evolution", Volume = "23", Number = "2", Pages = "254--267", Year = "2006" } @InCollection{Buneman1971, author = "Peter Buneman", title = "The recovery of trees from measures of dissimilarity", booktitle = "Mathematics in the Archaeological and Historical Sciences", editor = "Hodson, F. R. and Kendall, D. G. and Tautu, P. T.", publisher = "Edinburgh University Press", pages = "387--395", year = "1971" } @Article{Buneman1974, title = {A Note on the Metric Properties of Trees}, author = {Peter Buneman}, journal = {Journal of combinatorial theory (B)}, year = {1974}, volume = {17}, pages = {48--50} } @article{Fitch1971, author = {Fitch, Walter M.}, title = {Toward Defining the Course of Evolution: Minimum Change for a Specific Tree Topology}, volume = {20}, number = {4}, pages = {406-416}, year = {1971}, doi = {10.1093/sysbio/20.4.406}, URL = {http://sysbio.oxfordjournals.org/content/20/4/406.abstract}, eprint = {http://sysbio.oxfordjournals.org/content/20/4/406.full.pdf+html}, journal = {Systematic Biology} } @article{Lento1995, author = {Lento, G M and Hickson, R E and Chambers, G K and Penny, D}, title = {Use of spectral analysis to test hypotheses on the origin of pinnipeds.}, volume = {12}, number = {1}, pages = {28-52}, year = {1995}, doi = {10.1093/oxfordjournals.molbev.a040189}, URL = {http://mbe.oxfordjournals.org/content/12/1/28.abstract}, eprint = {http://mbe.oxfordjournals.org/content/12/1/28.full.pdf+html}, journal = {Molecular Biology and Evolution} } @article{Lewis2001, author = {Lewis, Paul O.}, title = {A Likelihood Approach to Estimating Phylogeny from Discrete Morphological Character Data}, volume = {50}, number = {6}, pages = {913-925}, year = {2001}, doi = {10.1080/106351501753462876}, URL = {http://sysbio.oxfordjournals.org/content/50/6/913.abstract}, eprint = {http://sysbio.oxfordjournals.org/content/50/6/913.full.pdf+html}, journal = {Systematic Biology} } @Article{ Rambaut1997, Author = "A. Rambaut and N.C. Grassly", Title = "Seq-Gen: an application for the Monte Carlo simulation of DNA sequence evolution along phylogenetic trees", Journal = "Comput Appl Biosci", Volume = "13", Pages = "235--238", Year = "1997" } @Article{Revell2012, title = {phytools: An R package for phylogenetic comparative biology (and other things).}, author = {Liam J. Revell}, journal = {Methods in Ecology and Evolution}, year = {2012}, volume = {3}, pages = {217-223}, } @Article{Revell2014, Title = {Rphylip: an {R} interface for {PHYLIP}}, Author = {Revell, Liam J. and Chamberlain, Scott A.}, Journal = {Methods in Ecology and Evolution}, Year = {2014}, Number = {9}, Pages = {976--981}, Volume = {5}, Doi = {10.1111/2041-210X.12233}, ISSN = {2041-210X}, Keywords = {phylogeny, statistics, computational biology, evolution}, Url = {http://dx.doi.org/10.1111/2041-210X.12233} } @article{Holland2004, author = {Holland, Barbara R. and Huber, Katharina T. and Moulton, Vincent and Lockhart, Peter J.}, title = {Using Consensus Networks to Visualize Contradictory Evidence for Species Phylogeny}, volume = {21}, number = {7}, pages = {1459-1461}, year = {2004}, doi = {10.1093/molbev/msh145}, URL = {http://mbe.oxfordjournals.org/content/21/7/1459.abstract}, eprint = {http://mbe.oxfordjournals.org/content/21/7/1459.full.pdf+html}, journal = {Molecular Biology and Evolution} } @article{Bryant2004, author = {Bryant, David and Moulton, Vincent}, title = {{Neighbor-Net}: An Agglomerative Method for the Construction of Phylogenetic Networks}, volume = {21}, number = {2}, pages = {255-265}, year = {2004}, doi = {10.1093/molbev/msh018}, URL = {http://mbe.oxfordjournals.org/content/21/2/255.abstract}, eprint = {http://mbe.oxfordjournals.org/content/21/2/255.full.pdf+html}, journal = {Molecular Biology and Evolution} } @Article{Csardi2006, title = {The igraph software package for complex network research}, author = {Gabor Csardi and Tamas Nepusz}, journal = {InterJournal}, volume = {Complex Systems}, pages = {1695}, year = {2006}, url = {http://igraph.org}, } @Article{ Stefankovic2007a, Author = "D. Stefankovic and E. Vigoda", Title = "Pitfalls of heterogeneous processes for phylogenetic reconstruction", Journal = "Systematic Biology", Volume = "56", Number = "1", Pages = "113--124", Year = "2007" } @Article{ Nixon1999, Author = "K. Nixon", Title = "The Parsimony Ratchet, a New Method for Rapid Rarsimony Analysis", Journal = "Cladistics", Volume = "15", Pages = "407--414", Year = "1999" } @Article{ Matsen2007, Author = "F. A. Matsen and M. Steel", Title = "Phylogenetic mixtures on a single tree can mimic a tree of another topology", Journal = "Systematic Biology", Volume = "56", Number = "5", Pages = "767--775", Year = "2007" } @Article{ Pagel2004, Author = "Mark Pagel and Andrew Meade", Title = "A Phylogenetic Mixture Model for Detecting Pattern-Heterogeneity in Gene Sequence or Character-State Data", Journal = "Systematic Biology", Volume = "53", Number = "4", Pages = "571--581", Year = "2004" } @Article{ Thornton2004, Author = "B. Kolaczkowski and J. W. Thornton", Title = "Performance of maximum parsimony and likelihood phylogenetics when evolution is heterogeneous", Journal = "Nature", Volume = "431", Number = "7011", Pages = "980--984", Year = "2004" } @Article{ Studier1988, Author = "J. A. Studier and K. J. Keppler", Title = "A Note on the Neighbor-Joining Algorithm of Saitou and Nei", Journal = "Molecular Biology and Evolution", Volume = "5", Number = "6", Pages = "729--731", Year = "1988" } @Article{ Saitou1987, Author = "N. Saitou and M. Nei", Title = "The Neighbor-Joining Method - a New Method for Reconstructing Phylogenetic Trees", Journal = "Molecular Biology and Evolution", Volume = "4", Number = "4", Pages = "406--425", Year = "1987" } @Article{ Pagel2008, Author = "Mark Pagel and Andrew Meade", Title = "Modelling heterotachy in phylogenetic inference by reversible-jump Markov chain Monte Carlo", Journal = "Philosophical Transactions of the Royal Society B", Volume = "363", Pages = "3955--3964", Year = "2008" } @Article{ Shimodaira1999, Author = "Shimodaira, H. and Hasegawa, M.", Title = "Multiple comparisons of log-likelihoods with applications to phylogenetic inference.", Journal = "Molecular Biology and Evolution", Volume = "16", Pages = "1114–1116", Year = "1999" } @InCollection{ Pagel2005, Author = "Mark Pagel and Andrew Meade", Title = "Mixture models in phylogenetic inference", BookTitle = "Mathematics of evolution and phylogeny", Editor = "Olivier Gascuel", Publisher = "Oxford", Address = "New York", Year = "2005" } @InCollection{ Swofford1996, Author = "Swofford, D.L. and Olsen, G.J. and Waddell, P.J. and Hillis, D.M.", Title = "Phylogenetic Inference", BookTitle = "Molecular Systematics", Editor = "Hillis, D.M. and Moritz, C. and Mable, B.K", Edition = "Second", Publisher = "Sinauer", Address = "Sunderland, MA", Year = "1996" } @Article{ Kolaczkowski2008, Author = "Bryan Kolaczkowski and Joseph W. Thornton", Title = "A Mixed Branch Length Model of Heterotachy Improves Phylogenetic Accuracy", Journal = "Molecular Biology and Evolution", Volume = "25", Number = "6", Pages = "1054--1066", Year = "2008" } @Article{ Dempster1977, Author = "A. P. Dempster and N. M. Laird and D. B. Rubin", Title = "Maximum likelihood from incomplete data via the EM algorithm", Journal = "Journal of the Royal Statistical Society B", Volume = "39", Number = "1", Pages = "1--38", Year = "1977" } @Book{ Felsenstein2004, Author = "Joseph Felsenstein", Title = "Inferring Phylogenies", Publisher = "Sinauer Associates", Address = "Sunderland", Year = "2004" } @Article{ Felsenstein1981, Author = "Joseph Felsenstein", Title = "Evolutionary trees from DNA sequences: a maxumum likelihood approach", Journal = "Journal of Molecular Evolution", Volume = "17", Pages = "368--376", Year = "1981" } @Article{ Felsenstein1985, Author = "Joseph Felsenstein", Title = "Confidence limits on phylogenies. An approach using the bootstrap", Journal = "Evolution", Volume = "39", Pages = "783--791", Year = "1985" } @Article{Penny1985, Author = "Penny, D. and Hendy, M.D.", Title = "Testing methods evolutionary tree construction", Journal = "Cladistics", Volume = "1", Pages = "266--278", Year = "1985" } @Article{Penny1986, Author = "Penny, D. and Hendy, M.D.", Title = "Estimating the reliability of evolutionary trees", Journal = "Molecular Biology and Evolution", Volume = "3", Pages = "403--417", Year = "1986" } @Book{ Yang2006, Author = "Ziheng Yang", Title = "Computational Molecular evolution", Publisher = "Oxford University Press", Address = "Oxford", Year = "2006" } @Article{ Paradis2004, Author = "E. Paradis and J. Claude and K. Strimmer", Title = "{APE}: Analyses of Phylogenetics and Evolution in {R} language", Journal = "Bioinformatics", Volume = "20", Number = "2", Pages = "289--290", Year = "2004" } @Book{ Paradis2006, Author = "Emmanuel Paradis", Title = "Analysis of Phylogenetics and Evolution with R", Publisher = "Springer", Address = "New York", Year = "2006" } @Book{ Paradis2012, Author = "Emmanuel Paradis", Title = "Analysis of Phylogenetics and Evolution with R", Edition = "Second", Publisher = "Springer", Address = "New York", Year = "2012" } @InCollection{ seqinr, author = "D. Charif and J.R. Lobry", title = "Seqin{R} 1.0-2: a contributed package to the {R} project for statistical computing devoted to biological sequences retrieval and analysis.", booktitle = "Structural approaches to sequence evolution: Molecules, networks, populations", year = "2007", editor = "M. Porto H.E. Roman {U. Bastolla} and M. Vendruscolo", series = "Biological and Medical Physics, Biomedical Engineering", pages = "207--232", address = "New York", publisher = "Springer", note = "{ISBN :} 978-3-540-35305-8" } @Article{ Mathews2010, Author = "S. Mathews and M.D. Clements and M.A. Beilstein", Title = "A duplicate gene rooting of seed plants and the phylogenetic position of flowering plants.", Journal = "Phil. Trans. R. Soc. B", Volume = "365", Pages = "383--395", Year = "2010" } @Article{ Schliep2011, title = "phangorn: Phylogenetic analysis in {R}", author = "Klaus Peter Schliep", journal = "Bioinformatics", year = "2011", volume = "27", number = "4", pages = "592--593", doi = {10.1093/bioinformatics/btq706}, URL = {http://bioinformatics.oxfordjournals.org/content/27/4/592.abstract}, eprint = {http://bioinformatics.oxfordjournals.org/content/27/4/592.full.pdf+html}, } @Thesis{Schliep2009, author = "Klaus Schliep", title = "Some Applications of statistical phylogenetics", year = 2009 } @article{Lanfear2012, author = {Lanfear, Robert and Calcott, Brett and Ho, Simon Y. W. and Guindon, Stephane}, title = {Partition{F}inder: Combined Selection of Partitioning Schemes and Substitution Models for Phylogenetic Analyses}, volume = {29}, number = {6}, pages = {1695-1701}, year = {2012}, doi = {10.1093/molbev/mss020}, URL = {http://mbe.oxfordjournals.org/content/29/6/1695.abstract}, eprint = {http://mbe.oxfordjournals.org/content/29/6/1695.full.pdf+html}, journal = {Molecular Biology and Evolution} } @Article{ Rokas2003, title = "Genome-scale approaches to resolving incongruence in molecular phylogenies", author = "Rokas, A. and Williams, B. L. and King, N., and Carroll, S. B.", journal = "Nature", year = "2011", volume = "425", number = "6960", pages = "798--804" } @Article{ Schliep2011b, title = "Harvesting Evolutionary Signals in a Forest of Prokaryotic Gene Trees", author = "Klaus Schliep and Philippe Lopez and Fran\c{c}ois-Joseph Lapointe and Eric Bapteste", journal = "Molecular Biology and Evolution", year = "2011", volume = "28", number = "4", pages = "1393--1405" } @Article{ Swofford1987, title = "Reconstructing ancestral character states under Wagner parsimony", author = "D.L. Swofford and W.P. Maddison", journal = "Math. Biosci.", year = "1987", Volume = "87", pages = "199--229" } @article{Posada1998, author = {Posada, D. and Crandall, K.A.}, title = {{MODELTEST}: testing the model of {DNA} substitution.}, volume = {14}, number = {9}, pages = {817-818}, year = {1998}, journal = {Bioinformatics} } @article{Posada2008, author = {Posada, David}, title = {{jModelTest}: Phylogenetic Model Averaging}, volume = {25}, number = {7}, pages = {1253-1256}, year = {2008}, URL = {http://mbe.oxfordjournals.org/content/25/7/1253.abstract}, journal = {Molecular Biology and Evolution} } @article{Hendy1982, author = {Hendy, M.D. and Penny D.}, title = {Branch and bound algorithms to determine minimal evolutionary trees}, volume = {59}, pages = {277-290}, year = {1982}, journal = {Math. Biosc.} } @Book{ Rao1973, Author = "C.R. Rao", Title = "Linear statistical inference and its applications", Publisher = "John Wiley", Address = "New York", Year = "1973" } @Book{ Burnham2002, Author = "Burnham, K. P. and Anderson, D. R", Title = "Model selection and multimodel inference: a practical information-theoretic approach", Edition = "Second", Publisher = "Springer", Address = "New York", Year = "2002" } @Article{ Lapointe2010, title = "Clanistics: a multi-level perspective for harvesting unrooted gene trees", journal = "Trends in Microbiology", volume = "18", number = "8", pages = "341--347", year = "2010", url = "http://www.sciencedirect.com/science/article/pii/S0966842X10000570", author = "Fran\c{c}ois-Joseph Lapointe and Philippe Lopez and Yan Boucher and Jeremy Koenig and Eric Bapteste" } @article{Wilkinson2007, title = "Of clades and clans: terms for phylogenetic relationships in unrooted trees", journal = "Trends in Ecology and Evolution", volume = "22", number = "3", pages = "114--115", year = "2007", url = "http://www.sciencedirect.com/science/article/pii/S016953470700019", author = "Mark Wilkinson and James O. McInerney and Robert P. Hirt and Peter G. Foster and T. Martin Embley" } @article{Warnow2012, title = "Standard maximum likelihood analyses of alignments with gaps can be statistically inconsistent", journal = "PLOS Currents Tree of Life", year = "2012", doi = "10.1371/currents.RRN1308", author = "Tandy Warnow" } phangorn/vignettes/Trees.Rnw0000644000175100001440000002626412545265757015722 0ustar hornikusers%\VignetteIndexEntry{Constructing phylogenetic trees} %\VignetteKeywords{Documentation} %\VignettePackage{phangorn} %\VignetteEngine{Sweave} \documentclass[12pt]{article} \usepackage{times} \usepackage{hyperref} \begin{document} \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rfunarg}[1]{{\texttt{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\R}{\textsf{R}} \newcommand{\pml}{\Robject{pml}} \newcommand{\phangorn}{\Rpackage{phangorn}} \newcommand{\ape}{\Rpackage{ape}} \newcommand{\multicore}{\Rpackage{multicore}} \newcommand{\term}[1]{\emph{#1}} \newcommand{\mref}[2]{\htmladdnormallinkfoot{#2}{#1}} % leave comments in the text \SweaveOpts{keep.source=TRUE} % Ross Ihakas extenstion for nicer representation \DefineVerbatimEnvironment{Sinput}{Verbatim} {xleftmargin=2em} \DefineVerbatimEnvironment{Soutput}{Verbatim}{xleftmargin=2em} \DefineVerbatimEnvironment{Scode}{Verbatim}{xleftmargin=2em} \fvset{listparameters={\setlength{\topsep}{0pt}}} \renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} <>= options(width=70) foo <- packageDescription("phangorn") @ \title{Estimating phylogenetic trees with phangorn} %$ (Version \Sexpr{foo$Version})} \author{\mref{mailto:klaus.schliep@gmail.com}{Klaus P. Schliep}} \maketitle \nocite{Paradis2012} \section{Introduction} These notes should enable the user to estimate phylogenetic trees from alignment data with different methods using the \phangorn{} package \cite{Schliep2011}. Several functions of \phangorn{} are also described in more detail in \cite{Paradis2012}. For more theoretical background on all the methods see e.g. \cite{Felsenstein2004, Yang2006}. This document illustrates some of the \phangorn{} features to estimate phylogenetic trees using different reconstruction methods. Small adaptations to the scripts in section \ref{sec:Appendix} should enable the user to perform phylogenetic analyses. \section{Getting started} The first thing we have to do is to read in an alignment. Unfortunately there exists many different file formats that alignments can be stored in. The function \Rfunction{read.phyDat} is used to read in an alignment. There are several functions to read in alignments depending on the format of the data set (nexus, phylip, fasta) and the kind of data (amino acid or nucleotides) in the \ape{} package \cite{Paradis2004} and \phangorn{}. The function \Rfunction{read.phyDat} calls these other functions. For the specific parameter settings available look in the help files of the function \Rfunction{read.dna} (for phylip, fasta, clustal format), \Rfunction{read.nexus.data} for nexus files. For amino acid data additional \Rfunction{read.aa} is called. %When using the \Rfunction{read.dna} from \ape{} the parameter the we have to use as.character=TRUE. We start our analysis loading the \phangorn{} package and then reading in an alignment. <>= library(phangorn) primates = read.phyDat("primates.dna", format="phylip", type="DNA") @ %require("multicore") \section{Distance based methods} After reading in the alignment we can build a first tree with distance based methods. The function dist.dna from the ape package computes distances for many DNA substitution models. To use the function dist.dna we have to transform the data to class DNAbin. For amino acids the function dist.ml offers common substitution models ("WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa" and "mtREV24"). After constructing a distance matrix we reconstruct a rooted tree with UPGMA and alternatively an unrooted tree using Neighbor Joining \cite{Saitou1987,Studier1988}. <>= dm = dist.ml(primates) treeUPGMA = upgma(dm) treeNJ = NJ(dm) @ We can plot the trees treeUPGMA and treeNJ (figure \ref{fig:NJ}) with the commands: <>= layout(matrix(c(1,2), 2, 1), height=c(1,2)) par(mar = c(.1,.1,.1,.1)) plot(treeUPGMA, main="UPGMA") plot(treeNJ, "unrooted", main="NJ") @ \begin{figure} \begin{center} <>= <> @ \end{center} \caption{Rooted UPGMA tree and unrooted NJ tree} \label{fig:NJ} \end{figure} Distance based methods are very fast and we will use the UPGMA and NJ tree as starting trees for the maximum parsimony and maximum likelihood analyses. \section{Parsimony} The function parsimony returns the parsimony score, that is the number of changes which are at least necessary to describe the data for a given tree. We can compare the parsimony score or the two trees we computed so far: <>= parsimony(treeUPGMA, primates) parsimony(treeNJ, primates) @ The function optim.parsimony performs tree rearrangements to find trees with a lower parsimony score. So far the only tree rearrangement implemented is nearest-neighbor interchanges (NNI). However is also a version of the parsimony ratchet \cite{Nixon1999} implemented, which is likely to find better trees than just doing NNI rearrangements. <>= treePars = optim.parsimony(treeUPGMA, primates) treeRatchet = pratchet(primates, trace = 0) parsimony(c(treePars, treeRatchet), primates) @ For small data sets it is also possible to find all most parsimonious trees using a branch and bound algorithm \cite{Hendy1982}. For data sets with more than 10 taxa this can take a long time and depends strongly on how tree like the data are. <>= (trees <- bab(subset(primates,1:10))) @ \section{Maximum likelihood} The last method we will describe in this vignette is Maximum Likelihood (ML) as introduced by Felsenstein \cite{Felsenstein1981}. We can easily compute the likelihood for a tree given the data <>= fit = pml(treeNJ, data=primates) fit @ The function pml returns an object of class pml. This object contains the data, the tree and many different parameters of the model like the likelihood etc. There are many generic functions for the class pml available, which allow the handling of these objects. <>= methods(class="pml") @ The object fit just estimated the likelihood for the tree it got supplied, but the branch length are not optimized for the Jukes-Cantor model yet, which can be done with the function optim.pml. <>= fitJC = optim.pml(fit, TRUE) logLik(fitJC) @ With the default values \Rfunction{pml} will estimate a Jukes-Cantor model. The function \Rfunction{update.pml} allows to change parameters. We will change the model to the GTR + $\Gamma(4)$ + I model and then optimize all the parameters. <>= fitGTR = update(fit, k=4, inv=0.2) fitGTR = optim.pml(fitGTR, TRUE,TRUE, TRUE, TRUE, TRUE, control = pml.control(trace = 0)) fitGTR @ We can compare the objects for the JC and GTR + $\Gamma(4)$ + I model using likelihood ratio statistic <>= anova(fitJC, fitGTR) @ with the AIC <>= AIC(fitGTR) AIC(fitJC) @ or the Shimodaira-Hasegawa test. <>= SH.test(fitGTR, fitJC) @ An alternative is to use the function \Rfunction{modelTest} to compare different models the AIC or BIC, similar to popular program of \cite{Posada1998, Posada2008}. <>= load("Trees.RData") @ <>= mt = modelTest(primates) @ The results of is illustrated in table \ref{tab:modelTest} \begin{center} <>= library(xtable) xtable(mt, caption="Summary table of modelTest", label="tab:modelTest") @ \end{center} The thresholds for the optimization in \Rfunction{modelTest} are not as strict as for \Rfunction{optim.pml} and no tree rearrangements are performed. As \Rfunction{modelTest} computes and optimizes a lot of models it would be a waste of computer time not to save these results. The results are saved as call together with the optimized trees in an environment and this call can be evaluated to get a "pml" object back to use for further optimization or analysis. <>= env <- attr(mt, "env") ls(envir=env) (fit <- eval(get("HKY+G+I", env), env)) @ At last we may want to apply bootstrap to test how well the edges of the tree are supported: %, results=hide <>= bs = bootstrap.pml(fitJC, bs=100, optNni=TRUE, control = pml.control(trace = 0)) @ %$ Now we can plot the tree with the bootstrap support values on the edges <>= par(mar=c(.1,.1,.1,.1)) plotBS(fitJC$tree, bs) @ %$ \begin{figure} \begin{center} <>= <> @ \end{center} \caption{Unrooted tree with bootstrap support values} \label{fig:BS} \end{figure} Several analyses, e.g. \Rfunction{bootstrap} and \Rfunction{modelTest}, can be computationally demanding, but as nowadays most computers have several cores one can distribute the computations using the \multicore{} package. However it is only possible to use this approach if R is running from command line ("X11"), but not using a GUI (for example "Aqua" on Macs) and unfortunately the \multicore{} package does not work at all under Windows. \section{Appendix: Standard scripts for nucleotide or amino acid analysis}\label{sec:Appendix} Here we provide two standard scripts which can be adapted for the most common tasks. Most likely the arguments for \Rfunction{read.phyDat} have to be adapted to accommodate your file format. Both scripts assume that the \multicore{} package, see comments above. <>= options(prompt=" ") options(continue=" ") @ <>= library(parallel) # supports parallel computing library(phangorn) file="myfile" dat = read.phyDat(file) dm = dist.ml(dat) tree = NJ(dm) # as alternative for a starting tree: tree <- pratchet(dat) # 1. alternative: estimate an GTR model fitStart = pml(tree, dat, k=4, inv=.2) fit = optim.pml(fitStart, TRUE, TRUE, TRUE, TRUE, TRUE) # 2. alternative: modelTest (mt <- modelTest(dat, multicore=TRUE)) mt$Model[which.min(mt$BIC)] # choose best model from the table, assume now GTR+G+I env = attr(mt, "env") fitStart = eval(get("GTR+G+I", env), env) fitStart = eval(get(mt$Model[which.min(mt$BIC)], env), env) fit = optim.pml(fitStart, optNni=TRUE, optGamma=TRUE, optInv=TRUE, model="GTR") bs = bootstrap.pml(fit, bs=100, optNni=TRUE, multicore=TRUE) @ You can specify different several models build in which you can specify, e.g. "WAG", "JTT", "Dayhoff", "LG". Optimizing the rate matrix for amino acids is possible, but would take a long, a very long time. So make sure to set optBf=FALSE and optQ=FALSE in the function \Rfunction{optim.pml}, which is also the default. <>= library(parallel) # supports parallel computing library(phangorn) file="myfile" dat = read.phyDat(file, type = "AA") dm = dist.ml(dat, model="JTT") tree = NJ(dm) (mt <- modelTest(dat, model=c("JTT", "LG", "WAG"), multicore=TRUE)) fitStart = eval(get(mt$Model[which.min(mt$BIC)], env), env) fitNJ = pml(tree, dat, model="JTT", k=4, inv=.2) fit = optim.pml(fitNJ, optNni=TRUE, optInv=TRUE, optGamma=TRUE) fit bs = bootstrap.pml(fit, bs=100, optNni=TRUE, multicore=TRUE) @ \bibliographystyle{plain} \bibliography{phangorn} \section{Session Information} The version number of \R{} and packages loaded for generating the vignette were: <>= toLatex(sessionInfo()) @ \end{document} phangorn/vignettes/Trees.RData0000644000175100001440000014525612507002037016124 0ustar hornikusers]X^ E@T ReϊDlXP^]TQPzm EwA.,~y&9gI2Y<{ AMvy\r$x$=>L083o}wެshhMVaߎ̟H~5_|fdkh?]k\H~5_|F{bF2l5߮>4QQ"itv%'l7cKalwvmgmqԛ_8i1z̕>Somu{UP}󖭞7~F {o³KqoR7}Porjt~չTM.ꫵz#dojPo8v}oNa3m5ϧ{Tjw;G AT/zb[71*">Y/瓮Ro@as`z]AU%vW=(_Ď%趯zP?}ՃUJW=(1mAUJdW=(_D~ՃUJzP'|Ճ=hzP"}ՃUJdW=(H1WRb֖6OUt%PE1);ڂBmиNJZfqն+m\)1sԌ-(1gOނm5tKSHyD`Eh%JR]uJթae,Jׂ#Mj>Xgx}{ߗJt%J֕gw%jERZYY:qp&n ^lt-xfem|{lVf-Bˆ֝ o2r`TqPHy=v=!~ol7Y[3JQUƄ\&$!)oaǴc*w~݅xBts\'4? n\drڳ><\ɵ~a/hvvԹB-Qx?@$ 'ZZoң7֭W 1#KzF\1|lM%\ Sh mIe_f~4kЮ meOeAw).9^h/\Lg)'r,'r>rcQ3LЙS+'{F榌KX3|<[kFFv$7:89Ў1̲7ZHo #6_[x=If@|&#ƹYͭl?8YY1$PbPCG!ھ&Sk3Ǎ:9*o2Z m|@ge ڵ7j*BNfAXLlx!^}}y7’I]= %S[!%2luٟi qC &l g*MΪP]Q!S |L6v-O7Ը!E.VF;!fۋeʐ% )G<(ӎg za;JШZ+5H*2 תC Um+(\n [ Lѓ0'$Z=L&\l yt;r$pDp2-x&č>ue/+NuB>BJD`[&f/ez"X.}wű=ǟ狇yu3ccxB0}{@]x良bܲDOf!Rp4>*ŷ^+.7TM?~s ۜ{a[(Rw8<K\r.;Q{[)|t<Ϙ# K{M\q#ΎY1 2.n\B[џRMSZ-3Ot UP(0bn0SlX;k-7T }:UKh)V4 Ắ:y+_+%}oPHm|VtF)zzz>!DNFv cn[~L.}Oz3H<#|VU𴋗zkP Gf? kx.܆ C}k>Kx!1߇36mx^؍=?nP׊p"ip!ܖ:L&4@KC zxCة#{:%!! "P_*4E&+% AGIWP`+*%Tlu#e5}SB1 e9? :`6|')廐p`Եk=T33BHķ$=*DT)C䢚n__RS=" -7Nn/9t "w껧罂{ %τ8{ %zŐ>f1ZdT~&y|>AɌ&0P\^r,V~a}"p_#=pfSCm4(7|<<&Vi=5o_*J( aSV/XE|}y^uF\_+sq(UIӻZ37-]gDz\We/< \B6CljOPbsg1dWG~9q8\nI2MCk:aXg d?_(T3`CH{~~>L^ç Z[M!ɻ33Dr 2*x2~7 #c }G ,([NCoܹX[,ѳ}Ϟzcj%ܳ_q^/9W w>1ұ<6?P2h>w?uxH36>im_YOAuFSj9_Le `{1jQ>7qo2Dƻi~S'&[w$V}~vl8IOv[?h7z Yc`ŭMհEk/ؘO]ݼ6Hk9浗oy37$ 3DႿ׮v'ۍ P%S #$ͱu qEWVȑzpĐ>Zc nnֹ j$C~ WC2 'TI#v@PEiPx#l3TlQxo {6Kڧ/=Ô=1IxqE_=ʿE\ f 6-v$UW* qϷj :!kkT92JWng+V)@NYW[dHS4F^.1T\Ylc~ N%C㻝6M['Y|V j` Ϭyq B85#4Ťbh{pG33H-8y=8ʗvᓘo'OǐLZ# dOlrZWR!C#5֐"ȗ Mkh=;}oYo Z}AMa((~# i_GM^~xoeܜVG)}|>qwMw-mv_ȂOۮdru&'A^@iܲZ rn0%T˹[~iP'S m[],ߒz)vzՄuRsJ:!&˵/յR.aڋPvEfå)BV?z,S5miS],'%Ϙ5m%9~1G([qE&Դw֛rG)gYoy jpIlLp]I d]c5L!ӱ^37 {Fi$h _c ZqRWxCxe sW,~)DrrtԾWJ/L̥c XѢv= <f<iΚ2WO"eXǹNֵZ{ *M+d^wHHSzWttUöM񇹠[-\?4$2bI`,J<kmd\zGbȁr^>MFR<7Zхfl!U3TSߛ#z4xȝUk+j dLΙ&4]gU>0¶Ɋ!WqI.u׉D|9pÍdD To!&AܰMsR\r ?dP ;~83)msUW؉C}JBBɑ((}q{z}˥ bNyc3f^ڝh@yYd!X)q+k9[l?Os; sЋ /x;!{x AIkl'B]iV (tjښAգrϟϝ/:;C} ɇ`'a&rp,O(Ub,p9SN@Q8P5H rm{ێ ubBpA)W!}o h@ep)g D:Vi<8O~yjߨf6ó}6*4<]˖>?#^>8"߸OK"s2}LQT]0G2&/e`3Nu=pn\x\U)BgdE%HWbTEs$!0YAäYr( z+G8qsY3T6<13kL??g(En_3 s#JYFu{o$JzL+,RDQ`,L_szvFelCD`AQKuOvҋ,Ɉ_Xp]y\0IyɈYl{^;,\^77_:9 t^gA->"u AYvYV'ܗRqbF?2B<򀨋g4x J +? h>iԽ;x;C7{ep_kԡ@(h^v(?^^_(tt`s@ 4;mWΟR_@SʼnowNςK_8#9m383|R9$:]`Dkyʄ|Vf|]HҼ?L r 'AN v92PknW v/ L?k"<?2ckؿk^>z}1!ӶlBuѴGvB|[xx4)}Qh:I3x?5ȉ2DbEYS%r)scSAeWR&6,.v,?XiiuaS 9ne>Jʻl';ɶ̮Ww.4\Vғ֯Cv_rGvAxFQp/M-,vМ$))^}3뿔q?kmfQ(caID*ELjc\E@Enn?4;76z:Wd{6w?S)ʉ?3Lwˎo ߀<ˈ-Ouw9n3E)vG<Vx~N\kL2мpܤ [~i(hgaWܪr97ʫll+OI 8?Ѵ\;PJumI cKfLL1M0jijXs  鏽 b'FsG:8H?:~8|J朏tpȜup>?G:8H?tRYtp>L|󑎿)H?2~8߈?tpH#tp>83Ng7H?2~8_#p>Ntp>Hg2'1#`~8_#p|G:8|`H'q:G:8H?:~8:q>H7w6u6ڤdll@`|KkF% w"gv$@h/^<z G, F69_ΦƎ6,j»~ŗ)AY52#ǯsG`6VʶVsHѳNpFq mm6uVz DԔEIuiTY'a](?T'"R\̔ڷ $/`.5$Bm3_#1 gSM `~˘@ _ivv8 {Bc񌁧<W~حp,+B" ,.-r} 6G#*Cp0bo.R G`b8 s%1npub ,Ms1lp1 2Lmq2fF $V3\:b,u Gڏ:3?/芆CRho/Eɞ L*mucYӐX=z9ٚ!"V$0" `Yʈ^<2H݄az{B'YkR~P'mX☂+cﰞW$q7^)6{IwA+ӳzOޑ$K;/K\~4RxG HVKqSQ9$N 8WQ_R"hK4_cz_AI,1*Qg:wGPEREP**#$΍LԇQӻN:`[9VsYڄ6~86T1Moy3ed/ϯUe?Cil't6dc ^ 1bZOW_苑3z.:?6Tt;lWdھ>a{ 3Sa2^$T\$Oʤ|+[=A;՛zBq\=o.z? 7Qfr#cmb}Ůh1H:qCo/=V7O}9Z݅tBi^1S_$U<6zhF;W !{:zrO#EүFbqXg{:i!o :[b[w /A7n2ufӷpw8O([wi#wyS8}V]g_FoA])l^n:Fi܃Hx i w2QuדV7ٺɮt Jf*_Gtpw?½lŤ/)/KӜ.=wZcMٺFr?l#cf3e{d֙^K"ýe?ŋljOO'drD_Eo!=:6/&NG|m\/lM ocwKbXUH?N U)rȖ|T%ɩ^*}X 7RީlDU㗼=p U^IZBq'UbӪTz{x+ͩ2Pܵ.rm.b#|ߴ^Jtĩ\hgwL͕g QGCU3O^+*oȫTր1{mNTpr1jNLI'fsWQǩ߸:zF(9fTB_O|w ׌otJ뽟*w?֤y:Xge0ӭKlOZN/uE|~rm")hhTymʣʩӭj of\HoT #jPZnWw:va [+iPi]/_b<ؓ36SUw,MU\洨ur2Uu1]rMB[Rv-ףML;8d0*ͣ㫩Fsê3/_Vٙr6iK*nOqM"qVnnD:sʭEq_ROUX긠rEEc.UU5UfvyuUNާ^onRgnjP< Eй=*?Znڙ"mS>Se";ՈNU{Ҹـ{rTA##<'ESUwya~rkTKk.1M@dD#UvWOTac.}sq4lEU{+Z Uń۩cf^Jꘝgb.^-Hm:jim)KskRGΓиv{l(Z¼# DŽOM;5:<ϩƒB5!iQMEZʒ;AUUp*GR M/X*:rYnu|ofSꘐGSuc:PUV>#^0rJ uKշn <5Ug1TjK&gSMY$UH5ǔ:ނd6Í@;Ϻħp >҂#Oo9PeWa8W:j,U1xHِTiS&P5`ع ԑmwtIӣ藱-:/ھr$ͮ #xU͍_Cqiװ|9=~e~^I+ḼKBHw"BN~JSr϶]YK7an>yySڗ}Cw\`Ky (vyB}Oۀw15hXTݔ'bN{Q uMJI;jtC.Y#"Q 탴$b4- RG-A;@Dxװ?bϧ3h')^`egXBOhxǜ/vy5^x~-z^PmbmbCu!x#3EGD\>ќ6gSkDmѨ8FTOxxmpX q[{7pOmNeH5Vƛ'p'hNhZ╃g_; x+?Q`'ڇSx}K<#x+D&vd'b|++k8n(u;xvƋEtڗȞ` m"<k=j0/kOG0g; +߉;X#?߲^|Bmwj<'BUh| #|`-4Mw1ǪaHXmOD+>k?kb+;}H< X=Q{s+1 =|(* rX!Y*^Dc yX"<sYx>ˢLwxCk?+@{ )G/ gsk/>S+'{F榌KX3J=Zz#⍦Nc#+i*?[~=Eׯf`661h_q2R"#Oۍ.I?\kF(5iWilX⧳4@!zo _D[tauDI]!NzJGhE-G[čpm3ڢaŹ&u-$CHRC}h C?G[x@ mbJʘc2 &axL&`2ILd &S1tLh߻'cP0&0&&ZJ mayDb=La%,d&,d&+1Y 틭1Y!&k1Y&15 &C[o11Z(a -`b&4WqFN8v3N4?pd+&0َ+&;0qd'&0ٍLbB[c?&09!L19Lbr 㘜$&09Lbr^l"&0'&W0J/LauLn`⃉/&71&w zbI0&!bI8&DbI4&1bI<& $bI2&)P1I$ tL20ɤ* lw$ۘ$|L`RI&ŘäbRI9gxdl3b.~]ň!p1?{mڤÜI_2qbX1v]͌Ǝ crfld0v3v.`(!*:ؚegD |ĺm}A>@b_JܞN럪GOn~߯bxxЎKЏY#Pxu7_9\|@N6"n/لFX.-hōoo 71^~6cJl#G{-FƖFf({13j׵q8?V<ˠUIM6LAt$}d]ӥ]$"N1aMD6CЋ^ZfB+G^Az9rp'cALag6XN^c7aBBGY%?DfT h bI)vE.Ȱ:x ?8R= a^罁Mk!xL~|5(JTiaV1C<#JC^#& @w/__ \Z+쥠h(:<RMYC\íNz?0g8$󚚘1t+o26sd{;*o2Zc|6&|]6tw66l`] Q/JzƞsdꠋrWg۟9tj9WSmM5/;a֠mA;vЍ"'Ɛ[qٲBw7-sNoxw'r]wy0n؀ݫM>d_ ;g=w:gN<=,g9L#H;RB^Ce>yA>Wω{,G"\rQlv{8Qi9T񉯪ȟM%'߮Hܔڐ{"E"yaa)dePf5ZK['V"k)0~ѧ&;WZI%&]PP|:!@8eǠM d!U̩SЕk6٫ӻ4fr򧂓^jMm_Mn9YcViꓥ|x e$9uyB'Mm9Oya:90е{BʮAvZP=)dzyk_GN4pȉK:.JE FHM]*As䛗S )WԿFwur#M6 \OY*Zt:?pc<i-߸}|7ϓ=F/"k [Bɞnyrpؕ9Ϧi6Wߵ![YWpܓ|gPQ t54vo@v ;Irl6Si}]3v8,rlur\Za {N_%_w~k,~3A@L̸^nliԆ%c4q`A$9hg"y[cy3T2A~FrJ̚ez~2|i ':Q[dV[}cr˅+jG; ׌\p7y>yHd:"ߖn6\Vi]K0#Ȗw3+ko8`h=wNcC`9~X1}g>#ͦM*}G{SFܛ56Oy7/:5M0f~Zm",^YOQy9kMVeΟPg:.eÃ;B.S5j'ԙN;}1wTs2Pc>tB}뭿d];/giF}<S{ }} ceٓ)=Q[6CE> K^Q[ubwDx~Fd'vڍg<;1,Fx!3xEE}@+ 5]>xQE<_{MGt-Q}pf$|X/q_V19 kye %<NоQ;CvfxVxt3f_,c+j7F%4enDvAdO_XǛx׶`x>֕(vǻ ՗/X&z4#?fC(qQDmb+kƴD&\<^1+:u<ǫ+.BqLw\xXqV X/Cd_9U]YMYq'DBԟij+ j_%<~ z?ʓDX8xm~BxY5^C9` N=f=z+dZ16^/b -<ߜٷ)0W|okh и.в-G<{_] kֺ?=<ƛ#7"̠mCtk(xq3cb ?& x>Cs:؁.P{=ڷkuxuCm EDXՅCD|;X "ͨsDsڬMs(G-^O4^ 7Q=Qq5Qbe3xHm^Q-;<1x:1"Xo GD'N<;ioW}Ϫ0P|| g"ٚgڑh{5~yx;/㌺<ԝ/[Z3^б.j_"{5mSJj~x" ^=Q%,6l<' ㌈;ꂗQߔA.FXP; +;#"_cxGt ^l,͈,z /Q!c͍z-Zz I ^DnE['zn9O "_AcnNоQ;CvfxVxt3f_ cA`u=3"> 揧/^Mvk[vFs<@J;Kaz{ LhYʿx@'Qgì1-7vI?~~xbsxW>8qճUD}V <fgUWVgSV܉3'ŊڗT".a._'=}gȟ|Itxtgn?x}!< kxρCv T` m` 2c WoλCdp3hx>7J5r~kh\ckhYx|#vp=/a5y kOBdo"[MwXC1ŋsLK 7Q^4Ov Ѿ^\CëjPL ^,"^~.D"oaoFм'flCy͈޷5+k#Da[8Ye(o<$oB/p'hNhZ╃g_; x+?Q`'ڇSx}K<#x+D&vd'b|++k8n(u;xvƋEtڗȞ` m"<k=j0/kOG0g; +߉]8#("NC7ek|/niD8V}=T7<kDh{8'zX9^][9??Ëyx>@ىM\H^ aU9xL1<,ڊwwq,'g@+~5ئktׁCQc.Br<6r}6H(׺Ҽi_ lu>^ x!W 3/ a-wOU*+ ? ,8{;őzPlsⷠТwУ3e[@=kW ۾K"c^S3B}Mf hnhZۘ a&ѓBNfͿpF^d=O2; {gڧF1FǍW4 :'kkT92[zVa4MoeŜտ}KWE&Gsc{SD;Zǐ~^@jϾ#S>;B3{SHLq _{}+J ^ 2w ֆ/"w.9 wgy᳧تZ lAܸKէݺ@t, *T4)Ogk> w zOwZCA[|AeV&q{{]єZ0}; V4ޫXKھ(cߋ4Sɛ]׋L?>փ&]~;Wʮx |K ?P0bӠܴ[fz;([*dO}J7fZ'F2RliEg7wϡp*%F$h21K9uU8{!$Hu w?2jװb !c_CC!x˟\=2I{^hBXDnjv%V6!k Ex 7 z 1!^j !ؗj EluJROq=+ ums]3 S mLǠ|AwGC$-$څ,/GVвYDsNpֶKIv̥u'^y9xS&kۛH-B~W*|L)?j{=Cx{l@hR_br nXHۦP9)dj9%jq >"_5 ^nr#(K=7͕[WkAF]9bZ?um$ۺTkU/;=brR7h>,#(m}Od4TF_)_/} }"ՓDOP$\uT~PʿB$n@O#g@KAک7!cޒ ɋgB^7[vA/+NuB>BJD`[&f/ez"X.}wű=ǟ5b0n&sl/cY^Ƴo =T[( b4\_ ƵZAvˠb;}PvNas2?l ECopƏAg;o_ :Qi\p&=#՞5Q eDƒ'`+ki)JޜZƲǣ6E^n;he_f~4LI;_tv^ + NL XQ"Yة,sXqjlx-9[rރR Bn*@Ѐ,'~SbK?uzhySq,bl/%4zԾQWͬmg4m><[%gUhx-} ~FyGPJ]}p DqE&qho5}n`]၇ x@K'u$ 4LmZgstXe1 )i'*MΪP]Q!S |L6v-O7Ը!E.VF;!fۋeʐ% )G<(ӎgpga;JШZ+5H*2 תC Um+(\n [_,o V,gK)ӊ' Q7<: "S<]bp>=Qd㮈ꌟ^^gI][D~:#M3MZZ!,PHTtR "3,s _2R2jY' /!t&ϑ@ʾ`KRfm$-#r^6{7)Ec=х!'\C֣ {jwhy9|z!z-}S%c<脖 1$F(hS֮3j85/'eY2L|h Ki_ ʗ5/B]]u= R*_) >23cE$ mU k+R 8k\=P̗a~Ž;U{rFXj큨7y3zaK !M=] hUٷZ6悪2noŃ7_sz(Ȓ‡ʤ;'qK1/Ɋɷ2N+,.L /|G핳U$ N)7zTp_oye}BMYvVe}Xq%[~vZ/3NY[##^^KK9Q\I*ZeP˳(E:on!rP }M!g(3LX&3?6F%wc)zyp6s{=w|&73yx <Ά{hLԁeeiZs_vHeQ/Bc.81*1w dl.*Q(5|ev}Q]y}Їsۡx{}ѱ%xP ^;nJ}O'yM:= ,i,|$zT,->ffG 6+u}vacD)4h5nNOE\oy ?;q4@]OvB`yKܬQ>OUGrQQSJʠ=xΓ$D;`#w4#KeABsg?5;KԴ82eYoZڍw'k dk$zuc}MbX\^r,V~a}"p_^#1"N,nR˅1F2A!qgŜ)?cx:2υ'<9:-jgf^/j'˜7+%l Nȟ|ψNWgW7\eDȃ'//9"fF<燨D&-fbNk<턇5"&>Cn8*ֈ֕(vǻ ՗/XFՌmw#@}mW|,'ydYʿx@'Qgì1-7vI?~~xbsxW>8q3Q&_.0s>/.Pz5z5:VɌ5.xcl6_Z&^yD.*^{ٔqΨCbe0%';XCۆ=D)F뇇/" Q"mwֈǷP]b~$Z/<4);Xcxq M]$DZ롺gwX#VvF9sGDƊڏNf5V~Oެ\v gB<< &.$/AxªV}HVW&јoxmE\(]19|[ ^]f9v]x%F:BG?!|9gہӮ,9]h*-$xM1}dM{,Ok_IԅcaubB[&~c@+ L1 $0L1'ښω`B{1 $bB{0LbI:&dmE@b6`mLh_$bRI1&0)o)&ex.r7]qM_qbX1v͌Ǝ c=rf0ފ2ag0\QO3[wfש)n팿;pGwwxOQݕn?,Ú 4vסb-Fbt̯dowy5a(\pՖxj VJad9b$( 9RtnGk,!:wDx0ϒj(W/5ÝP~(-=JV}}m>sbBf !b V|W%g'?<&)/ G?ּE_5@_gЁ9zQ}4I|)Iwt'SJq< }G+SOGjlr˃ot%_q9(0ԯnx-2>%;P#nF^p}pVJ@)EFSh!|Bt3+觃:gjz{@|{~rj8BW(#?_ dw 'b~7+N H?k'-Umo-;[0{䕘Pr'dX(%WTLV-,>+Kxp0gּCAzo bR1m=v^~F߆}>ي=:$iS F:)$B;ʭ!CiG AuhL٢aU SE!wD!4ja\m(z?n &ܙo%E  zM_Fr^z4ι=jJch݅*ϝ c n@żܽ6&LP#߀\Ow [k (o6x{ɐlvhx.Nlk\֮ɿoqi%|.9[>HTx`DDgL%ʽ&.gǬ7.hw ˏm )IۦqmygBoBE%3wm*d%(݁h^kBYIYkM ޵ #QuvR+([47ܴVT4M n4W~)Snn= Obr]hqK5Ծ`'#*+oԁ-E80vb$4y]|+ Q2ޯ,}. =|2ڴF{a7m@]+^8fuܧ}xp[f3! R- (.0] qcw󃤊Ci]иB,H%^AUЗP&&Ҏ8^COm vx398cwnf-ҽgC"$DBؔ /8C(Ao_c*:#j@%pNKhOwKB Y*`Cܠ 2dYs{Nˣyb #wpa;/!if~߭)]SCc BVP$I}ڛu v- wm:^(bȮrpxݒdt@ð&NMӻQ3fxه n?@8 *msUW؉C}JBBɑ((}q{z}˥ bNyc3f^ڝh@yYd!X)q+k9[l?Os; sЋ /x;!{x AIkl'B]iV (tjښAգrp&z:LPFSG2KoIv@b Pސ& <ЇDߪw{ oxjRcqCF'}6@>vyVC썓|-*fĿ6e(&pS81>#)|*%!EHi(l)z B@9JNE>9dՆ <.u uT,+7@ȫ>6B;y@9xp?eR*PMzҵi-%F *Ȗh>(|7҈^ |z17]oCobM1x qbn-Vh.WdW4 RxG\+Y!>XA-)d=L%z n: ^U-[ X}1WssW6HǻiH+b{b'΃Ҍ|zmj6x,!EzD?-' s46}ԁ]YN_z? Ph^ a.OVb*Ps% T!ëҎY&XAst.@hG;}UpzSaaUymAo<.qqNV^ca?6_&FQ ?@(!Gq)Fr?L:/sBLZ)0΁o)ӣl_#F9%3x|70tJ^Qx`۠P*`]?րvx^j Ԛ/m7Å:&㹐8N76'2ܟ͸7<Pd!vhZSd nL 92vw6@ >cBr؆z󣀺4K(wUnfJHn/-,T>!qx?{d<=踢i\74 \KG0>Q8%b l~CkbT#5d_2xZ۱R2R QK H (R`(Rt0͍qWI qP`ښ b$ yOy㟚'D(>x#D1O l@FdID]gX L.:sW)5 {zAF|G@V١a7/[jiͷ!2CDGM3ž=s*b7y~rȌ, # y!)iIJ/NA6oE(N+:u*v̀ʝnoʏeCѹŅK#g_տ$ʍၿT~?>.@yMSښi4/>^%FpS!b3!lѻ! Baж7@P䗂pjM]!P"Ck8g$:fź+)fzZr?9e]!Q~s 2RBOoAvݺ󿽎\z]]{ޭၿ~Ը <2B tO tw_/[ӧo[CuJPH*~~iyOj 7 / ;N C@@ٌ!7>=f~ X/yČJ8<*l?W~>Aw=⁘r2 'o@켕#!J"cP^'I6kh0ijwĂ)pZNt|g]Y~/"4^22HY-Yx 5?^*y~կA|vrMEjH:zD,穨-EBUCK qCOԘϏLX6u~ث77<nn_p1TPO͟yoⁿ- q=~';7L ^5aHJsL5kVXրʁzM#ԓ%RdBy;W{_ ~⇛Qi%1;!3%l]$3yK[ ;=euyPkR׏j|Wdl|!yr .Ao(F")$'7~:.O2.\xh=P$o<]a-(Rq(rZ Z= M-xO"K}z=ѣ-$#p| 5Ku@]{*d3Ar7jOg[YR_?!0pHBow4>%H4e%"@^~yuBt}7}"\@!gvÍCjc>ftU5 Hg}.plO@M$y%y(:|¢_Az~{yљ /!mʕ;4#qxW ew~wnv uQ0Rf(DϿ^e &U&YrF̺vtF+ޛ~?IRvmsHqD92prtTuwvP,`^* yT8< EqG9"1D?0!c4COtWy}ΐD-h JDF\ż_}Nr: qDx=(=8oςpMT,6p 2. Sկ]A| ;ifl7No7/Ά| ^PA;H[0Ʒϓiq+ΚpNUY2F=-C&7\lM@>ON!y!BL>>G>?ޯ`ЛՓ@ᵏ50kIo:1\` _75 ƿ;'0uĨl8mU1痩 SdtG((= ݕ&on"K~tBҤWD\u7y|/>Ԍ [nŵФ<';G$fG*T~C:$>:$74;AqB 2u+PA}% oL;g>sIh&Zڂy-\#h U }Qo!ԣ9!k2\x.;b|.3#Gr* }/2ܐ=|a@ s[A4"PzF8[):=2g[^boTJqt#n +オ>@yjYam=bC{ xnq^+,ky3o?`Q~݌ iT !4,b8αWh>K7n܏.k3 ږ[g'ý+2 !}dm\7l޽ {l04]uQ`XPq{Ha_s/\ Cl?c9yD2/ L;:e:y1psAa {`ZU䟿]ןs{,F # mRΐmwFJB_%} R:&!|S;u G2^7|ϮJq F O ч^i֩ ^ 6#^ &U # T PՀ\7H8&o<}zC;'LЃŸdOMlI{G>.h_Lo/>$e$͛'ݑ DŽ J|蹲 RmHKxeb"!#+r([\qb<8rVx ObZ*fBR]_)K'H=FX40KnW\2"X?/TtၿT~ÿn>.w7\K&F2w*kFM{'>a;6HJA!{ӠhhJ4JVИ4>S HBxJ~m($T ڲID.n73a =ɐAEʹʨGO|Y#%O'+ayxg;2|? k %vyoAaq\t05x xMK:W #oxԇ_һ7BlÅ!#%b>ۻ{$ ;|*_@Zuҧxrw'$}/:=70 0pO|ï88J:(]]SW-d=8h$[O~x61-/u" +eBFyO@B Hz33&&zuB*o^u 2o?R n1*K-/y NۭŇW,<̀  _PKm)8wtf-Mr*OnPֽِ`œ qH=G ޚ4ݖၿ~r?7 XjhBjl4+(sĿVo8W7-m fgC'~9 ~kU8 =”QhYBmºAФ#} LaqbbdL9IKr>'rA*ۗ kg씡0j;ېY肭(r͍;Fߞ+&!ѷ}Dv5O>W\qJ m[;@hA  +7KfA5RIjvT}~bH^}`l,`=v" gZ< ,TŐi1oeW;gr OmFPW+ cM[&$}$Uw9iOT^bԛcqOi2ȧ+NU@>*b,l漃k܎{K>N9gnjtYI!y]fmyePE\p\HuDk1Hyw@*]۟x' .ۄ}&އj'RvrZp]sE@``[:Jb*!M}k@޾$ s"[):"wiB}3,Ù;﬷COƚN7!}z7de;wG>>Qz6ƝF/]# dʮ3pgžW'qx?+~~]@@/ ѫ'aY/%YC}$>A!m& j!4[!)SlMyx#3b_$Dn D &Bt-ac!< xoMUm;!{;ջ\ʂ<_z~X+ c~C͊ nhɨmfz(~ij:/ ~3w.=%/#qx2(.C:O~h(yº Zqw@:E)PО-r z >#x qî yѐP;޲g.`PwjЇ@+| k53jBZZ4sY|센N*\YqSwID \J!{k-xp[@&/G!JE`'w]How  [ ~ 4 8<@+x?@w1Ax0AG&[<ozsj͐{@uz`P#u>x]$DK^|W% OucC(%BTmsug'>!sޥuQP! }y?P+7@ug,6~r?׻ |ŦgVA}i%ِio`!۟&7Cs'!󇅓 _ 5/d)iTmB\'$g\Y f>Hg *9")0w˳u@V~~zykKzn+q$D zC(C7v FB2pyG<CD%~zYh<|*\;}(`xK7{vċ_s(p@|k ܺnŦ;OW ;< gVZƁA; Mt6D}-HH 5b8}YM F{»2F<rHͺN/ B`Q1{q}Oyl}WgW DtBׇp1zBvx xڻs_ Z(_C! D±nP;Ȼt>;Ѱ#2:RyHu)V@KCTj$ E~+}?EGp]arݼ#aQ œ?  &@&ײ]f8 T_ 3$:pv5v "y觜 } gޯ6<E; K O];jxZ g\?ܹj4|7_{gMuRIhҀJ(PѨAJ$2U$yvdgR%}yֺm5OwѲڟٯk}}mCl_u{gM#"kzw2Ոq{8`'(= ,+'X_4W ̚Ff`X`3tVHx勺WNˮhx$܊h&Ҫ~XЗVv9:jJгHQQ)Bi#_=s" D^՛צqBzб1UXzB'Uru;[#꺑ҧUP'4P sĸGcΛi I9nFPkHp}9 ;+E#wn@e+#l&q=B $% fX>|j1Ca\M4Fc]ׄ3QIr#_؃(ђ\)쮳Gkac_"!khrٔЦ µz_nXᙌsѼ0Rt!T)-k? eeA93;\ p࿥.g b:/>5rTuzZvɶBIqmHuQw4B~;R rYIg{bn07BC) @`7d8jJKG"+ELe-iu3 =>~0^e@KB_"A=- 4ZcNBE~iФw,# (i|@şA> ;+5яG|i?ߴo8r*'h-)jP.MM<M95Wh2g a@(2aXw~E4ͅ$YD7xf%<-_c(݇?ǣl%_ln,]9~dU^}tZ=4OӐ}0 kI> ݨ! '=ұC&B;AjDe|ʎ>fOJf4e#(X @TQ%ThO]' =©%CJu{*1hP6?FŒ f2@726゘YCz< #.hOS*^8m=2sdJ -h#)f-hUH݇Dӫ(2sQ}"Ə{&zY3QbHkW jY 6k}nj}qb) A>|MWĢ~Š?, =on%矱-) hg \Ex_^\ j)Ȕ|,\QMi+i~pR "Yx7kq_xӄ+U4|B5(ĮV#$am*OKp }ufP,W@~gݵ[Sr6f<Љ$͠H5BciPnSX~+~`ԗ/QQsM9i;Җx>;Yke̝CT0כ&Z:!4k% }q@xMr>&!xؘn$:.\t%ϿAڡ'H | k^1  퓮pI|ʳCZ4|m2V,q /ޒ8`|?n>X ,~) |MMsyj"jo2NH;~Ãj_̙gywExH?9 #cGCrF ޾СȲ,Pϼ! + 0)62I?]wQ.hHZlAj~+LEٽ>P(vޕ΂o8,'pgx_k,'~Q>o}~'3ǿ*|.89x> \6 aF]H.,̣:rػWy/mK`̸>ZԦvn}rkq<Щv!2vjөvd۱K!߼R~G!-{[GֳHIMz!tdO7e3ZKf )($#5dꑔP|؇eC?#UOs:bMjB6̴%.H!dMA6O)@$='1T #҆_EdH:Cbb/-r);?"bI7 z4Q?N>t}氆z x7%*.^n }ɼno:rSG)N|]a&,x$׭|ؗq_Һea:Qs-{r7 YHkgRW_@X_XcgpNtH^'G@LB? ><{PUc;QqіէQE׸ףFkaU]P<7C-]jA&$cP,i~ U7p/LS5pm:>_ /R] PyêVhnR@EǾFA9([,7U߫].QJq6ǝ+bO;4Rrq:&@e(>x}=Yw7uc)\0r zcFZ%cƣWH52SF2:;j6w=^d=3^t-4u%M'p8>7|?{~g{L}n;up!g唇]Vu!#S*<@} K U^kΉ^[4|NBzr2%Sz|qUA]ٶhЗ?ZJ*xw3j*3QҴBj|ڸsbv&rU{?R^p'fɻ>DHRQwvͩE'~rָe{Vrk\(8`Y;~3KXlb;Gس R-^#&.7 pJ$oTͰڤSxR͜v<؀ܧ}/B P}ej@e$x*קC63$C,AqUomO1DAἷq΂6>{ǴhE' ˚"uRMDLETbetf6f [p@i=V[:J(r=dF ³#xKqaGElcy)Aߙ{[PZ (! ۲vuخC⩠s E泐^P>'#Sv~jo6 ]F$ޙ&IPxV (#k3{ڵ݋W)Vʨ0à@Gk Vի!i nypX z uK7JUgF^AߑykskB[WˀTŝBۭsdGuU S$ٍKM9"%Q\ Z4l/r9{N@^1I>m׽$.;3[m0FOֺ}>>:fŃc h[)b 98]ae[90Ͽ{~v`ܳ:0`~CHS'Nػ' Q$N|֎=!s6!~G#b]*"ʺ?ۨ"4^> H]0ECoc٬"3t!+ui+?3BG\lhs+0)4io8{d;L:2'ui BZcA!/-^F#y$o@kܳr9N=ş/~v+uO5c6@c~n2IG\AMѹW2ȳR&"L{k" ǏjC[M@Ăc:u[f )l6A' ڴP)&e*ɕ_w}K!-Lњz^NCjQt4)0 6$ .V!Sb#zÁ?x>NJO8VG 9;d&յ^=U!Ӆzq^/S?Ku@njA M'ԪS}1,{bHp6/ypӫU'Jq=+Ï10eܹٛ!( 6-0᯲X ٛQ?t=p_hY[2򵗹 ]?u6]2ԭeh.3x˶ܹ4הOݐ9Ѥ?.% ӢEIr PS{<:߭f!Eun84+)-\lՍnCO[#P޽B);x~ܮIתP÷d/x?M f:~J?"F۩ H]R!GWhq#^~Lv8fε (u`vno=z- A68U i7^GB| E}󮞃G dg#g'u6yH,hA,i^+s_pൗ#{Nu,-ysM\4C P+--]$)`D]uyZhSv[׾/' xFgM:ZLF?'m~b=χؚyށ^se$k 4BtsӘJ߲I9>-\Sb$rt?J#>s2rRUQwûkk"WRO$ mRD#z7aԩ' P;px?5K:/JkJWܬt7>2RŻ"3byYT0ݦp@wG.k2+O~Ҫ! QL.]J;/wɤq 9OpF\NH4Pny3on% (($ mq5ċXB%#{v.qMQ[wg6s2.Á??U}?kwŃ@@Q+nیK{Nxȕ9V + A+S?>=RWp!!RWiy %oNg"VqTӨrei1u AWKnP.ثNGL3l{duGirK ^؆P)VHF6 P5r+J,[z`T'3/1WSNM4EۨH?Nf0&7!L]j+8#lzb!(ڛFU za8=6M{ZW/X[jSEP 6co8 jN6Mu&N*ZO6n.h^\dd rKrL'آ5mJcd?3 ';-eቪsÁ_=T]+u~wj)^Qsl>a侹 JǯGX>۠Hn@́cs"Tveb ??Rfl9$}E j_ȭ3gJ2:#l%:?7))+씟)gD.FdM:. p8ˁ\ۜb.u!a* M *%6ڱwp]aA+.e[tlA[jn2 :Zo6X#hdy(inR peeHX]0II>or^3 zA]!#Q4m`zh Jf"|n{2Wu$ [%J ܻjg_ߔ [p@O~S>UrGK3?u$ʙ E 5=Y@Rwl2MC"fDj}jV! p BۨqSty7SWFrs+<^unЧ=Vk_@CXTltwBDܐGnlCu~k>0<`>q݈>ԖSH&N~f\+/]x!7 c}G3inSx rQzh3$wڷ'D}+T"sfC($ƚx}^uVMپ %xԡxoɠ?9wbl@ s(eɎBJZף[v0;*Bzbд؇J8gƯ}y|I_(8`YʗF X &eo9"`o9X% ŝ_E*mDˑ8wQd.~a炌ղRfMbԎ3k T}I~R,^ۢnU^d;OݵeŔH!?sM>wl9M`usK{#'gE>'Ak=r'xE_BS0SGoq_aثHկ`V -G ` )qTC&PlV:iV2P)aB%j|Z`5v\4ԧBmߤjO*gUۘ|wo| #IDӎyG!9x#i؇J.|;3Δ=tRtʇ̜xRDgLOGwf9 Q~O-H3 G!ѡO "62rb{q#a>]2Q7 B  qlQeT/6Nv R7))\uf/ S#<~ݦ}}|R9%Xp34ی;+|;#|bHr[Rs~w+o_~Ppr` xā망p_@tPGF3SI!BzTP$dҜ) Ve?y7251+](y{UGfٲy[Q>YHknuuUuz¥1^ # s ^gЬG</yob[ë0e->\yH[f/c=W|3(o~7 Xgj{{:qvɇLQ d9Bw9t+[.MhFq*Hْ@A4|d8LjT,m=Ŏ=ۋ7$EA}>{=xd}3@+2gn@/qha;.A>m4+X u*^mauk nI}Ir'L6oA8AX |@|?|X0`[][λBg5Dh3_&W -ύ`Z"~ᕡ.sr~8$VhzEm7fT{̭Ӹk]ϫt 3_ߐ@BgAsF>Cl䐻.F; =;gHOG5撑4fW,CӸn4TYElV#p8>|/-G?wQ?rgZ#0Di +*Q;*jn[/2nm6IO\:R@Aٹ{w ݍe|tJ-E}t*)^z샻'Z!Yvζd9-'<"^#xTBrZ3^i(MNs%`Do'uڊgށ>]o򡿾Aҟ//767` f-R _8YG@gO1P=_/6E:JJ{ _ *qM?iӇnGo.燖!NiaI:qgӑb[0^xj+U'{F{x{~PlU` R7$]ΒA#6smU&aL{/p࿭. XAإ.}&pq`,}'8UiG+ !QU:%ubx~ Di䫝r`!p1'PP~%¬FNmJ&=pn0/D+rq)&/K.8O|df_J6,EntPӟ|S(YBp}8GuD? 5X1}͠hNe Ed#+ql@$O 4xk#r\)> -AΡI)BtP8j8%-Lh9|V|s Tjr/FN9"o.=۵i \N8jL:|u!{ sxibÁ_<"__e>P.zc^ڋhq.uG U]#W=dαHU O}[9dk ">~v֝V.l7nz&n_l%";"?A>CE џG#XA ƞ8W#T41+ OT;MďowFp}8'dm'N'|v (ڳs%}P5;l=Nmt^3H:$!4t>xa|9n?/I-/[t# x.d8wQ '4]1DwpiHe<--^^xQD%6ϋ.|۲y(R@X4ؙjwm22# ZOzs?{>EG:x&C jMۛ#킰"d[؇~?+CߩP' xg環'{84m:V, =dhVtϵFА7(NrcSH:A`d2^)v] i|s SNRNA:}G̣^D4PSHL _T' -@Yӊm7 ]v"]3ok.x7 HcOeB=HHy2 1ۼ;AfaQmd7W ~w~~|?=H'+Z!51d9$خ_.Hߪ(4\hjQ=3k\bx̷}qVPڴTWq^OZl%vȺ+*;v^(ZۺWh4NCٳ3RA^2'7t6De[ eZmq> 8 t7S(phangorn/vignettes/exdna.txt0000644000175100001440000000024212507002037015746 0ustar hornikusers3 40 No305 NTTCGAAAAACACACCCACTACTAAAANTTATCAGTCACT No304 ATTCGAAAAACACACCCACTACTAAAAATTATCAACCACT No306 ATTCGAAAAACACACCCACTACTAAAAATTATCAATCACT phangorn/vignettes/Ancestral.Rnw0000644000175100001440000001344612507002037016524 0ustar hornikusers%\VignetteIndexEntry{Ancestral Sequence Reconstruction} %\VignetteKeywords{Documentation} %\VignettePackage{phangorn} %\VignetteEngine{Sweave} \documentclass[12pt]{article} \usepackage{times} \usepackage{hyperref} \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rfunarg}[1]{{\texttt{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\R}{\textsf{R}} \newcommand{\pml}{\Robject{pml}} \newcommand{\phangorn}{\Rpackage{phangorn}} \newcommand{\ape}{\Rpackage{ape}} \newcommand{\multicore}{\Rpackage{multicore}} \newcommand{\term}[1]{\emph{#1}} \newcommand{\mref}[2]{\htmladdnormallinkfoot{#2}{#1}} \begin{document} % Ross Ihakas extenstion for nicer representation \DefineVerbatimEnvironment{Sinput}{Verbatim} {xleftmargin=2em} \DefineVerbatimEnvironment{Soutput}{Verbatim}{xleftmargin=2em} \DefineVerbatimEnvironment{Scode}{Verbatim}{xleftmargin=2em} \fvset{listparameters={\setlength{\topsep}{0pt}}} \renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} <>= options(width=70) foo <- packageDescription("phangorn") @ \title{Ancestral sequence reconstruction with phangorn (Version \Sexpr{foo$Version})} %$ \author{\mref{mailto:klaus.schliep@gmail.com}{Klaus P. Schliep}} \maketitle \nocite{Paradis2006} \section{Introduction} These notes describe the ancestral sequence reconstruction using the \phangorn{} package \cite{Schliep2011}. \phangorn{} provides several methods to estimate ancestral character states with either Maximum Parsimony (MP) or Maximum Likelihood (ML). %For more background on all the methods see e.g. \cite{Felsenstein2004, Yang2006}. \section{Parsimony reconstructions} To reconstruct ancestral sequences we first load some data and reconstruct a tree: <>= library(phangorn) primates = read.phyDat("primates.dna", format = "phylip", type = "DNA") tree = pratchet(primates, trace=0) tree = acctran(tree, primates) parsimony(tree, primates) @ For parsimony analysis of the edge length represent the observed number of changes. Reconstructing ancestral states therefore defines also the edge lengths of a tree. However there can exist several equally parsimonious reconstructions or states can be ambiguous and therefore edge length can differ. %\phangorn{} brakes them equally down. "MPR" reconstructs the ancestral states for each (internal) node as if the tree would be rooted in that node. However the nodes are not independent of each other. If one chooses one state for a specific node, this can restrict the choice of neighbouring nodes (figure \ref{fig:Pars}). The function acctran (accelerated transformation) assigns edge length and internal nodes to the tree \cite{Swofford1987}. <>= anc.acctran = ancestral.pars(tree, primates, "ACCTRAN") anc.mpr = ancestral.pars(tree, primates, "MPR") @ All the ancestral reconstructions for parsimony are based on the fitch algorithm and so far only bifurcating trees are allowed. However trees can get pruned afterwards using the function \Rfunction{multi2di} from \ape{}. <>= tmp <- require(seqLogo) if(tmp) seqLogo( t(subset(anc.mpr, getRoot(tree), 1:20)[[1]]), ic.scale=FALSE) @ \begin{figure} \begin{center} <>= <> @ \caption{Representation for the reconstruction of the first 20 characters for the root node.} \end{center} \end{figure} <>= options(SweaveHooks=list(fig=function() par(mar=c(2.1, 4.1, 2.1, 2.1)))) @ <>= par(mfrow=c(2,1)) plotAnc(tree, anc.mpr, 17) title("MPR") plotAnc(tree, anc.acctran, 17) title("ACCTRAN") @ \begin{figure} \begin{center} <>= <> @ \caption{Ancestral reconstruction for one character for the "MPR" and "ACCTRAN" reconstruction. When nodes contain several colours reconstruction is not unique!}\label{fig:Pars} \end{center} \end{figure} \section{Likelihood reconstructions} \phangorn{} also offers the possibility to estimate ancestral states using a ML. The advantages of ML over parsimony is that the reconstruction accounts for different edge lengths. So far only a marginal construction is implemented (see \cite{Yang2006}). <>= fit = pml(tree, primates) fit = optim.pml(fit, model="F81", control = pml.control(trace=0)) @ We can assign the ancestral states according to the highest likelihood ("ml"): \[ P(x_r = A) = \frac{L(x_r=A)}{\sum_{k \in \{A,C,G,T\}}L(x_r=k)} \] and the highest posterior probability ("bayes") criterion: \[ P(x_r=A) = \frac{\pi_A L(x_r=A)}{\sum_{k \in \{A,C,G,T\}}\pi_k L(x_r=k)}, \] where $L(x_r)$ is the joint probability of states at the tips and the state at the root $x_r$ and $\pi_i$ are the estimated base frequencies of state $i$. Both methods agree if all states (base frequencies) have equal probabilities. <>= anc.ml = ancestral.pml(fit, "ml") anc.bayes = ancestral.pml(fit, "bayes") @ The differences of the two approaches for a specific site (17) are represented in figure\ref{fig:MLB}. <>= par(mfrow=c(2,1)) plotAnc(tree, anc.ml, 17) title("ML") plotAnc(tree, anc.bayes, 17) title("Bayes") @ \begin{figure} \begin{center} <>= <> @ \caption{Ancestral reconstruction for fig.\ref{fig:Pars} the using the maximum likelihood and (empirical) Bayesian reconstruction.}\label{fig:MLB} \end{center} \end{figure} \bibliographystyle{plain} \bibliography{phangorn} \section{Session Information} The version number of \R{} and packages loaded for generating the vignette were: <>= toLatex(sessionInfo()) @ \end{document} phangorn/vignettes/phangorn-specials.Rnw0000644000175100001440000003030312507002037020214 0ustar hornikusers%\VignetteIndexEntry{Advanced features} %\VignetteKeywords{Documentation} %\VignettePackage{phangorn} %\VignetteEngine{Sweave} \documentclass[12pt]{article} % setwd("/home/kschliep/Desktop/phangorn/vignettes") % Sweave("phangorn-specials.Rnw") % tools::texi2dvi("phangorn-specials.tex", pdf=TRUE) \usepackage{times} \usepackage{hyperref} \newcommand{\Rfunction}[1]{{\texttt{#1}}} \newcommand{\Robject}[1]{{\texttt{#1}}} \newcommand{\Rpackage}[1]{{\textit{#1}}} \newcommand{\Rmethod}[1]{{\texttt{#1}}} \newcommand{\Rfunarg}[1]{{\texttt{#1}}} \newcommand{\Rclass}[1]{{\textit{#1}}} \textwidth=6.2in \textheight=8.5in %\parskip=.3cm \oddsidemargin=.1in \evensidemargin=.1in \headheight=-.3in \newcommand{\R}{\textsf{R}} \newcommand{\pml}{\Robject{pml}} \newcommand{\phangorn}{\Rpackage{phangorn}} \newcommand{\ape}{\Rpackage{ape}} \newcommand{\multicore}{\Rpackage{multicore}} \newcommand{\term}[1]{\emph{#1}} \newcommand{\mref}[2]{\htmladdnormallinkfoot{#2}{#1}} \begin{document} % Ross Ihakas extenstion for nicer representation \DefineVerbatimEnvironment{Sinput}{Verbatim} {xleftmargin=2em} \DefineVerbatimEnvironment{Soutput}{Verbatim}{xleftmargin=2em} \DefineVerbatimEnvironment{Scode}{Verbatim}{xleftmargin=2em} \fvset{listparameters={\setlength{\topsep}{0pt}}} \renewenvironment{Schunk}{\vspace{\topsep}}{\vspace{\topsep}} <>= options(width=70) foo <- packageDescription("phangorn") @ \title{Special features of phangorn (Version \Sexpr{foo$Version})} %$ \author{\mref{mailto:klaus.schliep@gmail.com}{Klaus P. Schliep}} \maketitle \nocite{Paradis2012} \section*{Introduction} This document illustrates some of the \phangorn{} \cite{Schliep2011} specialised features which are useful but maybe not as well-known or just not (yet) described elsewhere. This is mainly interesting for someone who wants to explore different models or set up some simulation studies. We show how to construct data objects for different character states other than nucleotides or amino acids or how to set up different models to estimate transition rate. The vignette \emph{Trees} describes in detail how to estimate phylogenies from nucleotide or amino acids. \section{User defined data formats}\label{sec:USER} To better understand how to define our own data type it is useful to know a bit more about the internal representation of \Robject{phyDat} objects. The internal representation of \Robject{phyDat} object is very similar to \Robject{factor} objects. As an example we will show here several possibilities to define nucleotide data with gaps defined as a fifth state. Ignoring gaps or coding them as ambiguous sites - as it is done in most programs, also in phangorn as default - may be misleading (see Warnow(2012)\cite{Warnow2012}). When the number of gaps is low and the gaps are missing at random coding gaps as separate state may be not important. Let assume we have given a matrix where each row contains a character vector of a taxonomical unit: <>= library(phangorn) data = matrix(c("r","a","y","g","g","a","c","-","c","t","c","g", "a","a","t","g","g","a","t","-","c","t","c","a", "a","a","t","-","g","a","c","c","c","t","?","g"), dimnames = list(c("t1", "t2", "t3"),NULL), nrow=3, byrow=TRUE) data @ Normally we would transform this matrix into an phyDat object and gaps are handled as ambiguous character like "?". <<>>= gapsdata1 = phyDat(data) gapsdata1 @ Now we will define a "USER" defined object and have to supply a vector levels of the character states for the new data, in our case the for nucleotide states and the gap. Additional we can define ambiguous states which can be any of the states. <>= gapsdata2 = phyDat(data, type="USER", levels=c("a","c","g","t","-"), ambiguity = c("?", "n")) gapsdata2 @ This is not yet what we wanted as two sites of our alignment, which contain the ambiguous characters "r" and "y", got deleted. To define ambiguous characters like "r" and "y" explicitly we have to supply a contrast matrix similar to contrasts for factors. <>= contrast = matrix(data = c(1,0,0,0,0, 0,1,0,0,0, 0,0,1,0,0, 0,0,0,1,0, 1,0,1,0,0, 0,1,0,1,0, 0,0,0,0,1, 1,1,1,1,0, 1,1,1,1,1), ncol = 5, byrow = TRUE) dimnames(contrast) = list(c("a","c","g","t","r","y","-","n","?"), c("a", "c", "g", "t", "-")) contrast gapsdata3 = phyDat(data, type="USER", contrast=contrast) gapsdata3 @ Here we defined "n" as a state which can be any nucleotide but not a gap "-" and "?" can be any state including a gap. These data can be used in all functions available in \phangorn{} to compute distance matrices or perform parsimony and maximum likelihood analysis. \section{Estimation of non-standard transition rate matrices} In the last section \ref{sec:USER} we described how to set up user defined data formats. Now we describe how to estimate transition matrices with pml. Again for nucleotide data the most common models can be called directly in the \Rfunction{optim.pml} function (e.g. "JC69", "HKY", "GTR" to name a few). Table \ref{models} lists all the available nucleotide models, which can estimated directly in \Rfunction{optim.pml}. For amino acids several transition matrices are available ("WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa", "mtREV24", "VT","RtREV", "HIVw", "HIVb", "FLU", "Blossum62", "Dayhoff\_DCMut" and "JTT-DCMut") or can be estimated with \Rfunction{optim.pml}. For example Mathews et al. (2010) \cite{Mathews2010} used this function to estimate a phytochrome amino acid transition matrix. We will now show how to estimate a rate matrix with different transition ($\alpha$) and transversion ratio ($\beta$) and a fixed rate to the gap state ($\gamma$) - a kind of Kimura two-parameter model (K81) for nucleotide data with gaps as fifth state (see table \ref{gaps}). \begin{table}[htbp] \centering \begin{tabular}{l|lllll} & a & c & g & t & - \\ \hline a & & & & & \\ c & $\beta$ & & & & \\ g & $\alpha$ & $\beta$ & & & \\ t & $\beta$ & $\alpha$ & $\beta$ & & \\ - & $\gamma$ & $\gamma$ & $\gamma$ & $\gamma$ & \\ \end{tabular} \caption{Rate matrix K to optimise. }\label{gaps} \end{table} The parameters subs accepts a vector of consecutive integers and at least one element has to be zero (these gets the reference rate of 1). <<>>= tree = unroot(rtree(3)) fit = pml(tree, gapsdata3) fit = optim.pml(fit, optQ=TRUE, subs=c(1,0,1,2,1,0,2,1,2,2), control=pml.control(trace=0)) fit @ Here are some conventions how the models are estimated: \\ If a model is supplied the base frequencies bf and rate matrix Q are optimised according to the model (nucleotides) or the adequate rate matrix and frequencies are chosen (for amino acids). If optQ=TRUE and neither a model or subs are supplied than a symmetric (optBf=FALSE) or reversible model (optBf=TRUE, i.e. the GTR for nucleotides) is estimated. This can be slow if the there are many character states, e.g. for amino acids. \begin{table}[htbp] \centering \begin{tabular}{|llllr|} \hline model & optQ & optBf & subs & df \\ \hline JC & FALSE & FALSE & $c(0, 0, 0, 0, 0, 0)$ & 0 \\ F81 & FALSE & TRUE & $c(0, 0, 0, 0, 0, 0)$ & 3 \\ K80 & TRUE & FALSE & $c(0, 1, 0, 0, 1, 0)$ & 1 \\ HKY & TRUE & TRUE & $c(0, 1, 0, 0, 1, 0)$ & 4 \\ TrNe & TRUE & FALSE & $c(0, 1, 0, 0, 2, 0)$ & 2 \\ TrN & TRUE & TRUE & $c(0, 1, 0, 0, 2, 0)$ & 5 \\ TPM1 & TRUE & FALSE & $c(0, 1, 2, 2, 1, 0)$ & 2 \\ K81 & TRUE & FALSE & $c(0, 1, 2, 2, 1, 0)$ & 2 \\ TPM1u & TRUE & TRUE & $c(0, 1, 2, 2, 1, 0)$ & 5 \\ TPM2 & TRUE & FALSE & $c(1, 2, 1, 0, 2, 0)$ & 2 \\ TPM2u & TRUE & TRUE & $c(1, 2, 1, 0, 2, 0)$ & 5 \\ TPM3 & TRUE & FALSE & $c(1, 2, 0, 1, 2, 0)$ & 2 \\ TPM3u & TRUE & TRUE & $c(1, 2, 0, 1, 2, 0)$ & 5 \\ TIM1e & TRUE & FALSE & $c(0, 1, 2, 2, 3, 0)$ & 3 \\ TIM1 & TRUE & TRUE & $c(0, 1, 2, 2, 3, 0)$ & 6 \\ TIM2e & TRUE & FALSE & $c(1, 2, 1, 0, 3, 0)$ & 3 \\ TIM2 & TRUE & TRUE & $c(1, 2, 1, 0, 3, 0)$ & 6 \\ TIM3e & TRUE & FALSE & $c(1, 2, 0, 1, 3, 0)$ & 3 \\ TIM3 & TRUE & TRUE & $c(1, 2, 0, 1, 3, 0)$ & 6 \\ TVMe & TRUE & FALSE & $c(1, 2, 3, 4, 2, 0)$ & 4 \\ TVM & TRUE & TRUE & $c(1, 2, 3, 4, 2, 0)$ & 7 \\ SYM & TRUE & FALSE & $c(1, 2, 3, 4, 5, 0)$ & 5 \\ GTR & TRUE & TRUE & $c(1, 2, 3, 4, 5, 0)$ & 8 \\ \hline \end{tabular} \caption{DNA models available in phangorn, how they are defined and number of parameters to estimate. }\label{models} \end{table} \section{Codon substitution models} A special case of the transition rates are codon models. \phangorn{} now offers the possibility to estimate the $d_N/d_S$ ratio (sometimes called ka/ks), for an overview see \cite{Yang2006}. These functions extend the option to estimates the $d_N/d_S$ ratio for pairwise sequence comparison as it is available through the function \Rfunction{kaks} in \Rpackage{seqinr}. The transition rate between between codon $i$ and $j$ is defined as follows: \begin{eqnarray} q_{ij}=\left\{ \begin{array}{l@{\quad}l} 0 & \textrm{if i and j differ in more than one position} \\ \pi_j & \textrm{for synonymous transversion} \\ \pi_j\kappa & \textrm{for synonymous transition} \\ \pi_j\omega & \textrm{for non-synonymous transversion} \\ \pi_j\omega\kappa & \textrm{for non synonymous transition} \end{array} \right. \nonumber \end{eqnarray} where $\omega$ is the $d_N/d_S$ ratio, $\kappa$ the transition transversion ratio and $\pi_j$ is the the equilibrium frequencies of codon $j$. For $\omega\sim1$ the an amino acid change is neutral, for $\omega < 1$ purifying selection and $\omega > 1$ positive selection. There are four models available: "codon0", where both parameter $\kappa$ and $\omega$ are fixed to 1, "codon1" where both parameters are estimated and "codon2" or "codon3" where $\kappa$ or $\omega$ is fixed to 1. We compute the $d_N/d_S$ for some sequences given a tree using the ML functions \Rfunction{pml} and \Rfunction{optim.pml}. First we have to transform the the nucleotide sequences into codons (so far the algorithms always takes triplets). <>= library(phangorn) primates = read.phyDat("primates.dna", format="phylip", type="DNA") tree <- NJ(dist.ml(primates)) dat <- phyDat(as.character(primates), "CODON") fit <- pml(tree, dat) fit0 <- optim.pml(fit, control = pml.control(trace = 0)) fit1 <- optim.pml(fit, model="codon1", control=pml.control(trace=0)) fit2 <- optim.pml(fit, model="codon2", control=pml.control(trace=0)) fit3 <- optim.pml(fit, model="codon3", control=pml.control(trace=0)) anova(fit0, fit2, fit3, fit1) @ The models described here all assume equal frequencies for each codon (=1/61). One can optimise the codon frequencies setting the option to optBf=TRUE. As the convergence of the 61 parameters the convergence is likely slow set the maximal iterations to a higher value than the default (e.g. control = pml.control(maxit=50)). \section{Generating trees} \phangorn{} has several functions to generate tree topologies, which may are interesting for simulation studies. \Rfunction{allTrees} computes all possible bifurcating tree topologies either rooted or unrooted for up to 10 taxa. One has to keep in mind that the number of trees is growing exponentially, use \Rfunction(howmanytrees) from \ape{} as a reminder. %<>= %trees = allTrees(5) %@ <>= trees = allTrees(5) par(mfrow=c(3,5), mar=rep(0,4)) for(i in 1:15)plot(trees[[i]], cex=1, type="u") @ \begin{figure} \begin{center} <>= <> @ \end{center} \caption{all (15) unrooted trees with 5 taxa} \label{fig:NJ} \end{figure} \Rfunction{nni} returns a list of all trees which are one nearest neighbor interchange away. <>= trees = nni(trees[[1]]) @ \Rfunction{rNNI} and \Rfunction{rSPR} generate trees which are a defined number of NNI (nearest neighbor interchange) or SPR (subtree pruning and regrafting) away. \bibliographystyle{plain} \bibliography{phangorn} \section{Session Information} The version number of \R{} and packages loaded for generating the vignette were: <>= toLatex(sessionInfo()) @ \end{document} phangorn/vignettes/Networx.Rmd0000644000175100001440000000776712545270146016255 0ustar hornikusers--- title: "Splits and Networx" author: "Klaus Schliep" date: "`r format(Sys.time(), '%B %d, %Y')`" output: rmarkdown::html_vignette bibliography: phangorn.bib vignette: > %\VignetteIndexEntry{Splits and Networx} %\VignetteEngine{knitr::rmarkdown} %\usepackage[utf8]{inputenc} --- This tutorial gives a basic introduction on constructing phylogenetic networks and to add parameter to trees or networx using [phangorn](http://cran.r-project.org/package=phangorn) [@Schliep2011] in R. Splits graph or phylogenetic networks are a nice way to display conflict data or summarize different trees. Here we present to popular networks, consensus networks [@Holland2004] and neighborNet [@Bryant2004]. Often trees or networks are missing either edge weights or support values about the edges. We show how to improve a tree/networx by adding support values or estimating edge weights using non-negative Least-Squares (nnls). We first load the phangorn package and a few data sets we use in this vignette. ```{r, eval=TRUE} library(phangorn) data(Laurasiatherian) data(yeast) ``` ## consensusNet A consensusNet [@Holland2004] is a generalization of a consensus tree. Instead only representing splits with at least 50% in a bootstrap or MCMC sample one can use a lower threshold. However of important competing splits are left out. The input for `consensusNet` is a list of trees i.e. an object of class `multiPhylo`. ```{r, eval=TRUE} set.seed(1) bs <- bootstrap.phyDat(yeast, FUN = function(x)nj(dist.hamming(x)), bs=100) tree <- nj(dist.hamming(yeast)) par("mar" = rep(2, 4)) tree <- plotBS(tree, bs, "phylogram") cnet <- consensusNet(bs, .3) plot(cnet, "2D", show.edge.label=TRUE) ``` Often `consensusNet` will return incompatible splits, which cannot plotted as a planar graph. A nice way to get still a good impression of the network is to plot it in 3 dimensions. ```{r, eval=FALSE} plot(cnet) # rotate 3d plot play3d(spin3d(axis=c(0,1,0), rpm=6), duration=10) # create animated gif file movie3d(spin3d(axis=c(0,1,0), rpm=6), duration=10) ``` which will result in a spinning graph similar to this ![rotatingNetworx](movie.gif) ## neighborNet The function `neighborNet` implements the popular method of @Bryant2004. The Neighbor-Net algorithm extends the Neighbor joining allowing again algorithm is computed in 2 parts, the first computes a circular ordering. The second step involves estimation of edge weights using non-negative Least-Squares (nnls). ```{r, eval=TRUE} dm <- dist.hamming(yeast) nnet <- neighborNet(dm) par("mar" = rep(2, 4)) plot(nnet, "2D") ``` The advantage of Neighbor-Net is that it returns a circular split system which can be always displayed in a planar (2D) graph. The plots displayed in `phangorn` may not planar, but re-plotting may gives you a planar graph. This unwanted behavior will be improved in future version. The rendering of the `networx` is done using the the fantastic igraph package [@Csardi2006]. ## Adding support values We can use the generic function `addConfidences` to add support values from a tree, i.e. an object of class `phylo` to a `networx`, `splits` or `phylo` object. The Neighbor-Net object we computed above contains no support values. We can add the support values fro the tree we computed to the splits these two objects share. ```{r, eval=TRUE} nnet <- addConfidences(nnet, tree) par("mar" = rep(2, 4)) plot(nnet, "2D", show.edge.label=TRUE) ``` We can also add support values to a tree: ```{r, eval=TRUE} tree2 <- rNNI(tree, 2) tree2 <- addConfidences(tree2, tree) # several support values are missing plot(tree2, show.node.label=TRUE) ``` ## Estimating edge weights (nnls) Consensus networks on the other hand have information about support values corresponding to a split, but are generally without edge weights. Given a distance matrix we can estimate edge weights using non-negative Least-Squares. ```{r, eval=TRUE} cnet <- nnls.networx(cnet, dm) par("mar" = rep(2, 4)) plot(cnet, "2D", show.edge.label=TRUE) ``` ## References phangorn/vignettes/movie.gif0000644000175100001440000055210412507002037015725 0ustar hornikusersGIF89a//__wwGG羾Φ! ! NETSCAPE2.0, $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~B%$#}( " ðǃ ʬŷv 'utƫ9guN(>'nWA!INu..F :ve k )"bJ-+pॿu Ȥ.-HpeKpԋ{ML 0j"VSs rFQe;l7W>1b*ܸ { YS` B;osGt{UuFM%3-X>`4ƦOh0Z_@14vՠa.FU6} iqQDW$mpU@hRu+6Avr noK0>ޝܷ?|=Ԁ?_%`LȄZJ'W5SsOT.v)U1!9'0奕婈Bm8FXPBb`cU$Kd|$ 6Q)ƇPPc|H_QL%q}i@W5]IFXݑ$JrEQ6f8ahqaV6JXgɩ}Z% L1 *F  I~i]#P*W*Y "X NkZJ,JalS(K؞:QmEț}-rrg/ pT$ڻJF1fZ/pcTknVV@+ohPG{-Sh7p^%\ ZhA_1%϶=5 -&ZdZSIt5Ѷ-pl.5Sä206BZwTՀE _'w7 ,˂:^>.ڹ1sа3ݰ@(^]C}^F.z}-S^  ׳ gBuo~&>fC V)Ci z $h>ֳ`G̨vA8+ut a>x`Rrd.H2`!`脇rՒW@t<X 4غ< ?>1q9@%*V$;*AB^Wo&gn\p2%*D>5078!9+x#cS0ʰBX`0Dd#IIBJ}艔kJ (0qI('Iꆣ57|B0.acqd6~Aq!N9^F$:nZSV×xjBU4NunEa̚ ̐Tͼ?!F̊8%4[i d m+3Q8q3SGOr0mډRplJ79O4=ZdR#hOJ@wW26VTRG@ӼDPҹi*9 ,FwEr8u.¨ ux(Wt[{Rԭ^uZ1usZq445YE϶T1,d$ZE%jyƏickҖ[m;F2ʔ|˵^P >/9 "tYPP]F gPsEv]> ={΄noLN;'LF! ,//__wwGG羾I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~2op qv m >.ߖ:,? +&34uxKI ]B&HIPMu92࢓~옠=MBAm4@8bI3{-rd<| 8z3I@WGUA$5+S/Sᇁa VY FjK7CEhrgȋ@ ~>yf}%1 8YyMTIֶ] ?k8nC!t OI mRp,q F.߈?}\Vv 4Qŏi?/zƐ.c%H)CwdeWO t/[!4_/\p,%X^ `L+uhb?aHc~PTԦ"IEI%fd+fUHkPVѣ9Vik,EZ2M\TiX杙WH'lZ)]qnYXu^ayjfZ40&Y%U(^!(Z1RiNV:Wi:HzjXC|ģ:QQ6jeK\)H*HJ,zҺ>K1kC܊n m>LJ" |X8'/Z/{0Еܻdj=8ň] 0 uN"0Զ@h3zjz/l<]<%CDI&鞏A4+K첑r sBa#ΚUZJ?N{SGM^4F;(ӌha7T$jL|иkzPѯBi%$݈`6^,9 S"˹;:zhza]zfLO6t:qؔ6c@ߠ>o{ФQOHr [d '[ :$lz+?:((ڗI΀YYs@O]uHނK l8ѥ7`k%,JO?NXdL[ V@mli$4KUEnLO/\N C&!|MA2Jg?gJ$dFy,f Ang^G-"mә#@q;$TGP Pͻ`m2`̲J/!!LVLpa-Rj]U9G;R1V|%H 1d*b(]0dMʨR 7 JV :ӗp T+@ݼM< cwpHͪ` zyL0ĵ -d:рN2 6@@uR  i]}STh&P gSK:Q7urc1h֭Ig+*.5.U;橊8pq B6h64E|~LKB/>T ߂~ĄGS^ڸ@sp@?V>(9od'σ2͈[=p1p=ɿx/vA<fOl n@ UADQL=EO\8bԩ` e`F PcӃpY!gBU%h"wy^ԎMiX`2_&ZiHOJh_15XG"i<@pRAa Ӹ_~ U&4ߚfx•pq& ]ec9^iƖm&(؁Сhq<|Enj-)jyPUPJFAe`ޅ ƬgRԞj(^l[ NnZkmbQjWT n[EJlRʮ 6nLHoIJhhJK0Ph:g||4,(9,Ķ0ƣ}T\ q-P)'gϜ%[Ͻ@,GȰHrN,K5TέGSW= ^ huJ8Qꕧ%< ݫ1ЪdD`ug5#+}4{Pì v H>Z c^C4F0Z(t^ @^ L$. i0wϿ, AپE c 5ҭooAn>}sB8 A3Я#]/Lj g: O/h?yx0O‡z.O ` A!p_ <\z/ql; c5DocIQ8-\ՄXBBc$\ W!kax`<*@"j1 !O" S$>ݢwt%.Gv+C6 Oj.r?N.ȩ'cg٣D kXnBb $?b<)C/x44`.*hJ:8PWa߂DЧQVDCb8DŀiŀO4D)L "cܥXN|7"ދ6PC>V^Jl I">7 ۥeCrۗbB)kj ֥f``0v)اr67m'ycӌ&4Vj iuOzzIJv:F8Jƞ'4fAjƫ‚Ab`+R,Nfql-'I-юkŞEDO˺k6kʈ/:oMKD #mGt%FJ^Lvݒ&""R6Yp$ې  \2S_-J ,|::5r  ЇX%Xn7Ps HLfu 0$r8C`$?)S4 ՐϕB8'vfsړ `-o*31=l= Ϋ- =)P u .پ@p `~ųxC|]7By֟'ﭽky3_>?\& П?On#89C_\vuo34W5u3`z"<dz'I @H1vœ  1C@H1sP0G xێл}3BҊU?L 57WF&4 ?44x.Äy3 ~6qo&ƅĄE N)Aq@A.Hȱ FEA#c*^\N)^L@Ɏ)OMW Xǹ%(#u::=>d*tD1W })I4FczVYR7b";_bɋȉ81%s#x,ɒN1cJQ }ϐ4S7HRCچNuRe>QPf=3,ce7鞀*s(*b?Gg#k()R AN */ά'߾v9Ճ"c,Uu#z@ f dm:FA3  rlbP*Z0H jբ@1Uic+Cj6YURcZ}r}`~[ජAٽ /Z?3>ѽl]+潴tmݢi|Kͯ~LN;0&B! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~GuD%q#@o" :$P *' ί۟  ˪ۦX Ҭ 郷%i (gn(0Ր`v8/E1┏La I8Ii=Pp\ʗ*!ǘ脇8Oh4ɨty$ aG>"И^I`#QY.ڗc(H EafvkA# @&guwjէ J:eR(h(ӣRV[i'iGTxj`*ou*k:kzk@@k F^Ƃaj\lolNZ|Z;EflX',R K˞+NjS  ::!n~ 0 'nI0>lDoD`ijm2X #7PXyխ񆚴+@-1zz\5s , `Dj. U2 8L/5O(󝌞k 8uK @<ґ(*]u P.)R]~ n6QG8em\uka,莔JO+2/d#fA#~ҏZjΨBU+ʻ0,/W4nD[V=Q$ mw8 i<8o)0\ U<~-P>d.# ԇpi =S!5`h8X9@X8u ;VHa  ]8`al/ݲ}d)a])ȍ9OT,:^ 2b@"&Zxifg*,p'(*,Laqwm',Kl]ĸFƀ8f(a5r:(cɚ!Jj[.fy86Eux\#ed`2>MbFd"EN (5q^D)L$h'ؖo@8KRL8W怓#ۖPQI G6 nj&=MC 8Zn!ZRT',BiXR|lINxECPt.}Z&$@StL:T 5 FZ ^H-'SK^rZUC#s_Mњy| aD\@H0W<, W浱1%d_   c3ײp6ogUѪ=AeS5ɲV5}m%ţgl~5 8p1|' 5d}A?LT!Ce^R9׈#2Ur!꤉fGЁhGh4Ӆ c<@#(DXzefOF|80%U:WZ׈cNA.IElЅ֜V,4%xV]}bNqJqhX (O U0ΤNaifŦzĦmDBo2*1XNk@:B "lFh6C8 m57-gY{n+DhFn; ΛCj8 kC0XkC  V SE¢f,OEd1I|cF|lA 0 (y g#G@13(/"I$bF#XgVrgdtE+ yuݵ!s`$` vp.@dvJ_?',}ȸS^-QopP{zF5.@?`ۊ;QM`3\ nԹG;a;4/ffO;/c+]{0[ZWZ²SOBeg:|8/%Hk.<@^KH`'ȵ+|+/JAv`_Ґ«[Ei1 `ەfXKdE2 Xֺ-Ea~kERAn^l޺ld\ l\|pa p kO\DfYDipS |69@"nr yF0P-O1xI(\g$L7- D@RO]ub 1`WBa6U[$am $x}w/ 8uӶ9"d6vHD~•@7x;Ry@).TUQՠnjEh:u煲>H)E[|BfΪ@<⏯*؜ @$xN{ :,ngOx7H <of\F>Pkda_ @;_z`@5@rv4eL n.,`3! .'{-z*P"@-#Jr&@SPg= 2$>XV\pWphτNfU1<HraϖDi!w=7#6*E@޴7ҔWkZV98~C4@0%@Kb"-F`dhEbIMbr9H29ɥf陎kSoyS@Fhޚ7KYHD[ PHx,>!=x۟$I k0Jfsq,#"v3&D/ :Jܬೀjhy֨' <=5K&@ 9ħ?LQȈ!̩@:b祡BG)ɪ])F*Q+)R]PMτE 4eC '%FA^2#h *ص3+bžL5I#R, X <ϏOZX-_Q6N ymMzёUn PњqYE[rp0 -mH׃Vͮvz xKMz|Kͯ~L! ,//__ww־ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~#)" vx~ z^ϗ ͱ_ڝ׶`ϖ̹F[nþ f*, )(4Gf`0-\ÇQ"RX@Qq <  $gU AB|@#0SbzԒ;DT#SyF%U+J \MSʪX @ OeΥ5Ն )Yv;(b: E`NdlH<.j<5jziq[ϸܽ-2bSyω})DgOPlYviVp蜈bqf1qj]Z5%V'RVjFVgNjS0FNp7+L(&ūڄXL.j>{SG0*EȊ-~KRىCAlʾCmNm J | ˀn ڤVxfU -i&fLL0Q 0VNVs2Z ( 0$~z*5  DGbd]|>,Yug5P (uU`Ԫl !eve$} p7NV;`SYO5{QCWpۦO:ma[]0iETCd%KAXش>`%@δjyfLx,?5]یZbc 6B瀉?oV;_~[>5_ܥ20L_ # d5{ i` F0 Jt& D<̅ A0 EP aaxc  j@J"e,-lm$M:Rň R 31s) Z 1V4/}ҫؕT9Hـ+lۚ)tE`G6 jm0\b.̈ޒk 0CB@t"{ >!NZQ͵mK[ج ȳJE:Xk懌>H9uί}l>;@lZ}χ=Nk3o_A1ScZ},!kOGoD{YLT(AK| / XF\+; FA%=0F  Ʃ' A2 #3F X г|r~ 0&p @fPcq $p5l' 0Ѐ Y} 64Ŝ/ 5?7i#\"e*.B;e=9Oj]HUki= a'8c;/><5v|XF`^9 /i~h{#-^wNB2??`0@rrƣ ]gmx1h`R bW ,,@i/t,Mj*HaJH8,`9|! d]D!n&< ~񀹅BdJ2Io8+BhؠMq:$T`A[؀#BdV G5$)%)j|0ScӐ$JHi 7;ưdlcm,mi *@0䈍 >JQdL3!`1 bL)LZ,IHm֣ŨSHELXʍ>iF!%LX~ TH`#L PV(>S`NX |Va,(); - cɆR8d!2RZXh5>%Ia(x0*abtRLҖNT.2>Դ !J)?)9TsũOuJE (Uw4JiJ,H-ZnYkȢO=r*T*P'{^og4v$_a X iYHəviYU*aI١-3ǎiV=O{t2mke pKMr:Ѝt6KZͮvz xKMz|KO! ,//__GG羾ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N 3, ~~  ~yvӓ Ԁèܙzٮϻq 䣐`? * F^( ( @_zaPLֿH[YZh!LG,[F /Z?kqXDWR"tP@ERQyeE*uLǢM9U=Prlڲ`:`V56gȵpx^bG5qo2ϻnvgSxο:D# u (]V개R@}sY6s)RY LhL,N8XlSPAq!,Uh[m#34֨`D 6V@ O2%%T _*SM}f4M֘.ɦ =PkOIqqg7UUfޡMĨ]h5)*-xiUi}Je:EXRTMD k:kD:jJ D*kH,>{WlDԇnDk>pHΞCPk= /ΛCn5P -/ P=4p tp  )4>uLqJ"kƱue@'*( ̖@ 0BjmWӻ$p4ǙDs $@O#3 PŽaBE| ^C6%iI -57 T)|Yh=8t}kl8hm,Qاf&khp4 4v>j,t4%M ԙ̑w-B3Xdcᯍp"2a:9Xz{|;soR ϣ'+(h1];a )N: M~:B~0+< N2q 50!;|vN, \qI-`-iB= *@4bJӸnk~D4Z;5\ω ,V#m!(De Wr,`'HQ[(#bbBŮi4#iEP"" =l x!K$MAQsEcһ+Cu4&EIdS`Vkj4eyuY%JX Fﰐ=h*Ua}gթ_FҚMjWֺlgKͭnw pKMr:ЍtKZͮvz:! ,//__޾ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N`o0 #| }}   ||~ʲ   }辳 â \A P,A9$i6Bp𗁣OTE!+ ZPUqܠ|ӰNj7<$PIE&A{F^0"!VcA@tȫZ0eFKk]w@P}c3&v\AD$|g)P͜@:tgJj͘W@l٧mwM)as.#Z:>t;_ov8'~}|ͣɮdՄߦ<}6Q?Mka_fTBCF QV НnU) 1ԉ,c:a 6uAT'ҀV\h,b41_ xDu=6ޘK+&I3$ފbO9Y"TfJ֢= %/vQ5%(iˆ֎BD 6'tyꙂimSoNaJTW,ũiƍ:ŘFzUQ*:jN\+CVhkGЊ">KD!tpkA-͎ Dpl;(ˮ۾S+c?Pn8/ [%[`. V~ yg.Vld[ +N?Aflr_`üAuba"$<&jmpZTtL%IF};귫\{`FĀ< BKz_Zȕ ; GDII X9g`IS  c\  㴤%P >9eq^Bh>\QI?OIbMNMqYM?63kaF$>ؾ Dm MA.prtoqUz ],(55qc"E vu"I? =3`g7#,ǿøR;o=*+qTG-90ђYy* TJ!8Z9,`M"1zX-P:р[P0y).xI`HS -L(!jVdSc^*{-)1 nA0`U)P `nJ(BN$]q^5][rsn㊐jivdK)ϖ E i &Š>hVAEeW II{> W|D\mut{Q +@vmPOa&~hADhU>m!M(` [J(PпY[%I6-4ICs⡡P*MJu}5iMSvi*Ba,'$Q$P@#xm&an1w2(h3d`/Z@D[ٲ\3X532D:`ۖVn;;cPhΪ\t"&8u9_w3w{@[DLkWw~Ѡof=3G|Q`W2c&Š ]MH,Pޅ_8".VV` <-0b(0ό)@ (@0{0"UH,"%ȍB.䒹86c$QPa/* 0@%U9Xڥ%`yho@Aک\yiXcZnL6*zIDYJIRUM^JdNpJ*ڄ2WIJL+Z&v` lf~CdЊ{kCj: KCl7/ ¾o+%..J[`ZFW]Fox RYM1|H&BBѣ݀ 0G u"ǎv%T` .I;dFPFZ"Zca^cluJѳIt 2ꇡ:Mi``HV']*zխHIFMDN, /!fKͭnw pKMr=:ЍtKZͮvz xKMz|K ! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~EG%@<$ #'"# $  ̩ʝ& ߎ 䮍"X@!+ rD1("!,!JX j Yc*| v+4[EiF2B(MAPo)-zF¤'|T .TgLǍ0}c*|t tZԵnFzeqa-CnpmBشcɎP)֦ G/ IRDܹ tWq@3YL`6 i6B:#?:A?ǽmA^P?>~Tx| n[..LdϿ;=m xzM{ M| A_sPoamGxG.$C?"`O)7!\R@aJ%8 M9,>\#ȍ~}Jy,ї,s%ƍ8~馗 If`U~u ݭ٦|.(i'w"n Wph[fVi 3c%Ii g`bcz %M/ښk~⏽zR^Fl EZkz mNkZalQ<~GD>mK$̾.nITokĺnGG 8BT||1,i|*@&} wyVE8} / z;36OʉAr@y `ގyx@ѠS lQ)Ts0pW>7a{VMqZfF jz"= U# =&P4!DDQC& UR.zQӰN?:~p?b1/S Wdn3a nZm֓ h-b RU ( F*[IGQCXGL^j|ݘ5*: LO-;&C ~У}aT"OPJ 2kUE]r $A< df!xISA3 p5cO J2S)!>LjPHY8J Ʃ@a|3AP$t -LC~D@ #P-83- ŚfFQ8*BSMmxSBU5FPX* (kRןn13,cĦjU݌^Ez5ef7z hGKҚMjWֺlgKͭnw pKMr:ЍtKZͮvz !! ,//__ww־ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~~-&" w {  s˓vΩѺx ۜɨ ѥ~ љw=臐) kB_q=<W%1q8JgN@YcPdRe7hRi' e OZzySz),_ɯJ@u[ŀ TZ0!~LeL6 v"4 ,e" #N' $R6Y/0B cl¤;̐yOf dl$ŜeVbZ]&(@RQv eZpd LIM< B S)5%‡9)5…DJ)"FT(EF +G5z+ڪkB(<0< ,>ðp@m9~m7l ׮m3K *Ԉٱ-aZbaUWB\,[𡈌sIfQԊY@1T8P\x )WmÚV(KR\\X+L,M9^8Oh,VP&0H0ղ!V\=P@aYL/e V0GA?Q#NBڛe^3LWt4 -MUUcԆ8? vŜx*9kىI ׫;89?cΓfxi"5-`\p騦sqpXp4=5s#wP1n?w}l).O*;}ϱI*@(G;v 4]hb̐$D٧p3:ANwx&brpJ* 1Exod=kS]>S @g.5=o x ģ ajrp\bcWW[v( yt8C @b֮ɴep:f>%{IvW9 {=t [ݍsGbMx̣ϓv@Ӂ/Og?'L- V q `mLH]FTbԍXu%xx*]db0 'Q4\v 92 ,`Fڂd ( ԏ1wؕWZ\Z@VdF ai&;LŬ6f %@$ i睒i$Z?o"/>*Eˡmh qƐ6蘃ZZYkƵm7#Ԥ#TڣPר-v*ފV"~JkTJl;ŰB&lO0K-^Ĵ.amH-BpKmxBE#caNj/)\E/$*ӥp]61/U r/][@gvl#0R5 Yו=*ilac}f^RihkֿX\+*US1QC iiQО| tW8S$uͅ]s‡1V4D'fl,@6a_qdg7v̂'x`N2<0#X^5p{)S?%.Binf:)}N%vNQB*g,~Xsdnk@~d= O"H>b#eǻop{ ,5}H1Ѐ` 4dgI[oHŁ9X3'_T=! 49 B'|T1hTA(K! 9@ yy!:`ջ rp A[!3A ڀv/0 %,ZB(\*X htý䰎f#)Pf`B\F( ndt 0*L(9+pGyTS*@YMj^:Iʥ`sX>VfiT Ȇ@ =`wE ?\[P򙥴,UK+M{(4(4U*{&Yn s5/KJOSZ#`' ȟ2"GLfx QTT'%BK)\zFQ  IqpMf4t7~bQÒm:%q2( ` $F VJ6EY*o$[SªTFUmXX#ͤkk+𡕄+t&Y̕h_P19Քnzu&L*U7{ggG0*'VR ʙ@dU %tNd7aVu,AGx <#/a*x V]$A^Fa&U޽ "w 6@b֪]{ii[@kVw{M3r=o?s Ύ'#w<2~sw|DI式ߵ:7V)o}]lG z ^hNXFI_eǡ~ƀ"a`vyb.b.zQaZ@*X&b4r{%H. 0츕 9oDfYrHN))䒒H^^"\ nd`Uz%옣 H*9pRs[$&ޏD㜾T"o1ډT"fw-t޶ vN48@̦"*JkpORɪ~ 㝤VjSԊl.BqlN(K-^'ӎtzX5Ӯf䩸Rv ( xٗqhMtv.aFC%Ԩ0 ":̏ pX+^D"i r@-#R> aD. A@pv#&<g׀9ʝM R\*ot6$ԏ|R7}q ^q,&8-P |_c,plM[fa;ё ႁUf!"(HGBhM &7L-#ҙ(P0U@@IP<  Т{?D~*4ZUN,%X{⊫I+ĨZT+Y-ՏYW)rnt`ԽL?-a5tTd'KZͬf7z hGKҚMjWֺlgKͭnw pKMr:Ѝt KZ ! ,//wwGG羾ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~K n pqxhʭoѺ ڗ ، ˝u ɖ*Be !+1⟉ ,JF? :~od}܃<ԣpL=oXQ'dܽqCӄ4* YPI K3HP5!ސZ Ve.T@ڽmļ*@.}R!g't`'<#9𛲮ˏ tv\(e  ^;  TWM`'ȈݽBNnLdZB'C51K^3|{޿,9y/(R]z-յ}~o<+gE{V_Tԇ`-HBF_NE^ā2`I4"-6-@ ,@ x"ec+*5j3R WLt߬";(]9,P6rPD!J ]̚^㘘R7yן3&d-c%rC'dmˢB3Ǝcɩ8Wݝ%l3gJfQڡĝŮFa3QȦ1Y@j:BՌVS6T(6|CeԉجkvLa9F5 X,Z]^X*e oaPѱVï5.1ֶd4qWp@[.s'Nr[4/? Lb"sE,k<#6t^ (%Z/"CZ#uPY}-j]NKuqU_5G4 Pڤ=6? 0PQp uXګ=zw΀.~&VMBOxU<G* V ޺2bn3κ<-Ҏ=UUiw> ÛN m8ӹ[|)B ݢ6A>0Lm~[:3=>f 8k$ꝥo @DWJBՁ - Y@d*  rd3> ve:@z$k-$ftv$ a`ZW&9 $хhS AޅIaR щQ=5oN uA&qJDU0ʙBX-K9\vΈ vv:@)@?P$3 KFRa;-f(ZH]F(6@ q,,<9:l)Z"ׅBO] MC\ _R2D<*Tь85]3Q!9w`5lSYPzwW8pNT%&OtSUQM$VFīvdT" qh*]T y%NL?VLb6vzBiSB-*Q9|J_K<tQe5|DP3LV3V!:H-TըSrEj\J׺xͫ^׾ `KMb:d'KZͬf7z hGKҚMjWֺlgKm! ,//__wwGG羾I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~ki r sȾdDZ j ݟ޻ߒp>)ط O ܃PB? (xXQŎ{KRH$K9R\q/:4 ؼ9'u:G(Ѣf}ˀRj֖i:KUT] &AX45Ϋ 4@ۿblUFP J%w5&4 Rr 3_ A' eI(HyQ7p۸eH0$qm-Fb>F%N_">%bA_^E(_Z|q+oѮ^Xÿs>O=)E}Fq:Av 6_LMDD`YDz*WJ"x&PDR 4:lԘP (4`j7=`/4@y#06 c'R.$T/i5heb4__-p_@uoI%fjKWn&VYZV2-9pp1Π[ xK]tŤ4`a%%dڗkwQz) OW$gƇ ٩*KSuV>ex+B6›dTʶjzcIDl5-e-`ۻK+L]:%j+䂜ٚSSbpByG9mK@SdqgȨIg~5}YSrq˝ibьZE}|3@sWGrgs%0%LK֧ayVm 0rZgzE l=olN@X[8/0yߘc- pȮ ՏWN 6*p@zS毃re, v*p;c?HY@Upfy("}o>gۥldjpO޽go[M(/y/XW hn#`v@#(F Y(oչ>}`A@*hoCb(p4O!&X] /",ciQØQs9!3EGO.%/bqU\5SNf|qDc(G8pXi2?> nԉ9BQ+iHYxs'IK'+EJ XI1 9ҥZz.w-o5Қ0ڨQل+Mlϴ+Y %+,1N`+L ,BXNp@Hj 9FM 3{wiMx)d? 7 ʄ\WqZTC&~UF-@VҏiHuRT.+{M(` H3c?O,C-xJCXqp kS>U0 NmpN\kHEN`GY3ikL[ ɪ[@Q!kv7ʰ gըQu6X|[y߹P[^YA`䂞rxa;Hpg6m)/Ȼ8Pf[qMXnL,l/ϡ/Sh>{O~Ϝ%v_aD^G}w-ȅW] V4@ a~X"^aRt!.J![1:b( 1\ێ~U@=CTn)c%<@6 yR2@_P$$ICQIUW c6"*MXjv 8ड़GNH3О' ~A8i {a-Y'hyOIFkҗqwj+2`O(UT@%  Pǜ$XYuӱ6|9Yk^_p'k}I? [s|hnD5g ! !%=Ar,Y0!V<i#R,f< D,M d!mܡ ͠\hC̀k ʘ@X, =@Gt5宠, )hf}iko S}va&v?&@fK3qk WoЀLSAZP|P& P7ZCҕL`A=kN% ;5z c J.g<K~'rޘ;4"T'F0ߘ)x(/=/=  (!2HIP_Q5f26r,KI <gN ߍ2@hs ! )&lABH~1LAۂ?! s)b 2>hvR 5P#E Aw8UК.Q3a(&8VFPY jVGUƉ±(2KM!G`C6'[d=*±]CQM`I'e8"4BtmB4[fFS./ :Q\@QDU`w#'c7P xHS-!#]G`>gQ3Ş;s^kV{<6R hD'e]=Qo.42brqI&Z<< Dm+Ȋp{<7 u (43hs*E\{]'W 4r,B3 Bf$n#Jk7 >c KE`-b_޹t:25Z՘x3vÇcc¾9P{ ¥ex-M&"~! dJ)PBX@ 1MqN` EQ K$tI#v բ)j8$x%s@x @ӽgŰ#n;bh'pڔ@+nP!D (D3f@p/BQZ=qaANͱUc\TtQi\I#jq5kG8ys$Q# j>6ʩm@4 ArAv$<[šXT p,Z 88-Z % r&L7ߙA-8qvfK;M- 0Xg.aF# Pvf)7OAWRJ) ,`&k(XTg)\tŒAw!]gP'+d @Z~%8Yv@H( {pӽȮ QhM^VޒU9 Fi.0D/gJF@ G  ѽ9XA`Mձ~)P\紊>ެgz6pp^wls0~ѹ`gA|CO#=D9/\ X[~['Ouo},2sf$IE}|A;:? SKD!Lx-  L dCw<ɮ!;Z$%tBYb(Êiи҉Qa # NV}?)2ab&\U2GlU "1~J/(bxxQO8*ycS*Ձ=ޑdtP riTQ#]GPQ2F5A`.lʡoP|ԋҏ4)~m?Ȯ0ЁFCHG4JK iKi5#ƕl2"JLfHɨH1)PZ%Y  2R:H%X%LZzXkS I[.qMNw9@:%;9EEzq(LuIْ3 hH<@GKfКFgy4^v0 G'T:TL(\TJժZXͪVծz` XJֲhMZֶp\J׺xͫ^׾ `KMb:d'KZͬf7z hGk! ,//__ww־ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~FXTM68 ? +AbOETx5x'jG1Ʒe1HRǎ03Π(w, fd/g͝JKTIrڊIPa#,@_RE%FŃSکZΑň (M}fO&c `dɶk2bly4RkH͋ɜ9}Y= >F/`r5$[phԯ&#{zT2[cPARѡc`.liV ;b<܎.MVzg]%4{ڶwNv 4PPqTѱԉJ>%U" Sl!'to=8To#Xej!`2 b DG17:wKLd%xSc%BގX@tVfYO5GzM$G5j5%A 0@!Yj1 QlbtW#-:G}&i1@ǞM>T GvFN|8_됇 Th)!PjC-ű8@[4늶!,z 0@\(r1-~n,r-zq ż mKK 6;b4.v ~|Ĭ7*` EW-P-Ҍf K=0v!ǹ$+4 Fp@3/`tW.򖄾ua`CORj]B3}B8 Y"@=3+M,|G 4@# 9ׇwgi*VWR(s`( ?ڽ J`x-\#q4oF$WVCx;λ։u|{Cs[$Mj|_9Pkz'85.r{0(L8`@# IMI$Oq%w ؝o(J0Ѷ͙0F~r )aN|;TB43 %d+I%X n޲6J"Z,uO?oc#Si%! 0 $?"񑈑66*EQb b>r9Hh&e*RK (Kt`#dXb~-GG)_jZ 7 fDg7a)$ǚ 1ɩ(s:Y49OnZ2MX3 0DXb e*q& L *ȜHO:J0ЇTSLP)F0r(=S@TMgS2*}SRAjԦ:PTJժZXͪVծz` XJֲhMZֶp\J׺xͫ^׾ `KMb:d'KZͬf7Ξ ! ,//__wwGG羾I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~VQM F/1 8 <'!~X0t Ѐ e3䞇#(xف A#AkSf#M y2KĔt-KˆeY枸V+U I5w)%.Cf-TKSI,i-F|Ec'4#^dDԜĺHYJIkRW?PJԢHMRԦ:PTJժZXͪVծz` XJֲhMZֶp\J׺xͫ^׾ `KMb:d'+! ,//__ww־I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~4JF o w hҽs[8%PC|~Kp@u! F_ 1q8ɓu`Y"%[#?BdhLKr9x߂Ji(NCOZCCl`@`y.)RۤXl@ݪZMٿ(I8QzY RX&-gK2敎-ڎ'nap˾N#s8,@P!@w':检!ӝMGG ;nvM_AuK04G&M2\ӨfL}@vzh ZUzhay֡C a?w!QH{ ~ƈ}wvݱ .!~ J0"|xwa#;x$ZѝWC!&0"yRn8H% hjl_@(S'9v'7:v , (?f{(&uL5zrdS#f!S0pfQf:[rxǍnq#$ᦀU\ZI%J.GCaUl}.9xƕ,{bLcճ7[˶[ k\̉ RQ.j`kŮ{L{%cR 8Oj13qcpl(R|L!0*XƜ 3PjiٌK,<_i)Q%0жhEPgO2M~"C#-2Nˢ3C\N)c?Q#Tѿg\y(We@TSb LТCtXD2ބ lĘ6DȳӖMwg#.1:`RT&uてM[CH|bTƭD*SrկD6q)6^RNNGVk/]|TnPdĉ *!U?&cֲkM7 hur](N;Ik[ǝNzBKTM˥d;ӕ(׷aP4{]UdyWxA[X'" xw0`!@'(W0Am<ɗǃtkyd(%E6% H:yߒoJv(JXWGrZq4)'ITr%Z¥-fcʝjJo~ѦW nh8$H2*ʡk  Y's (P@(Wf*FA m!{aoQF&zѧ%~ FFe2B^[`ɡ5b綹.&f [[E= M5WX&6D\Ũ`jE"o6I@{Mḥ0.22ӟW*< ( dBH7,@3#24r=.t:g0(C2+tB 0 -j)0l.1 f#F1LDf&[q ?fOU%-60?EaA DHDfBaM| P<JK9}$ (/bO g4ӛSv5@V'B]̢O_ &d_N#F ÷p3鈒5) yGBh,ҔGYOPyIzd#㹪]oDUs, .s)K*( CIK:$XFI]rk!)=AS^4aӢHMRԦ:PTJժZXͪVծz` XJֲhMZֶp\J׺xͫ^׾ `KMb:d'KZL! ,//__wwGG羾ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~J:6 $ "  $p=}A n\uӢ!a_ !AE c>5s/G$GrKu "CŜAQFЦ 8/|O n8i B乳 +L"ҔJ49Gn︴ A6 /B%#Y  f`d jo(skx/4 [x=]aE@{7H(JtB͝b<ꕎq1՞YѽeCSu riח_ӽ!]V}rp?U؇`LĘ4џuwNi\|,he _5%^&KIvy0Pb'J iGdPI$׆2e&@ ZQ|ƍYl="`d)nA䝦i|i՛_@iR+~Q+EZ7+Qd7-* F[*~& PYp^=G؅dЀ#ycAu%I\ "P^x Khfl?8,P .~Rtxkr_b.J QJ/=VS@4 -!q0V|gإ L3p K!,8X ol-L fM- x >3Gm7fc$e3;4CKq LJkUp؉ͶdYĶ2ȩ vq+0w ˬG^Dr,YP䵔v`.:e/~M-"D@NM|f]7|%O+@` OX#/K%@vA N -D_s|4 E*~ћLvqի!܋0#+Տ, e!,!A oQ'ĸlYrPWB!]Rh3A' ?H:3 T AJC0!Җ8H~M*7  KVxéI~pNp"Qb0XÕvxɌ+JrP  "PGb ){_@lf>`0`$茲&H *;C '%C慠%F4AE&~n,)Ą*;:a 1a #yphG(߯Ŵae)a +N@o(,VDrbқĝ#tR_7En02Y"ik!B˂f˜DBND0[hJ.I̧J-zR0biK]<3e-4@ PJԢHMRԦ:PTJժZXͪVծz` XJֲhMZֶp\J׺xͫ^׾ `KMb:d'! ,//__ww־ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~Ĝ@< 9  6 u# @ ~%^mVM^ AT$xZ5)axƍmAm+XRgDo ɣsf—*Eqf :L(fd y =&Ho7Q @&!L= 8tu4cuқ!:aՙE}ŌgFlt:<6#""VK6Ic&5Qe(ǖ g#qICQ)S$*YY*^i眬ƝiI)蹨oՍh`\ X\@\w%Zy yJE5@^")p2 $է'i Pc:n1vyjk҇֕En+.nI! xZW~lG@(\?b(eDۭ`>R%@%A+C.VhoGp8.ߓwuR->UR*b.Ϲ0d=l~<-۠lΣ֦8 u 0`5 d tM4>*&*HC?ɵ_pכV2]f | PVarzu~wu[oWSݩ8jL xwMON EIS:9p5R.o?}ж췙WÉ\ ^iz'h 1/h" L u]?>|'p?X~I2vnC=#Cʜ8P8 X75hG XbfuLQ|r IfK(d0@D؝~OV6II #(!&sKc(b0,#3@ ){XaȄ` 10h &JQp*>޽T)G.N@Oƿ V(#*|kIcj` Ɯ GS~&@K<F&zb'{DBȖH( 7.d(1Nˢ41-3y X70Y.h2j^7/NhFD}dr[0O!ʧ> :m >LkN"]XD%Jfԣ!Nlc,$`JzH:+~y8ͩNwӞ@ PJԢHMRԦ:PTJժZXͪVծz` XJֲhMZֶp\J׺xͫ^׾ `KMb[! ,//__wwGG羾I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~ED  B > 5 9ap;l!0a 'BU`m&RCgQIo %0’F*DM7yvAJ'!Yr0hW.do)J"u !~7Zՠ \+ȱtv즡 WBD P@dimҾ uY"PbXF;YĂQ13 pC;٥㋚ʯ30x]ۆ\-4"(C 2q}]>8nnu8o0SWҦ+H=03;6Y?Xج+ /nB ˙Xs{gjn.zqN?TrQm_== NÂqDdX( HS0@ %@[1!ƌIp!5 i-A'ΐ@PH/H|&"!h!WsE֘k4b; ɑ8A@[F䈷uY1qHnf%paكQ^lw*q\*aZ׊d(vТ)G˨]J)-vaE̊h₫KV| E @{`ʧ>Lp\͂AQH@\⣒v&A@lX&d.&):AxGh,ƙ)(1 Ñ}D|+;%!+~X `{0^ql $& [=|hmߔs @QU=6P^VmLi?o](vy $ޖ6*Sx ~wW33`L @@ N _}xUة7-x&E'{x3D ^C}OO}P%+iH e5 bي9j){If5Iɺ/0ʬdеK# 3)0I{kݶt:us`>V@!2>b>.;6(BJhB ͱ~1yjٜ::Mh3j^6g!{gD˃Zt0Q (iLiRSH ԢHMRԦ:PTJժZXͪVծz` XJֲhMZֶp\J׺xͫ^׾ `KMb:l! ,//__ww־I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~QMOǻ J ӻGF =ӷ Nj.ܼC&p6c`ackE"UŎLh-)L!e䁛#02ɓ@A<܅ i!rt@I"n\3z4UVX"~)Hx@hWuNMT^BjC6lFw1cnMO`Uނ-^.qYQKNj֓!=Zi pAwg Q}4𜀂?vtusrC G?dAI<ȹş?Hp 7xCIXCI)} :~I0 `90"xot~W)ᵱ)1#5Uk4<\DRsd\T!U/fkI¢%0*bHjY7$%g%1yIdZhc <#GO5RDv!*ʖhĹY((mߤ)2)~i@Ex^Tg5&Exa*ʄSRU{lxKS+>q*7*!auÒafl 蕁 K†1#kp@g/Ykxk0ԓ/Q@Ϡcy{+pp { &s$r10pd3+ / #okYaP&S* Vi'i. S 3n @mC٨ N/h`綀nq57K靧BUo3;@WW\Su/VEO2pyĭT#< 絛Bk.Z\fn̉'Ek]+yYyƏ-T`%Q NxӢ<\ h@@+ 2I2ͲM6,{^rzaDpa`RB1.z B^=<XhXgD@ M? ,)HP54>-J5 d J!-v} >5PqM̚N5ǑGVq*s!hrBb;2GDԍvӀ<^ cIvQBA 5J.+(i_ WB,كF%0kr\+k¢O،0cZwA6m`S܈!s_uH]afIS~,eiTњ֓gAVnjf QSkJ?+ֈs$uk$I$S\妹Rӥ )ySBrԟfPCJԢHMRԦ:PTJժZXͪVծz` XJֲhMZֶp\J׺xͫ^׾ `KMb! ,//__ww־ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~CVR T¶DzO ξL   K̲A෿(m~Gs s&-'q"> |akoc-8;6+YrqNۂ<=ʥ(V#Ș!APi-}V.\4uFݚz+DG r0ۡ'$f@*GIκ6?y֠&RR_āFAk/Bes;{ ?#YrJye#G]ZY]&&8v#i(GBEze@+& aGn+|+WJGr* UluʑefJ@ H%kGQ!oY-u ĥ}Sk_.# {<[鍊ŋJ l=ۇP4ozO (@8\@fEF= h< X8jqnfg6`'S-"ߜD:9y]h)˞? ̑t!ʄY0Z'-n+g:2ZD@IE΅m@\ѩm8!HkptfQgP ֠!;X>X !˫GX~T0hE 8c3"T݌o8T9ű\HqjA'yfous "^WxdqK,5i6;gA4nn[b3a*ΩO^ST`f g Vx` b@ :`U<VXamXENbQH&D*.bI2XD6Pz9 cIBYDF]G.ɤ= R@e<%XGutGfÈi]G_zOr͕QI"ٞcbl-GʟgV&YHv ZG8]fI$1PWOu fI 9#ug%@ۣF*w"BR`"U`Y"i.9ft3ȘY1ViF_bf2$Y 89p!/@\ ٟ$\l:& qm (0K 8 a(CVqh` $)0P i0IbXE"@,JHJm$ \@ mz, ebjFh&>fm10o);ze!5i>jC @!k)e2)EhzpŴy-,lgһ@%u?\c~QN 7 , l4Bu ϫеkn:?!SQ.ei"14MvFLknB4mmߤrFr&zM%EԔ]75kbGJ11iL'6 j/9Izal?ua>Nm't gK7 *N~t%!4/ 0 -d } ܛގԯKPdђoL7܂O FpU1DRLnR3G9FV I\%м$U&0Vow֧0gd+h| V4CHY/y&;mPTh +0i "cXY p e6 , .Q]ꀩl 'EL4 2rW"C 0IGXl&_h"Č5*Q!`'g,Ua5E' c*ۈ"1]lJLzEdb qTs# `э(F/BhH`$09mL-fX0y%TAI 줚P ,&P'BK˅A1# Rh=6'th?9Ş|wa0U4%{cЬ p2UJLa3a2K */ o~qBkp*RqiGծz` XJֲhMZֶp\J׺xͫ^׾ `KMb:d'KZ! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~.#r$+nÿ&%pƺ"˶k' g `& e߶5% HۿmdXA]ΥSGQ>grśZG;I;"Izpsn jy<)Y%;)i-R9tT7Q 8&Ul}#SX77 񑜉gsd)ⱷqTPpJ+ _#(8-y.Dʇ.yGY/63]ҰKHׅ,pεhodz a\ ҲMz;6ۂ` Eŭgo/bݩӿ_GER,@Z] 6a7v3mzEY EJkXEJD.Va1J^R Rc#,DZ-iČJ61M"Q.cU&dYU`H 8OYDj q%)_Wl@-IɉzY1ϝ!{$>[<@jSns@w 0 |#8p Ô) 8 W'Y gI(؇ۂ5J.v Mvpo#pHSBK$i Iփo\n ;#gl bmIpұ+F*,r #)?w$ !Y- @0uWnv~4%5Aj`4bwz$V~̄.%IR pQYΚlg D. ^8>f|nxӤ'0t;x0M~D, Sw^]㖤 9TTбDTZ8mCU&{@>v߂v]M]Cz?P tBp@ d;y1ua̲?^xi#i2 z (R *@ǭ`:L8n F> qя2 ЇƘ.`a#YbƸX/hUFT>bdՄ0 /{4Ed BTY0ˊ?H'+eb6p uťB.rYaXε;Ja5:tkL$2&KRI^u1 HʫiIPQAd:~ `&wtd%(Fդjcġxr 顯#hJ0i8l m*ylp6 lhִVf6b^ 7v`v!Pf cKg+(c?ivU P0B`Uœ<<{N\g #+5KV^z69lޞ . 46(;ۙn&H {N8 \d4tOO13tdB)]~ ,ol#/M|]y]Ci9 XgpᎴʫЎ1i|!;7P% Q r4Ã')eˆa}BNrd})+&|=vU2! -T4 .ٔ$^HVȓW $p KnQ.1k zNT3H#SѬ4 @j'""T< R6=O-UʠQ>POtZ 2bebH)Nn.)} Ӿ4GIUU^6iJ(@< ∣QXfZp6ãTmX rW!pt ux ԗ6itm\LJbldR [X Z:*&S0OSG%.Vc86L% yG fcKQ,!I:E╴ͨHiCclyf p)M&p&6[*nm/{& )h(&:gu99uҳ{On Ä=|{;hP 4(D3P U%6w8flDmRG5L 戜&'zo^NI&̬&3v7Ng >ENwGtPTJժZXͪVծz` XJֲhMZֶp\J׺xͫ^׾ `Kk! ,//wwGG羾ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~Ygce`\ ʮU ѻ̳ Zͦ ƻPβ ZuwEܭ_ĢEPc NbbY|Xm`d  Jq4 D|Gj0jy$<Ɍ z&fJelE F'S2+>3tjG~a)U3vQ*֋YWvϥԞvFJ)ʶn !)@u#  x 4U$0dP=P`Z+`fʠQ*+gIZA*n0mC i}s97D|k#.]EL2})lzTdqM7%MPNHxDJXKD]i胅ӂ!р% )qRX-[>HHc C: !=``=((]Z qCxB䘙<*x4݉Otй`jz@r2`N}#_ peTnÉLS)|W*ŠG:Z2 X*q wY2{R6@q0T }Tw$@I$ ĉ*ܹ+7 yDbĹ찵Ie eDR"z -86a.DJ@Kvmh$@ 46:֯GYٴ0:l1S (|ZwnoիkSe%F/F{I ,Wy<8u'q#/k5 _0UK 1VkH&!=E=Έe"J -Y*SArvp*R`/e (LFg!\O ,^ڽ@$!idӼ {[웢s4M%T-LsubJk 9f" ,C3y7y>ZLIȮXMy'9pS"xt"=z"+`7;^'WpMoI '6XLK 4#rw]( 㾿yXREi gYMQ0pDX"l椻19 H홟+tx Fw("7ſ1?ZN@5挌' t BY><!ߣDxt4{/E(x?Ep%x1Ĝ-eG$*v*lNsW|O#Ǚ~ i,x&:SPu`D<"@♞' Χ@T`P #'BAυ~՘L" yR  6C.l:ԩRCD@ˉu&:ĮxxDž$P1BӐmE3T,g%2eTgXzse|MzM-djKֶp\J׺xͫ^׾ `KMb:d'KZͬf7z! ,__GG羾ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~yiegbļ^ƬW Ͷ]ş Zɤ \  eVkWp LSsq3u4D1`:N8lJ6$_AI@4-CDsQ44m,`Ρdz"5 R3> ϩb :&*0 ~.-e+bx.m@ ;w ʼn Krt D6}1 p8.P/ASk];{z>]e{wsp)K^f~MDb*DX. jE*q_FL!~h"`E@V"!Ć2eb0 _e>6hĉ''&s~͠g80HB9\MG 1c8 |F@cqT&!Η1ؤ'h & mlYi@$uS'? T5BQ.<)}•5R)h z„)JBjdCVZ0.PVK@(LH*c#xH+寴끶(pkg 5) (@o;AK&pZW $ pP8 0I5W:I-Z?AZ wsbpJ¡ׁ9vΕ0+ uo5.| L#Bn@=4Хޔ~Ib8t|T4SRH UK0QJk]Mv}tRɘo6HEhXmjCD$7u8NjdeZֶp\J׺xͫ^׾ `KMb:d'KZͬf7ىF! ,//__wwGG羾I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~ieg b ƾ^  Vޣ ]ˤ  [_qzS 5Έ=-9 g;q"Z6nS bZ!6RmQi4"$M虌51R2">s*>yQRz* ֲ_KtmJjT.v pySwWKxB (.?1vx9AE!2{%pV3|A@ٹ'w1w,``۸KUy; Uԧ.gUu:yۆZo>14m,^mU_Mu6  NMqYhD"QQaE|HbX\rXzt1Z〄DV8T3)RM ^a4D5 F՘$1e}|>܀!nL"GMHI +($}dJgJui-҇) |>t`'6ʛ` p ^9,F  c )h~^l'2o p)B3#VҶp\J׺xͫ^׾ `KMb:d'KZͬf7z@! ,//__ww־ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~iegb ƾ^ ȬW Ϻʱ]ˤ Y S !ӧ[O %A5 z81v8+`/ckf8 {f0tGBW9̀WiE틠ik2ZO+2a_;)(tZ2If;#(h )쓟 '@U Ё`=FP,&x(DIljbkD{ l!I@*.b3)J= ҕv@/.HA͔ M3 ~2sf68#%N2gڅ=_rlfLM%',Zf* cIN) ӾTVĸ~krQxM@˕`Nf#P+LM@װcPҠnV@.l /.Nq㠎/0_p%vm"UCϣsuQj@4y9?+%{ aT>|>Rw}!'T8$ۆ8GV a2@yJY|QO\!;!9DJwbU f@7APV-&&;Hc0$X2O?ftc!؍c[MJق I*!!z:(0J <# A }^懮pfz@$k*Bv& XĢXd -REB~( _[iLzj6ю A Ca0Dhr]" fTZ, rL~7|,Hv4?[ 0|a^5`tBⰐ2CHD" .L2":Pdǖ&:uLSz h~ӓKj&25,EITINKIǩ|-9@"XA%^WM2 ZUKT7@߈]")Q$cOk[z_2H2 0uL1+l>9ő%fv $8)8 R#x''@; ЁnP2tU {(y"* 8T<Ew@jd逫2c.ۧT2z|?SY 9nzAs~Aiqˑm'N@LZ3O劰MXz kofmJuX( 01ax ؄ kgmFr(Y,cp[9F5g4k 1p.gM( Ux6!@JûoOcokbkCtkYh@k׉!. ۾yw<U/o*FC(O  7Z &4~^b5:3fWwhn1n16׮e~b^<`߼/bࡩH\*̍|$7CD! yw,篐bG1~ɨ2p3z &$A$3 mPz` A2y&4RX120 gr2v7 i#\N!7%d |C*Z18ibu@v.*(P:(@~0u胋[6ց6,*#%&],]p"t,g!-hߥ{bc{]XG\`>OܡIE+F>VGvو@=ӗ8l!,(~ n/Hry2={ ݄Wʚ~ $sX6G$A")S|(Ȳ ( >9P}!mTW=Ԣ d{D/N|PGi&z=؁8A*4eE,2y egҫ`ɾ9f6uJ*kԔcYjK5IS'JժZXͪVծz` XJֲhMZֶp\J׺xͫ^׾ `+! ,__wwGG羾I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~Cc_a \ XQзVѪLU |kvrJ-k1=dqb`̘f#3? )2%ɐL f%K/._r)S 55(P3'zTP.E婴KҦ[B"uꕪV`:e+(^> + ٲK΢Mv푶n;d*~2֗=Vp `e$PAm C C(Y 8~쩜V ./͝c.~]2}N~v1  8p`vgPAdE=@5 0Рq7C~Y@˭0<>Dy Xzʬx]6)(5ς;W 4\by7Ї{\-f[<6"]M  @ ŧOr&Yv@^nDv #wU@wD &ΌlX6X "'&WDxgۄּ8Iz tKI^C&"8^Ċ5AAh?*zf`:lqzq~J`* |5jA5<ڢP F ,ʀ z m0 rߚv`%bz`ѵAz"Ҟ@"VKIppJM' Yq!'+$k L1,l˳!P*"g/Sss i2,Z5IPܮ{奐ڠvj MCrL?e瀢3W81a V2rP \%B`&8! I0T.<cX<58!%$F1 hF3kqH hSD}Y =IPm s$G9J@#^ 6R@C Mqc # 0mg!Ma,⮸4he&~kZ r6yt `[<+0oDy*=hgt wP)8zixqf` mc Cbe0$xVHz48cL۬Ub*">ˋ(tG.YI\ H8ENf~9W a%QY{h1㉙c]UHwQ)qKݥ6'5M}4p{oʳ`&ʠ6Mlb#mplj,2ڂrh **R/(JOѕ 0.UDc|k#>[(e9 `*Q&FٳdBN#UGUb:PeUa?yV*TA\J׺xͫ^׾ `KMb:d'KZͬf7z -&B! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~M.#l$+h,jŻ"e'a%Z$ `^ >~lAl*ԇvMO/vۨf;C@uSNA jqSpL"uR7-_>e#ͩknĪVh d(M[)[3QߖzUvxֱ"ʘ%-.= 6 !KJFy\NqxĀuBfnFX |ھ*{378kS,|3]>HJ~'M=̽i#!`^.K^*{=/7)`ྦٯէ_9`q $` r9&X\B2퍃٪A ƂQq0%AېoD:tbF#)MqԬ2,p`dT3}`*Xæ)&;\47(D"6zY Bȏ;Do9}Lݙ՘jT[ժZ5xͫ^׾ `KMb:d'KZͬf7z hGKҚk! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~.#¼i$+e,g"ҿb' ^%- Vÿ雒0{7p7i1 Cuh1j$R|LAh9]L8݄ N7,tshF4tMO a@jdZ52KU,>bRg DlB:Fҗzqمl.l&QK.eAָ-0y+R?d PP&{@`aM#_H(0&x!7u1^.@qa-"Zx'FR4Y9b,7FIÎT!c|C"H}JQǟLfBZ" P#հڞd)}D l*P=HYĤ)g"!:ݢi]?,:Z)!;wZHݕB++Y&*<akzkON+j I5ty݁)ѪН^c. o6;. 8  8@ ,@ATܖwBw1TNl`MeG{1+؊jkB 343Hs0SR$ 0@ Po Pt [5D, b'TmT:*݊*,wnglӺ~뺔ثK-. ̎ܞ'^7rʞVN )l+0%\{ 1K!yۀ2 D w;?8~QzԽrRmÿ:X?ZW@eHp^u@!ŧS(@ 6AdBC\P';!L$EP`؃P!"7!>,HCĩh8{> EٰJ_ ;/U+NTժ}ոUxͫ^׾ `KMb:d'KZͬf7z hGKҚMB! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~u.#d$+`,b"]'Y%R$ XߕvɎţWЛ3!Çy'o:Uj#Ơ8b9@fbn8*F94L4 |S(-sA!jK= n֢vOSZ>lD9PzX׍踒QyFv (WW\~ݎ@bՍV*T >hxbY}Y3YPc9ڢ:M;5jՁrD0{n=F ~<(A:= o(Ep\@#3aC%Իe̗9?  ǒyA`<(V` 8 ?NŁ؃ DžIƣ*Sa '((l$.G6 &4WEB,!0:4=ڠჂK<3P# vOPb)R 1>B*#+%f7geo bRz\)m%0 >v L\YfrymK|P43xs x_q 3+ӑ55.>۵˻YʅģWQ]rT͋]Z=@d'2` ڣٓ@3DS9(ʂ~!\0  `hb5Q  (^ :82X+XCx (bhա_}8(#(tҟOy&4#)b&pi6t R4`(3#8^@Vmހf=BV5;Wi9UPEr1WE8,bJZC[_c&v * 0nM &\ #Jpk2b l=Xj9zUK ..ڃ)n@X÷ [n̻֭S@K/6 evh 7PKpYm2h[pn]|?-RȰB߀8lmv9gp{h%I u <-M"~!7Mo;5_S%v t9wlcȧ sUGCT땽Mn#/0tk0uC@OW_!!X.? V{SG.៽π+0 JMsp !K ŠB yxS(`H2E !q>{t"%UX2ҍ,,]2h| &Fr[,_8 "+͚>'w?wɜ^C}p뺗!_^ك,\5-zf{g\7NyhȌzaJ7GGm1(F8΀jAbQE-{Pbi,;fX :)?֨Y8Ŏ52%Ť0],VJjmKFx.ɢN00YT XU?_T$uV؃ # 879}MC\E%@Zj* Tc (hy"8 6|*- ʩZ̺PK@vQԚˢ ¸JKĸ.HZ .P+!>4VU'5xZ<>Z› ?ɨnLX $@IPSjĪN[ ,h~3>C+dbi]EP/N0շ{Tt5֮\U>m|#FmeHcu7%o)cpH(}I΁.)m5+P<1'74m8Z'ʛsfgsN) "xzJ4G;KJG|i~| ?DXY?D{dn@_y=r>2[M? F6OxٟP~$}AWѐ/9^$ $|L2q D<$B+VfP8P |!<('N !p:A>t 1 4<"谉F!)VB ^\tADF`,#Te41"#]FvoNpG6Q"AʕG5 92x"#E7`pE$#9H䢃29mhZr! (@ո& 9:M9_&6B@?ILZ"o$1*e,kșpxg=ge/4Ne݋4AsM=OqY!AYwC3fvJ h@`$8U\}Ө$A =r]X4]Lmu,ܚ4ְ<ݨ[39Ym궪v}eHMb:d'KZͬf7z hGKҚMjWֺlgKͭn! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~M.#S$+O,Q#"K' W_>TNa#cP`E7v|1Bk (h2 Am):lI3nxpb1%=ަF! ȷOG,Ő0 _U,]@a!@gGa/[$`ܽW]_n]s.VM:Iԡ0.^Eu؂| P\|% (^fluZW<,i4੓.hI+8gPf*4m@&p-&p[ ʚ9 |,#xU<- |l>T#S"y´.ggP/G:d@6S8 D\$4L챹c'͂Q@4߆2F3*D)iRӦ] ^@1 )^mB |YWҚ(4WggTa sysZ@L %pIIۓHp\C|qM.Bi O*'5"fhXyj]ʵJ>) kP魼̧mЗQ{\WM ՐJO?'j$D3]QC#T9^:7 b$ /M >?`{1 : @xAYQ@>C&R 'za$C,WX!PV!>wD'ܰQ!Х%BN/=K |"O >4;撲A4GR+Xʰ+R#4!``TciW,Db%o 4.T2ՒCՁFg4B|rYdA|@7yJ:Gh֘2bH4%#xRXBK޸ɹd|7fiS 5pg>a T^4f]4#CA@ 54;&Oo⓼;P"]Ϋx9ιXYmMM"W6t$zbk kUzuc!P̬f7z hGKҚMjWֺlgKͭnw pKMr:>! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~%_$"{-#v ]D 4X]@.G8PlXpEAy.Pt(1Ij a8ɜď9 r$JI#C? rg ԉɩNPw&bPDU2mm;.³z5o*}P! 4@,2,!oE/DAw_ b2'i܄=`}x%ф{=vnp쵝C>yod=tf\bh7&ṯ~3X6‰ rd~ )+$[#:>J+m% NR5NA*30@hhd IʃkR />.//`i 08% k h n- k:1."47*Nw(k0//'B h9lћRӴEwܸVt,3,9\pwF})K . ]-;:+-C(0P(K F#is%Q`cZ]`$c:h'E*8uW7e>&Y9IW%ү>@ ,Y$MWC%;MZ=iie$IPp?i U?L8%#BZ09>nР\ f@a7CB (M%R4r"z((JH!`->^dBbF%-9&,# &59mÑ ݈[dcxGQ1Ȑ F@C)chHld E2R8@BЂdisIAe-0a:t t(`KrpƼMRQ/szR&S)jeCc#DH BXp2xsox( X81Q4Ejڠ* i ÄW3D"8Bn/&{[ї4l'͇!>}^JNj?Dy9i7ϔb *t5&PD/tj,/{8!=ⓨQ]Uieo.,YG ǜէ`=SoB|K\)p['c]jrAaIZͬf7z hGKҚMjWֺlgKͭnw pKMrۂ! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~:%a$"\#Y &?'   3#@6r*H$]9 pP.Ƅd߷}d&L?GD1RmjiPd׆i:H"JAZ~7'C] !2ONL0,Uc57Sd SB[KI9ZH61Ur RDe$Mqлw5_}n^^?nWtGUԿ>l:ۿsXnpV>_ulLh2Fhxj( c&`%TMZ^&Z)6" !&}ƀ 8`]/d'ˆ^@tU ߩq"[BB*@b<'b$ B Aw#=vg Gdpk0&[yv(d,@gR)\ĸg8Ѐ{BI$@a u&3fЦ%W6TQ}6i@yuQ4;r]9i(?NNuKc&നQ!,J«O _ X@ `I .ؒ@'00&ʰ[D m ۋ"+͵.C`0¾5<Ǹk7`\g;t1#@!#/s-0S8; 0P 1oB&w=Elв\^* Iv,9?u ( -`o6 EP2Cfv?ou%|:S<0.g%n UZ*z.t2׺ᝀ`MԭiSRӴW> TH6ǨJ"fI:ش @"f^:&ItRe=S?ح"y^0μ[ f=P?8c()2dŁ]- <k6d}X*dCn` 2N04^̊$[ Ð!=F1q )bV} q 8%1VfQ B|c(G(,L# rC #t {|,";$2=:\%&H$^T-yK8` 8GP9 Irr<Ă v$ya=dUe]' b"nL @ a,KS0 &FNE[:*g$rs3,:IJ2 V xLmga85)NF 8$._QXR ".0w'-R$-Z Z=7yp1ӿZp ?mpGzT@ 0 H0 c~T@m5S̀dE|iHRkb_w17*cdq@^)h4K*rtvA\# isHjb L>X5.ƌG!Ep bҪD (PeZ kfCk5; (lF{<Vi -Ib,X&P~B'{ZZn ^KҼὮ\@-*K"-Jh .m@,"OgϥlsF-$$ 4DMBĺxs .0)3Hқ!<4ؠb[6Q\Qf <.Y7+ĢR)am"ٙT$1Y)<%4Rdp퍤՞ř?!!Aͳ) .e=AğzDM&<6RQ<8<.5 !Oš|\ٍCts AwhybUVqBfkU}B{@/ I"@ɉ6G:}"TJR#Ex! 6s؃p>a(58"g%NAŢ8Dɍ2PSx o\lvP0@W_ ukTs&D,(x =<`H lT,vȀZ )Pcm9"%$_H 8 &I0; `E䡌TӀV.Pws 'G1_e3@fuX1^F`KMydX!>u$|H3f9P%qe7 W`fD- Y$`l d8/(ƚ g1byi"+ NJi2Ò(]jT&ƫ -L` d@ (1$1'Qr\Hdz$v#m@mk!>wj2.p:*\Dr3A %~W1HICE'iES 3p+kG(hU@(a/K W(!:(DD5.iv`Nk&$~hQ[C;IC,rQgIePB -)/$=MuLjwʐt UsӼ|k:Ua!Îst 禱TҲafoz hGKҚMjWֺlgKͭnw pKMr:! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~b%g$"'` #&F(  G#AfM'Ax}p #NC2j, dqdٰ4Ȗ.\A=i'821 4ERK{ UԪ_bu떮^ {e,*%8%lܺWEv/߷zvJ[Ne>m 8,#j&$4g3 ,Qġc>tW)teף"퇽E [Āz<ȸN٦Qܙn~+=u˫x]3`AL>{ @ҐրMaDB@֛ wi Ĕ!r&l ObF t|xE hGe !2J /& IGeM)uDCǀ&Tfc$X%*؇`ƛ?!~ ɣ IǞ9"VD&gǀZr-;{$XRߋ0[a(`#xFo˩ HyAqZhjk/Ji\]w/Zϧe8k̮RȬX"m)Q#,[bHӚ@\Vd2蒀%/5Bpj]PM#ܛo8p + - i'?J)&~oQ۫ ,$'?+?)P+s2@ 0<38١0AG-Wl,̿|BO)xT}5zp2Nj\'k! pÜ2Qsс'182̌_D5bIq97× i!]|O0к뇗ԀU.2>ؕAY~.mN +Rဧvâͩ&u$wU653~rL* 6 6R;D^7U-3T~#\'H;Z_!=!`*r\+hr\Bx\Xj k-vBJaEYQ0I8_ Y|R!T.(93#:]hIg.h|ć˛#Ms& wNo4jhB&GCYoQ9lh   UWihT_I 6GRS"|+!`y'ĺ%+w"BbCMҚMjWֺlgKͭnw pKMr:Ѝt KZ7!! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~ʽ%i$"d#a &G'  H# 4`A~O@h""ZC9opF\tdGDPAPѧnK)SƝHb,BY<$LDLb?ΰJb$')aʓ kYDA tJ7ƒnSBk߉L79(/Q5$!`A0GzE#:]@ڲN~I!Qxke] bMIY4 3XO бASfCŠWV=qhāxMl$@Ms Zl^?x",k-x'I(%DB_FRP ww%7B4o Re ^CMQ3&QD(2az\jg@*V.JnQi=(R${Aqȷ$-pjrHj-{%#X!+/ n^֚ҪC2ƩjB qj,lӢ%H~a1Wn E+]Y̩:ŧZ/͂hpTkV> IOc,+ɧκL"ɖ) <8 3@3C+` $ȃzԫ*Csh33mX12x m hdkY[F*<W+]D4>8mDPጊ 1iCESY7._#C U:Vjp)GW6Aa*!h܅_qC>@ƴ;A>x8ً3˟F/}p]B$%v4Ѩrj-|1Jn 3X/vC7h Ih0GVX^A^@n-⧇1, _w!yp axpmP! 5fuL2 qqS 98u(2NpDPp<4PJ=g+ uH-.]k`(bӊ!ɇ0BuxW.~)iUDa#/pAX D&Y)d''S4{ mhA۩ %Z8Z`x:ȦA_ʃBY5 4`@TPxMjxU%MhˈKI2am,6#v2O`at9iL}BiMtc DY-ుMz);P"fjta G}'N?ǂ8w5]_s? -iM'L4* nZmlQH:DBulT4! gO"䴫:jd6U~&` @J}yڽ`(2pi>(E#:I&\o~e“رJڍC6)[%=t^H݃qկ݊$SDH!;& } s̸Mg#i>Plj{1' pM1bv"cZ[J;`` Y'ԝXep;Ic@!O) [լé^>8Aguyu ] &N|fI( d 64AQb> VpuwUH7hb9dTHer#=dVM.7ȋ6kqbaw(`;pR~4Z^4#fiAme($LȦV7#]%dd#dZjE}j舜Zƌpri1xhKcJ2J^+)ʬԺŭҦ,eyKX;c.[5BP-.NgXN&"h u\rN얙 W1q:+ʸ`sE"b @3 4/:r PG}s(st;/Qwצ@ ?U L6mr./6iPtlGy0-i 0l5|,2"kLK_%yzʃנt4ED-߲dTœ9s, ,i heA֘*LPV!=)laSn^< d0/˻fp='QT9V FHSE>B>lp *ĆKC.(a@X A4"!v $ʪjW(B1z ܄vy!${$HDꆇ2D~x$0A,$7P!Z.&\U@\d5wp]_bz9h1#>b eTf !ZE(hSc3~azqֳ!pm`sP>h[ P5RlA@c"C⩒ 9S-YetMLܦeuIr#5-@"$ N< )/;'7{F4KzD |ByBzӘ_Abr~S*Jb:N@Gsxh(}=G'"Hz iNFRrx%3()R_ѥ`NUOJ變.@6BХ57IјU5ʺEU*=@;Nmkdj 0L:ƶ@c'KZͬf7z hGKҚMjWֺlgKͭnw p3! ,//__GG羾I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~_ZUR ˾8 9 BC-XLq pCy JL8bt$+XG<^QyW`t2 ,PpΜ>!2riBiS=6JT+]*9@N,fG'it[tΪq/&T[ƍqn  5^J [\d-̳AC~X $\_M* \w?x~Yxu\pK28ΞRnx P}vxמEe9=-7f)W,4ԁ!-7No^H.X:eAH Лpf ,Ĩ+*ypZ#-耍hCג7`>M1+H%#E_Gvsp.0&Oi6"Yb9"KS0\x@x R'}"gv'if.hFQ>{*B։&WY藋:VeA05&$Vjʭ(FC"yA#+N٢RD*:p^eٜ~ꎈ<]cǶҬPWvYvVJ+ 3k TK&p j&yp)TǺ9  5#`nϪ3b0 TlL:|Ңx-\wP[#"s ċR  ,u`,v"4N$}5TDHU"wٝj(smz. Δ9w筑7Be͖I@RNJOԩzAo|:Hff^@{.P};.nY|FҭMbQpv^$OcEV I+У&k*ާ*3Pq68TK1?8XP|Eq!0N`k\s8a&E8暘P=*?’b8hSN#4914j0B8p'lˠ>#"GE ; / 0,H7+>4#hI06E)7+]1PL詑)`)RS0ԥe6u_~.[jR9ptM݈IME=|Ԭh@2-θ"]ٜWDj]ʱEتX,6d'KZͬf7z hGKҚMjWֺlgKͭnw! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~s%j$"e#b &H'Q" N~ 0 ޽k& 7 8HRG&3$ɓISH/ D~`6xmrӉ%- u2+j@TB h0!G~X/W͞rZvP"[vr[Ơݡy9@/R>z-Z6{ (!f#\^2!Go2h# ^'ʾM\ (@'sՆK'|2B.sُWǰ;=0mPc%ۄȤ$"< afj ^Zfc7pu&]p=Yw^i}BgiBt#Cnrg c(0CP #  s" %(:* 3`ꐪI &L*G;+huTjkH<&j h-#& -n@?b'= XF<8,RJ3cCkR逴57E@1=@kĸ\$&/Sق |lNʳ-+ 8'c02ڀc Ƙ-Cp(07BKuQAA:|( P\\.DXxrB;pă qa= ( ,űTbE3c&B!T,\CUQIATQ]<@S1헸z !W T|s:t BYRT+묖F邇m3"uR_ӎ)jhP]pUE54=+VmUz5lk"T_+/#O4 TGplM ٫vs+NQӟs遆*ŕEͩVיɶ5_f+Z"nw pKMr:Ѝt"KZͮvz xKC! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~w%j$"e#b &H'Q" N~ ( ޽Fπk& 7!1aAC< gakP6!BŔ$#L*RsF[4daKḶwQ¨QBH5 K]T]|4j,$cU-;qBᔬݒ500_4آ[6 hC+WƍNcpӀt9k| -zK?$V6t6\ue|i˟|q $?7fsei@ڣzp9T;P W ,)  %C_@^d/֠Br@jJݗB=ЀSCbE--s4h#{ã t;G#= HaEM^RVcwX %F_c ymXV tٙw N 6!J'| P~h(ʰf q }*BsI`7G;לshYA;8WiR(WʱTF(jyQKrlx@*pA)V QEKY$H>mPd27#<\ @ܽH;kο^lF#.n(mk1 } *'K*V;l}$'μrK&!Әʲ@Z,K ?KrS/S&0bo/1#23KfXw DҞ-MK'qSQMw-}C–8 (5Mo -f%=@V -,d)0\՚igf࠷;N.Srnϫ7 l<  T]x#{[n Y/N`I! q-+wT:Ut5)/{!+ַ /<qx,?m">'jBg"Ҥ0Z([c-^d|1D7xK:@Kb &yk;FMTS Ž0{.QX@SE pU+K=s$)m B(AQְf>N'&#Ihδ9ɥ/o|DFڧs/9xx?k^s@ yFo|[_yր-_!zm@-@nD  _mBi1`F& y_(2"1fM|]8# -@}|ѴcUC d@,d9 HWPTe (URy™8 mRߜ"dyAxb))(jZPduFꁞj9ΚfA: h5c UHj("@d5$:\0cER% @ Jbq~EW"-z wMvȴfnurA@-2! j1ҠfPp7n;1 :!B_8@"cb^cX`!ji4H:> +r\~FLrnq4L9 V7Y:ٓ PTPIZD1Rh , 0~1)cZ]I uYO4S45D6e(>T 9K-AZ)/DOETбQ@f@"lSFL ˲ʖeTNYBP]3kI&0XxՖ .61%XUFOYaTP4KW`5jWֺlgKͭnw pKMr:ЍtKZ"! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~*%h$"c#b M'  ID$;~=(KP{=WE"=g A<~\=Ofr%w+0 MK6|SπQ@]45p,F{X˓ֵ"Աd}&LkҢj@,y*=S#XxӨ(+Af18\i z; ᥁-ӠW<+]V.y[/Ğv56۠`7g70 x\9u{TM=h }=Lv gŹG@y 6HR{MP84aۡ_t# 1] (@= z,@/@И#fcO8I7H]Kр=BQΐ O9ex g_`a f%XWҎk0%LN:iwUiYp7gJ}ЦݡhB0(Yi 29Fɘv>0@C = jڴpӳ:cTHS^ 5ʏlً3.uW@GYu <77lJ0U|wߐ@=HƲ^.L>'3%P=i*֓‰9Z-s4Dӿ-F>&{ ]ܘBWT8:ҳrq3N2{-(EoܺJd ù,ӅL{CǞ^Ov!:HwXՋ a)x7 <|QBZρgCZ?gux+z5dv)X(S!"c}P%fwC`|&BBD{P`'ȍ/"|Q„*X1 B)X/E1RXlT!EJIQWey J偋n4R:mi&.>nJ6dBKQQ%,=(ܩ)EޠM-G9s?ŦTI1Q.%DK`N'uC<*"?S"ɹfkjyH?*~51^ȪeG4NVV0(7 ~՟2-V?[)ѢE^8dms pKMr:Ѝt'KZͮvz xKMz^! ,//__wwGG羾I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~rWR P < 8 ? c8fw3y1G]D jS[38 \&3IL y` ! KIb"ܾ cmYuu7'6}BboC%K8㮇0uˡkQGM"Ƕx;tMz5]_g ⬟wRyM{ zoJnDPF ",p UߑhKd0w HiPBA?E#Rk(@I 1*UwaHtX֐Fe@؀1% %)5G`$8@цfD4ذ'8Z[b0DQn!(SLEX:Ehl`Em)GXa "2c (BqlDEԐ١b^ JJ'-dxPґM^4g `gxfW֦vvhk@|+FГmP'v:qpc+LmZdC"9 ҄C'1X lAgTX!!z8 {A@=U Ɓ m g9RR @ OQxtHŊprX'Mr+MX9Ot =7 .$;$t*TFx^D`F`P-aY GxţbOjiP351SW2=FKSIVB)L)7vGzkjPn*e_bγǒljAZ\lgKͭnw pKMr#:ЍtKZͮvz x9! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~*%e$"`# ] J'Le _&d&MZ8/{"- )G]Ì E70Mk*[rnRLt5dDX0B$ȧti8BXǎ%?XLȠˇ8a4 )5FM|X˛qo="zpEL5m \lBmR1qȟ@]Ap`ĸ!Ep]M*&u+[> Y ċC wt>}A= Hnwy={B_ P;n/$_={ gЂ$Ppq a+Xءߥ@>#Y 4`/d#2ݍq2 ,q X@ALmMmԀ60PHI+N4`HpAgJv`x'%ZDmX9@ @[qυyǺ)kJ5ꢪ< I(qd2G`R< ud "!$&nicMK,%3؆ϙ\ sX-3xq}/&D0V6Rx ? .6',jΪ5lᮐJ_qW S*´jjkպlgKͭnw pKMr:ЍtKZͮvz x! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~%d$"_#,5+ &-Nǵq̝BƒV̧.C" HxA`p=gp1Kc*='0\MzLrJ"J &H+S}܎&5|=eS% `tsYM5n٥;g@ MA%Ru!6d`p{&H5.drREz0 6mNS@=3; YۣA_彟64tZ:z8zpmT/_DMC|zCĿw?2|½}Q `mEV[*W Hp~#tbZWw"} iBOكm>ft{Ч ApTP.6â'6XZi֠ M ]AZC'3A? gk`߮3H; , C&;ǂ,F5Bl"  4Ѐq*( Y6.0-B7)#6lpopW j@~Y[謈h.U魩E¾%|"I ;Q@P%~.ZL~DApe& e2CpE=C:s,(^U7;*0,lb1v ݌7dTNN<|pʇ݅FzV<mV8"R76XbXCmmhaIXǤW! +1U_؜״C+LC(XZP㑶Bu1'Fe#MH *~9ȷT$kXp]>vD=b(E&"GLN7kz 9R/(aWF`EB:[_K GA+)D]Y ~l(@-RCXIiYܴŕ"TBJX'-d%C☁f-(%ZҢ,%d⛂9DkBH,s(,QDBh,"B',R=bg,,bv# J ʯ5'`ц~KhF>҅`)(W\~aP(RbA[%bLEXȴZb4[KX \!޵ h]>CDHd. jXRi$װfث\'LVBȊ ЎV}VծdANbIvͭnw pKMr:Ѝt&KZͮvz xKMz[! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~П%52$-"1&/*, #Nd6@kCp8 P B`QAA&xOaG(HⰌG@4dM8!$xżV`!P bvێeV+( HSYW2;@P%r+03rzD_fYٶCq3"VRB1̈ Rf4ambp=|C18%<1cgA;\9U =w ܮtyam^ڽׇOzFCCnp-V B~ z*­fՅEBsrv(@VbN"1 $J"8;=Yr 0@ڬU (Pc|R 8 7~:,Uz#в^0'^i X5ޫJ.y.*)JF*/,dh-mSoK鄒dleٶG06w]tr}uQ;(X|wq.W43\ @iCs,]cDa6MZ? ཈irXfw"1HBϴ<F @<e)BD-<+T88{8s," Vc @HE `,t ST7#٦1B`̲B$-c*&-+e@%nl$GK%+yy3zrV 1Ae&^yE-MH`'n ;.Z?LjItZ74fOrJ*򁖀``pGH,pa ^™NKr)[E5Mbf,pbV9I'nPˬ,ZɂP,29s8_B{">c*nji G{)4fA` a݄~ (Hv!(hC"ޱHD\ 7gBXxH(>c "=( DB '(i%8)KnC\O0bPey 9KoT#X gf|a?W(z5yp' MY :R9Ц4< !' CTc/覬'Tkj\([l.ẕ뭥>l.UҺc 4 x . MX)L[ "&><#Q{[j>$t[߹{/JMKJpf2.UI3gv\?V?0Hm5hVZR)0a*P8厴a<5@R*:Nb$FZ2 ,* qQ @Ur 4\)MfQ/+ Gt Z+@E"hٕL}U@@^L3T=EGn)g?u~K.,_i6n5|cvЎTp 1A)k\킇wTu#`2("51i~dh3 mYVƖ-HEzxRkx,AJ5˃`W<m{$Q@0-r 퐉v#ЏqERnl#z> (%mPU UQ2,$ct X@p]0@?W$߈643E $_'>C p˜0'!)C1 !NpsN9E yȔ! zs A"4QDSA~  5[CcLF>6|c0hc^n(VLa%֓6CdǑ&J`ǙN@"̃ gbp,dn `@~FY" cM alt} ~s@I5+!=B;҅ Iu((Y8It{G6|lQ6(D }ͺm1A޹ۊMDҷ { o-#`u%8mLmgwTy\ rFf:yBai%'Yw`'!$) X5:Ÿΰ v) h0kvB'L* H* Yj*W 0@ }D"LXY@a,Ф 5x6ul ;pBA(=rڂ+mo6#V7۔G.ԝ^x[:hEnMd.|ڋ솧VH$d|oK!ԭ S QT$QzXV{m t9sx+ij_K=u iM@T%E.E-BVO˵C^@'<[x$ mA 3N_@͗Pc\eL03Wgzc@Ѽ1D6yaDD3lЋ6:We #!-R5(  Nr!13p[ [؋Wt؋JᇼL~0bS{@b.H&:~b^u\"%enjz&5p1ATjim~ېcIIJ*,jӘJΨFV+7x 1OHUO67,wpb!2Ŝjf[hM0kECEtMO.e=0;H~f:30<`MC$.]a@stfX1OCy<^ԉƩ2Y9CDdǸي 'Ii#0ۑ$Axh(̛៥^#ujpt"HPT/8mD6lzx&*v:t*V,3'X1Eұ@fZ6}+ *tWO ( 8@'j娣6H:bTWC 0(@$ِS%]=x` e Uy(f`$g f}iYҪKd(ɶT- ` ,CwM+? ) ǯ$D(頓 @L&೯ <q.*/P~t5FV(VEؗ75G3ݫQOȓԌ9PYSG>:4aLI{ςHT:PDm+ 0Jf  /1P ]APBCx K B[1 P .:Ȇ#o`0\xC o؊a*bErb.XzoLCq=Vk=8Qcv{ #h0E E,$')PEUb (Q($xs f3V>M0$3˥.u)]_G?J] H@XGK E"b$g@a.,I4S.s #* !.hs,pH24M㡒 Iæ"/=x@y=]?94Blˤ& 8&rg=j dAgb?T)0NOOn\yQ?Nmc= *HCOaT?X4XXTs ҩ VK:r@j # 0X*Z]puVR} *`)*^TxMg6Mk_j*Iž+V0;QqSVm49l9j&Gك WP{NV!j:<ͭnw pKMr:ЍtKZͮv9! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~ʿ%5R#1L$ /I  H( "$΁>h+\ņQʃ@1.I/A},d( u %pr弖BBlւ~ Hp#Q-2S0?Bh} UIRql@*Т)ЗU%Le{.߃hܹٴ:i@=eMblBlBpI78} N칯&kCFMqF)SEe2?}p طEG9G3  x|q;8|0<pL@_ Lp^| }+aӽ`߅Bq!_ޑ0`"l ,R%b+d>A8{;J8 $@I#l(ơ^lS y|eÕ( i ?PX!u ,F{tĆÄn/bb7 !}C!PAu*Hx ⁋b( [?LE{4‹|p#-F…#,fh=bU#+8ABZ[ɭc8f}Mf-rNΎ!K8G6EkI.gX1Ig `%RWj ڑ aAf-fI`v3 e?$X|hPe\LA)~l> OB0I< p^FNt1 _yPQl38L( i mŲ$[R|r L:=e5aQgԥFL5NTRf* L}.*XYű`f=+:5}+\*W)^U׽x_idӔT:ԪM,ȒI'lrR:Z-=YH3~]]Ş\FjDZFAKelXPU(dVN 5R4=Q{KQ4@;`]gG]MHhnU`abtS'CqpF8Ay]1o8vR5qlJ0ⅷKXV{Zi9|86Z﷯ȍC6V~>]3̣< {0'`^opk*aNG@xmRYtmzO"z?] =2qR JKc/<]#͌SjNƱG ʭ*'/4}}q\c,2uG06Z=%Ϲ & ^߆"-\(H05f<,`bMo ^1Sr߈8Dͳ :t(b05Έ_2Fl'za[!c\D\m[ UE*X ^|!FY0h$I`Cځ NE+DK zf!EE0y3UI?kk5I#fK`d4 8-Ӓ2.s^sS0~ T/PM썪/wEmuo@2n6ͱ€,%piPt4Ϧ]v11O[5zGngMOЃ}vő-5e,b`נ>eSů"%as.hpΨx4#PN Nú_9%] pc|dvSP$dY 9}c'\Q⎓B1R3'V S.UVx2L>Ok-4i /7QmZ848`X$cDqD$p/Kkmh +h$yV`P 0 'dtli՜ItCMAkDZ˘* )Ȣe8 f-]C'vK Aŀ/.H5أ8s%e*,Wb:60 (~=@fHjƤGcL*\4 lE~ATOwdֆTyr[;jq0pu&MnτISlvlYG0)Bn4eD(ͭ-,\ِJ.'gw '6ƏA$g2*`!ZhdMk(|Q ó k H,Bl-*l/4U M@k/%keq O& @jp> [ < Pa,P? @0g]^ƀO]-xI & f3+u7{HbJuIC Q0B^ 6nHR囁\RV9~]]8K%0:_^ToN%tVp|:ThFUʨkF )/a U2A= R#_,Aw>`k_bXhOh_څaS2 qWoWQTA5F)[{j fU^P 8O/EBXPлa{](&&!>"jBS] 81 SSYﳆX1$i_E479<0t'B9y dL䨇mI'ڈ:! CDF$%+F‘,J!6%,Y$+s'Oej)̲uې)e̤xhf:Z5sį]Jp5Qs%4h"@ y:hs8$.vNdmbCÈR`?o|RqQP/1L 8}&T_bt+^ e,Y-fb@ں׀ܹW[E0#0O,0y+0 M &ԥh 'Ξր!>1;pW׺ z8M:F5QdP/b nвC.p>unZ {7[ `i͓=p_gxi@l/D^ \w)`si])0n=줖EqsÍ؀1@`:XB&!>ؕ ,Ê*ٌF` H6#iE$-% PYB:[W, JV9Bhr5~yř@z%e( 4=`&0-iM=̐xԕ7m@ Х* @ g ]KiB@ jnS|JBT BNhkBi$ժPC@@^G<" HW_] = I nB@,/YS @{J〠 ڙ9fa ڒH0w ?/$PQ`zLB)STu+Y!z4s %N(!?#2UTe@*hRA5q%:@<ˈNCW9W#^2:QYdQNJT4TV0u/*\eչvYh+ *jz)+bSŎ@=a#KRvG(3z#\r|tbq2XGؖUZ4:[хqɚGt KZͮvz xK! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~*%5Q#1KO H( "N$P߾~ֶI@݂| "LmaC *Ĝ>  G#KBnI'E3Ҁ}r‹)ٿl5@-ؓ!`$8yn e1Aֈ$ DO, XqX妃N!T =d#C S]Tˠ>21|$ EAiyd@I$L#&`M$B!C>J[Y9g3I*!- Ac?iPC'SP&@H &/OCۓX@=1J$ԥ+v VTTjRS6(lJё8UTc%!xBnU7]TgcxLҞ2+^]ֽ6~e]6}= X9 )dGɂ/6TjGQ}'IS.U Z(LD u*JkYW'mf5WgS?h9zl\YYЍtKZͮvz x! ,//__ww־ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~%¼A!;?8 >  ۹:EP܅kD8^=>XAB} ޱ(" )I%':S[T?EkAM$M`ʄALK|'QHD{(#1}[)ݺw֫}x- 30]2d jϢpq/"cTKk8m#FII`K Xk~F\(ueԖ;Կ0u2Z@8-DkrҌs^Z] st3^@\@% pnHvVguv GLĝτ&L|q{Sζg1 JbD8/uceDX|IV`9Ag^Zli( 0aȈV {`iSLC cȎO&O DDw^"a$F4 W89A?)50AWhcdJXu@ :h 0F:֬8G3` -4b^gCa)I>) 4i -!12.T|hrp1ufԁ?ė fmhGL5"g = ~o!90Ed#>R$ &I$x#(SQkR9K|8)|%.AP]v*ёpaK&̔%LdN@vt4ɷPs MJ "( S4n:ߘh2[3<<ϖR&8[ʖ5 Mk:WxA Xcķ t=@o6»1EtE/( qH)WɁ'>@JУ#v@8tVbQbOjM Ȯx)Z+ εZn@;*t+Qi]>OM*() VS̓dYxU],ؑ:Rb*nETT3K6EQ>o?]gKͭnw pK ! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~̆%5P#1JNG(""K/~I``At ^aih>18 G")ǒ'QFw/!jGIO8D*EMEB @`j:%(>] S ʚVKUmhūu^+gv0aM+YIBnrd' sNիgꙛhG|Ůn.!yMtҞ6 fX*`Asg4ٙ @0U!= \u`sA\ 3@#u|y/Ā5%P %`M 4N<eGJ$`0 cM}a.`cM B'—"EΎn6-ݳb57VD Dy-.`~]w>]vE"G>zPt N$.>@UvgM YdN:Gg{]dBfbȨ4Qzk; 6_8 DUЗ}v4Y6 iAFl UP,*VN<˂TKȀ@h[ p@ j,4lHj@( o0Z8fY_p.| $ q80 ~<̵-43pq2 pMr<|,d3@6C2XZdG>'/0q,&(e3V})qqĹ\^+8u6IKiJgM(Ni9yW*x2+ EBx3s/ZSyXU ڟgn}5j$H0ԾY#< ˀXq;1Z1DOSj\Rx8Sɠ%l^GR+ *‰`hyRQz5`OT6%/p әؚ8X<)I`8S8O63;O@6BUGIt(CETqQE(?R@5?τCgh bKPPNP&M|q`u!^C7qtƿd*37G?ާ/n$CiXJ($I,3-qd6) ܯA*UB_Kଖ> %.sP] .YS< $ 4)iҠ0֌޲&8Uq <8ig\| T yfX߄&*{"=e #݀ZJe"2k̅f%XEI`g!VH@EALt5)b"$H+ \,`jUG#r/ N=ǽ&(, ۪`~lW[)reU OIrNSφ5<9M)c)Dݣ8 0.EԠb.1_@p-/i! D6n xKMz|! ,//__wwGG羾I8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~o%=!7;  4 : όpZ|#V&-ހv8qFE 0H c9.CFCg 8P|.D%&5 mR&><]T%FIϛ] k*D!>Ru)/d%rZcCK( (AWr}"xY7ja<3v@f&c01H,;8Cr/&#V}jЀ::Dd X袒$a=_mY<q.bgG" f> LOA(՜.vَ gDm#iz=_920@5hY)&a|Z登 Te7$%>dA(.$*jXHc_jhl^A?\rN:亐2. >-| h o Bxp;@Y.8@ ,Î[?qv| n&r!C:pr+,lKREf'Ǚ̹|ٵ,f7!RLܷt[ZmOC!R7G[Qա0E;"Β8glykO_dJ`| `h gIh oBN했&fGw><&G|%㸫s2|v[M~lI$>_>%bRdfEwݠd&EGB} ( XdPt :&eCK' Cw PMo@Πw*@&Z2@5,?hJDc %ٓG'NHqFdŵu*t"9XEd9 k`9 vGȱ0# OA`匎%O DRr$ IH|#(OQ~@93e̢D$(,7َTΒڪKu\Ĵ%a2 &2)=R@, v"jLIfg⫚z_MiNC&qN= sH<-U U4'%j2)ڤV8)Ox}$A }Υ%(#zr?F"%:$PI礮$R.v7Tr3+$MGgt)(wWð,JMi4QZjP=2E&` UGrbWcOck QoBM1~҂hۘ,jc=YK$hVPUKVS.Wy YB[tkiaw pKMr\;D! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~"%5K#1EI B(ٻm )`auƯ_fb~ ,\8GIm (Iep !3PqcN6Tz $LLNUt5]$ѲXrEKiEUY89U(ocx(?V1 x^ TN>EVv!)nq%t@~*yjA"e+8ɓCH' NsMmH1H^G2 v*k ,0i /<G&i`$}(< p:+ ,f% $y$m2>[* >[h.G?g}&;٪ F:n]`!o x);^`Ѷ)Kjxƒ.,ߋ, c6Hr R<%B3g $kį07L , )idO PD͈mw( Pi0x=@&1G 2, Qf'~cnm&!&`M C):*UKEhK찖70%.u-Q/aa`ƴTNL3h%4/iִ%p ]rә"t4:Upuw"KNz@? jQ>q80[G!52XɓNaFs1QHH|Xpgkӭ4=O.QAfYPkc!-ؗJY6ʄzhR=uv16:]A֊ZYI.P:.7 yskkhƾePJziS27x<&z$x2ڒ 562yU˱e7\CO~*<·gBz}1 `h-ۭ\i_yEf t*8Y՜1PR LX "B'P"[g \  X  p嘅ndWJ3 PtQ¬#(D9%Fx24ʰef7 W 0tΩx& 0TyA\Gh梌6hQe$((9hʙv颐ZCŕ`/= 40 gWLPqkp5Q&P j.@,.GG?0l* Э nhCy-bA|a6O2s2@ "―a/ @g*k㼋L +ۻ*"~Z#/03`j)RQ}Zl)d, lT^pV{ 0cNAmN}BDͯi}ÁKI@ cqSe:hq^75;.)T=s8ZY6L0w.lw Ѻ=G型J(nG0|ᣰ%os@^zoT>Z.Y+؆"W뚪Q{q&Sߡer!Dɡz DDܼR  ALS N&S %|P(%p ۱b .C B@ i@tyED'4ًŚ 5L &̉ОW%k 8( ) &|y#!maXk oaMp'H }A3-я;!(ŒQ@FAS2=|%}'Y'si;rT .$L0p%2_eBt]R憈&8&8Iq$A Iidg6Gn9}H¤6#9s&JnhXFpoqhKьnHaV_EF\D'8SBe9R\O(iF̔>E JЀ4"UlQ7@((dƴ-MzAʠn `֬';W/Q董$54:B"R֚8QJb1<)ݬFF}5H2t\($ Oq0M@FjX.`ċZ) u?Lڈ`Ce=(Zyl. ;Kd%/0r}9.+'φRJKiz xKMz^4! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~֤%5F#1@"D  =P|{``}D7d!o &`Bu 5b<0S\9Rv LDf&mdw@hn(T<8v40Ƈ8=-<ruUNn1e 'Xg*f]\z}+h%DZ.b~lj@؊B5{X AA{9ݠ  Vr씄t'mr5gq)̂{E2/rv/7ѣEwIm m_@mcTkS] vtøg)L\xG+< Y7LLG_W0'NB+( pXD\& xf1nX(8'Lxo9#**㣋RiŀLIJ*f%l.&p6 T N!a؈|_>="c# 4< 'n.P)B>@~擪 +zc'jKူ2z%k ˕2]k L''8 tŇɳhĬ@,PٺΘp*Y#֋)p[fJ|`$Tp n2+2Nzt0[,siϣyA&JqֆAoʢ-%MF/fX'`7]CmpB[g ^luJ/ Oqilm:k _JCe]]uk$&7vVp[s8(QNae٠6WEsl7T@P9XOyJޚϜ+nJbNe\}j;*׵P~𧈾6[we ҿ51 YDkI$$.LZP m > ' M0}$A3*4 Ai){2{".s:pOsn}(RsO%gLkne]GY.mcI_hCK`t=,T\M}OiUNUQuU+.n*}j*9E J8pc̡^ַ:lVe+<:9/@#,k[aI5*JgnuO(Aʆbr-fZgL4ViC)J׊V.j&eȁ4^Lڭ,UX!v_$*]I `\z xKMz !! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~%5C#1="|  n {'=0@x"^G" 1&  pXD ~4N94?;Y9]0~$Q&Mȑ Hp?lڵӽ dbiNPJ[G_#.`@TH$Ʌ <8S^t Zx?:O~\}l~2o݂؀Uvhrqu~ۙW' K׺}Iŵ h] =,a(Pwj WϺe_Y ܏zx[ o 0r]R0W1 %ts -m8 _/dC0#ڄ(Ea EƜ@ "Ekp#^ٍ *NلǨҖ@)Q3oZa1'r-%eV&@ 0el@FLe 8 gK 4h @iՐ 4gy)qi<<\K[F*B8*\2yʃ[. *r:h*J >a+ְ7V-V1l" d ʨ[[N hkrn^|f( Ajʬ Ɗ0pkCQ**ϔG' '  exiUBf\}ˏ& sx4EepL**Jl"wE^Q&"L 0@X3["\dT':肳ΰB;xUtgX5JN嫩F0jlylZ VgWcV$.{]0yaS<&2$2x&4a id6mrB )#8':!u%l<㹂y3 #'@YƁ@Eh?O޳$ 2=C{VJgH9w hK&1A` R-GS`52-y; Q 4Ef1l* h˨Hi* zJ@-WgQ-KuYF<5t4\+ >ҩ2҄o}( Hrs y4^Wp@ [ jl#@Hg,^Yi49f$~x-_;Nz.Y[(#|Kͯ~_2! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~׎b%^]$#f5( D[w4KFz$Nc ƟMgVJ%pf[d*wof:r!Uc@خK',W 'd(l3y wѕ!9G垝:G^/l^uW/չze xHch/`vb8laN0](!p`l8 xiUZH/ݨˆraZ€Ä:Va1~ÆEN\1& 0@"𨅇4 G`~V>@#YץlbcZy%Wp n"u"8 TjVQ X瘂¹wR•FWa.^:8ꄝ pi.1- Z,'Ih˄Da**Jo*DJK hKʥoŭaZa"r**T;3^V{z[`^L6—zAG È>.Vi?*q{I"u J^G6I6 7o9R!Uҹ0Ll (wm&ȃ&0 )vfh&-u_mشxKu P_l*p.yOy@ lFՌčiDBgG~)Ѹʀ 0hqqaZ(8m9?9 @+Pzlx.Z-}/O|6eu`L3@xᅝ 50@V͈B1fl΄BlOA۷l.3(8 q08 T @$ :Z;j!7-t!(C.|[  P )D(D+ThM2q 0|$((XN!-:!^døqY;R55G݈09[ǴD:ڠ1ak:d2FIѣ@I0r  d *#a@h8Rb+"71j$o8stH'}ك12|f)h7"6m怊޴)yVYkZMۅcdGV/t)]qdY/a/Űa/o}!(r Ȁ1!K Ӝ7XB|FV! 4P 8c" 4 lDV)BZdB6 eΦł&r@e IB-@ ٜJ9c.P( ĩI,8",TE8):!!lƩK\|Jkʺn BF үB)_%Y)Nz*: q#WQWX+%6 ?Qb5cM)f@ 0]@P,;Z e   I ŒHEeလmEjZE! B&P OJh]ad| 0jRTfn9>KBŲ>Lʕ(bIA , H1/L چrT HED*: yC.S.x q`8 :(0@f.|(8C2 nB 0ynxO: ۔Lb'(N٦yKjSwoafQk o^jVa @=U?@\~w+9G[}ޥ OZgfvXb8 n_XlW rp $R.3 wB+UX `(Ґ N>X+z=p p%6N\‚6!xJ@-"8)P(F#eXe<1: cE'4;RfqL{W|QaF6}@\:l4<($(B{Q٧$p'F#M%<O m");'3iDӹkB@13'~Ґ0TJë@)nMZ+mVԬȰ-VR.'q4ղ0 Y)[ :z,bki2ϰxڶ/L֏MOP,`in45ΖZ{`i09~Wm͛۽@<{[UsBQWˤcv@3"nU8ܫpieD|imuo& `Kg (ੴ'Q ؀iɓZ|ymyJ7p[?n)lJ75MOUBK!QuxRmأ[iIw"ՙ€O@uoN UX"@4&@Sۑ2"4X8V!V@*XK P'Z\I#(K6)4@Rڃ1Ąy^*%oib[yD|E &qڗ%u٤7 "!rq𣗌(R6Zxzà5C_ ɕD3F ĤJҨ>Y h*[ajQ[òS=$Hp`=ꫦ3*qx, O5^sB Ph0X g6s0> $D$'uE%2N|b (Pz ip-^dA_rQceDA_:,- @x0A?@<ɏD/!~|u"aIy$Xr^cK*\[ɘ]~Qf/(^k&Iaڳ/8FQ`+4f LT(H4Ոi43)grsd&ߪ)N$'6Ӊ6v|gt$O">)}^`(g&ЁgAYP UVA Q D 4iz]eO & E!> n-J߉ ^$OV+r$PLMm`M_4L~]tD1Ԧ4s k X=!#5xSyV\Iycw$D \ԕR}GQF|$+%D5>)PcUePPL~ jbQ&<t`fZ}#L2n@[Cַf.-OP"?\TmV!I$El*(SrݖrQY}wuMIlsMkA$=nW0֗/FKͯ~L ! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~ǎr%nm$ #T( " Y (W-~Ѣ9P8s6p:"(2f1 DZAìdRTFQE:qg%j&ok@IUfKR4`-=PInN&R<`NHJ'bEJX8 >+ Y\%3* 24ڮiB/LCd zCpfs7(8@@ Ep@Ѡ\ =w\3ۨ4qT < =jcR`q !d?MRNTa'ŨhGAp/^F4Z0cW`,A1h$,FTp%a9r>)V$(-rAw1q:ʨF'}mȃ9Qv#<=A CdǫrJ$yDh ye ?0`R ) 0\ٿ2(6z\DNX/MJApV*gyL$nQOb@iEQ d3&8aq€P,qs| )|)8!)C|,=Zlu<Ԡ 7#Ѓ3UD5ΈBmёB젶Y=R.B{XfԦMMt8eO+ISpA5*XSJ5urR];>sQTY8z1HWUͮ: kV֙ՊmŁXTuu\JVuk|F[yҵ8Qa%W91d 4\*"--\`_bXƼ!1)0\;  59 )`o_+]2=>MAhI ecJG gkl1^)wb̄,r4! CJͯ~L3!! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~lx%ts$#Z( "_" -[@n 8e@gb!C)AHŋQ9stAVIX}TlIӉr 4 1@S%3EQA`@ * tj<5>t'*#M9cdk(%@n6Or,Hy>" ØHTO2-H2Kn:l6}!*%w{Ԡ1 P]677{ԷӇ4`@YsķdM ؔ(Q-F{FF Яgϟ}]s^ v_ 0e <]Gx+0_aI P{'F`Fa: ,5T% (HMB9Te8BEg`a7HgB@9xɟ Dd1 `|oz /i|+m6qE>ie?(ڟoohvH8`A> c"G7S¦#6ȟkEnP-?2#>{kKlNWdmO4tPh/%>@ TxDj0 Dvfw'qna@G[ @9 KT1- /*BrR

p莭$+%P nE`nFߌfOp 9v37cn%|4#"EeH= 7Gy_%Y,\ $\&1)cҒTOjt&3^xzKE]{10h;<6 -U""d Y+Msxl/m-Y.L`4| )O5*>y}4>*~f< P$H(DGЉE+jQ`t(G;:BEKjΙ*rئPdl2Bq2CI 4Ee JߙJJHա~rf7FR93dȑ`}A )/m \S55vY]e q2X6鴝" j<XuxԮ0iX-ô:s)۟xV@B&A|4impSZAdw64 Y'k1¾6(lWE"ӗ_?M@ڢetKw5W]"C )e.CZ6záQT/|󌻥eN;'L '!! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~}%yx$ #_(""e" `Xz RG`YN_/E/~gr6>Po 9VOI&Crƒ`fyxP @WMyQ0l@Lb. ~AU"*4~?(fեկR0R @҉6WqA9D AH,eX:0zA5n (4Б]NG7! sA\hJ$ 5(WaR&4"#z|Rм@(H!ΑB mIO ƕt%Vy{Ƌfsѡ=X&P)iϊϟN$*֠Ϥ,tj J G_jFn4k Ght+b%%G+be nLcYKHX! 2Y:Wլ8cDכsAe= R1qXE[ugYβR^κޱnɍXS1ɅnජaZaAl i5ŜXZxyH\:w&t򢑱*W wgj+ LN;B! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~%~}$ #ȿd( "i лa h?.A03/YP _7~1(ɒux2DST`0/KRdҴIPAItZ,NW- 6D>!S$N%Ru?ɺ_Ʌ+lݴ9H.*۠vM3 b3p~\lċT̓G٪e n_S9'. %G0`` @ϏW}twKN]\ƽ2NhË@r ~^ |W~낵S|@܆qI@((Wi@-kCa 93RQJ"H׉VID^88݋'O'Vb~HIl!B4&.eS) %yv% ?p5}ƚYWDh\]qc-9N< t0>%/N86^@䏎m6V"htdTdLG(}Jq&>YY=*8`CT){!˯N$@ 8fb,uB>+ִCȗHj0D]:l &:3仄9KH81\U"/ A'P3,&kr"Cqm@.s36#pT? * ur# x4;!91[%y5ԉ]_}v21]B1gm'<:hWzy#m8-BM/NLU@8C.֍y xn2{H&p:.E ('îz [{ Ӎ#? '>OLQE` 24iaw"n:}L6قѠvldU0Y\'a+B`m.UKTô ٝxiP$IB0P%TH|?$+ۺQY{j~޽-_+KҊ\RvxE-~LN! ,//__GG羾ΦI8ͻ`(dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~mwsrY Ϻ^ ٰ׬ٻR QU˯X!'=PέpX.s"RÉk*blqxRخGY@&$ѠXJȜyf߾ )Z{A+`ҝKc4-t;V Z0e:54Xϰ nɚ5wvHq W\, ,V{![MA=YȌ'ɝ;7@@۸ͻ'VJ@ȓ+_<c[('ؗ'!8/~͛o  Ȁ;#^f|8?=~W@&Bd.5jǁ|7ft^_EiAe+0xvrX`Ct ,`X8#$")\:>&dK @%G$T4%TLVdUDSeC$=q: يbÄ8d%h,tHͦQ5cRw @biJ=K_Jd.;"2|ڐqM)ggso Y8)X፴{e4khO=(`"lj o5 ju B 1( . 0 jVTN܂) @*q0D2,8 (?,Ȧ dzv?ӐovY4G+@ ,0tt T U[l\օ0k0(Fr) x5w|-n9Gݸ v__;+DtL7琇~:Op_3v^:z>Srz}%o0  Y|؎o=/_K0?K{H/oM"& Sg׳Oܫ` >y4ZCxР-w#@4JڧW7?HYb0ɤY:J~PcdcjM)@TY%pP)BClŀ qJ(.K;(Jb)N H4"Cм1&#f|h6*ُ8sG D9ثc2QkvPƐtUGP䨐L"& Ñ;Pg/-6G( .NlP zl\>$wiLc;!aJX:5҅-\TZhtA& %8Iq&x֗N `%%bĬeXiuNب}E%2LZՂe~+wc]#O޺FP~{ jkcX {Tuξ6xѶ&7fF@3aNovfU`Rhyw%UxXRVǁz89rT :XREʌ(hBXSH&)9WPC0N:[[:AeD]OxY؇ęmf3!5gL)L6Q(YNAFDhn*qzF z7aWV (I JM'^**"=&DgN`"TycRX*m}r[q J Yي7\ۚF3)/B&-[2Vnp"Y >F䭦2З9ݏ~kC隊hW"0KqL,0 X\3 ' A%<;),pp'4\d V\@~_eiٶp?t&97 _ڦYXʽw ]L'BHkv0* cg}"&,zE]l_ݭ~F^wsI7e\<*2g"ԥE6t™ē_&k{5.<; f#M~0p(g$~4U\ВES\ ^?!P!w@X0ZPY5j'J*~Y*/h.d.D}6Gi"#Ѡ=a*K8DdA=YĉsD0YRDTFPmՌЬHQ}i1_= i~lH" ` vHd!0G$WdDb29s9HE2c., )IGRf h$"G4 ?}'4$Jdܡ$arISVK&١J)bOs!5EŒQN)(/Ok3 sS)PD%B%˅rq>#ځRxLAnȟDCtX1%$vNQ=)8Ok|UH6 ȣ"(zSYs[;#c|@JթUfϧ2T*m\!RnU8N_ ʆ-PTD])ՑD޸9D`"x>i_I0hboɋhzc3c!@ji_)ubT, !.֚TXR@B W&n`g@4̋RD;4&;,] Bvd,Emtg%#uBhLN;! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~%$#r(" w ߳ ­o &jD03n_?iي``%YhF3NFC}$ԎHNL%\Zf?WL񦕐*II' q璒%Ɗxe p4DM%XuвL:j`MT}%jVؚۂݸXS`oef.^ۖEdEǐB Au@'J y>* 췹ڷ3ܬp^p;@ΣVGw]ӻNx jOGo@Ag~]xĞ<55q `r0& ߅^Y44R1u NV<~0z#M[1.儇a9ҀZ+Fan4Ztd .) dMt$_A%u$YZ8yF6NVg)RI Fy't:4hgtmƹharhM9)x ]c)cdJjL穜:jw ʺE TA1 YTI-*>#'g:(IuWG̢Cd"PRJ Vө!4ŤZ K@_lƪk Z$:(C ‡BSd:DWii2 ]k p/PҨ95Ϡ2;CACl%~ luخ?6]-k;w?|vZ7]w0wj0փ y Џи]9|`1+7 wӁS }o[zg:JPY梄i`U;Y*I h@2 2 A `Z m(@sbO"QKjnWPde"fT 9}$;!9IuaL;ap9p2bAQ0]uAp 1s#YEdrM,41ˌI H8v3+bmkDP> r1%p-)\pGpuh9WbchF2eb%ߺx[}DV$t#*/=veQ&|;LN; ! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~%$v("w#|̭ ɳ ɩs׿ 'J&?Q.@7^1g@DE]DX9i7 (=kųWm}Zz9`r>j1-R6kh4;  :7w~w̬a,vL<A۩O_dWT yA\8?$~ET5P7kDAQE6P'c(@%PZd<0G&#2P 1#*0$ 0$6$3v$EMYH$=Z$=-v~NAu,'yFOUipэ|aa&炉1ќX᧗A1ieDjqRJj+ve+~+*ԁ5Z+R}TN#d *8pA`2d{dF&wdzj0]ݕ ȕP|4DZs,`C@2 .Of;\ZCΡ 5~ffQ 4B_݃ŵn l}@6hOӅ1VCs%ζYxY|0A4w  1-B*(^yvaB9䌆C,n缠7fK3vH]X}7y?sq>HBo  gãׯɽ v5`Wޓ/i%|3V/B;g|\}I+ #% N>]0E; Mng0 x- |B@]:>} z=8 WeMƤة. a~9VW5>e1bҗD|D,.! E,cJhhU~QzR5+Si M ?\`g\&Ds$8I$%EIةj-XeJYGMsZ+gI%'o!HR9&NCnW^jBT-/®3FUB.A'%B14fdu -"39zsH!B洅Ձ?#:R輨 Q@=He-@; =|,+t) `ME5!q=NU:h %~ Cy]l*hA!ʩjUG" Q{WݱaVUSN.,/^KÜ#*-ƮCdg : gGkegnf6@/K'ꍯLX8^S`/0i#,@(J02-*%.r\(m"'s/O@n&e2RE "fG!y&`[[M:JvڅeCπz55x8d`9?Ep` Nri*UfI^ ? (gI}|D7IӶ}4`ٵ 740C/NԔS]/aW͒5=ϾhgtO~bLG>֍;sIg ,@bnQsZP`=#4L5` R TȁFRg"j[S8)^`Q,*b84R@bTXPȣאU0HdȇA~O^Lo2VS%WU[ZIeQɥ2-VLIJzɦ'ELYE (V8&Xj6!(6cYI0^zRq%iQ|JPjbRʃ ;7\g\U&dp9Gdy6vFł Ofל)2uKՌyKP `= h- xC*MhK;pUۨ./E,qP̡j (q5slaڽ7]B-MtK@k]O1pO+5J~Gcɔ+\gdFW ЖP]vl@$Wwc `r@ᇣZ6D.9xs`g^9-c.标_d =lfV) Xt３/ۜUi~"h#h}eo>?~ғP_Br=. Wz{!'o{(tdft|A-Y@P \G-M0@uaTbڙ;d 48x=z~HU<B"h퐢fH-QՌX0$rEsIV 猲bYAX $=t(Rs^x?aYhR2$a^m? X$X:j0ؘaHʼ5HXJ=uZF+%`[Bk*?2σqf[J4|ы=TS/˵|Z{(M"Vb9$0U a*d@c4p9 P\DݗΉu_Q q! #ΐ"EI/&ǂ5!e'АcNt0Q@bS"-ikI'y?)3ё|PSCg^U>'1(5 U*5s.Hv fŲr\:PS醙V6^+8L&m-,ƕ1{je-,X+Ouu{++Rˁ8/}$[ -e[.}bl>܆aqZ385$F mN]:u.s'ހFV5囎wOͯ~LN3! , $dihlp,tmx|pH,Ȥrl:ШtJZجvzxL.zn|N~>%$#{("Ɂ Ҳӂ Źt&swȭ F?=J '(6Y:g+8{J= n iw$F SݪIyT1 H`3kHtZH #fѪ RQ[L.Fڅ`4b<(!>E]!X9Z5@ӦD)Nxm=r6@%xd]5ݔNnf#`3(|ݵg-g~^Hqۻjdi7T9^(`vՄViB@Q3`?l(a^Q|zȄg5 b#.u]4 [)e?@Frd,OhBZSR9dc%]` XIpcY%l)$͝g|I3EF8h44znFzJFfA՛[aDhVEZ+BlSXD,Ml=^qkgV1l2틄~;ű<|fgګ *ک p˂A&@|ZΊ-h*1ڥ.kFC魹pfL9Nm8p0G,"˭+Cp@7Xj“"[ATet 2sG3`C*(o ԴĻQ, qǛg r̸ jrj{)$vj'w38 sސj*<8䤗m ~-z >~P n`s)x'1n{'HDNt[5=%ę8f/$|0P?>-\a׷/[ɧ\W>R9 ,X,j9Ab-FRMX`v'nWA!INu..F :ve k )"bJ-+pॿu Ȥ.-HpeKpԋ{ML 0j"VSs rFQe;l7W>1b*ܸ { YS` B;osGt{UuFM%3-X>`4ƦOh0Z_@14vՠa.FU6} iqQDW$mpU@hRu+6Avr noK0>ޝܷ?|=Ԁ?_%`LȄZJ'W5SsOT.v)U1!9'0奕婈Bm8FXPBb`cU$Kd|$ 6Q)ƇPPc|H_QL%q}i@W5]IFXݑ$JrEQ6f8ahqaV6JXgɩ}Z% L1 *F  I~i]#P*W*Y "X NkZJ,JalS(K؞:QmEț}-rrg/ pT$ڻJF1fZ/pcTknVV@+ohPG{-Sh7p^%\ ZhA_1%϶=5 -&ZdZSIt5Ѷ-pl.5Sä206BZwTՀE _'w7 ,˂:^>.ڹ1sа3ݰ@(^]C}^F.z}-S^  ׳ gBuo~&>fC V)Ci z $h>ֳ`G̨vA8+ut a>x`Rrd.H2`!`脇rՒW@t<X 4غ< ?>1q9@%*V$;*AB^Wo&gn\p2%*D>5078!9+x#cS0ʰBX`0Dd#IIBJ}艔kJ (0qI('Iꆣ57|B0.acqd6~Aq!N9^F$:nZSV×xjBU4NunEa̚ ̐Tͼ?!F̊8%4[i d m+3Q8q3SGOr0mډRplJ79O4=ZdR#hOJ@wW26VTRG@ӼDPҹi*9 ,FwEr8u.¨ ux(Wt[{Rԭ^uZ1usZq445YE϶T1,d$ZE%jyƏickҖ[m;F2ʔ|˵^P >/9 "tYPP]F gPsEv]> ={΄noLN;'LF;phangorn/vignettes/primates.dna0000644000175100001440000001010012507002037016410 0ustar hornikusers 14 232 Mouse ACCAAAAAAA CATCCAAACA CCAACCCCAG CCCTTACGCA ATAGCCATAC AAAGAATATT Bovine ACCAAACCTG TCCCCACCAT CTAACACCAA CCCACATATA CAAGCTAAAC CAAAAATACC Lemur ACCAAACTAA CATCTAACAA CTACCTCCAA CTCTAAAAAA GCACTCTTAC CAAACCCATC Tarsier ATCTACCTTA TCTCCCCCAA TCAATACCAA CCTAAAAACT CTACAATTAA AAACCCCACC Squir MonkACCCCAGCAA CTCGTTGTGA CCAACATCAA TCCAAAATTA GCAAACGTAC CAACAATCTC Jpn Macaq ACTCCACCTG CTCACCTCAT CCACTACTAC TCCTCAAGCA ATACATAAAC TAAAAACTTC Rhesus MacACTTCACCCG TTCACCTCAT CCACTACTAC TCCTCAAGCG ATACATAAAT CAAAAACTTC Crab-E.MacACCCCACCTA CCCGCCTCGT CCGCTACTGC TTCTCAAACA ATATATAGAC CAACAACTTC BarbMacaq ACCCTATCTA TCTACCTCAC CCGCCACCAC CCCCCAAACA ACACACAAAC CAACAACTTT Gibbon ACTATACCCA CCCAACTCGA CCTACACCAA TCCCCACATA GCACACAGAC CAACAACCTC Orang ACCCCACCCG TCTACACCAG CCAACACCAA CCCCCACCTA CTATACCAAC CAATAACCTC Gorilla ACCCCATTTA TCCATAAAAA CCAACACCAA CCCCCATCTA ACACACAAAC TAATGACCCC Chimp ACCCCATCCA CCCATACAAA CCAACATTAC CCTCCATCCA ATATACAAAC TAACAACCTC Human ACCCCACTCA CCCATACAAA CCAACACCAC TCTCCACCTA ATATACAAAT TAATAACCTC ATACTACTAA AAACTCAAAT TAACTCTTTA ATCTTTATAC AACATTCCAC CAACCTATCC ATACAACCAT AAATAAGACT AATCTATTAA AATAACCCAT TACGATACAA AATCCCTTTC ACAACTCTAT CAACCTAACC AAACTATCAA CATGCCCTCT CCTAATTAAA AACATTGCCA GCTCAATTAC TAGCAAAAAT AGACATTCAA CTCCTCCCAT CATAACATAA AACATTCCTC CCAAATTTAA AAACACATCC TACCTTTACA ATTAATAACC ATTGTCTAGA TATACCCCTA TCACCTCTAA TACTACACAC CACTCCTGAA ATCAATGCCC TCCACTAAAA AACATCACCA TCACCTCCAA TACTACGCAC CGCTCCTAAA ATCAATGCCC CCCACCAAAA AACATCACCA TCACCTTTAA CACTACATAT CACTCCTGAG CTTAACACCC TCCGCTAAAA AACACCACTA TTATCTTTAG CACCACACAT CACCCCCAAA AGCAATACCC TTCACCAAAA AGCACCATCA CCACCTTCCA TACCAAGCCC CGACTTTACC GCCAACGCAC CTCATCAAAA CATACCTACA TCAACCCCTA AACCAAACAC TATCCCCAAA ACCAACACAC TCTACCAAAA TACACCCCCA CCACCCTCAA AGCCAAACAC CAACCCTATA ATCAATACGC CTTATCAAAA CACACCCCCA CCACTCTTCA GACCGAACAC CAATCTCACA ACCAACACGC CCCGTCAAAA CACCCCTTCA CCACCTTCAG AACTGAACGC CAATCTCATA ACCAACACAC CCCATCAAAG CACCCCTCCA ACACAAAAAA ACTCATATTT ATCTAAATAC GAACTTCACA CAACCTTAAC ACATAAACAT GTCTAGATAC AAACCACAAC ACACAATTAA TACACACCAC AATTACAATA CTAAACTCCC CACTAAACCT ACACACCTCA TCACCATTAA CGCATAACTC CTCAGTCATA TCTACTACAC GCTCCAATAA ACACATCACA ATCCCAATAA CGCATATACC TAAATACATC ATTTAATAAT AAATAAATGA ATATAAACCC TCGCCGATAA CATA-ACCCC TAAAATCAAG ACATCCTCTC GCCCAAACAA ACACCTATCT ACCCCCCCGG TCCACGCCCC TAACTCCATC ATTCCCCCTC ACCCAAACAA ACACCTACCC ATCCCCCCGG TTCACGCCTC AAACTCCATC ATTCCCCCTC ACCCAAACAA ACACCTATCT ATCCCCCCGG TCCACGCCCC AAACCCCGCT ATTCCCCCCT AATCAAACAA ACACCTATTT ATTCCCCTAA TTCACGTCCC AAATCCCATT ATCTCTCCCC ACACAAACAA ATGCCCCCCC ACCCTCCTTC TTCAAGCCCA CTAGACCATC CTACCTTCCT ATTCACATCC GCACACCCCC ACCCCCCCTG CCCACGTCCA TCCCATCACC CTCTCCTCCC ACATAAACCC ACGCACCCCC ACCCCTTCCG CCCATGCTCA CCACATCATC TCTCCCCTTC GCACAAATTC ATACACCCCT ACCTTTCCTA CCCACGTTCA CCACATCATC CCCCCCTCTC ACACAAACCC GCACACCTCC ACCCCCCTCG TCTACGCTTA CCACGTCATC CCTCCCTCTC ACCCCAGCCC AACACCCTTC CACAAATCCT TAATATACGC ACCATAAATA AC ATCCCACCAA ATCACCCTCC ATCAAATCCA CAAATTACAC AACCATTAAC CC ACCCTAACAA TTTATCCCTC CCATAATCCA AAAACTCCAT AAACACAAAT TC AATACTCCAA CTCCCATAAC ACAGCATACA TAAACTCCAT AAGTTTGAAC AC ACAACGCCAA ACCCCCCTCT CATAACTCTA CAAAATACAC AATCACCAAC AC AATACATCAA ACAATTCCCC CCAATACCCA CAAACTGCAT AAGCAAACAG AC AATACATCAA ACAATTCCCC CCAATACCCA CAAACTACAT AAACAAACAA AC AATACACCAA ACAATTTTCT CCAACACCCA CAAACTGTAT AAACAAACAA AC AACATACCAA ACAATTCTCC CTAATATACA CAAACCACGC AAACAAACAA AC AGCACGCCAA GCTCTCTACC ATCAAACGCA CAACTTACAC ATACAGAACC AC AACACCCTAA GCCACCTTCC TCAAAATCCA AAACCCACAC AACCGAAACA AC AACACCTCAA TCCACCTCCC CCCAAATACA CAATTCACAC AAACAATACC AC AACATCTTGA CTCGCCTCTC TCCAAACACA CAATTCACGC AAACAACGCC AC AACACCTTAA CTCACCTTCT CCCAAACGCA CAATTCGCAC ACACAACGCC AC phangorn/README.md0000644000175100001440000000262412545270412013371 0ustar hornikusers[![Build Status](https://travis-ci.org/KlausVigo/phangorn.svg?branch=master)](https://travis-ci.org/KlausVigo/phangorn) [![CRAN Status Badge](http://www.r-pkg.org/badges/version/phangorn)](http://cran.r-project.org/package=phangorn) [![License](http://img.shields.io/badge/license-GPL%20%28%3E=%202%29-brightgreen.svg?style=flat)](http://www.gnu.org/licenses/gpl-2.0.html) [![CRAN Downloads](http://cranlogs.r-pkg.org/badges/phangorn)](http://cran.r-project.org/package=phangorn) phangorn ======================================================== phangorn is a package for phylogenetic reconstruction and analysis in the R language. phangorn offers the possibility of reconstructing phylogenies with distance based methods, maximum parsimony or maximum likelihood (ML) and performing Hadamard conjugation. Extending the general ML framework, this package provides the possibility of estimating mixture and partition models. Furthermore, phangorn offers several functions for comparing trees, phylogenetic models or splits, simulating character data and performing congruence analyses. You can install - the latest released version `install.packages("phangorn")` - the latest development version `devtools::install_github("KlausVigo/phangorn")` If you use phangorn please cite: Schliep K.P. 2011. phangorn: phylogenetic analysis in R. Bioinformatics, 27(4) 592-593 License ------- phangorn is licensed under the GPLv2. phangorn/MD50000644000175100001440000001442312547516462012434 0ustar hornikusers6935e0c843976a470143b72ada3f1785 *DESCRIPTION 2d67e088ea29f95611ee42b755b256e0 *NAMESPACE d091257060fa258698275d7f93abfb41 *NEWS 115bc297835dcaab7d32527fcacb2061 *R/Coalescent.R 874ee7c405b1384b2f04828ac27574ef *R/Densi.R f916be823b9a838d49145695b0a37aa1 *R/SOWH.R 188e8e2a81eb0c50cc6b7cda6d2c9b98 *R/cladePar.R 5a95cd8530b05882c63f5d48073d7d3f *R/clanistic.R e4992df0ce2eaeb1380543eed22aa769 *R/dist.p.R 31db0490edd334101645270e922c3341 *R/distSeq.R 0693ec904c923ea37447ec460d2a86f7 *R/distTree.R ecbb9305836be819d53745855d9ab3ff *R/fitch.R 86e1095878e3b46eca343d1804a6957e *R/hadamard.R 75c515f0fcb9127a033df76e071eb2ca *R/modelTest.R c4c58c9e35b58e21176f482fd6150002 *R/neighborNet.R 4fbe2e2c5b83e638962921d0b75d4203 *R/networx.R 6c4a570cf453429cfe60b3f0d23ee69b *R/parsimony.R 7d2d79ba2ac0f697caa372f487a0f06a *R/phyDat.R 8579b368fcf48fa7fa0ffed2daf1576b *R/phylo.R ef07cb79ed0ece0caa494ed7c566e17b *R/sankoff.R bd5ce765336904ef9fd6ee286dc42220 *R/simSeq.R 2b4d6884b4ee2b92e617cea76f79d3da *R/sysdata.rda e59cce6bb3c64d7853ce58450f92f7fb *R/treeManipulation.R c7639eb4e9f2d2749b4e4aa54555bc75 *R/treedist.R c925e4cd5ce95bf91968fc909d6eef76 *R/zzz.R 76c6c00aad6e70113fca211f6ee04c6d *README.md df6481d8fdef70e63bfc09054cbb7bab *TODO c0bb685510ddd82f07347d07b3468cfc *build/vignette.rds 4a92b07bcd170e85bd237e460acafa93 *data/Laurasiatherian.RData 4b269c2e640293341b9b1c04d4dd7f4e *data/chloroplast.RData 19f84425e8caaf9f605490cdff17dd81 *data/yeast.RData b4d3fa3f40aae3a68846d1f28274e9a0 *inst/CITATION 61b3722df2ead748e0db8595428412a1 *inst/README cd23e5801a1f3632bf0cdd76e5242279 *inst/doc/Ancestral.R 0b18e27e3877621f05e6f78c89a0f5d2 *inst/doc/Ancestral.Rnw bfd8e0dfe0c57e211e4600e8221b530d *inst/doc/Ancestral.pdf 8d18b0e4a292379ba270a7a26f4d041e *inst/doc/Networx.R 6cf134802b4b98bb286e71f135ead8bd *inst/doc/Networx.Rmd 80f428b2d03d8874db4e9071225057b9 *inst/doc/Networx.html 6e9e97e846668cbf1e077067764e6283 *inst/doc/Trees.R e3f16cf1e79426ba67016beed7ee6011 *inst/doc/Trees.Rnw 46d2167ad02c1ee4670cd07e6420876c *inst/doc/Trees.pdf 1d5112656a0fe77fd68081a8a81474b9 *inst/doc/phangorn-specials.R 6e60535c60981d4f5492b73ebf7344df *inst/doc/phangorn-specials.Rnw 1c3fda481fca1865b5a0b6dae6667885 *inst/doc/phangorn-specials.pdf 3009f9da02a198cb557d435cc5ad8c7f *inst/extdata/Blosum62.dat 72f496d4c6e937ffe744d25bd8891313 *inst/extdata/Dayhoff.dat 5aa357dab0e72b27023e4302bc37dbad *inst/extdata/FLU.dat 7f63f617d5d29421b0bd90ab8511feb7 *inst/extdata/HIVb.dat 29e1aa10906a86bb9bca6d9c7f98a6cb *inst/extdata/HIVw.dat ca86e539345fa57de5c77a60308bed09 *inst/extdata/JTT.dat fdc1176d0c0f2db3de1c9dfd83d3c070 *inst/extdata/MtZoa.dat 106715eba35efc2743ccad7923ac13ce *inst/extdata/RtREV.dat e05f5a0ca507e4e15e7b95d1ce93b9fa *inst/extdata/VT.dat fc090d051ce4f18b937448a254e2764e *inst/extdata/cpREV.dat 50c707c26bf9015b37670f15d5e1c14b *inst/extdata/dayhoff-dcmut.dat 6da24109959f0c7a7db50c8db78d5d42 *inst/extdata/jtt-dcmut.dat ddc4bd45521cd72848aaf2f79b90ac6e *inst/extdata/lg.dat 917303a3df098f9137c651de0afa78fa *inst/extdata/mtArt.dat 1cd5e39670b86d32b5fe5c27dcc79648 *inst/extdata/mtREV24.dat 0ca0d0e987fcebf847a876779eddd934 *inst/extdata/mtmam.dat 87fa1533c4dfe7074237cfa2196bcbeb *inst/extdata/wag.dat 985da8b17504af26eff230a7160f208e *man/Ancestors.Rd bda5669b71de975e1309d909c495b71f *man/Laurasiatherian.Rd 4d6fb151c28a597eadc0d4ec2c59a504 *man/NJ.Rd 5dd84777963b553e8c89bddc951b17c8 *man/SH.test.Rd b3418f878911164dd974046f0492c79c *man/SOWH.test.Rd 6403c950d8f9700d3fe1c847970461ef *man/allTrees.Rd 2c88d4ded0156a68c44cee9e8fc290b4 *man/ancestral.pml.Rd 52ca504c035177a8ac1dbe43fc8e90d5 *man/as.splits.Rd 3b53888e5f37fd54344286a9175d8dc2 *man/bab.Rd 1a6c4849b1cd2c672e93ad940d1e8652 *man/bootstrap.pml.Rd 22ad0ef60c2edd8b3d003f170f2fa15a *man/chloroplast.Rd 4361615c7d1dc7beb8a4e6118505423c *man/cladePar.Rd 8d3c6fd646d8a64e29dc79791692a388 *man/consensusNet.Rd 5868068eb5f8be4302c0c3caadd25943 *man/densiTree.Rd f44e43abbbf7707821627c8e88f6e9fa *man/designTree.Rd 924c4e906042d64ac4fc4907af8c6cf1 *man/dfactorial.Rd da8a199fb9669c127cedfc3e58a650ad *man/dist.hamming.Rd e7e01cc12be2fac182ff773826ad286f *man/dist.p.Rd 4f8fa46c2cf1f904d1b85f35fc4db884 *man/distanceHadamard.Rd 72abceeb247f22b3da6560df0c20468a *man/getClans.Rd c1cacff95f20b574c03126d3f8e24106 *man/hadamard.Rd 9c306689d9d7cd539d8d1055b35e24a2 *man/lento.Rd f24a38210a0e90d3241e27514a6f5b8a *man/midpoint.Rd 0d51482b4a6375d72d220b80a667f917 *man/modelTest.Rd 5a825bb21eeef78dccf760a5ee0aca26 *man/neighborNet.Rd 94cd3c21e4dd4a6919db7fde5146a711 *man/nni.Rd f1ffe19a44e661d78c1bff049213d230 *man/parsimony.Rd 06d3770fff0d07f19393875735cfa004 *man/phangorn-package.Rd 71f4c68026c05fc0467f8d2366e629de *man/phyDat.Rd d7eac237d2e8950f6aca364bdc349542 *man/plot.networx.Rd cb484368c04bf20d286dedf974c83da1 *man/pml.Rd f8182027284ceba292fc437e87af3fad *man/pml.fit.Rd 9506d15a81467d18f40bb4741b3d9d28 *man/pmlCluster.Rd 8b06bdee57c510a690ea04b40bac4844 *man/pmlMix.Rd ff67d17fa29bf88cea645905334c5ecc *man/pmlPart.Rd bfc83a71d7de4e1c0b994b8b9c853439 *man/read.aa.Rd eaadcb69db59ca4c512eeb6258013714 *man/simSeq.Rd 2e7848b9bac018bde56302f70066a49a *man/splitsNetwork.Rd 2614e984b5c5aa40d9364d3542172654 *man/superTree.Rd 9f0dd1accd30d7b177038b787d3a3296 *man/treedist.Rd 64399c9fb7fb25d103c25aa925ab7a10 *man/upgma.Rd b97649fe8b91a0632a1ded89a6f43125 *man/yeast.Rd 9a8672b7759d360a54c251d1866b3e05 *src/Makevars 56d140fd1f0fceb9031c4ad70dfb96f1 *src/dist.c c658fdd18a82e58979b0105e0747e8b3 *src/fitch.c 63c45a73f83920a12ab7f921555a5e11 *src/ml.c a573d9543f40a6a32c5af7c14ad8993a *src/phangorn.c d8e5c864aa0b122ce426a67479d3a610 *src/read_aa.c fb760099aedbfcf9df0e638780df4cf3 *src/sankoff.c 7d1eaef831fb2372b367f5be1b0a5790 *tests/testthat.R ee456463a48eac9fb661c9b0b00f8aba *tests/testthat/test_parsimony.R 3b6b3635995a131b5beb515ae2897e28 *tests/testthat/test_phyDat.R a2f72d835a2eb1ad694dc19f1f48242f *tests/testthat/test_treedist.R 0b18e27e3877621f05e6f78c89a0f5d2 *vignettes/Ancestral.Rnw 6cf134802b4b98bb286e71f135ead8bd *vignettes/Networx.Rmd 9608eda76927e9438fa12a63ef8692cd *vignettes/Trees.RData e3f16cf1e79426ba67016beed7ee6011 *vignettes/Trees.Rnw 6af5f4d4c2e93469cc19d46a97ab5d0f *vignettes/exdna.txt 1ca8b1d97a011a9d0ecd9630d548dfb3 *vignettes/movie.gif 6e60535c60981d4f5492b73ebf7344df *vignettes/phangorn-specials.Rnw baba59abae9999be96bcc36d17793385 *vignettes/phangorn.bib d3069d1eff9e70bed655b8962bf4ee2b *vignettes/primates.dna phangorn/build/0000755000175100001440000000000012547505677013225 5ustar hornikusersphangorn/build/vignette.rds0000644000175100001440000000051712547505677015567 0ustar hornikusersRMO@--$* 6\L^7d[[+7[J^Lufk_G^9` pUj xk< gx P*t&ovN-1Lphangorn/DESCRIPTION0000644000175100001440000000145512547516461013632 0ustar hornikusersPackage: phangorn Title: Phylogenetic Analysis in R Version: 1.99.14 Date: 2015-07-09 Author: Klaus Schliep, Emmanuel Paradis Maintainer: Klaus Schliep Description: Phylogenetic analysis in R: Estimation of phylogenetic trees and networks using Maximum Likelihood, Maximum Parsimony, distance methods and Hadamard conjugation. Depends: R (>= 3.0.0), ape (>= 3.3) Imports: quadprog, igraph (>= 0.6), Matrix, parallel, nnls, methods, utils, stats, graphics, grDevices Suggests: testthat, seqLogo, seqinr, xtable, flashClust, rgl, knitr ByteCompile: TRUE License: GPL (>= 2) VignetteBuilder: utils, knitr URL: https://github.com/KlausVigo/phangorn Repository: CRAN NeedsCompilation: yes Packaged: 2015-07-09 14:57:03 UTC; klaus Date/Publication: 2015-07-09 18:11:29 phangorn/man/0000755000175100001440000000000012542610772012665 5ustar hornikusersphangorn/man/Laurasiatherian.Rd0000644000175100001440000000065312507002037016262 0ustar hornikusers\name{Laurasiatherian} \alias{Laurasiatherian} \docType{data} \title{ Laurasiatherian data (AWCMEE)} \description{ Laurasiatherian RNA sequence data } \usage{data(Laurasiatherian)} \source{ Data have been taken from \url{http://www.allanwilsoncentre.ac.nz/} and were converted to R format by \email{klaus.schliep@gmail.com}. } \examples{ data(Laurasiatherian) str(Laurasiatherian) } \keyword{datasets} phangorn/man/dist.p.Rd0000644000175100001440000000635512507002037014354 0ustar hornikusers\name{dist.p} \alias{dist.p} %- Also NEED an '\alias' for EACH other topic documented here. \title{Pairwise Polymorphism P-Distances from DNA Sequences} \description{ This function computes a matrix of pairwise uncorrected polymorphism p-distances. Polymorphism p-distances include intra-individual site polymorphisms (2ISPs; e.g. "R") when calculating genetic distances. } \usage{ dist.p(x, cost="polymorphism", ignore.indels=TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{a matrix cotaining DNA sequences; this must be of class "phyDat" (use as.phyDat to convert from DNAbin objects).} \item{cost}{A cost matrix or "polymorphism" for a pre defined one.} \item{ignore.indels}{a logical indicating whether gaps are treated as fifth state or not. Warning, each gap site is treated as a characters, so an an indel that spans a number of base positions would be treated as multiple character states.} } \details{ The polymorphism p-distances (Potts et al. in press) have been developed to analyse intra-individual variant polymorphism. For example, the widely used ribosomal internal transcribed spacer (ITS) region (e.g. Alvarez and Wendel, 2003) consists of 100's to 1000's of units within array across potentially multiple nucleolus organising regions (Bailey et al., 2003; Goeker and Grimm, 2008). This can give rise to intra-individual site polymorphisms (2ISPs) that can be detected from direct-PCR sequencing or cloning . Clone consensus sequences (see Goeker and Grimm, 2008) can be analysed with this function. } \value{ an object of class \code{dist}. } \references{Alvarez, I., and J. F. Wendel. (2003) Ribosomal ITS sequences and plant phylogenetic inference. \emph{ Molecular Phylogenetics and Evolution}, \bold{29}, 417--434. Bailey, C. D., T. G. Carr, S. A. Harris, and C. E. Hughes. (2003) Characterization of angiosperm nrDNA polymorphism, paralogy, and pseudogenes. \emph{Molecular Phylogenetics and Evolution} \bold{29}, 435--455. Goeker, M., and G. Grimm. (2008) General functions to transform associate data to host data, and their use in phylogenetic inference from sequences with intra-individual variability. \emph{BMC Evolutionary Biology}, \bold{8}:86. Potts, A.J., T.A. Hedderson, and G.W. Grimm. (2013) Constructing phylogenies in the presence of intra-individual site polymorphisms (2ISPs) with a focus on the nuclear ribosomal cistron. \emph{Systematic Biology}, \bold{doi 10.1093/sysbio/syt052}. } \author{Klaus Schliep and Alastair Potts} \seealso{ \code{\link[ape]{dist.dna}}, \code{\link[phangorn]{dist.hamming}}} \examples{ data(Laurasiatherian) laura = as.DNAbin(Laurasiatherian) dm <- dist.p(Laurasiatherian, "polymorphism") ######################################################## # Dealing with indel 2ISPs # These can be coded using an "x" in the alignment. Note # that as.character usage in the read.dna() function. ######################################################### cat("3 5", "No305 ATRA-", "No304 ATAYX", "No306 ATAGA", file = "exdna.txt", sep = "\n") (ex.dna <- read.dna("exdna.txt", format = "sequential", as.character=TRUE)) dat= phyDat(ex.dna, "USER", levels=unique(as.vector(ex.dna))) dist.p(dat) } \keyword{ cluster }% at least one, from doc/KEYWORDS phangorn/man/phangorn-package.Rd0000644000175100001440000000244312507002037016352 0ustar hornikusers\name{phangorn-package} \alias{phangorn-package} \alias{phangorn} \docType{package} \title{ Phylogenetic analysis in R } \description{ Phylogenetic analysis in R (Estimation of phylogenetic trees and networks using Maximum Likelihood, Maximum Parsimony, Distance methods & Hadamard conjugation) The complete list of functions can be displayed with \code{library(help = phangorn)}. Further information is available in two vignettes. \tabular{ll}{ \code{Trees} \tab Constructing phylogenetic trees (source, pdf) \cr \code{phangorn-specials} \tab Advanced features (source, pdf) \cr \code{Ancestral} \tab Ancestral sequence reconstruction (source, pdf) \cr } The first vignette (to display type \code{vignette('Trees')}) gives an introduction in phylogenetic analysis with phangorn, and the second vignette covers more advanced feature like defining special character spaces. } \author{ Klaus Schliep Maintainer: Klaus Schliep } \references{ Schliep K.P. (2011) phangorn: Phylogenetic analysis in R. \emph{Bioinformatics}, 27(4) 592-593 } \keyword{ package } %\seealso{ %~~ Optional links to other man pages, e.g. ~~ %~~ \code{\link[:-package]{}} ~~ %} %\examples{ %~~ simple examples of the most important functions ~~ %} phangorn/man/SOWH.test.Rd0000644000175100001440000000404112507002037014677 0ustar hornikusers\name{SOWH.test} \alias{SOWH.test} \title{Swofford-Olsen-Waddell-Hillis Test} \usage{ SOWH.test(x, n = 100, restricted = list(optNni=FALSE), optNni=TRUE, trace = 1, ...) } \arguments{ \item{x}{an object of class \code{"pml"}.} \item{n}{the number of bootstrap replicates.} \item{restricted}{list of restricted parameter settings.} \item{optNni}{Logical value indicating whether topology gets optimized (NNI).} \item{trace}{Show output during computations.} \item{\dots}{Further arguments passed to \code{"optim.pml"}.} } \description{ This function computes the Swofford--Olsen--Waddell--Hillis (SOWH) test, a parametric bootstrap test. The function is computational very demanding and likely to be very slow. } \details{ \code{SOWH.test} performs a parametric bootstrap test to compare two trees. It makes extensive use \code{simSeq} and \code{optim.pml} and can take quite long. } \value{ an object of class SOWH. That is a list with three elements, one is a matrix containing for each bootstrap replicate the (log-) likelihood of the restricted and unrestricted estimate and two pml objetcs of the restricted and unrestricted model. } \references{ Goldman, N., Anderson, J. P., and Rodrigo, A. G. (2000) Likelihood -based tests of topologies in phylogenetics. \emph{Systematic Biology} \bold{49} 652-670. Swofford, D.L., Olsen, G.J., Waddell, P.J. and Hillis, D.M. (1996) Phylogenetic Inference in Hillis, D.M., Moritz, C. and Mable, B.K. (Eds.) \emph{Molecular Systematics} (2nd ed.) 407-514, Sunderland, MA: Sinauer } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link{pml}}, \code{\link{pmlPart}}, \code{\link{pmlCluster}}, \code{\link{simSeq}}, \code{\link{SH.test}} } \examples{ # in real analysis use larger n, e.g. 500 preferably more \dontrun{ data(Laurasiatherian) dm <- dist.logDet(Laurasiatherian) tree <- NJ(dm) fit <- pml(tree, Laurasiatherian) fit <- optim.pml(fit, TRUE) set.seed(6) tree <- rNNI(fit$tree, 1) fit <- update(fit, tree = tree) (res <- SOWH.test(fit, n=100)) summary(res) } } \keyword{models} phangorn/man/pml.Rd0000644000175100001440000001655212507002037013743 0ustar hornikusers\name{pml} \alias{pml} \alias{optim.pml} \alias{pml.control} \title{Likelihood of a tree.} \description{ \code{pml} computes the likelihood of a phylogenetic tree given a sequence alignment and a model. \code{optim.pml} optimizes the different model parameters. } \usage{ pml(tree, data, bf=NULL, Q=NULL, inv=0, k=1, shape=1, rate=1, model="", ...) optim.pml(object, optNni=FALSE, optBf=FALSE, optQ=FALSE, optInv=FALSE, optGamma=FALSE, optEdge=TRUE, optRate=FALSE, optRooted=FALSE, control = pml.control(epsilon=1e-08, maxit=10, trace=1), model = NULL, subs = NULL, ...) pml.control(epsilon = 1e-08, maxit = 10, trace = 1) } \arguments{ \item{tree}{A phylogenetic \code{tree}, object of class \code{phylo}. } \item{data}{An alignment, object of class \code{phyDat}.} \item{bf}{Base frequencies.} \item{Q}{A vector containing the lower triangular part of the rate matrix.} \item{inv}{Proportion of invariable sites.} \item{k}{Number of intervals of the discrete gamma distribution.} \item{shape}{Shape parameter of the gamma distribution.} \item{rate}{Rate.} \item{model}{allows to choose an amino acid models or nucleotide model, see details.} \item{object}{An object of class \code{pml}.} \item{optNni}{Logical value indicating whether toplogy gets optimized (NNI).} \item{optBf}{Logical value indicating whether base frequencies gets optimized.} \item{optQ}{Logical value indicating whether rate matrix gets optimized.} \item{optInv}{Logical value indicating whether proportion of variable size gets optimized.} \item{optGamma}{Logical value indicating whether gamma rate parameter gets optimized.} \item{optEdge}{Logical value indicating the edge lengths gets optimized.} \item{optRate}{Logical value indicating the overall rate gets optimized.} \item{optRooted}{Logical value indicating if the edge lengths of a rooted tree get optimized.} \item{control}{A list of parameters for controlling the fitting process.} \item{subs}{A (integer) vector same length as Q to specify the optimization of Q} \item{\dots}{Further arguments passed to or from other methods.} \item{epsilon}{Stop criterion for optimisation (see details).} \item{maxit}{Maximum number of iterations (see details).} \item{trace}{Show output during otimization (see details).} } \details{ The topology search uses a nearest neighbor interchange (NNI) and the implementation is similar to phyML. The option model in pml is only used for amino acid models. The option model defines the nucleotide model which is getting optmised, all models which are included in modeltest can be chosen. Setting this option (e.g. "K81" or "GTR") overrules options optBf and optQ. Here is a overview how to estimate different phylogenetic models with \code{pml}: \tabular{lll}{ model \tab optBf \tab optQ \cr Jukes-Cantor \tab FALSE \tab FALSE \cr F81 \tab TRUE \tab FALSE \cr symmetric \tab FALSE \tab TRUE \cr GTR \tab TRUE \tab TRUE } Via model in optim.pml the following nucleotide models can be specified: JC, F81, K80, HKY, TrNe, TrN, TPM1, K81, TPM1u, TPM2, TPM2u, TPM3, TPM3u, TIM1e, TIM1, TIM2e, TIM2, TIM3e, TIM3, TVMe, TVM, SYM and GTR. These models are specified as in Posada (2008). So far 17 amino acid models are supported ("WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa", "mtREV24", "VT","RtREV", "HIVw", "HIVb", "FLU", "Blossum62", "Dayhoff_DCMut" and "JTT_DCMut") and additionally rate matrices and amino acid frequences can be supplied. If the option 'optRooted' is set to TRUE than the edge lengths of rooted tree are optimized. The tree has to be rooted and by now ultrametric! Optimising rooted trees is generally much slower. \code{pml.control} controls the fitting process. \code{epsilon} and \code{maxit} are only defined for the most outer loop, this affects \code{pmlCluster}, \code{pmlPart} and \code{pmlMix}. \code{epsilon} is defined as (logLik(k)-logLik(k+1))/logLik(k+1), this seems to be a good heuristics which works reasonalby for small and large trees or alignments. If \code{trace} is set to zero than no out put is shown, if functions are called internally than the trace is decreased by one, so a higher of trace produces more feedback. } \value{ Returns a list of class \code{ll.phylo} \item{logLik}{Log likelihood of the tree.} \item{siteLik}{Site log likelihoods.} \item{root}{likelihood in the root node.} \item{weight}{Weight of the site patterns.} } \references{ Felsenstein, J. (1981) Evolutionary trees from DNA sequences: a maxumum likelihood approach. \emph{Journal of Molecular Evolution}, \bold{17}, 368--376. Felsenstein, J. (2004). \emph{Inferring Phylogenies}. Sinauer Associates, Sunderland. Yang, Z. (2006). \emph{Computational Molecular evolution}. Oxford University Press, Oxford. Adachi, J., P. J. Waddell, W. Martin, and M. Hasegawa (2000) Plastid genome phylogeny and a model of amino acid substitution for proteins encoded by chloroplast DNA. \emph{Journal of Molecular Evolution}, \bold{50}, 348--358 Rota-Stabelli, O., Z. Yang, and M. Telford. (2009) MtZoa: a general mitochondrial amino acid substitutions model for animal evolutionary studies. \emph{Mol. Phyl. Evol}, \bold{52(1)}, 268--72 Whelan, S. and Goldman, N. (2001) A general empirical model of protein evolution derived from multiple protein families using a maximum-likelihood approach. \emph{Molecular Biology and Evolution}, \bold{18}, 691--699 Le, S.Q. and Gascuel, O. (2008) LG: An Improved, General Amino-Acid Replacement Matrix \emph{Molecular Biology and Evolution}, \bold{25(7)}, 1307--1320 Yang, Z., R. Nielsen, and M. Hasegawa (1998) Models of amino acid substitution and applications to Mitochondrial protein evolution. \emph{Molecular Biology and Evolution}, \bold{15}, 1600--1611 Abascal, F., D. Posada, and R. Zardoya (2007) MtArt: A new Model of amino acid replacement for Arthropoda. \emph{Molecular Biology and Evolution}, \bold{24}, 1--5 Kosiol, C, and Goldman, N (2005) Different versions of the Dayhoff rate matrix - \emph{Molecular Biology and Evolution}, \bold{22}, 193--199 } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link{bootstrap.pml}}, \code{\link{modelTest}}, \code{\link{pmlPart}}, \code{\link{pmlMix}}, \code{\link{plot.phylo}}, \code{\link{SH.test}} } % \note{For small trees the likelihood seems to be very similar to Paup* or PhyML.} \examples{ example(NJ) # Jukes-Cantor (starting tree from NJ) fitJC <- pml(tree, Laurasiatherian) # optimize edge length parameter fitJC <- optim.pml(fitJC) fitJC \dontrun{ # search for a better tree using NNI rearrangements fitJC <- optim.pml(fitJC, optNni=TRUE) fitJC plot(fitJC$tree) # JC + Gamma + I - model fitJC_GI <- update(fitJC, k=4, inv=.2) # optimize shape parameter + proportion of invariant sites fitJC_GI <- optim.pml(fitJC_GI, optGamma=TRUE, optInv=TRUE) # GTR + Gamma + I - model fitGTR <- optim.pml(fitJC_GI, optNni=TRUE, optGamma=TRUE, optInv=TRUE, model="GTR") } # 2-state data (RY-coded) dat <- acgt2ry(Laurasiatherian) fit2ST <- pml(tree, dat) fit2ST <- optim.pml(fit2ST,optNni=TRUE) fit2ST # show some of the methods available for class pml methods(class="pml") } \keyword{ cluster }% at least one, from doc/KEYWORDS phangorn/man/neighborNet.Rd0000644000175100001440000000250612507002037015411 0ustar hornikusers\name{neighborNet} \alias{neighborNet} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Computes a neighborNet from a distance matrix } \description{ Computes a neighborNet, i.e. an object of class \code{networx} from a distance matrix. } \usage{ neighborNet(x, ord = NULL) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{a distance matrix.} \item{ord}{a circular ordering.} } \details{ \code{neighborNet} is still experimental. The cyclic ordering sometimes differ from the SplitsTree implementation, the \emph{ord} argument can be used to enforce a certain circular ordering. } \value{ \code{neighborNet} returns an object of class networx. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} %% ~Make other sections like Warning with \section{Warning }{....} ~ \references{ Bryant, D. & Moulton, V. (2004) Neighbor-Net: An Agglomerative Method for the Construction of Phylogenetic Networks. \emph{Molecular Biology and Evolution}, 2004, \bold{21}, 255-265 } \seealso{ \code{\link{splitsNetwork}}, \code{\link{consensusNet}}, \code{\link{plot.networx}}, \code{\link{lento}} } \examples{ data(yeast) dm <- dist.ml(yeast) nnet <- neighborNet(dm) plot(nnet, "2D") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ hplot } phangorn/man/midpoint.Rd0000644000175100001440000000304112507002037014763 0ustar hornikusers\name{midpoint} \alias{midpoint} \alias{pruneTree} \alias{getRoot} %- Also NEED an '\alias' for EACH other topic documented here. \title{Tree manipulation} \description{ \code{midpoint} performs midpoint rooting of a tree. \code{pruneTree} produces a consensus tree. } \usage{ midpoint(tree) pruneTree(tree, ..., FUN = ">=") getRoot(tree) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{tree}{an object of class \code{phylo} } \item{FUN}{a function evaluated on the nodelabels, result must be logical.} \item{\dots}{further arguments, passed to other methods. } } \details{ \code{pruneTree} prunes back a tree and produces a consensus tree, for trees already containing nodelabels. It assumes that nodelabels are numerical or character genereated from numericals, it uses as.numeric(as.character(tree$node.labels)) to convert them. \code{midpoint} so far does not transform node.labels properly. } \value{ \code{pruneTree} and \code{midpoint} a tree. \code{getRoot} returns the root node. } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} } \seealso{ \code{\link[ape]{consensus}}, \code{\link[ape]{root}}, \code{\link[ape]{di2multi}} } \examples{ tree = unroot(rtree(10)) tree$node.label = c("", round(runif(tree$Nnode-1), 3)) tree2 = midpoint(tree) tree3 = pruneTree(tree, .5) par(mfrow = c(3,1)) plot(tree, show.node.label=TRUE) plot(tree2, show.node.label=TRUE) plot(tree3, show.node.label=TRUE) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ cluster } phangorn/man/splitsNetwork.Rd0000644000175100001440000000360212532161141016033 0ustar hornikusers\name{splitsNetwork} \alias{splitsNetwork} \title{Phylogenetic Network} \description{ \code{splitsNetwork} estimates weights for a splits graph from a distance matrix. } \usage{ splitsNetwork(dm, splits=NULL, gamma=.1, lambda=1e-6, weight=NULL) } \arguments{ \item{dm}{A distance matrix.} \item{splits}{a splits object, containing all splits to consider, otherwise all possible splits are used} \item{gamma}{penalty value for the L1 constraint.} \item{lambda}{penalty value for the L2 constraint.} \item{weight}{a vector of weights.} } \details{ \code{splitsNetwork} fits non-negative least-squares phylogenetic networks using L1 (LASSO), L2(ridge regression) constraints. The function minimizes the penalized least squares \deqn{\beta = min \sum(dm - X\beta)^2 + \lambda \|\beta \|^2_2 }{% beta = sum(dm - X*beta)^2 + lambda |beta|^2_2 } with respect to \deqn{\|\beta \|_1 <= \gamma, \beta >= 0}{% |beta|_1 = gamma, beta >= 0} where X is a design matrix constructed with \code{designSplits}. External edges are fitted without L1 or L2 constraints. } \value{ \code{splitsNetwork} returns a splits object with a matrix added. The first column contains the indices of the splits, the second column an unconstrained fit without penalty terms and the third column the constrained fit. } \references{ Efron, Hastie, Johnstone and Tibshirani (2003) "Least Angle Regression" (with discussion) Annals of Statistics K. P. Schliep (2009). Some Applications of statistical phylogenetics (PhD Thesis) } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{\code{\link[phangorn]{distanceHadamard}}, \code{\link[phangorn]{designTree}} \code{\link[phangorn]{consensusNet}}, \code{\link[phangorn]{plot.networx}} } \examples{ data(yeast) dm = dist.ml(yeast) fit = splitsNetwork(dm) net = as.networx(fit) plot(net, "2D") write.nexus.splits(fit) } \keyword{ cluster }% at least one, from doc/KEYWORDS phangorn/man/phyDat.Rd0000644000175100001440000000753412532105756014416 0ustar hornikusers\name{phyDat} \alias{phyDat} \alias{as.phyDat.DNAbin} \alias{as.phyDat.alignment} \alias{as.data.frame.phyDat} \alias{as.character.phyDat} \alias{as.DNAbin.phyDat} \alias{read.phyDat} \alias{write.phyDat} \alias{allSitePattern} \alias{as.phyDat} \alias{subset.phyDat} \alias{acgt2ry} \alias{baseFreq} \alias{cbind.phyDat} \alias{c.phyDat} \alias{phyDat2alignment} \title{Conversion among Sequence Formats} \description{ These functions transform several DNA formats into the \code{phyDat} format. \code{allSitePattern} generates an alignment of all possible site patterns. } \usage{ phyDat(data, type = "DNA", levels = NULL, return.index=TRUE, ...) read.phyDat(file, format="phylip", type="DNA", ...) write.phyDat(x, file, format="phylip",...) \method{as.phyDat}{DNAbin}(x, ...) \method{as.phyDat}{alignment}(x, type="DNA", ...) \method{as.character}{phyDat}(x, allLevels = TRUE, ...) \method{as.data.frame}{phyDat}(x, ...) \method{as.DNAbin}{phyDat}(x, ...) \method{subset}{phyDat}(x, subset, select, site.pattern = TRUE, ...) phyDat2alignment(x) allSitePattern(n, levels=c("a","c","g","t"), names=NULL) acgt2ry(obj) baseFreq(obj, freq=FALSE, drop.unused.levels=FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{data}{An object containing sequences.} \item{x}{An object containing sequences.} \item{type}{Type of sequences ("DNA", "AA", "CODON" or "USER").} \item{levels}{Level attributes.} \item{return.index}{If TRUE returns a index of the site patterns.} \item{file}{A file name.} \item{format}{File format of the sequence alignment (see details).} \item{n}{Number of sequences.} \item{names}{Names of sequences.} \item{subset}{a subset of taxa.} \item{select}{a subset of characters.} \item{site.pattern}{select site pattern or sites.} \item{allLevels}{return original data.} \item{obj}{as object of class phyDat} \item{freq}{logical, if 'TRUE', frequencies or counts are returned otherwise proportions} \item{drop.unused.levels}{logical, drop unused levels} \item{...}{further arguments passed to or from other methods.} } \details{ If \code{type} "USER" a vector has to be give to \code{levels}. For example c("a", "c", "g", "t", "-") would create a data object that can be used in phylogenetic analysis with gaps as fifth state. There is a more detailed example for specifying "USER" defined data formats in the vignette "phangorn-specials". \code{allSitePattern} returns all possible site patterns and can be useful in simulation studies. For further details see the vignette phangorn-specials. \code{write.phyDat} calls the function write.dna or write.nexus.data and \code{read.phyDat} calls the function \code{read.dna}, \code{read.aa} or \code{read.nexus.data} see for more details over there. You may import data directly with \code{\link[ape]{read.dna}} or \code{\link[ape]{read.nexus.data}} and convert the data to class phyDat. The generic function \code{c} can be used to to combine sequences and \code{unique} to get all unique sequences or unique haplotypes. \code{acgt2ry} converts a \code{phyDat} object of nucleotides into an binary ry-coded dataset. } \value{ The functions return an object of class \code{phyDat}. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link{DNAbin}}, \code{\link{as.DNAbin}}, \code{\link{read.dna}}, \code{\link{read.aa}}, \code{\link{read.nexus.data}} and the chapter 1 in the \code{vignette("phangorn-specials", package="phangorn")} and the example of \code{\link{pmlMix}} for the use of \code{allSitePattern} } \examples{ data(Laurasiatherian) class(Laurasiatherian) Laurasiatherian baseFreq(Laurasiatherian) subset(Laurasiatherian, subset=1:5) # transform into old ape format LauraChar <- as.character(Laurasiatherian) # and back Laura <- phyDat(LauraChar, return.index=TRUE) all.equal(Laurasiatherian, Laura) allSitePattern(5) } \keyword{cluster} phangorn/man/bab.Rd0000644000175100001440000000431612507002037013672 0ustar hornikusers\name{bab} \alias{bab} \alias{BranchAndBound} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Branch and bound for finding all most parsimonious trees } \description{ \code{bab} finds all most parsimonious trees. } \usage{ bab(data, tree = NULL, trace = 1, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{data}{ an object of class phyDat. } \item{tree}{ a phylogenetic tree an object of class phylo, otherwise a pratchet search is performed. } \item{trace}{ defines how much information is printed during optimisation. } \item{\dots}{ Further arguments passed to or from other methods } } \details{ This implementation is very slow and depending on the data may take very long time. In the worst case all (2n-5)!! possible trees have to be examined. For 10 species there are already 2027025 tip-labelled unrooted trees. It only uses some basic strategies to find a lower and upper bounds similar to penny from phylip. It uses a very basic heuristic approach of MinMax Squeeze (Holland et al. 2005) to improve the lower bound. On the positive side \code{bab} is not like many other implementations restricted to binary or nucleotide data. } \value{ \code{bab} returns all most parsimonious trees in an object of class \code{multiPhylo}. } \references{ Hendy, M.D. and Penny D. (1982) Branch and bound algorithms to determine minimal evolutionary trees. \emph{Math. Biosc.} \bold{59}, 277-290 Holland, B.R., Huber, K.T. Penny, D. and Moulton, V. (2005) The MinMax Squeeze: Guaranteeing a Minimal Tree for Population Data, \emph{Molecular Biology and Evolution}, \bold{22}, 235--242 White, W.T. and Holland, B.R. (2011) Faster exact maximum parsimony search with XMP. \emph{Bioinformatics}, \bold{27(10)},1359--1367 } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} based on work on Liam Revell } \seealso{ \code{\link{pratchet}}, \code{\link{dfactorial}} } \examples{ data(yeast) dfactorial(11) # choose only the first two genes gene12 <- subset(yeast, , 1:3158, site.pattern=FALSE) trees <- bab(gene12) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ cluster } \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line phangorn/man/designTree.Rd0000644000175100001440000000405112507002037015233 0ustar hornikusers\name{designTree} \alias{designTree} \alias{designSplits} \alias{nnls.tree} \alias{nnls.phylo} \alias{nnls.splits} \alias{nnls.networx} %- Also NEED an '\alias' for EACH other topic documented here. \title{Compute a design matrix or non-negative LS } \description{ \code{nnls.tree} estimates the branch length using non-negative least squares given a tree and a distance matrix. \code{designTree} and \code{designSplits} compute design matrices for the estimation of edge length of (phylogenetic) trees using linear models. For larger trees a sparse design matrix can save a lot of memory. %\code{designTree} also computes a contrast matrix if the method is "rooted". } \usage{ designTree(tree, method = "unrooted", sparse=FALSE, ...) designSplits(x, splits = "all", ...) nnls.tree(dm, tree, rooted=FALSE, trace=1) nnls.phylo(x, dm, rooted=FALSE, trace=0) nnls.splits(x, dm, trace = 0) nnls.networx(x, dm) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{tree}{an object of class \code{phylo} } \item{method}{design matrix for an "unrooted" or "rooted" ultrametric tree.} \item{sparse}{return a sparse design matrix.} \item{x}{number of taxa. } \item{splits}{one of "all", "star".} \item{dm}{a distance matrix.} \item{rooted}{compute a "rooted" or "unrooted" tree.} \item{trace}{defines how much information is printed during optimisation.} \item{\dots}{further arguments, passed to other methods.} } \value{ \code{nnls.tree} return a tree, i.e. an object of class \code{phylo}. \code{designTree} and \code{designSplits} a matrix, possibly sparse. } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} } \seealso{ \code{\link[ape]{fastme}}, \code{\link[phangorn]{distanceHadamard}}, \code{\link[phangorn]{splitsNetwork}}, \code{\link[phangorn]{upgma}} } \examples{ example(NJ) dm <- as.matrix(dm) y <- dm[lower.tri(dm)] X <- designTree(tree) lm(y~X-1) # avoids negative edge weights tree2 = nnls.tree(dm, tree) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ cluster } phangorn/man/densiTree.Rd0000644000175100001440000000453512531405224015075 0ustar hornikusers\name{densiTree} \alias{densiTree} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Plots a densiTree. } \description{ An R function to plot trees similar to those produced by DensiTree. } \usage{ densiTree(x, type = "cladogram", alpha = 1/length(x), consensus = NULL, optim = FALSE, scaleX = FALSE, col = 1, width = 1, cex = 0.8, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an object of class \code{multiPhylo}. } \item{type}{ a character string specifying the type of phylogeny, so far "cladogram" (default) or "phylogram" (the default) are supported. } \item{alpha}{ parameter for semi-transparent colors. } \item{consensus}{ A tree which is used to define the order of the tip labels. } \item{optim}{ not yet used. } \item{scaleX}{ scale trees to have identical heights. } \item{col}{ edge color. } \item{width}{ edge width. } \item{cex}{ a numeric value giving the factor scaling of the tip labels. } \item{\dots}{ further arguments to be passed to plot. } } \details{ If no consensus tree is provided \code{densiTree} computes a rooted mrp.supertree as a backbone. This should avoid too many unnecessary crossings of edges. Trees should be rooted, other wise the output may not make sense. } \references{ densiTree is inspired from the great \href{www.cs.auckland.ac.nz/~remco/DensiTree}{DensiTree} program of Remco Bouckaert. Remco R. Bouckaert (2010) DensiTree: making sense of sets of phylogenetic trees \emph{Bioinformatics}, \bold{26 (10)}, 1372-1373. } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{plot.phylo}}, \code{\link{plot.networx}} } \examples{ data(Laurasiatherian) set.seed(1) bs <- bootstrap.phyDat(Laurasiatherian, FUN = function(x)upgma(dist.hamming(x)), bs=25) # cladogram nice to show topological differences densiTree(bs, optim=TRUE, type="cladogram", col="blue") densiTree(bs, optim=TRUE, type="phylogram", col="green") \dontrun{ # phylogram are nice to show different age estimates require(PhyloOrchard) data(BinindaEmondsEtAl2007) BinindaEmondsEtAl2007 <- .compressTipLabel(BinindaEmondsEtAl2007) densiTree(BinindaEmondsEtAl2007, type="phylogram", col="red") } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{plot} phangorn/man/plot.networx.Rd0000644000175100001440000000701312532161166015635 0ustar hornikusers\name{plot.networx} \alias{plot.networx} \alias{as.networx} \alias{as.networx.splits} %\alias{reorder.networx} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Phylogenetic networks } \description{ \code{as.networx} convert \code{splits} objects into a \code{networx} object. \code{plot.networx} plot phylogenetic network or split graphs. } \usage{ as.networx(x, ...) \method{as.networx}{splits}(x, planar = FALSE, ...) \method{plot}{networx}(x, type="3D", use.edge.length = TRUE, show.tip.label=TRUE, show.edge.label=FALSE, edge.label = NULL, show.node.label=FALSE, node.label = NULL, show.nodes=FALSE, tip.color="blue", edge.color="grey", edge.width=3, edge.lty=1, font=3, cex=1, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an object of class \code{"splits"} (as.networx) or \code{"networx"} (plot) } \item{planar}{ logical whether to produce a planar graph from only cyclic splits (may excludes splits). } \item{type}{ "3D" to plot using rgl or "2D" in the normal device. } \item{use.edge.length}{ a logical indicating whether to use the edge weights of the network to draw the branches (the default) or not. } \item{show.tip.label}{ a logical indicating whether to show the tip labels on the graph (defaults to \code{TRUE}, i.e. the labels are shown). } \item{show.edge.label}{ a logical indicating whether to show the tip labels on the graph. } \item{edge.label}{ an additional vector of edge labels (normally not needed). } \item{show.node.label}{ a logical indicating whether to show the node labels (see example). } \item{node.label}{ an additional vector of node labels (normally not needed). } \item{show.nodes}{ a logical indicating whether to show the nodes (see example). } \item{tip.color}{ the colors used for the tip labels. } \item{edge.color}{ the colors used to draw edges. } \item{edge.width}{ the width used to draw edges. } \item{edge.lty}{ a vector of line types. } \item{font}{ an integer specifying the type of font for the labels: 1 (plain text), 2 (bold), 3 (italic, the default), or 4 (bold italic). } \item{cex}{ a numeric value giving the factor scaling of the labels.} \item{\dots}{ Further arguments passed to or from other methods. } } \details{ A \code{networx} object hold the information for a phylogenetic network and extends the \code{phylo} object. Therefore some generic function for \code{phylo} objects will also work for \code{networx} objects. The argument planar = FALSE will create a planar split graph based on a cyclic ordering. These objects can be nicely plotted in "2D". So far not all parameters behave the same on the the rgl "3D" and basic graphic "2D" device. } \note{ The internal representation is likely to change. } \references{ Dress, A.W.M. and Huson, D.H. (2004) Constructing Splits Graphs \emph{IEEE/ACM Transactions on Computational Biology and Bioinformatics (TCBB)}, \bold{1(3)}, 109--115 } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} } \seealso{ \code{\link{consensusNet}}, \code{\link{neighborNet}}, \code{\link{splitsNetwork}}, \code{\link{hadamard}}, \code{\link{distanceHadamard}}, \code{\link{layout.kamada.kawai}}, \code{\link[ape]{evonet}}, \code{\link[ape]{as.igraph}}, \code{\link{densiTree}} } \examples{ set.seed(1) tree1 = rtree(20, rooted=FALSE) sp = as.splits(rNNI(tree1, n=10)) net = as.networx(sp) plot(net, "2D") \dontrun{ # also see example in consensusNet example(consensusNet) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{plot} phangorn/man/nni.Rd0000644000175100001440000000235312507002037013731 0ustar hornikusers\name{nni} \alias{nni} \alias{rNNI} \alias{rSPR} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Tree rearrangements.} \description{ \code{nni} returns a list of all trees which are one nearest neighbor interchange away. \code{rNNI} and \code{rSPR} are two methods which simulate random trees which are a specified number of rearrangement apart from the input tree. Both methods assume that the input tree is bifurcating. These methods may be useful in simulation studies. } \usage{ nni(tree) rSPR(tree, moves=1, n=length(moves), k=NULL) rNNI(tree, moves=1, n=length(moves)) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{tree}{A phylogenetic \code{tree}, object of class \code{phylo}.} \item{moves}{Number of tree rearrangements to be transformed on a tree. Can be a vector} \item{n}{Number of trees to be simulated.} \item{k}{If defined just SPR of distance k are performed.} } \value{ an object of class multiPhylo. } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} } % \seealso{ } \examples{ tree = unroot(rtree(20)) trees1 <- nni(tree) trees2 <- rSPR(tree, 2, 10) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ cluster } phangorn/man/hadamard.Rd0000644000175100001440000000502312507002037014703 0ustar hornikusers\name{hadamard} \alias{hadamard} \alias{fhm} \alias{h4st} \alias{h2st} \title{Hadamard Matrices and Fast Hadamard Multiplication} \description{ A collection of functions to perform Hadamard conjugation. %Hv of a Hadamard matrix H with a vector v using fast Hadamard multiplication. } \usage{ hadamard(x) fhm(v) h2st(obj, eps=0.001) h4st(obj, levels = c("a","c","g","t")) } \arguments{ \item{x}{ a vector of length \eqn{2^n}, where n is an integer. } \item{v}{ a vector of length \eqn{2^n}, where n is an integer. } \item{obj}{ a data.frame or character matrix, typical a sequence alignment.} \item{eps}{Threshold value for splits.} \item{levels}{ levels of the sequences.} } \details{ \code{h2st} and \code{h4st} perform Hadamard conjugation for 2-state (binary, RY-coded) or 4-state (DNA/RNA) data. \code{write.nexus.splits} writes splits returned from \code{h2st} or \code{\link[phangorn]{distanceHadamard}} to a nexus file, which can be processed by Spectronet or Splitstree. } \value{ \code{hadamard} returns a Hadamard matrix. \code{fhm} returns the fast Hadamard multiplication. } \references{Hendy, M.D. (1989). The relationship between simple evolutionary tree models and observable sequence data. \emph{Systematic Zoology}, \bold{38} 310--321. Hendy, M. D. and Penny, D. (1993). Spectral Analysis of Phylogenetic Data. \emph{Journal of Classification}, \bold{10}, 5--24. Hendy, M. D. (2005). Hadamard conjugation: an analytical tool for phylogenetics. In O. Gascuel, editor, \emph{Mathematics of evolution and phylogeny}, Oxford University Press, Oxford Waddell P. J. (1995). Statistical methods of phylogenetic analysis: Including hadamard conjugation, LogDet transforms, and maximum likelihood. \emph{PhD thesis}. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{\code{\link{distanceHadamard}}, \code{\link{lento}}, \code{\link{plot.networx}}} \examples{ H = hadamard(3) v = 1:8 H%*%v fhm(v) data(yeast) dat = as.character(yeast) # RY-coding dat2 = dat dat2[dat=="a" | dat=="g"] = "r" dat2[dat=="c" | dat=="t"] = "y" dat2 = phyDat(dat2, type="USER", levels=c("r","y"), ambiguity=NULL) fit2 = h2st(dat2) lento(fit2) # write.nexus.splits(fit2, file = "test.nxs") # read this file into Spectronet or Splitstree to show the network \dontrun{ dat4 = phyDat(dat, type="USER", levels=c("a","c", "g", "t"), ambiguity=NULL) fit4 = h4st(dat4) par(mfrow=c(3,1)) lento(fit4[[1]], main="Transversion") lento(fit4[[2]], main="Transition 1") lento(fit4[[3]], main="Transition 2") } } \keyword{ cluster }% at least one, from doc/KEYWORDS phangorn/man/dist.hamming.Rd0000644000175100001440000000405612535355315015544 0ustar hornikusers\name{dist.hamming} \alias{dist.hamming} \alias{dist.logDet} \alias{dist.ml} \alias{readDist} \alias{writeDist} %- Also NEED an '\alias' for EACH other topic documented here. \title{Pairwise Distances from Sequences} \description{ \code{dist.hamming} and \code{dist.logDet} compute pairwise distances for an object of class \code{phyDat}. \code{dist.ml} fits distances for nucleotide and amino acid models. } \usage{ dist.hamming(x, ratio = TRUE, exclude="none") dist.logDet(x) dist.ml(x, model="JC69", exclude="none", bf=NULL, Q=NULL, ...) readDist(file) writeDist(dm, file="") } \arguments{ \item{x}{An object of class \code{phyDat}} \item{ratio}{Compute uncorrected ('p') distance or character difference.} \item{model}{One of "JC69" or one of 17 amino acid models see details.} \item{exclude}{One of "none", "all", "pairwise" indicating whether to delete the sites with missing data (or ambigious states). The default is handle missing data as in pml.} \item{bf}{A vector of base frequencies.} \item{Q}{A vector containing the lower triangular part of the rate matrix.} \item{\dots}{Further arguments passed to or from other methods.} \item{file}{A file name.} \item{dm}{A \code{dist} object.} } \value{ an object of class \code{dist} } \details{ So far 17 amino acid models are supported ("WAG", "JTT", "LG", "Dayhoff", "cpREV", "mtmam", "mtArt", "MtZoa", "mtREV24", "VT","RtREV", "HIVw", "HIVb", "FLU", "Blossum62", "Dayhoff_DCMut" and "JTT_DCMut") and additional rate matrices and frequences can be supplied. } \references{ Lockhart, P. J., Steel, M. A., Hendy, M. D. and Penny, D. (1994) Recovering evolutionary trees under a more realistic model of sequence evolution. \emph{Molecular Biology and Evolution}, \bold{11}, 605--602. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{For more distance methods for nucleotide data see \code{\link[ape]{dist.dna}}} \examples{ data(Laurasiatherian) dm1 <- dist.hamming(Laurasiatherian) tree1 <- NJ(dm1) dm2 <- dist.logDet(Laurasiatherian) tree2 <- NJ(dm2) treedist(tree1,tree2) } \keyword{ cluster } phangorn/man/allTrees.Rd0000644000175100001440000000157212507002037014722 0ustar hornikusers\name{allTrees} \alias{allTrees} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Compute all trees topologies.} \description{ \code{allTrees} computes all tree topologies for rooted or unrooted trees with up to 10 tips. \code{allTrees} returns bifurcating trees. } \usage{ allTrees(n, rooted = FALSE, tip.label = NULL) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{n}{Number of tips (<=10).} \item{rooted}{Rooted or unrooted trees (default: rooted). } \item{tip.label}{Tip labels.} } \value{ an object of class multiPhylo. } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} } % \seealso{} \examples{ trees <- allTrees(5) par(mfrow = c(3,5)) for(i in 1:15)plot(trees[[i]]) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ cluster } phangorn/man/parsimony.Rd0000644000175100001440000000673712542610772015212 0ustar hornikusers\name{parsimony} \alias{parsimony} \alias{optim.parsimony} \alias{sankoff} \alias{fitch} \alias{PNJ} \title{Parsimony tree.} \alias{CI} \alias{RI} \alias{pratchet} \alias{random.addition} \alias{acctran} \description{ \code{parsimony} returns the parsimony score of a tree using either the sankoff or the fitch algorithm. \code{optim.parsimony} tries to find the maximum parsimony tree using either Nearest Neighbor Interchange (NNI) rearrangements or sub tree pruning and regrafting (SPR). \code{pratchet} implements the parsimony ratchet (Nixon, 1999) and is the prefered way to search for the best tree. \code{random.addition} can be used to produce starting trees. \code{CI} and \code{RI} computes the consistency and retention index. } \usage{ parsimony(tree, data, method="fitch", ...) optim.parsimony(tree, data, method="fitch", cost=NULL, trace=1, rearrangements="SPR", ...) pratchet(data, start=NULL, method="fitch", maxit=1000, k=10, trace=1, all=FALSE, rearrangements="SPR", ...) fitch(tree, data, site = "pscore") sankoff(tree, data, cost = NULL, site = "pscore") random.addition(data, method="fitch") CI(tree, data, cost = NULL) RI(tree, data, cost = NULL) acctran(tree, data) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{data}{A object of class phyDat containing sequences.} \item{tree}{ tree to start the nni search from.} \item{method}{one of 'fitch' or 'sankoff'.} \item{cost}{A cost matrix for the transitions between two states.} \item{site}{return either 'pscore' or 'site' wise parsimony scores.} \item{trace}{defines how much information is printed during optimisation.} \item{rearrangements}{SPR or NNI rearrangements.} \item{start}{a starting tree can be supplied.} \item{maxit}{maximum number of iterations in the ratchet.} \item{k}{number of rounds ratchet is stopped, when there is no improvement.} \item{all}{return all equally good trees or just one of them.} \item{...}{Further arguments passed to or from other methods (e.g. model="sankoff" and cost matrix).} } \value{ \code{parsimony} returns the maximum parsimony score (pscore). \code{optim.parsimony} returns a tree after NNI rearrangements. \code{pratchet} returns a tree or list of trees containing the best tree(s) found during the search. \code{acctran} returns a tree with edge length according to the ACCTRAN criterion. } \details{ The "SPR" rearrangements are so far only available for the "fitch" method, "sankoff" only uses "NNI". The "fitch" algorithm only works correct for binary trees. } \references{ Felsenstein, J. (2004). \emph{Inferring Phylogenies}. Sinauer Associates, Sunderland. Nixon, K. (1999) The Parsimony Ratchet, a New Method for Rapid Parsimony Analysis. \emph{Cladistics} \bold{15}, 407-414 } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{\code{\link{bab}}, \code{\link{ancestral.pml}}, \code{\link{nni}}, \code{\link{NJ}}, \code{\link{pml}}, \code{\link{getClans}} ,\code{\link{ancestral.pars}}, \code{\link{bootstrap.pml}}} \examples{ set.seed(3) data(Laurasiatherian) dm = dist.hamming(Laurasiatherian) tree = NJ(dm) parsimony(tree, Laurasiatherian) treeRA <- random.addition(Laurasiatherian) treeNNI <- optim.parsimony(tree, Laurasiatherian) treeRatchet <- pratchet(Laurasiatherian, start=tree, maxit=100, k=5) # assign edge length treeRatchet <- acctran(treeRatchet, Laurasiatherian) plot(midpoint(treeRatchet)) add.scale.bar(0,0, length=100) parsimony(c(tree,treeNNI, treeRatchet), Laurasiatherian) } \keyword{cluster} phangorn/man/distanceHadamard.Rd0000644000175100001440000000172212511032376016364 0ustar hornikusers\name{distanceHadamard} \alias{distanceHadamard} \title{Distance Hadamard} \description{ Distance Hadamard produces spectra of splits from a distance matrix. } \usage{ distanceHadamard(dm, eps=0.001) } \arguments{ \item{dm}{A distance matrix.} \item{eps}{Threshold value for splits.} } \value{ \code{distanceHadamard} returns a matrix. The first column contains the distance spectra, the second one the edge-spectra. If eps is positive an object of with all splits greater eps is returned. } \references{Hendy, M. D. and Penny, D. (1993). Spectral Analysis of Phylogenetic Data. \emph{Journal of Classification}, \bold{10}, 5-24. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}, Tim White} \seealso{\code{\link{hadamard}}, \code{\link{lento}}, \code{\link{plot.networx}}} \examples{ data(yeast) dm = dist.hamming(yeast) dm = as.matrix(dm) fit = distanceHadamard(dm) lento(fit) plot(as.networx(fit), "2D") } \keyword{ cluster }% at least one, from doc/KEYWORDS phangorn/man/consensusNet.Rd0000644000175100001440000000347612507002037015643 0ustar hornikusers\name{consensusNet} \alias{consensusNet} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Computes a consensusNetwork from a list of trees Computes a \code{networx} object from a collection of splits. } \description{ Computes a consensusNetwork, i.e. an object of class \code{networx} from a list of trees, i.e. an class of class \code{multiPhylo}. Computes a \code{networx} object from a collection of splits. } \usage{ consensusNet(obj, prob=.3, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{obj}{An object of class multiPhylo.} \item{prob}{the proportion a split has to be present in all trees to be represented in the network.} \item{\dots}{Further arguments passed to or from other methods.} } \value{ \code{consensusNet} returns an object of class networx. This is just an intermediate to plot phylogenetic networks with igraph. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} %% ~Make other sections like Warning with \section{Warning }{....} ~ \references{ Holland B.R., Huber K.T., Moulton V., Lockhart P.J. (2004) Using consensus networks to visualize contradictory evidence for species phylogeny. \emph{Molecular Biology and Evolution}, \bold{21}, 1459--61 } \seealso{ \code{\link{splitsNetwork}}, \code{\link{neighborNet}}, \code{\link{lento}}, \code{\link{distanceHadamard}}, \code{\link{plot.networx}} } \examples{ data(Laurasiatherian) set.seed(1) bs <- bootstrap.phyDat(Laurasiatherian, FUN = function(x)nj(dist.hamming(x)), bs=50) class(bs) <- 'multiPhylo' cnet = consensusNet(bs, .3) plot(cnet, "2D") \dontrun{ library(rgl) open3d() plot(cnet, show.tip.label=FALSE, show.nodes=TRUE) plot(cnet, type = "2D", show.edge.label=TRUE) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ hplot } phangorn/man/superTree.Rd0000644000175100001440000000442312507002037015123 0ustar hornikusers\name{superTree} \alias{superTree} \alias{coalSpeciesTree} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Super Tree and Species Tree methods } \description{ These function \code{superTree} allows the estimation of a rooted supertree from a set of rooted trees using Matrix representation parsimony. \code{coalSpeciesTree} estimates species trees and can multiple individuals per species.} \usage{ superTree(tree, method = "optim.parsimony", rooted=TRUE, ...) coalSpeciesTree(tree, X, sTree = NULL) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{tree}{ an object of class \code{multiPhylo} } \item{method}{ An argument defining which algorithm is used to optimize the tree. } \item{rooted}{ should the resulting supertrees be rooted. } \item{X}{ A \code{phyDat} object to define which individual belongs to which species. } \item{sTree}{ A species tree which forces the topology. } \item{\dots}{ further arguments passed to or from other methods. } } \details{ The function \code{superTree} extends the function mrp.supertree from Liam Revells, with artificial adding an outgroup on the root of the trees. This allows to root the supertree afterwards. The functions is internally used in DensiTree. \code{coalSpeciesTree} estimates a single linkage tree as suggested by Liu et al. (2010) from the element wise minima of the cophenetic matrices of the gene trees. It extends \code{speciesTree} in ape as it allows that have several individuals per gene tree. } \value{ The function returns an object of class \code{phylo}. } \references{ Liu, L., Yu, L. and Pearl, D. K. (2010) Maximum tree: a consistent estimator of the species tree. \emph{Journal of Mathematical Biology}, \bold{60}, 95--106. } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} Liam Revell Emmanuel Paradies } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{mrp.supertree}, \code{\link{speciesTree}}, \code{\link{densiTree}}, \code{\link{hclust}} } \examples{ data(Laurasiatherian) set.seed(1) bs <- bootstrap.phyDat(Laurasiatherian, FUN = function(x)upgma(dist.hamming(x)), bs=50) class(bs) <- 'multiPhylo' plot(superTree(bs)) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{cluster} phangorn/man/upgma.Rd0000644000175100001440000000172212507002037014255 0ustar hornikusers\name{upgma} \alias{upgma} \alias{wpgma} \title{ UPGMA and WPGMA } \description{ UPGMA and WPGMA clustering. Just a wrapper function around \code{\link[stats]{hclust}}. } \usage{ upgma(D, method = "average", ...) wpgma(D, method = "mcquitty", ...) } \arguments{ \item{D}{A distance matrix.} \item{method}{The agglomeration method to be used. This should be (an unambiguous abbreviation of) one of "ward", "single", "complete", "average", "mcquitty", "median" or "centroid". The default is "average".} \item{\dots}{Further arguments passed to or from other methods.} } \value{ A phylogenetic tree of class \code{phylo}. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link{hclust}}, \code{\link{dist.hamming}}, \code{\link{NJ}}, \code{\link{as.phylo}}, \code{\link{fastme}}, \code{\link{nnls.tree}} } \examples{ data(Laurasiatherian) dm = dist.ml(Laurasiatherian) tree = upgma(dm) plot(tree) } \keyword{cluster} phangorn/man/SH.test.Rd0000644000175100001440000000247412507002037014441 0ustar hornikusers\name{SH.test} \alias{SH.test} \title{Shimodaira-Hasegawa Test} \usage{ SH.test(..., B = 10000, data=NULL) } \arguments{ \item{...}{either a series of objects of class \code{"pml"} separated by commas, a list containing such objects or an object of class \code{"pmlPart"}.} \item{B}{the number of bootstrap replicates.} \item{data}{an object of class \code{"phyDat"}.} } \description{ This function computes the Shimodaira--Hasegawa test for a set of trees. } \value{ a numeric vector with the P-value associated with each tree given in \code{...}. } \references{ Shimodaira, H. and Hasegawa, M. (1999) Multiple comparisons of log-likelihoods with applications to phylogenetic inference. \emph{Molecular Biology and Evolution}, \bold{16}, 1114--1116. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link{pml}}, \code{\link{pmlPart}}, \code{\link{pmlCluster}}, \code{\link{SOWH.test}} } \examples{ data(Laurasiatherian) dm <- dist.logDet(Laurasiatherian) tree1 <- NJ(dm) tree2 <- unroot(upgma(dm)) fit1 <- pml(tree1, Laurasiatherian) fit2 <- pml(tree2, Laurasiatherian) fit1 <- optim.pml(fit1) # optimize edge weights fit2 <- optim.pml(fit2) SH.test(fit1, fit2, B=500) # in real analysis use larger B, e.g. 10000 \dontrun{ example(pmlPart) SH.test(sp, B=1000) } } \keyword{models} phangorn/man/lento.Rd0000644000175100001440000000273412507002037014271 0ustar hornikusers\name{lento} \alias{lento} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Lento plot } \description{ The lento plot represents support and conflict of splits/bipartitions. } \usage{ lento(obj, xlim = NULL, ylim = NULL, main = "Lento plot", sub = NULL, xlab = NULL, ylab = NULL, bipart=TRUE, trivial=FALSE,...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{obj}{an object of class phylo, multiPhylo or splits} \item{xlim}{graphical parameter} \item{ylim}{graphical parameter} \item{main}{graphical parameter} \item{sub}{graphical parameter} \item{xlab}{graphical parameter} \item{ylab}{graphical parameter} \item{bipart}{plot bipartition information.} \item{trivial}{logical, whether to present trivial splits (default is FALSE).} \item{\dots}{Further arguments passed to or from other methods.} } \value{ lento returns a plot. } \references{ Lento, G.M., Hickson, R.E., Chambers G.K., and Penny, D. (1995) Use of spectral analysis to test hypotheses on the origin of pinninpeds. \emph{Molecular Biology and Evolution}, \bold{12}, 28-52. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link{as.splits}, \link{hadamard}} } \examples{ data(yeast) yeast.ry = acgt2ry(yeast) splits.h = h2st(yeast.ry) lento(splits.h, trivial=TRUE) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ cluster } \keyword{ plot }% __ONLY ONE__ keyword per line phangorn/man/pmlMix.Rd0000644000175100001440000000604112507002037014411 0ustar hornikusers\name{pmlMix} \alias{pmlMix} \alias{pmlPen} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Phylogenetic mixture model } \description{ Phylogenetic mixture model. } \usage{ pmlMix(formula, fit, m=2, omega=rep(1/m, m), control=pml.control(epsilon=1e-08, maxit=20, trace=1),...) } \arguments{ \item{formula}{ a formula object (see details).} \item{fit}{ an object of class \code{pml}. } \item{m}{ number of mixtures. } \item{omega}{ mixing weights.} \item{control}{A list of parameters for controlling the fitting process.} \item{\dots}{ Further arguments passed to or from other methods. } } \details{ The \code{formula} object allows to specify which parameter get optimized. The formula is generally of the form \code{edge + bf + Q ~ rate + shape + \dots}, on the left side are the parameters which get optimized over all mixtures, on the right the parameter which are optimized specific to each mixture. The parameters available are \code{"nni", "bf", "Q", "inv", "shape", "edge", "rate"}. Each parameters can be used only once in the formula. \code{"rate"} and \code{"nni"} are only available for the right side of the formula. On the other hand parameters for invariable sites are only allowed on the left-hand side. The convergence of the algorithm is very slow and is likely that the algorithm can get stuck in local optima. } \value{ \code{pmlMix} returns a list with elements \item{logLik}{log-likelihood of the fit} \item{omega}{mixing weights.} \item{fits}{fits for the final mixtures.} } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link{pml}},\code{\link{pmlPart}},\code{\link{pmlCluster}} } \examples{ \dontrun{ X <- allSitePattern(5) tree <- read.tree(text = "((t1:0.3,t2:0.3):0.1,(t3:0.3,t4:0.3):0.1,t5:0.5);") fit <- pml(tree,X, k=4) weights <- 1000*exp(fit$site) attr(X, "weight") <- weights fit1 <- update(fit, data=X, k=1) fit2 <- update(fit, data=X) (fitMixture <- pmlMix(edge~rate, fit1 , m=4)) (fit2 <- optim.pml(fit2, optGamma=TRUE)) data(Laurasiatherian) dm <- dist.logDet(Laurasiatherian) tree <- NJ(dm) fit=pml(tree, Laurasiatherian) fit = optim.pml(fit) fit2 <- update(fit, k=4) fit2 <- optim.pml(fit2, optGamma=TRUE) fitMix = pmlMix(edge ~ rate, fit, m=4) fitMix # # simulation of mixture models # \dontrun{ X <- allSitePattern(5) tree1 <- read.tree(text = "((t1:0.1,t2:0.5):0.1,(t3:0.1,t4:0.5):0.1,t5:0.5);") tree2 <- read.tree(text = "((t1:0.5,t2:0.1):0.1,(t3:0.5,t4:0.1):0.1,t5:0.5);") tree1 <- unroot(tree1) tree2 <- unroot(tree2) fit1 <- pml(tree1,X) fit2 <- pml(tree2,X) weights <- 2000*exp(fit1$site) + 1000*exp(fit2$site) attr(X, "weight") <- weights fit1 <- pml(tree1, X) fit2 <- optim.pml(fit1) logLik(fit2) AIC(fit2, k=log(3000)) fitMixEdge = pmlMix( ~ edge, fit1, m=2) logLik(fitMixEdge) AIC(fitMixEdge, k=log(3000)) fit.p <- pmlPen(fitMixEdge, .25) logLik(fit.p) AIC(fit.p, k=log(3000)) } } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ cluster } phangorn/man/ancestral.pml.Rd0000644000175100001440000000530612507002037015711 0ustar hornikusers\name{ancestral.pml} \alias{ancestral.pml} \alias{ancestral.pars} \alias{pace} \alias{plotAnc} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Ancestral character reconstruction. } \description{ Marginal reconstruction of the ancestral character states. } \usage{ ancestral.pml(object, type = c("ml", "bayes")) ancestral.pars(tree, data, type = c("MPR", "ACCTRAN"), cost = NULL) pace(tree, data, type = c("MPR", "ACCTRAN"), cost = NULL) plotAnc(tree, data, i, col=NULL, cex.pie=par("cex"), pos="bottomright", ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{an object of class pml} % \item{type}{either "ml" or "bayes"} \item{tree}{a tree, i.e. an object of class pml} \item{data}{an object of class phyDat} \item{type}{method used to assign characters to internal nodes, see details.} \item{i}{plots the i-th character of the \code{data}.} \item{col}{a vector containing the colors for all possible states.} \item{cex.pie}{a numeric defining the size of the pie graphs} \item{pos}{a character string defining the positiond of the legend} \item{cost}{A cost matrix for the transitions between two states.} \item{\dots}{Further arguments passed to or from other methods.} } % \item{eps}{a small value to prevent rounding errors} \details{ The argument "type" defines the criterion to assign the internal nodes. For \code{ancestral.pml} so far "ml" and (empirical) "bayes" and for \code{ancestral.pars} "MPR" and "ACCTRAN" are possible. With parsimony reconstruction one has to keep in mind that there will be often no unique solution. For further details see vignette("Ancestral"). } \value{ %A matrix containing the the estimates character states. An object of class "phyDat", containing the ancestral states of all nodes. } \references{ Felsenstein, J. (2004). \emph{Inferring Phylogenies}. Sinauer Associates, Sunderland. Swofford, D.L., Maddison, W.P. (1987) Reconstructing ancestral character states under Wagner parsimony. \emph{Math. Biosci.} \bold{87}: 199--229 Yang, Z. (2006). \emph{Computational Molecular evolution}. Oxford University Press, Oxford. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{pml}, \code{parsimony}, \code{ace}, \code{root} } \examples{ example(NJ) fit = pml(tree, Laurasiatherian) anc.ml = ancestral.pml(fit, type = "ml") anc.p = ancestral.pars(tree, Laurasiatherian) \dontrun{ require(seqLogo) seqLogo( t(subset(anc.ml, 48, 1:20)[[1]]), ic.scale=FALSE) seqLogo( t(subset(anc.p, 48, 1:20)[[1]]), ic.scale=FALSE) } plotAnc(tree, anc.ml, 1) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ ~kwd1 } \keyword{ ~kwd2 }% __ONLY ONE__ keyword per line phangorn/man/dfactorial.Rd0000644000175100001440000000125012507002037015250 0ustar hornikusers\name{dfactorial} \alias{dfactorial} \alias{ldfactorial} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Arithmetic Operators } \description{ double factorial function } \usage{ dfactorial(x) ldfactorial(x) } \arguments{ \item{x}{ a numeric scalar or vector } } \value{ \code{dfactorial(x)} returns the double factorial, that is \eqn{x\!\! = 1 * 3 * 5 * \ldots * x } and \code{ldfactorial(x)} is the natural logarithm of it. } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} } \seealso{ \code{\link[base:Special]{factorial}} } \examples{ dfactorial(1:10) } \keyword{ classif }% at least one, from doc/KEYWORDS phangorn/man/treedist.Rd0000644000175100001440000000363312515734377015014 0ustar hornikusers\name{treedist} \alias{treedist} \alias{RF.dist} %\alias{print.treedist} \title{ Distances between trees } \description{ \code{treedist} computes different tree distance methods and \code{RF.dist} the Robinson-Foulds or symmetric distance. } \usage{ treedist(tree1, tree2, check.labels = TRUE) RF.dist(tree1, tree2=NULL, check.labels=TRUE, rooted=FALSE) } \arguments{ \item{tree1}{ A phylogenetic tree (class \code{phylo}) or vector of trees (an object of class \code{multiPhylo}). See details } \item{tree2}{ A phylogenetic tree. } \item{check.labels}{compares labels of the trees.} \item{rooted}{take bipartitions for rooted trees into account, default is unrooting the trees.} } \value{ \code{treedist} returns a vector containing the following tree distance methods \item{symmetric.difference}{symmetric.difference or Robinson-Foulds distance} \item{branch.score.difference}{branch.score.difference} \item{path.difference}{path.difference} \item{weighted.path.difference}{weighted.path.difference} } \details{ The Robinson-Foulds distance is well defined only for bifurcating trees. RF.dist returns the Robinson-Foulds distance between either 2 trees or computes a matrix of all pairwise distances if a \code{multiPhylo} object is given. For large number of trees RF.dist can use a lot of memory! % The function used internally is 2 * (nt - m) where nt is the number of tips and % m is the number of shared bipartitions. When there are multifurcations the % distance is therefore increasing!! This may be different to other implementations! } \references{Steel M. A. and Penny P. (1993) \emph{Distributions of tree comparison metrics - some new results}, Syst. Biol.,42(2), 126-141} \author{ Klaus P. Schliep \email{klaus.schliep@gmail.com}} \examples{ tree1 <- rtree(100, rooted=FALSE) tree2 <- rSPR(tree1, 3) RF.dist(tree1, tree2) treedist(tree1, tree2) } \keyword{ classif }% at least one, from doc/KEYWORDS phangorn/man/modelTest.Rd0000644000175100001440000000514212533667306015123 0ustar hornikusers\name{modelTest} \alias{modelTest} \alias{AICc} \title{ ModelTest } \description{ Comparison of different substition models } \usage{ modelTest(object, tree=NULL, model = c("JC", "F81", "K80", "HKY", "SYM", "GTR"), G = TRUE, I = TRUE, k = 4, control = pml.control(epsilon = 1e-08, maxit = 10, trace = 1), multicore = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{an object of class phyDat or pml} \item{tree}{a phylogenetic tree.} \item{model}{a vector containing the substitution models to compare with each other} \item{G}{logical, TRUE (default) if (discrete) Gamma modelshould be tested} \item{I}{logical, TRUE (default) if invariant sites should be tested} \item{k}{number of rate classes} \item{control}{A list of parameters for controlling the fitting process.} \item{multicore}{logical, whether models should estimated in parallel.} } \details{ \code{modelTest} estimates all the specified models for a given tree and data. When the multicore package is available, the computations are done in parallel. This is only possible without GUI interface and under linux. Only nucleotide models are tested so far. } \value{ A data.frame containing the log-likelihood, AIC, AICc and BIC all tested models. The data.frame has an attributes "env" which is an environment which contains all the trees, the data and the calls to allow get the estimated models, e.g. as a starting point for further analysis (see example). } \references{ Burnham, K. P. and Anderson, D. R (2002) \emph{Model selection and multimodel inference: a practical information-theoretic approach}. 2nd ed. Springer, New York Posada, D. and Crandall, K.A. (1998) MODELTEST: testing the model of DNA substitution. \emph{Bioinformatics} \bold{14(9)}: 817-818 Posada, D. (2008) jModelTest: Phylogenetic Model Averaging. \emph{Molecular Biology and Evolution} \bold{25}: 1253-1256 Darriba D., Taboada G.L., Doallo R and Posada D. (2011) ProtTest 3: fast selection of best-fit models of protein evolution. . \emph{Bioinformatics} \bold{27}: 1164-1165 } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{pml}}, \code{\link{anova}} } \examples{ \dontrun{ example(NJ) (mT <- modelTest(Laurasiatherian, tree)) # some R magic env = attr(mT, "env") ls(env=env) (F81 <- get("F81+G", env)) # a call eval(F81, env=env) data(chloroplast) (mTAA <- modelTest(chloroplast, model=c("JTT", "WAG", "LG"))) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{cluster} phangorn/man/simSeq.Rd0000644000175100001440000000525712507002037014414 0ustar hornikusers\name{simSeq} \alias{simSeq} \alias{simSeq.phylo} \alias{simSeq.pml} \title{ Simulate sequences. } \description{ Simulate sequences for a given evolutionary tree. } \usage{ simSeq(x, ...) \method{simSeq}{phylo}(x, l=1000, Q=NULL, bf=NULL, rootseq=NULL, type="DNA", model="", levels=NULL, rate=1, ancestral=FALSE, ...) \method{simSeq}{pml}(x, ancestral = FALSE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ a phylogenetic tree \code{tree}, i.e. an object of class \code{phylo} or and object of class \code{pml}. } \item{l}{ length of the sequence to simulate. } \item{Q}{ the rate matrix. } \item{bf}{ base frequencies. } \item{rootseq}{a vector of length l containing the root sequence, other root sequence is randomly generated.} \item{type}{Type of sequences ("DNA", "AA" or "USER").} \item{model}{Amino acid models: one of "WAG", "JTT", "Dayhoff" or "LG"} \item{levels}{ \code{levels} takes a character vector of the different bases, default is for nucleotide sequences, only used when type = "USER".} \item{rate}{rate. } \item{ancestral}{Return ancestral sequences?} \item{\dots}{Further arguments passed to or from other methods.} } \details{ \code{simSeq} is now a generic function to simulate sequence alignments. It is quite flexible and allows to generate DNA, RNA, amino acids or binary sequences. It is possible to give a \code{pml} object as input simSeq return a \code{phyDat} from these model. There is also a more low level version, which lacks rate variation, but one can combine different alignments having their own rate (see example). } \value{ \code{simSeq} returns an object of class phyDat. } \author{ Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link{phyDat}}, \code{\link{pml}}, \code{\link{SOWH.test}} } \examples{ \dontrun{ data(Laurasiatherian) tree = nj(dist.ml(Laurasiatherian)) fit = pml(tree, Laurasiatherian, k=4) fit = optim.pml(fit, optNni=TRUE, model="GTR", optGamma=TRUE) data = simSeq(fit) } tree = rtree(5) plot(tree) nodelabels() # Example for simple DNA alignment data = simSeq(tree, l = 10, type="DNA", bf=c(.1,.2,.3,.4), Q=1:6) as.character(data) # Example to simulate discrete Gamma rate variation rates = phangorn:::discrete.gamma(1,4) data1 = simSeq(tree, l = 100, type="AA", model="WAG", rate=rates[1]) data2 = simSeq(tree, l = 100, type="AA", model="WAG", rate=rates[2]) data3 = simSeq(tree, l = 100, type="AA", model="WAG", rate=rates[3]) data4 = simSeq(tree, l = 100, type="AA", model="WAG", rate=rates[4]) data <- c(data1,data2, data3, data4) write.phyDat(data, file="temp.dat", format="sequential",nbcol = -1, colsep = "") unlink("temp.dat") } \keyword{ cluster }% at least one, from doc/KEYWORDS phangorn/man/bootstrap.pml.Rd0000644000175100001440000000660512526413242015762 0ustar hornikusers\name{bootstrap.pml} %\Rdversion{1.1} \alias{bootstrap.pml} \alias{bootstrap.phyDat} \alias{plotBS} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Bootstrap } \description{ \code{bootstrap.pml} performs (non-parametric) bootstrap analysis and \code{bootstrap.phyDat} produces a list of bootstrapped data sets. \code{plotBS} plots a phylogenetic tree with the with the bootstrap values assigned to the (internal) edges.} \usage{ bootstrap.pml(x, bs = 100, trees = TRUE, multicore=FALSE, ...) bootstrap.phyDat(x, FUN, bs = 100, mc.cores = 1L, ...) plotBS(tree, BStrees, type="unrooted", bs.col="black", bs.adj=NULL, p=80, ...) } \arguments{ \item{x}{ an object of class \code{pml} or \code{phyDat}. } \item{bs}{ number of bootstrap samples. } \item{trees}{ return trees only (default) or whole \code{pml} objects. } \item{multicore}{ logical, if TRUE analysis is performed in parallel (see details). } \item{mc.cores}{ The number of cores to use during bootstrap. Only supported on UNIX-alike systems. } \item{\dots}{ further parameters used by \code{optim.pml} or \code{plot.phylo}. } \item{FUN}{ the function to estimate the trees. } \item{tree}{ The tree on which edges the bootstrap values are plotted. } \item{BStrees}{ a list of trees (object of class "multiPhylo"). } \item{type}{ the type of tree to plot, so far "cladogram", "phylogram" and "unrooted" are supported. } \item{bs.col}{ color of bootstrap support labels. } \item{bs.adj}{ one or two numeric values specifying the horizontal and vertical justification of the bootstrap labels. } \item{p}{ only plot support values higher than this percentage number (default is 80). } } \details{ It is possible that the bootstrap is performed in parallel, with help of the multicore package. Unfortunately the multicore package does not work under windows or with GUI interfaces ("aqua" on a mac). However it will speed up nicely from the command line ("X11"). } \value{ \code{bootstrap.pml} returns an object of class \code{multi.phylo} or a list where each element is an object of class \code{pml}. \code{plotBS} returns silently a tree, i.e. an object of class \code{multi.phylo} with the bootstrap values as node labels. } \references{ Felsenstein J. (1985) Confidence limits on phylogenies. An approach using the bootstrap. \emph{Evolution} \bold{39}, 783--791 Penny D. and Hendy M.D. (1985) Testing methods evolutionary tree construction. \emph{Cladistics} \bold{1}, 266--278 Penny D. and Hendy M.D. (1986) Estimating the reliability of evolutionary trees. \emph{Molecular Biology and Evolution} \bold{3}, 403--417 } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} } \seealso{ \code{\link{optim.pml}}, \code{\link{pml}}, \code{\link{plot.phylo}}, \code{\link{consensusNet}} } \examples{ \dontrun{ data(Laurasiatherian) dm <- dist.logDet(Laurasiatherian) tree <- NJ(dm) fit=pml(tree,Laurasiatherian) fit = optim.pml(fit,TRUE) set.seed(123) bs <- bootstrap.pml(fit, bs=100, optNni=TRUE) treeBS <- plotBS(fit$tree,bs) treeMP <- pratchet(Laurasiatherian) treeMP <- acctran(treeMP, Laurasiatherian) set.seed(123) BStrees <- bootstrap.phyDat(Laurasiatherian, pratchet, bs = 100) treeMP <- plotBS(treeMP, BStrees, "phylogram") add.scale.bar() # export tree with bootstrap values as node labels # write.tree(treeBS) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{cluster} phangorn/man/yeast.Rd0000644000175100001440000000070312507002037014267 0ustar hornikusers\name{yeast} \alias{yeast} \docType{data} \title{ Yeast alignment (Rokas et al.) } \description{ Alignment of 106 genes of 8 different species of yeast.} \usage{data(yeast)} \references{ Rokas, A., Williams, B. L., King, N., and Carroll, S. B. (2003) Genome-scale approaches to resolving incongruence in molecular phylogenies. \emph{Nature}, \bold{425}(6960): 798--804 } \examples{ data(yeast) str(yeast) } \keyword{datasets} phangorn/man/NJ.Rd0000644000175100001440000000244612507002037013457 0ustar hornikusers\name{NJ} \alias{NJ} \alias{UNJ} %- Also NEED an '\alias' for EACH other topic documented here. \title{Neighbor-Joining} \description{ This function performs the neighbor-joining tree estimation of Saitou and Nei (1987). UNJ is the unweighted version from Gascuel (1997). } \usage{ NJ(x) UNJ(x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{A distance matrix.} } \value{ an object of class \code{"phylo"}. } \references{Saitou, N. and Nei, M. (1987) The neighbor-joining method: a new method for reconstructing phylogenetic trees. \emph{Molecular Biology and Evolution}, \bold{4}, 406--425. Studier, J. A and Keppler, K. J. (1988) A Note on the Neighbor-Joining Algorithm of Saitou and Nei. \emph{Molecular Biology and Evolution}, \bold{6}, 729--731. Gascuel, O. (1997) Concerning the NJ algorithm and its unweighted version, UNJ. in Birkin et. al. \emph{Mathematical Hierarchies and Biology}, 149--170.} \author{Klaus P. Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link[ape]{nj}}, \code{\link[ape]{dist.dna}}, \code{\link[phangorn]{dist.hamming}}, \code{\link[phangorn]{upgma}}, \code{\link[ape]{fastme}}} \examples{ data(Laurasiatherian) dm <- dist.ml(Laurasiatherian) tree <- NJ(dm) plot(tree) } \keyword{ cluster }% at least one, from doc/KEYWORDS phangorn/man/as.splits.Rd0000644000175100001440000000525712507002037015073 0ustar hornikusers\name{as.splits} \alias{as.splits} \alias{as.prop.part.splits} \alias{as.splits.phylo} \alias{as.splits.multiPhylo} \alias{as.splits.networx} \alias{as.matrix.splits} \alias{as.Matrix} \alias{as.Matrix.splits} \alias{print.splits} \alias{write.splits} \alias{allSplits} \alias{compatible} \alias{write.nexus.splits} \alias{read.nexus.splits} \alias{as.phylo.splits} \alias{addConfidences} \alias{countCycles} \alias{presenceAbsence} \alias{addTrivialSplits} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Splits representation of graphs and trees. } \description{ \code{as.splits} produces a list of splits or bipartitions. } \usage{ as.splits(x, ...) \method{as.splits}{phylo}(x, ...) \method{as.splits}{multiPhylo}(x, ...) \method{print}{splits}(x, maxp = getOption("max.print"), zero.print = ".", one.print = "|", ...) \method{as.prop.part}{splits}(x, ...) compatible(obj) allSplits(k, labels = NULL) write.nexus.splits(obj, file="", weights=NULL) read.nexus.splits(file) addConfidences(obj, phy) presenceAbsence(x, y) addTrivialSplits(obj) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{An object of class phylo or multiPhylo.} \item{y}{An object of class splits.} \item{maxp}{integer, default from \code{options(max.print)}, influences how many entries of large matrices are printed at all.} \item{zero.print}{character which should be printed for zeroes.} \item{one.print}{character which should be printed for ones.} \item{\dots}{Further arguments passed to or from other methods.} \item{obj}{an object of class splits.} \item{k}{number of taxa.} \item{labels}{names of taxa.} \item{file}{ a file name.} \item{weights}{ Edge weights.} \item{phy}{An object of class phylo or multiPhylo.} } \value{ \code{as.splits} returns an object of class splits, which is mainly a list of splits and some attributes. \code{compatible} return a lower triangular matrix where an 1 indicates that two splits are incompatible. } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \note{ The internal representation is likely to change. \code{read.nexus.splits} reads in the splits block of a nexus file. It assumes that different co-variables are tab delimited and the bipartition are separated with white-space. Comments in square brackets are ignored. } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{prop.part}}, \code{\link{lento}}, \code{\link{distanceHadamard}}, \code{\link{as.networx}} } %% as.phylo.splits \examples{ (sp <- as.splits(rtree(5))) write.nexus.splits(sp) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ cluster } phangorn/man/pml.fit.Rd0000644000175100001440000000472712542607654014544 0ustar hornikusers\name{pml.fit} \alias{pml.fit} \alias{edQt} \alias{pml.init} \alias{pml.free} \alias{discrete.gamma} \alias{lli} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Internal maximum likelihood functions. } \description{ These functions are internally used for the liklihood computations in \code{pml} or \code{optim.pml}. } \usage{ pml.fit(tree, data, bf=rep(1/length(levels), length(levels)), shape=1, k=1, Q=rep(1, length(levels)*(length(levels)-1)/2), levels=attr(data, "levels"), inv=0, rate=1, g=NULL, w=NULL, eig=NULL, INV=NULL, ll.0=NULL, llMix=NULL, wMix=0, ..., site=FALSE) pml.init(data, k) pml.free() edQt(Q = c(1, 1, 1, 1, 1, 1), bf = c(0.25, 0.25, 0.25, 0.25)) lli(data, tree, ...) discrete.gamma(alpha, k) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{tree}{A phylogenetic \code{tree}, object of class \code{phylo}. } \item{data}{An alignment, object of class \code{phyDat}.} \item{bf}{Base frequencies.} \item{shape}{Shape parameter of the gamma distribution.} \item{alpha}{Shape parameter of the gamma distribution.} \item{k}{Number of intervals of the discrete gamma distribution.} \item{Q}{A vector containing the lower triangular part of the rate matrix.} \item{levels}{ %% ~~Describe \code{levels} here~~ } \item{inv}{Proportion of invariable sites.} \item{rate}{Rate.} \item{g}{ %% ~~Describe \code{g} here~~ } \item{w}{ %% ~~Describe \code{w} here~~ } \item{eig}{Eigenvalue decomposition of Q} \item{INV}{Sparse representation of invariant sites} \item{ll.0}{ %% ~~Describe \code{ll.0} here~~ } \item{llMix}{ %% ~~Describe \code{llMix} here~~ } \item{wMix}{ %% ~~Describe \code{wMix} here~~ } \item{\dots}{Further arguments passed to or from other methods.} \item{site}{ %% ~~Describe \code{site} here~~ } } \details{ These functions are exported to be used in different packages so far only in the package coalescentMCMC, but are not intended for end user. Most of the functions call C code. } \value{ \code{pml.fit} returns the logliklihood. } \references{ Felsenstein, J. (1981) Evolutionary trees from DNA sequences: a maxumum likelihood approach. \emph{Journal of Molecular Evolution}, \bold{17}, 368--376. } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} } \seealso{ \code{\link{pml}, \link{pmlPart}, \link{pmlMix}} } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ cluster } phangorn/man/chloroplast.Rd0000644000175100001440000000071212507002037015474 0ustar hornikusers\name{chloroplast} \alias{chloroplast} \docType{data} \title{ Chloroplast alignment } \description{ Amino acid alignment of 15 genes of 19 different chloroplast.} \usage{data(yeast)} %\references{ %Nisbet R.E.R, Schliep K., Steel M.A., Knapp M. Howe C.J. and Lockhart P.J. (2009) %The slop of rocks and clocks %\emph{Potato growers weekly}, \bold{425}(6960): 798--804 %} \examples{ data(chloroplast) chloroplast } \keyword{datasets} phangorn/man/Ancestors.Rd0000644000175100001440000000270412510603465015114 0ustar hornikusers\name{Ancestors} \alias{Ancestors} \alias{Children} \alias{Descendants} \alias{Siblings} \alias{mrca.phylo} \title{tree utility function} \description{ Functions for describing relationships among phylogenetic nodes. } \usage{ Ancestors(x, node, type=c("all","parent")) Children(x, node) Siblings(x, node, include.self=FALSE) Descendants(x, node, type=c("tips","children","all")) mrca.phylo(x, node) } \arguments{ \item{x}{a tree (a phylo object).} \item{node}{an integer or a vector of integers corresponding to a node ID} \item{type}{specify whether to return just direct children / parents or all } \item{include.self}{whether to include self in list of siblings} } \details{ These functions are inspired by \code{treewalk} in phylobase package, but work on the S3 \code{phylo} objects. The nodes are the indices as given in edge matrix of an phylo object. From taxon labels these indices can be easily derived matching against the \code{tip.label} argument of an phylo object, see example below. All the functions allow \code{node} to be either a scalar or vector. } \value{ a vector or a list containing the indices of the nodes. } \seealso{\code{treewalk}, \code{phylo}} \examples{ tree = rtree(10) plot(tree, show.tip.label = FALSE) nodelabels() tiplabels() Ancestors(tree, 1:3, "all") Children(tree, 11) Descendants(tree, 11, "tips") Siblings(tree, 3) mrca.phylo(tree, 1:3) mrca.phylo(tree, match(c("t1", "t2", "t3"), tree$tip)) } \keyword{misc} phangorn/man/cladePar.Rd0000644000175100001440000000240612507002037014657 0ustar hornikusers\name{cladePar} \alias{cladePar} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Utility function to plot.phylo } \description{ cladePar can help you coloring (choosing edge width/type) of clades. } \usage{ cladePar(tree, node, edge.color = "red", tip.color = edge.color, edge.width = 1, edge.lty = 1, x = NULL, plot = FALSE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{tree}{ an object of class phylo. } \item{node}{ the node which is the common ancestor of the clade. } \item{edge.color}{ see plot.phylo. } \item{tip.color}{ see plot.phylo. } \item{edge.width}{ see plot.phylo. } \item{edge.lty}{ see plot.phylo. } \item{x}{ the result of a previous call to cladeInfo. } \item{plot}{ logical, if TRUE the tree is plotted. } \item{\dots}{ Further arguments passed to or from other methods. } } \value{ A list containing the information about the edges and tips. } \author{ Klaus Schliep \email{klaus.schliep@gmail.com} } \seealso{ \code{\link{plot.phylo}} } \examples{ tree = rtree(10) plot(tree) nodelabels() x = cladePar(tree, 12) cladePar(tree, 18, "blue", "blue", x=x, plot=TRUE) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{plot} phangorn/man/getClans.Rd0000644000175100001440000001426412507002037014711 0ustar hornikusers\name{getClans} \alias{getClans} \alias{getClips} \alias{getSlices} \alias{getDiversity} \alias{diversity} \title{ Clans, slices and clips } \description{ Functions for clanistics to compute clans, slices, clips for unrooted trees and functions to quantify the fragmentation of trees. } \usage{ getClans(tree) getClips(tree, all=TRUE) getSlices(tree) getDiversity(tree, x, norm=TRUE, var.names = NULL, labels="new") diversity(tree, X) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{tree}{An object of class phylo or multiPhylo (getDiversity).} \item{all}{A logical, return all or just the largest clip. } \item{x}{An object of class phyDat. } \item{norm}{A logical, return Equitability Index (default) or Shannon Diversity. } \item{var.names}{A vector of variable names. } \item{labels}{see details. } \item{X}{a data.frame} } \details{ Every split in an unrooted tree defines two complementary clans. Thus for an unrooted binary tree with \eqn{n} leaves there are \eqn{2n - 3} edges, and therefore \eqn{4n - 6} clans (including \eqn{n} trivial clans containing only one leave). Slices are defined by a pair of splits or tripartitions, which are not clans. The number of distinguishable slices for a binary tree with \eqn{n} tips is \eqn{2n^2 - 10n + 12}. %A clip is a different type of partition as it is defined by evolutionary or cophenetic distance and not by the topology. Namely clips are groups of leaves for which the maximum pairwise distance is smaller than threshold. %For a better separation we additionally demand that the maximum pairwise distance within a clip is lower than the distance between any member of the clip and any other tip. A clip is a different type of partition, defining groups of leaves that are related in terms of evolutionary distances and not only topology. Namely, clips are groups of leaves for which all pairwise path-length distances are smaller than a given threshold value (Lapointe et al. 2010). There exists different numbers of clips for different thresholds, the largest (and trivial) one being the whole tree. There is always a clip containing only the two leaves with the smallest pairwise distance. Clans, slices and clips can be used to characterize how well a vector of categorial characters (natives/intruders) fit on a tree. We will follow the definitions of Lapointe et al.(2010). A complete clan is a clan that contains all leaves of a given state/color, but can also contain leaves of another state/color. A clan is homogeneous if it only contains leaves of one state/color. \code{getDiversity} computes either the \cr Shannon Diversity: \eqn{H = -\sum_{i=1}^{k}(N_i/N) log(N_i/N), N=\sum_{i=1}^{k} N_i}{H = -sum(N_i/N) * log(N_i/N), N=sum(N_i)} \cr or the \cr Equitability Index: \eqn{E = H / log(N)} \cr where \eqn{N_i} are the sizes of the \eqn{k} largest homogeneous clans of intruders. If the categories of the data can be separated by an edge of the tree then the E-value will be zero, and maximum equitability (E=1) is reached if all intruders are in separate clans. getDiversity computes these Intruder indices for the whole tree, complete clans and complete slices. Additionally the parsimony scores (p-scores) are reported. The p-score indicates if the leaves contain only one color (p-score=0), if the the leaves can be separated by a single split (perfect clan, p-score=1) or by a pair of splits (perfect slice, p-score=2). So far only 2 states are supported (native, intruder), however it is also possible to recode several states into the native or intruder state using contrasts, for details see section 2 in vignette("phangorn-specials"). Furthermore unknown character states are coded as ambiguous character, which can act either as native or intruder minimizing the number of clans or changes (in parsimony analysis) needed to describe a tree for given data. Set attribute labels to "old" for analysis as in Schliep et al. (2010) or to "new" for names which are more intuitive. \code{diversity} returns a data.frame with the parsimony score for each tree and each levels of the variables in \code{X}. \code{X} has to be a \code{data.frame} where each column is a factor and the rownames of \code{X} correspond to the tips of the trees. %TODO See also vignette("Clanistic"). } \value{ getClans, getSlices and getClips return a matrix of partitions, a matrix of ones and zeros where rows correspond to a clan, slice or clip and columns to tips. A one indicates that a tip belongs to a certain partition. \cr getDiversity returns a list with tree object, the first is a data.frame of the equitability index or Shannon divergence and parsimony scores (p-score) for all trees and variables. The data.frame has two attributes, the first is a splits object to identify the taxa of each tree and the second is a splits object containing all partitions that perfectly fit. } \references{ Lapointe, F.-J., Lopez, P., Boucher, Y., Koenig, J., Bapteste, E. (2010) Clanistics: a multi-level perspective for harvesting unrooted gene trees. \emph{Trends in Microbiology} 18: 341-347 Wilkinson, M., McInerney, J.O., Hirt, R.P., Foster, P.G., Embley, T.M. (2007) Of clades and clans: terms for phylogenetic relationships in unrooted trees. \emph{Trends in Ecology and Evolution} 22: 114-115 Schliep, K., Lopez, P., Lapointe F.-J., Bapteste E. (2011) Harvesting Evolutionary Signals in a Forest of Prokaryotic Gene Trees, \emph{Molecular Biology and Evolution} 28(4): 1393-1405 } \author{ Klaus Schliep \email{klaus.schliep@snv.jussieu.fr} Francois-Joseph Lapointe \email{francois-joseph.lapointe@umontreal.ca} } \seealso{ \code{\link{parsimony}}, Consistency index \code{\link{CI}}, Retention index \code{\link{RI}}, \code{\link{phyDat}} } \examples{ set.seed(111) tree = rtree(10) getClans(tree) getClips(tree, all=TRUE) getSlices(tree) set.seed(123) trees = rmtree(10, 20) X = matrix(sample(c("red", "blue", "violet"), 100, TRUE, c(.5,.4, .1)), ncol=5, dimnames=list(paste('t',1:20, sep=""), paste('Var',1:5, sep="_"))) x = phyDat(X, type = "USER", levels = c("red", "blue"), ambiguity="violet") plot(trees[[1]], "u", tip.color = X[trees[[1]]$tip,1]) # intruders are blue (divTab <- getDiversity(trees, x, var.names=colnames(X))) summary(divTab) } \keyword{ cluster } phangorn/man/pmlCluster.Rd0000644000175100001440000000550412507002037015300 0ustar hornikusers\name{pmlCluster} \alias{pmlCluster} %\alias{pmlCluster2} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Stochastic Partitioning } \description{ Stochastic Partitioning of genes into p cluster. } \usage{ pmlCluster(formula, fit, weight, p=1:5, part=NULL, nrep = 10, control=pml.control(epsilon=1e-8, maxit=10, trace=1),...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ a formula object (see details).} \item{fit}{ an object of class \code{pml}. } \item{weight}{ \code{weight} is matrix of frequency of site patterns for all genes. } \item{p}{ number of clusters. } \item{part}{ starting partition, otherwise a random partition is generated. } \item{nrep}{ number of replicates for each p. } \item{control}{A list of parameters for controlling the fitting process.} \item{\dots}{ Further arguments passed to or from other methods. } } \details{ The \code{formula} object allows to specify which parameter get optimized. The formula is generally of the form \code{edge + bf + Q ~ rate + shape + \dots}, on the left side are the parameters which get optimized over all cluster, on the right the parameter which are optimized specific to each cluster. The parameters available are \code{"nni", "bf", "Q", "inv", "shape", "edge", "rate"}. Each parameter can be used only once in the formula. There are also some restriction on the combinations how parameters can get used. \code{"rate"} is only available for the right side. When \code{"rate"} is specified on the left hand side \code{"edge"} has to be specified (on either side), if \code{"rate"} is specified on the right hand side it follows directly that \code{edge} is too. } \value{ \code{pmlCluster} returns a list with elements \item{logLik}{log-likelihood of the fit} \item{trees}{a list of all trees during the optimization.} \item{fits}{fits for the final partitions} } \references{ K. P. Schliep (2009). Some Applications of statistical phylogenetics (PhD Thesis) Lanfear, R., Calcott, B., Ho, S.Y.W. and Guindon, S. (2012) PartitionFinder: Combined Selection of Partitioning Schemes and Substitution Models for Phylogenetic Analyses. \emph{Molecular Biology and Evolution}, \bold{29(6)}, 1695-1701 } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link{pml}},\code{\link{pmlPart}},\code{\link{pmlMix}},\code{\link{SH.test}} } \examples{ \dontrun{ data(yeast) dm <- dist.logDet(yeast) tree <- NJ(dm) fit=pml(tree,yeast) fit = optim.pml(fit) weight=xtabs(~ index+genes,attr(yeast, "index")) set.seed(1) sp <- pmlCluster(edge~rate, fit, weight, p=1:4) sp SH.test(sp) } } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ cluster } %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line phangorn/man/read.aa.Rd0000644000175100001440000000322712507002037014441 0ustar hornikusers\name{read.aa} \alias{read.aa} \title{Read Amino Acid Sequences in a File} \usage{ read.aa(file, format = "interleaved", skip = 0, nlines = 0, comment.char = "#", seq.names = NULL) } \arguments{ \item{file}{a file name specified by either a variable of mode character, or a double-quoted string.} \item{format}{a character string specifying the format of the DNA sequences. Three choices are possible: \code{"interleaved"}, \code{"sequential"}, or \code{"fasta"}, or any unambiguous abbreviation of these.} \item{skip}{the number of lines of the input file to skip before beginning to read data.} \item{nlines}{the number of lines to be read (by default the file is read until its end).} \item{comment.char}{a single character, the remaining of the line after this character is ignored.} \item{seq.names}{the names to give to each sequence; by default the names read in the file are used.} } \description{ This function reads amino acid sequences in a file, and returns a matrix list of DNA sequences with the names of the taxa read in the file as row names.} \value{ a matrix of amino acid sequences. } \references{ % Anonymous. FASTA format description. % \url{http://www.ncbi.nlm.nih.gov/BLAST/fasta.html} Felsenstein, J. (1993) Phylip (Phylogeny Inference Package) version 3.5c. Department of Genetics, University of Washington. \url{http://evolution.genetics.washington.edu/phylip/phylip.html} } \seealso{ \code{\link[ape]{read.dna}}, \code{\link[ape]{read.GenBank}}, \code{\link[phangorn]{phyDat}}, \code{\link[seqinr]{read.alignment}} } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \keyword{IO} phangorn/man/pmlPart.Rd0000644000175100001440000000514612510766550014602 0ustar hornikusers\name{pmlPart} \alias{pmlPart} \alias{pmlPart2multiPhylo} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Partition model. } \description{ Model to estimate phylogenies for partitioned data. } \usage{ pmlPart(formula, object, control = pml.control(epsilon=1e-8, maxit=10, trace=1), model=NULL, rooted=FALSE, ...) pmlPart2multiPhylo(x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{formula}{ a formula object (see details).} \item{object}{ an object of class \code{pml} or a list of objects of class \code{pml} . } \item{control}{A list of parameters for controlling the fitting process.} \item{model}{A vector containing the models containing a model for each partition.} \item{rooted}{Are the gene trees rooted (ultrametric) or unrooted.} \item{\dots}{Further arguments passed to or from other methods. } \item{x}{an object of class \code{pmlPart} } } \details{ The \code{formula} object allows to specify which parameter get optimized. The formula is generally of the form \code{edge + bf + Q ~ rate + shape + \dots}, on the left side are the parameters which get optimized over all partitions, on the right the parameter which are optimized specific to each partition. The parameters available are \code{"nni", "bf", "Q", "inv", "shape", "edge", "rate"}. Each parameters can be used only once in the formula. \code{"rate"} and \code{"nni"} are only available for the right side of the formula. For partitions with different edge weights, but same topology, \code{pmlPen} can try to find more parsimonious models (see example). \code{pmlPart2multiPhylo} is a convenience function to extract the trees out of a \code{pmlPart} object. } \value{ \code{kcluster} returns a list with elements \item{logLik}{log-likelihood of the fit} \item{trees}{a list of all trees during the optimization.} \item{object}{an object of class \code{"pml"} or \code{"pmlPart"}} } %\references{ ~put references to the literature/web site here ~ } \author{Klaus Schliep \email{klaus.schliep@gmail.com}} \seealso{ \code{\link{pml}},\code{\link{pmlCluster}},\code{\link{pmlMix}},\code{\link{SH.test}} } \examples{ data(yeast) dm <- dist.logDet(yeast) tree <- NJ(dm) fit <- pml(tree,yeast) fits <- optim.pml(fit) weight=xtabs(~ index+genes,attr(yeast, "index"))[,1:10] sp <- pmlPart(edge ~ rate + inv, fits, weight=weight) sp \dontrun{ sp2 <- pmlPart(~ edge + inv, fits, weight=weight) sp2 AIC(sp2) sp3 <- pmlPen(sp2, lambda = 2) AIC(sp3) } } \keyword{ cluster } %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line