iterators/0000755000177700017770000000000013213772427013630 5ustar herbrandtherbrandtiterators/inst/0000755000177700017770000000000013212620524014572 5ustar herbrandtherbrandtiterators/inst/examples/0000755000177700017770000000000013212617761016421 5ustar herbrandtherbrandtiterators/inst/examples/ivector.R0000644000177700017770000000125111472542406020215 0ustar herbrandtherbrandtlibrary(iterators) # return an iterator that returns subvectors of a vector. # can specify either "chunks" or "chunkSize" arguments # since that is what the "idiv" function supports. ivector <- function(x, ...) { i <- 1 it <- idiv(length(x), ...) nextEl <- function() { n <- nextElem(it) ix <- seq(i, length=n) i <<- i + n x[ix] } obj <- list(nextElem=nextEl) class(obj) <- c('ivector', 'abstractiter', 'iter') obj } # create a vector iterator that returns three subvectors it <- ivector(1:25, chunks=3) print(as.list(it)) # create a vector iterator that returns subvectors # with a maximum length of 10 it <- ivector(1:25, chunkSize=10) print(as.list(it)) iterators/inst/examples/ilimit.R0000644000177700017770000000066011472542406020034 0ustar herbrandtherbrandtlibrary(iterators) ilimit <- function(it, times) { it <- iter(it) nextEl <- function() { if (times > 0) times <<- times - 1 else stop('StopIteration') nextElem(it) } obj <- list(nextElem=nextEl) class(obj) <- c('ilimit', 'abstractiter', 'iter') obj } it <- ilimit(icount(Inf), 3) print(nextElem(it)) print(nextElem(it)) print(nextElem(it)) print(tryCatch(nextElem(it), error=function(e) e)) iterators/inst/examples/itimer.R0000644000177700017770000000107411472542406020036 0ustar herbrandtherbrandtlibrary(iterators) # Returns an iterator that limits another iterator based on time itimer <- function(it, time) { it <- iter(it) start <- proc.time()[[3]] nextEl <- function() { current <- proc.time()[[3]] if (current - start >= time) stop('StopIteration') nextElem(it) } obj <- list(nextElem=nextEl) class(obj) <- c('itimer', 'abstractiter', 'iter') obj } # Create a iterator that counts for one second it <- itimer(icount(Inf), 1) tryCatch({ repeat { print(nextElem(it)) } }, error=function(e) { cat('timer expired\n') }) iterators/inst/examples/irep.R0000644000177700017770000000077011472542406017506 0ustar herbrandtherbrandtlibrary(iterators) # return an iterator that returns the specified value # a limited number of times irep <- function(x, times) { nextEl <- function() { if (times > 0) times <<- times - 1 else stop('StopIteration') x } obj <- list(nextElem=nextEl) class(obj) <- c('irep', 'abstractiter', 'iter') obj } # create an iterator that returns a 7 exactly 6 times it <- irep(7, 6) # convert the iterator into a list, which gets all of its values print(unlist(as.list(it))) iterators/inst/examples/iforever.R0000644000177700017770000000053711472542406020371 0ustar herbrandtherbrandtlibrary(iterators) # return an iterator that returns the specified value forever iforever <- function(x) { nextEl <- function() x obj <- list(nextElem=nextEl) class(obj) <- c('iforever', 'abstractiter', 'iter') obj } # create an iterator that returns 42 forever it <- iforever(42) # call it three times for (i in 1:3) print(nextElem(it)) iterators/inst/examples/ipermn.R0000644000177700017770000000670011472542406020040 0ustar herbrandtherbrandtlibrary(iterators) permn <- function(x) { n <- length(x) if (n == 1 && is.numeric(x) && x >= 0) { n <- x x <- seq(length=n) } if (n == 0) list() else permn.internal(x, n) } permn.internal <- function(x, n) { if (n == 1) { list(unlist(x, recursive=FALSE)) } else { fun <- function(i) lapply(permn.internal(x[-i], n - 1), function(v) c(x[[i]], v)) unlist(lapply(seq(along=x), fun), recursive=FALSE) } } ipermn <- function(x) { n <- length(x) if (n == 1 && is.numeric(x) && x >= 0) { n <- x x <- seq(length=n) } ipermn.internal(x, n) } ipermn.internal <- function(x, n) { icar <- icount(n) if (n > 1) { icdr <- NULL hasVal <- FALSE nextVal <- NULL } nextEl <- if (n <= 1) { function() x[[nextElem(icar)]] } else { function() { repeat { if (!hasVal) { nextVal <<- nextElem(icar) icdr <<- ipermn.internal(x[-nextVal], n - 1) hasVal <<- TRUE } tryCatch({ return(c(x[[nextVal]], nextElem(icdr))) }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { hasVal <<- FALSE } else { stop(e) } }) } } } obj <- list(nextElem=nextEl) class(obj) <- c('ipermn', 'abstractiter', 'iter') obj } icombn <- function(x, m) { n <- length(x) if (n == 1 && is.numeric(x) && x >= 0) { n <- x x <- seq(length=n) } if (m > n) stop('m cannot be larger than the length of x') if (m < 0) stop('m cannot be negative') icombn.internal(x, n, m) } icombn.internal <- function(x, n, m) { icar <- icount(n - m + 1) if (n > 1) { icdr <- NULL hasVal <- FALSE nextVal <- NULL } nextEl <- if (m <= 1) { function() x[[nextElem(icar)]] } else { function() { repeat { if (!hasVal) { nextVal <<- nextElem(icar) nn <- n - nextVal icdr <<- icombn.internal(x[seq(nextVal+1, length=nn)], nn, m - 1) hasVal <<- TRUE } tryCatch({ return(c(x[[nextVal]], nextElem(icdr))) }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { hasVal <<- FALSE } else { stop(e) } }) } } } obj <- list(nextElem=nextEl) class(obj) <- c('icombn', 'abstractiter', 'iter') obj } tostr <- function(x) paste(x, collapse=', ') failures <- 0 # test ipermn using permn for (x in list(list(1,2,3), 1:3, 1, 'bar', 3, c(), letters[1:6])) { cat(sprintf('testing ipermn on: %s\n', tostr(x))) actual <- as.list(ipermn(x)) expect <- permn(x) status <- identical(actual, expect) if (!status) { cat('test failed\n') cat(' expected:\n') print(expect) cat(' actual:\n') print(actual) failures <- failures + 1 } } # test icombn using combn for (m in 1:8) { for (x in list(1:2, 'foo', 1, 7, 1:8, letters[1:6], rep('foo', 3))) { m <- min(m, length(x)) cat(sprintf('testing icombn on: %s\n', tostr(x))) actual <- as.list(icombn(x, m)) expect <- combn(x, m, simplify=FALSE) status <- identical(actual, expect) if (!status) { cat('test failed\n') cat(' expected:\n') print(expect) cat(' actual:\n') print(actual) failures <- failures + 1 } } } if (failures > 0) { cat(sprintf('%d test(s) failed\n', failures)) } else { cat('All tests passed\n') } iterators/inst/examples/ifilter.R0000644000177700017770000000113111472542406020175 0ustar herbrandtherbrandtlibrary(iterators) # Returns a filtering iterator ifilter <- function(it, FUN, ...) { it <- iter(it) nextEl <- function() { repeat { x <- nextElem(it) if (FUN(x, ...)) break } x } obj <- list(nextElem=nextEl) class(obj) <- c('ifilter', 'abstractiter', 'iter') obj } # Simple example use it <- irnorm(1, count=10) is.positive <- function(x) x > 0 print(as.list(ifilter(it, is.positive))) # Example using a function with an additional argument it <- irnorm(1, count=10) greater.than <- function(x, y) x > y print(as.list(ifilter(it, greater.than, 1.0))) iterators/inst/examples/iseq.R0000644000177700017770000000125211472542406017504 0ustar herbrandtherbrandtlibrary(iterators) # return an iterator that returns subvectors of a sequence # of a specified length. # can specify either "chunks" or "chunkSize" arguments # since that is what the "idiv" function supports. iseq <- function(n, ...) { i <- 1 it <- idiv(n, ...) nextEl <- function() { n <- nextElem(it) x <- seq(i, length=n) i <<- i + n x } obj <- list(nextElem=nextEl) class(obj) <- c('iseq', 'abstractiter', 'iter') obj } # create a sequence iterator that returns three subvectors it <- iseq(25, chunks=3) print(as.list(it)) # create a sequence iterator that returns subvectors # with a maximum length of 10 it <- iseq(25, chunkSize=10) print(as.list(it)) iterators/inst/examples/ivector2.R0000644000177700017770000000233511472542406020303 0ustar herbrandtherbrandtlibrary(iterators) # return an iterator that returns subvectors of a vector. # can specify either "chunks" or "chunkSize" arguments # since that is what the "idiv" function supports. ivector <- function(x, ...) { # don't evaluate x if is specified using the ':' operator q <- substitute(x) if (identical(q[[1]], as.name(':'))) { rm(list='x') # being paranoid: don't want to evaluate promise lower <- as.integer(eval.parent(q[[2]])) upper <- as.integer(eval.parent(q[[3]])) inc <- if (upper >= lower) 1L else -1L len <- abs(upper - lower) + 1L it <- idiv(len, ...) nextEl <- function() { n <- nextElem(it) y <- seq(lower, by=inc, length=n) lower <<- lower + (inc * n) y } } else { i <- 1 it <- idiv(length(x), ...) nextEl <- function() { n <- nextElem(it) ix <- seq(i, length=n) i <<- i + n x[ix] } } obj <- list(nextElem=nextEl) class(obj) <- c('ivector', 'abstractiter', 'iter') obj } # create a vector iterator that returns three subvectors it <- ivector(1:25, chunks=3) print(as.list(it)) # create a vector iterator that returns subvectors # with a maximum length of 10 it <- ivector(25:1, chunkSize=10) print(as.list(it)) iterators/inst/examples/irecycle.R0000644000177700017770000000077711472542406020355 0ustar herbrandtherbrandtlibrary(iterators) # This functions returns an iterator that recycles the values of # the specified iterator irecycle <- function(it) { values <- as.list(iter(it)) i <- length(values) if (i == 0) stop('iterator must have at least one value') nextEl <- function() { i <<- i + 1 if (i > length(values)) i <<- 1 values[[i]] } obj <- list(nextElem=nextEl) class(obj) <- c('irecycle', 'abstractiter', 'iter') obj } it <- irecycle(icount(3)) for (i in 1:9) print(nextElem(it)) iterators/inst/examples/ihasNext.R0000644000177700017770000000320611472542406020327 0ustar herbrandtherbrandtlibrary(iterators) # This example was originally written and contributed # by Hadley Wickham, with minor modifications by # Revolution Analytics # Define a hasNext generic function hasNext <- function(obj, ...) { UseMethod('hasNext') } # Define a hasNext method for the "ihasNext" class hasNext.ihasNext <- function(obj, ...) { obj$hasNext() } # This function takes an iterator and returns an iterator that supports # the "hasNext" method. This simplifies manually calling the "nextElem" # method of the iterator, since you don't have to worry about catching # the "StopIteration" exception. ihasNext <- function(it) { it <- iter(it) # If "it" already has a hasNext function, return it unchanged if (!is.null(it$hasNext)) return(it) cache <- NULL has_next <- NA nextEl <- function() { if (!hasNx()) stop('StopIteration', call.=FALSE) # Reset the "has_next" flag and return the value has_next <<- NA cache } hasNx <- function() { # Check if you already know the answer if (!is.na(has_next)) return(has_next) # Try to get the next element tryCatch({ cache <<- nextElem(it) has_next <<- TRUE }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { has_next <<- FALSE } else { stop(e) } }) has_next } obj <- list(nextElem=nextEl, hasNext=hasNx) class(obj) <- c('ihasNext', 'abstractiter', 'iter') obj } # Create a "counting" iterator that has a hasNext method it <- ihasNext(icount(3)) # Print the values of the iterator without the need for error handling while (hasNext(it)) print(nextElem(it)) iterators/inst/doc/0000755000177700017770000000000013212620524015337 5ustar herbrandtherbrandtiterators/inst/doc/iterators.pdf0000644000177700017770000022774213212620521020061 0ustar herbrandtherbrandt%PDF-1.5 % 13 0 obj << /Length 1541 /Filter /FlateDecode >> stream xڵXK6WVX$EE_IўEQ9xmэ$f;/RҮMQEg|3CNN~z/<_u%V<>YlSJygy,vf~yu[*m+N ,q~Z9* [<]+|Fo[jMb\nqh*S$sgU^V zt[J'Feja{\i@_*pԬX}w$zr04t:bW+DQt kSڸdye@#X4qMF >t>O+^9, pB 3stnX͍.<yE~h-BlT=ALU}'2~$cJh~W73@t (cܐ*-pi{_/oXVˆr?)`9E۫ Cʁ 3&!QvZʆ HjK#!QTCM *G3Nz\3Lgv,̞:GÞb09\Gx;^&sҪ2aץsK!*& gM[VM36ͧuk&ҭ\L X\V*KzgFZ>Em(˥<6Z;I"f3) 0< ~vX:?󺏢h1*Na&?|J>'ޢ;@3j/Ogʧ)!,cFcPmœA.3810 AS>S\6j.B[ݞ/;e 1)S@ϒo5\KZ"6D 1~=;tIm%YeA V^Y*ȓkZFlb endstream endobj 26 0 obj << /Length 1612 /Filter /FlateDecode >> stream xXK6WZ!)@ d-&)݃>?6>>DrAC%r8|3C*TvxLvd̘p*c B6eOWJU|_!]|Q+BXv;ۖVv-0?a 'btf<:QVe:s6t]XrLe8>SE]S6.*_Ю|p ono x^ GN;Atqn <0s!6w74X3  ~nŒ FZ9 pe#[S#m k=92 Pt% JW^Ǜy㋉ =yɺ7%FHu4X(rc:ΥlTW%3%#C<hnḆH} lBi۵Ys?; qegHx9t{ o w-#;(0PLBOZazR&/t}*>|lry5Jy 3pϛrm{B׭+^uEeAL|fE"تv| e!w霨į1 c_]sPX"xߩ@Ia GۦNdY#jŰ C_q= `WM~boS97O-.(>#`Uݯ$ŋ6'{m`t4<verpTvmrnIo<2Nچ; zE?פwS7] Ϛ-gCjcϾ;uJ[GjE),srY<px;mKA ʂ30 Z 2[UŴxqC9)pQ_)nVֱ.%m912ASwr*~``VQ{贸,{ZӁi$?冿:A%~uY#qGD|5 $еhhSKSb1:V^N1 ./ч TLϦ1w SM(@DB}t/Y`)+, uGȟ':?ajLR:G}Uy ~ ]M+Q 7}FDK SSg2:*r\f7ul endstream endobj 30 0 obj << /Length 2068 /Filter /FlateDecode >> stream xYKs#5Wq\J7Eql(KxcխyXpglyo_a:KqcM_MK!}ΩdH߭yuuemB/B%Z٩ΚΫ(uŻ+ݤvRgz4z߽BPv.h!#]%ZZIL"}d.ߥe:tKO_Wkt˕Y&f^1C>R93 Y&?dVdZa}V%")P,ڈ+$m@3YȢ௱IG83 D712QChpD;h!ڙ(C'"ܐ|Ny3k Df e/Ӹ%'HMa}ʒ}6[vlhQTG U(PJ\2.&8(N\2fv̌"'ZhҡT|B/)R{KD8桹8Uј85)ŎA˗luE JpEoyGY |$C+9xUSF@۳46qP\RbQ 2Oc_Fs Dr_>:3e.4O~P[FwJǑshs) nȎ Q􋕒&NE%/ڊdC):PyCXhuu jPK_[ ǀ-hv]d lQگZ֤ OX<'Wk}Ɵ>O-0ȖE8f#e $c@,Ƅnjmݛ=]ճ $K$.Rq%]+[nBh>óa"sXleaBq{Ny* :iBY;P (f Lv3Z{ۿu(u_Co eɽZ 2 <ߖ ?Re DS? ǁܣZtܾO'䆲w$֩X,1eGDÙ= ehM mHxih$盛2&]i: ԝɊzmyʿ'op ݑ71uBrcy<_~~{bO `GmTqavKHCpdǯ´RgMbtE3XUhd#am[kذf|Ut"x?ЊQF܊j]g& &2z@AOr;XWg#$n֠0.LCd^Ϥ6?Lrgc7e y<vK@țC6LoȨ)<3g% $*V|*fWO()HFR$YzX=DͶ|E2I?HW#`?[Rީd+#kq$a[dѻ\koF89M"^,io ^(\oOjpcc,+3g׍n>ao\tpP|DF]K r:Y AAn`h> stream xUKo1 ϯqiy E r*=RV= BBc#QwʨwUwvaAhVY5bTzmSRuz_@Hnto׫˳ Zy :@EŎ[khz$_ZƬUƞ6@whwu@w^EcP]wum /9]nO}LKhBrd;`"pX"h:XiBCS q}G4f$&9Y[h fW82 2AlpaTK#Xq ,khje5 m ObR HҎ|$K58xCjQjCh|6z0Wt"W9:l&D+ Irljؙ @Qy59JOveHө$i:˝e'-ClجקZwa(םIO7=CD6{NdzF7:XnKKy d{,rxn$uPi7m >hI-O"}y˪/-&`ҋ1 k.G\q_k^ȴtݝzo[9W' ;DV??i@ђ~j'xr endstream endobj 44 0 obj << /Length1 1623 /Length2 8616 /Length3 0 /Length 9673 /Filter /FlateDecode >> stream xڍTk6 %!8C0tt "%%ݥ4% 9=}k֚y{׾ae啵[@0$$@^CH@//ʪE:@#a5 p,0^FjaU@@TR@L /C8BvZ4pU䁀"a  A@-0i qh v-E"$@777>3a#p"m:gb2v+@Bnt# {swqYA]u<;_޿Aa8--N`f:@J|Hw$ mvp]PŽJ}l:!{s?fE<C:OXn0 k(wV.N@} DE/{?2 /&*@-my8AP wX߷ZCp jX@l0ߋ!G@&dz0+8? $+ 忕rrpwWPD $w-0:UY{?8ZN pC"_t忣_)88;Bk8 *E {7 oVտÿ}(}(ؿ}(PZtE@~@_]5TKj@!83pv/+dixׇ|c]7LA\`%q 8M$_U8{:pP֘t}c3ބ3=B=aG C:^޷ PTY^h^}VvR47:Q.{S4" 5"c KErN8~v$sA5g7Z(xI0Bs;5 1=(V*WXȏfu-W•m3RET?WGCc-WX~8fRdU 8knRxFCt#Rq`nm%ONStcN{?-h4><Va79{'7B *`˘{2;{iTjvU< @w,dfͤ6~>{4Jo%xڪ2f'CW`ͩ0y%C΂DfD5I NSfsE/9T=Z8UUJ~33efb!p6U> ѩqz=j]`u (}2Jst]ǹmN_ w/Ujˆ >< z!bqYcs"BP"k]6%.N1Z+q $˜^H|zq5ނ!O}GB%(<׵%La51L.%to,uz[DÑH"e,!:&67VX%$1Br2B0[L`"cr=!]g ctzGoKJxpXe\@_ PJ/,y5 [kut$zRs;_مvBTǨ_g7vXW, )R}xAX8Dyf-4q~D*JDا|)'$$CLVKXf('wΪ%;Քf\NjT Ǘ0  Ĉ1?I#w~q/{M䛲0sP{xavI*`Ԓ|2VZCpL=D2jCRi/,) I%̥}>JcLo&զ`c '6Ӌ{BcsRa'Ɠy[fV܋/]KLˉ.AKf=<V91 s(CQT{Eڸx`Qf8fP|Eq+u:VZ6OOl͍8=BA)X4V"R9FEM"xFTc[^LeQ5&?.Kq|NW+M'vTx]3mG޷YIIUAI`e':@{KB К0\VS/+#1$? ̇v@ cz-"N InM'#H_HI1m[J ѵ,7[6g?>5&yI:,nLHC>;y  }P6WبItM,X7oJ˘wϹma+Z}-\Ų'=! sfr$yj˛\ ܰcB۰OA{9Nh3g4lO2Oddд̪>>T~3@J}-JӞ4f1@ x0arزu%zX>@"{+YvZ7ic@it~./~\k^@B}}՟ PXdJsU6uסR.8~ u"4֦5SmJ;gsQlzb7cV>PEFJ(W9zEeƴQ+{ohMk HY/9u) el$$Qn=Lm}JK[pPlZsש_?`YU,pBXWvtDT9慈HX+IjNM 5<3j_XCj58[ۊۅ$\3$А$`cͯ3U>Ip̓ACf+&8 d{8i& !|~g]r$ڦMΠeӂcq؅]'+ BY4^W[ kAeF7xD;PH7/}z oQb4 ϶kJvn2j5az&%C47!Q2H rF `_Zi/2N44`d̚_FyhL(Y|LEڡи*H@IRr=ǘUk >rE(Պ'~$'.RCdO͎3I?˚dMG_Wluԋ+WpVMצmzxТZw*Xf@_r>s}L*4ku0l}<b9t=$$W~9"\ҵNc-ݏV/>w(-J 8!y і?)ڎ;u;X&t9we omΓB/j3;mmVS u]X|XX뙮JΘ- g'HWU}7= 5qt8F|GԌdɯ1b1U(|9}%Vغ];V0Z9[ŒD6iآ O+62¢Ub)vԀNo;rV4 ZfZ-?4D"=7ώNܴM#Tr^p7,?=Xu|Ӏ)Z9(ӗ룗V?'(LPeEHҚ~ X$Jq>%wn%VfhjS kfD Z=N˖ #`el 1sa@>]T~sM0JYQbw黝i2)N]яb@zXz듉`Oeשy]=2M9RKVCޱU1#pYM%a84֍z]f.Q 27}i]̞~"oqx:~Z^ni^K4rʛ8;rInzjb}P*텄l@ I̷2 IEo1%8c_ + VEmL3!.t6('Gitru*yI8jP{<@gcM=L=N.o_*YslqzIS)Zr[@w3"P&< AoyF^£Sǧ۷h;Q'LH =dEb"1dmR-V>S0VdkUKgQv}ʔ%#u(lu(6f]nsUTբfoUK\Ct:2H^b^=|N R} jgB8qpо~CHnЯZXq|SV\< #mKJOd󏁝BM:46v[S-ZWcԸI.,0ni4>N?Y1Vj8SeHmi)'mAHPh',b2,#a 5O̟F7&xDDL0!dՓZ̤e| j@#s,Ow(o; I_ۺi*.5 ()]Mq"5&D//lieSYR׫Hx%kMU4^WԢeY$r36ڻGWܚQS;dɑ")訄if& !]5Vt>9#J>@&2 \7ȍ/fE[uֲ^^SPH/AmMzmIJݘڠ{(=wW~R/DmxoC#|0r76lG7g`KZ>/TشK:.`L d.HD_sakҧK!v Ϗi;GDv40G66a銃MDTLgԬ^^Kh#Xsܗ dRP3$#؍nJצHhKnl)&浛.D;'QA(n,c3t'{-9D2561יESDwc(N\wMkOv#%IQ߼,N?i ^ճ}:]\½dT/[67*e,KzHS.MH?NlBPH 8;튪,}$gX4[P`8L Â"b)2wF{J QuifD"4_-NPז>.LtkSK5f\h>i6 [D䗧c!}x_ Xi2W'+cOd݋qQc1Y4 YvtnKW[Oz=5dm=4Jp y\QpOuaIaN"ow j>KĝRas ҙ+&qI 3LU/0OڈɣʘR~Ю; nIZb.n和i7B4DntUxcM~"nM#uy[| h6U ]s`\\Ny VRX!TR}ĉ=@'ASy?7yEk F"~b̽J6!_dz5)Nt*.Ä}qP呋;KV\a10ѽ!y& .SӉ#yx]cW=(QngHy{K 팺o@J\&1 YZFNϴdD@hPc%Ǟw$oQӼT=2&zzn-%'N\ _@mtn;Lu19-#| KZmvds :bȧ 4dbIf~VdFN/$dǝLf_A7m7Ԣ4#) 18bւ+rqpn% lޫ79tp,'C8+Gug^۝ozdk2XY~PW1A{㸫w<,һF xAfIoDJmʣ{aHg:az Tzt 3<<5„rط(%Y4KbߧgZ 8>\)wW: Nliɳ3i9v#H_x(Y/ Mkw,* |I=W LxAf(nAKAp+3.M+3CvOza-*z—*}BN0eQ [8ZV^51&/x]?R񛣛8lMj# _>cઐe켬8A zf!8]O90[ȾZ6]PQLg6aQԑ-\v4k[ntP.XDr̼3X).Fd_(e;N:}p5=y^e?.|EBm1#E#`mAmw˕B]&*bI> Y!Q11; OhZ߸T:Yked"UD7>?#ەfsQxUɁ,Z!]: Hh>Y*Ɩ p8#0UjZV3QjOwsXɂqr85"as/s 䝏bzfx*lWDT"j"~Lx{2K]X";S&/P d0&.ooQjޒfKfw>8T~^GOgY ~JȞ2")A)nk{ʞ9/QP̦P&k5 ^qJ/cZ{h:eCĹ1 1YL cwJ8C7d!ez=ibުI<\;+RԒCVʤ(VW}+"a"FENUqMƨ[ē endstream endobj 46 0 obj << /Length1 2107 /Length2 15151 /Length3 0 /Length 16421 /Filter /FlateDecode >> stream xڍP\-KwwwӸn ]e}}1Ǵ}sENB/ljg 9330D唙YLL LL,䪖6ՁNv 8:mbF~rv `abG;G)@ c:!{8Z[8*j377'ݿ¶@GK#@h^bgb tT|3;D<,A3K @A33d{ÿ:7H+[_J~ SQ;[[ ,&Z@^f SD3,\bvy7!LLLlnbWzU{H |f">f/'#W O33` 4!n/>{>>^v ?_F9Y1yaڿsxѳYؙ\\Nv&gQ4wLBAfv}?iOݠw.y̸.;+oݐͿh3>rv[߮wVhjbYig=-$,݁&vTsgfb_fX?9'_}q8 ca9:y 0 ;;}Ma#=.`f׍r28Q? (9?{AlF?轺^]0jqsF:{b|oz4bLl,llYlmMw=f_O?|l`|i޼?2??CA3]vEwn~o}q6Fw%O{??4?%w|kxv|O.L@ǿK8:A{_z]@9;`Za7qi]tjzE.Gu[h+T7BKD/^GmaIJO ʓ >(:n H*` -C…Xy/0P<:W!\>EP2Co3KLOGq:ss;;F$@sZ쥽0ZԃGKy1:I%*3UZ86kl6fsW^R| K:*z]*Ѷ8-|Ef]؉N!M]{1s ^&L;F@^k>;h:ʍb(Ne]pJ<>$=s!9zMcu~me{oO<)=%W CC-w4~ iJvf^k"⠁^"uV~ǀ}6VZpMUW6zl\C D_pKZGN\PL"vW@|@uMNFɜp//Z-AQ}vZs:!G%*I:to%EqŸYT`iHܥo23L[Rbrb;v ٜj3l%ԋ\ńnd)rPVom[Ktp.0~xJLB>h\lV\KLAR@Tz.̔Ig7awBMs"eH\)ʽ`'jǂ6_c+'Y1BT9p& ERՍ8V #$\!/H~Z蝕8)\dz`efo3c"ZeqWn'" W-NEorjVB ~N#ߕeb҃  G3=b񽽔 b8qZI4aE<# q! aQ%~d?~ڦuOq EcE#I okʟ΍hc_prydB~ʋӷ@ͲP1%ׇYjwj\ u~kttL2^WĦg[ÛR9(ŘT–$jfnW {NJPt0$feѮ} n /b*hd~޳w]ֵp.!ZBrq CrA|T%.k7IVsBWNDb;16$ͫtѹ(r-JA|)\9fBr8Z$&Q;ӹӱ`l2("HQCdZFR ~LxaҞ\N8`g$wc4C6qk>i^q07rT.Uqå%f>n$\p`_Qb]1QEj.҇@K%^u,,C .8\)E~-wjm4U~ =|2[@; uнzhj-ZZkAaKnOpkne™ n\ybу@"؍ց 夶CAn l7S hX-ڏ%?N+cs"8)ntmUˠvOQƵ;Y7#i3:CSௌVM?Mhެnt-;ѸZ?Rv;nA]@ń`FfC~ kt ,st5gS.eD,&<<1SL>DcGr}T6 v`š|cTt1B ,F1MAQhB[!8]bo]z5+B eH'`qIb vKj?9. D7Q$OrTv Oo-!j `XnT m6%l:7| \!6`tN:{?"%n%M ].4'tE.z݀нժe/?Q,_UYbTf { 6" ˩YĨ0lOs0#U%X&A(td 2[}~5ݻ}߈hvDJwk G9';rzh!g`ЎazO8Dn` .=r`'g="TM:! qjM~sRDNNp*t16nƎ 8َeo" r/*ħ0wxn}*2S1C9>$Kon*N"sCM,EsXhcư&Dm (~$ ͂ &PB,a(yM~nsv }Q*h/~j{p|scF#+2q!֠I|%zU1Yl-~wd54x4@l+qp#R%BK`f e1-C!y9i=#}F}z2 0F_TI`/՟7߶<9;NQ.Vk\ˆ9= n 53GNfN_P =3{ N$DG\@e` γdb'c:+]8;lmB#3YsWc, ]LJ2Fx}}KQ[M#FPFSۿBۨ=۹DҢ7({`p(Kݎ4ڮ4᭟e}ly&I⍙aHZŇQZd.Q G,+ ~l_y 5,J>4@A=䍵/îR>_VH^(=+άg!ec>$t(L1bΨ-'uaC־<]9bn$VPU*ʺZP(u Sn8/u ֻk.RT\( WuFiOILrf^ OI1A*nR {:ǣk# laVAXe\u݀4h 5oR65BFIŰjPKovєBMƙs}G^vA|sTlyImKؠP{~iԡ 1.]ŞYr5f4߱aGM~W/e+һUʡ.ą?\2|E )1 9"T k#EfHG`>ۉ~.v0k K8 9bj6*\ZvbU]Lxg+eVv;R6mf"OS>Dnui)¼U>3' j(έ_xyM|mwg'_[k3RQՑAPddnU{m8}%y-,)J+8{[> V}\ұ $=v/LcrljYrB<o8P(ǎ&fjv\18{dP-p3Gt18-ܹ@G]u,D-ˣXﱕ 'ԅ5zi/ZWXF&K7( UqSy{WLp<˞AFH+ԙG=уA=}Fh]9лyݱWDWWetŪ:W0sFgK[i (~W^Uőf}M#~,!}tsdH 7:a)/Paa;4:msrl{JN0`cO{ N RSgsIe׹3`a#z;LgmԠi'BUE1 y78?n&&RHU·HD =jYL1ıyZOջ҅)sCC.R7m||?h:!?8C?{O$\8'`h{_*z7 тq.V7sxd}Z`!МikSXKkEX:4,$a9`R"#'l-jBEo E'aP2Xn]E$I*5򇗛c^)40ѹi$I;XKA[R7KxM1̒KwR[ZcSN}*0 y<@=i/O:ȰvAv9= URgC@lk,]AxʞfV«Ia"|5StĨ} 2 u4|u*C!F}4 uY7YhLH\$8ouPǧ&Ŏ.&8->N%=-@ D1+TKdTG3=:%"9b,޻FY]Αޔ *­^sBE`p{ܓ`{1e1ļk@yN.s6IA;Xk n\hQM"s2 gz+;pղ M^_^f]1dQvE&Okȯ/b2%uĭ:baEy.jwgР wFs4 ?py}JU[hmQr~%ѩ^/@F4'ʇ X8ű} qxYJo; vauQgu2O.8/.)E6nj(AH@Jb.!KZSgH/K!oQI]O?yi@cd*ծ'?<~m4~?tZ&raD>qQ=jG|fkغee\2ؖ$vPz9ST> o?51h{2(eX1fuRH[㇋VOEq0ۄc}(j z 3F>l ߹hyA2>ɡK$p@J7&Fv:Oj'h"s[P)&'URPXBݱvՔE×߮xJJ|(!"t~ȮQotxQK 2B;h-4OfL_o!2 R2 ==ۖtzxZl^L(edtrbmtaYS@5l\u4vкa 5zcK"*7vh/Vcs;lmIɗ ] D/tI>lwG@%l|QY"VQj&WaH"E#|nف8p R+_TGġ7f j ;tE3F'TЩ=Tk )'U\@9ğ|>$^gdn 'ڡhȔu8Pn4Ԡ弌>)>ܨ¡ σr k!~*1"L3Lޤd|Tr?LrT8e)0w.X6 ` -: Ml09YJb=/3J?Fy_J%b?sS9p 00{8,տ[;AYn3lбb+BZ.;f"uf":XKL$ZNhĶUr91<g/j5h:C/&IP2(E H``xUI+iH1|X_, E|~S T2.91Թ7)vIj z.n'*lqyª>3St遜+>[2s)[tu2( &i|V1.3|_ ׻Kē( "hZ% G b?'quoH&vPۧ߮@KKV+ Bigbٜ+Ze< m&A kRk< "d+2pJbF W9ۡ|59v|Ul/G>HB\L;k ,N 늺T'dn_uI(~ }zzݲW/y>fE턱o+/ā]+_ѽa2?Dc|ZLMx-38DF@T3y~Se8?o!PUZ媬)hsjJߨ8TamB 5 &)7,;B7s<~1\3!x{]WYjjW7N=Ww Ҫ^_TdeMuz vu8ΛZ*( C* )rqvhAt%Ncc ."Mb,oBX|DLky;Oz30шR ܚFyZD[fڂFuxitȉ<]{^ZgH[kzVThIRDC_CضUcS*Nҁ@-Fڿ_w]Hh58l[m?ߛ*xpd7O&#CvBHvkk#])0|ant pXN F9}>K47&wm^f:PA&|ŵ7b,2ёj9fC9n@і7WMYZ2"Ob ⦮ڏ% ,'W#Ah@fR ˤ"Y].Q$RǚzVoyNTFabC_]Z+E\r/2A+U^.O9=R~=uX.IYAȠt<NcL)z0OzUQ[X8&u;VǽT懩ŹU)lˀkFsnW1?ڢM0!\gnE XoeAH <6(0uick,΋RtnV9؝SJMG֜|1Po9Kӑõ拷cn )΃ JM1J~u֍/̇XU#ôS‘x.w.m',onlN09Gyk޺ ~F :3Sٓ747Bѷqd2:I`&O&\X ?JТEg0̘BKaR#+! 7N ŀֶ~^,HXjXa3^~j)7?$c;AŐbpz ol?oxԕռB/p>mBhC7)kf]MMєߒ2m2yؔ릝mZl4zqp|h}LC+Y{1fzEӵ,HCF@p Jv_Iv}Tu T5(*/SL9:$HY`SXZ*a"Ã[AM)ʾ!,2%h'Fʃ} vܷ4[9DQ v/W8&s8˵ja vxOWW8&zG&Xʼn~b4W/q ۀ>;\LH~KVʙr6~6|?ujBk4d?+QtDG~h5^f,tB<|.ak k`P&\q×!{Qr*KfaNYO}z5[ G;3&/~Y~͔YX*"-Tw&CL'l& =xŰw{ krNu,WY 8iNEt KUBU 93zJ%oU9VMև&zǜ~Y?Q=7Q3QYPhTFmr5W Y_y{'ՎDS_R͞!,n1*QZ_1eR@HTd5f`|ct*}rߎ{r.ȉ6F w ½{1on{[|d:@Q˼ֲsOYl#MY 6sfN&M:5v顪uU-5)&_˰v3Eb98h$]7~-3լٷu&=HVv0jSZ54G%G`⤜?}P ,+fN }sz >.3:b_um[XQ0e#n BD+Ɓ.=7(ަJsb#`WMo"l}`rǂ*{| UpL;i`LƝF%pQ#iQۺ4Q*EE=𜪘$&IxpHd$6 Cfjmp[ܧyBxkF+3CKO\\d)ؔ^?zESG$Á#[`ۜNoL;Bf5":(%=IrYx 9\zy6#wj`~bIb¡wWR;K55(=[q\E ȔP㣱SND͘RS$1'%5NRGENU~i2EcxՇǯ]lOn٪ V|0/):/uۣ!lYC7[ 1*!GS[&(@.E/1iwVr-Iy^Koe)nㅂZ<#wt`/P>,4"uZ-= ٺ~SUz[;搐%ũĚ 0KR_Yek&hָ[~`"V>5|4UKiW?`n$6M@Ϲ δ_qeWi p~`G hlL:n jܦgmPcL(tTt#7ebᒥ htV Jě IUV׆)8U͌4>cKJlsts0QvfDn 2m%?oE[Mf&LYo³2`d;Ea 2 ^p0;1 >5ѫg&[5oƊXY2" DC}-KB[Ę6`Z-#‘ t {Jʐ. cT/vY ҇k0_xlCeySDC9X58"X3;屯Ei-MshFoO\ĢZpwO0:glg-J8wuyq.O*7i݋^LZaɕ s#g!"\o2,6AzƒåwWqbn:b9!~|_t:\5t<1D04{: ү߫w'X LTٷɮs!Ō dnz|"JAyo5TaS4O-syLѤ:|6mC4) S]ywqϵR7Mӳ~c2m-)2CM?+,^^Ľm9vP==zVb4dOk| } vg>`BKtK],=F`O*wi%llNNKsgG1hoWkU֙g~*uKqe kaKaq|\Um~Ỳ\"(qq*s{K0>gJ#Kk0aѵj9I9TWr*uEIg>W|2 v o\fL-3&l58$$yD,j@ώg{LFXv4kLۉ+$[$Yo;y"՟+PW>P7"& ~=/POhkpijK]ay Sp%,r#83n3{\đEr,RӾN1o-Y[ lS^ K&)&;p vMh3cWcb9GVIխ c9(]>I`ߺp^|>4s'VBM(8(*QMT1gߤQFAkyf;^!6ҋT~'Y6AԠ5!gti0]T1'}(FP^LU'?K ?%3q!0'jPKEvjN:D'>A>!H~Ǯ/a2w)%Xk޸yK77N)eT-q^ ,;q%<Džex}Oˆ2KBylb+eoWZvE{g|9.UEP/1УJUy/+e؏|[HqM(: JX{;82=Zv'ZkoMU 3GF5aW_CYeADZwJ'ou's$KM]~p XVenUUtڄ?z ~nhl6AAZY&˞_J|Vo~rps(\tk|5n]%1k%IM&i e{>?wt7LV*? ?uT*KN\1"ih$f9Brw.BMs|ZkvQq$f\\u!?+ @g{1=vW0Ӽ:2+`> c 2}ɟQS~k i֚&Fx?"rPvgZ5w$KcH F#z41[gϵ:$2 #goIN_fܬ Upw.JMmf: wjaw9b/p L*v3tLe3TqP.r6!no:f|Ce}Z焐jJɺxDe[sLP bQP֚u&>Y%`"6G2Ε nsO)x=_t9nR,8a<RJPr9tS3C|(UPQ9B̈|,>a{sD38~{yӲ (RJlGJVFfWFA:C(bsҧ(!o5F( 6$%UѰAG6]5{7`MO2QȥS] -;ոnzvǍhz{:0<ٴ\ma#ñ?ĸ 9oѾ&T}.SCc2kGz^M7W7 sXFz ЎDh nM2bd-۫۔K3F~QVO)|@7xQh6=yWw2wG-&O*Dnz >/)/nxN%=ܥ lE.X|>Hxca,}!m#֔aM7L$y7ʵD7[Xx*%/o cKnvQ3݊#֒\y l>4?U[F(,f)c"RV,kG~Fb\E;0 FqATg}S [a2D>j26Qr;A -df"S)'Is-_`B`υHBHusn=y^ag?V!#X"SZmdnڈ 4pv7:NZb&Hj {<Ov Ļ`=."]2̢,)M1ɦ(iS\KIJD%+5"1qpk(pzGF\†4Y.ƌ2\?/JrcS)=#c`hlӟ(^?CW瘢d\H ޻( tmTPȅ羖6o1Y R =|PeWFjȅ[- r?3MWq$붯Psdj맻`d+QŏL6q( d/'Ӡ]S@p4`]J=bMKs|s?mo֭>VeMQ1+,8V9߬ Q Q[Ho8BT%9KopVSuA}a 7vNl'm endstream endobj 48 0 obj << /Length1 1523 /Length2 8171 /Length3 0 /Length 9184 /Filter /FlateDecode >> stream xڍT[-C 8XpN@#ݸ !=y$ܙ[Vvթ:gZEEfAYY E5v rk@mN?`S'Oȹ9oy@/"̑ i 1(`P:bi̿ F;p2MvO+Lm0_)XMXaŒ7@ vt~7 P2+:=@ ]ff<l! 0)jv<-PU(ۃ"0;+;'ٛB= PK PV`uvwfBMm`O񦮦[S'ŸMbӧn wvbunw]KPg'IBm`dm075݄=&dBf vp@>nvYNadm~fxj?{9Ύ.`t7BggC@3%O'3/tw>I{Ͽ ezCslz2>qq; qqx>EwBe0_>ҿ v FR= `G@n YB;M[7mjY'+žTm_36WiĠF4lqY%욿 o ;?<NO? /)O:IH/Q40 s~ <9>Q^ M/`q4xl >߈Il6Oi>|JldW Gģ̌Ms̀`, $l]rS)FƲ=*4ErsF.M)KEG/aM jㄽcb5=Y4Dwl8b߸u˸~VFt%F3 h>,sř ;^/*>18bog/G`zTUj-;8uh퇧tD-ZԎv{P*9,iw}3r$7QF1|}LU>_2O'+o..ʔ{żo*4A 7w wj|p?;ԣk_g[.$ d#Z&e,Y Ba*eyx6Y{>+hgY%x]J=.5'2^t+}ôY+VGb9J'S՟YFrcK٪r4p)YbHU{&M;rl*x,){ޤFK/.=er-Ew?KV]ݾurKzKħ88IP*}Yѳ.hQjc>!XC Lk-B.b+į$بϋ7ٔ~쓱|)r@QLw8M^fEA.8ouk#?ۯ5p0ބP@A3Tm2$!MhV1֘/@*Qd 'fouF%Ȉ^ca'h~_VѵL}==jyq[ʃI*lǚY}*r)E%qM{W:}1;,yl5_/)&CKzg[kY?-m`xJg .8%m#Z{v=#->>m dFjFbLI iŸ?-5'$,xYk0e^+}2Ӆ!I{ū#GBHiQp7W./5%#WRfFz~tN۵eU:RXc yӪ,BF#W{P+ dtm% ?lgPi峷QlɶWe?GZ 4kֺDBE Š$ k~tS7wY%'"O|1 ؅Vܷk$h#$͒r+ zf5~2D/Czt{7p{1=Pߴ"򏃩nPlYN% \:B_˼Ch64]7ҳ9 |7V_ ^!3%iéop\۳KX&l8 %1ICJ6͏.|K9~ee\/WY._tF`&E+Z3Mل=x_Yʒ0GAa{\]mS46C#߅ I121$/[ 2ͪ/Ýd#|g=fq@}MN ZaVG˾MkvD3*&J bHp_c=>u cSLnAhXÒ4f@[u:l7:$Ҳt6i:KRs٤!nƺIT J{YDINrͨ!q<HW '?^FuC9[TgjOGO$.(tE뷕Yɧ%s1(tS'G%g}!f&[k7MVe;x~Jqܘ2︬]e A oK ު}yҧr>|uu?wY\GݥRv zPdq#5fK16Ky?:W,# pjU0g^g? ȯYHU]jB_eǹKhrl_F&$G~OuUMLc3e`lI2T(pxXCy~e;x(3Ho )NE)dto8_$*$yiƴY.>)H|K|V%|)xYOww4*#R1F{TUoN\MׇA7Lq](@#u'^zv;ipK_|#S%$Į4Tobxnw"L[jϐ4#-ЯSfk'؇ygDhbzʼn ]Jd6ke:hMW"kC m$,Fe'YPEDjؖdHu:#2ԩN~C7]Qva1vx mFGʻgHSN}@rbeQE(9KMܑg1bQC!ۧ;͍ud|53۶^x1"ޛb\@`esIZF';t͗H&5?sLqf+${MԹݥ>%ϲ dV8/^zTx0FןqżixZC,d^4AP!M-?Rl5kE I8MMb?774-}J6IO\(?B\o;WESI;hlѡ6xO؃6~b.<ظ(Gk6g8WK+L.(4G%_Hbӌ.:1LV! WM J wqtR{'QL^]GWA~}ܧE[!\J@6{HmQ?`M&ѳ㛜7 PB㮤5BjuvD-k8#*|ҡqN;G. !Y e%[gxq~b%8QdhQOY`P&O͸"~NZ;{ۮlnBtJ8!2<'?:/8+u3JENf'ߐ&Qua;|47[VGN/B.7K<ԡuMI"Sogj'*.r#S'YK _K"#1_gByU+x=T;GN췐1z]i!WD3oQ#'&fPڟ?S9zDTw >KҮLOB VkX_ n;8a!>8fyM(rm?Gc>3>I*fXdAVIn}D 㷟.R./C+m& *pcPv6ɦL8^+mãX mo{jJBs0v>㮴^w姷/%#1>T)QmHAX }&HZz|* *uPIEbv+NKєmP` t$oZd{iuDza}N~E6@@v7SёM8RLoɤ LXkvJke>jZE+!HFZDhY Ț;.H\ l#dH >ie5 T0fx̖/> pTNJUGk_2Rq M6$tskCjCeȶZ;bĬW3CD$IS4pChW dx]A2Җ<[6u "p$.80/$kIXo?'퉺Āt vOwNcWs->s,z(=83$h/-1Pa.l/h5=0禼 X Ȍ|3LI|fʃaCP,\5Mo |ϵv׏g>dsmL\AޫjǸ)Kg&m^hRVw' DIJL_e_UI{2"_q*_B==)[`gjV_`ѐh 8cP0Ate90(Y%Yꢇh0U8t%eԅ;1lz}3y YL0_kZ֝3n摄uvX4^LP?3Y\]+yxÒ=?3wx/bNj녥lF8&9Τ*lEHkcM"Ȼ fB:%CdG~۞EwWH/@zuz]?I ho; OKbVhJ&|@+kWRAؐ`kఠTZBՌUAR,藬^G.:, :5[4ўɚq/jy^`VH!u耻l|E)a;"XN?CG  8ҭ[ܩMC1U񬘩l)t"IUe ?Bqk,݅Rk DCvKop-Su[1_>0%&5ΪLj1ςXhAgQ-G}1_%7!w~G3xIdnݼjRu` z:k̏hDž<rMÇ\ZmtRؒ 9@0Ix6 Y/!3;b#:P{IMIMSv1 Cۺ|*{3vG 2E%.P;hDS4ŋ9A QN~X MBF+u/UHW:Y7m_2N-^׷5Ơ~N{j7XHl[%~bu7??C) 0S+D {ctָ ǯ]_ Ƚ[b< %4D|M^㰔s>_hN4%yeqk|x%9jܛd0+FU,?U;n_ rw]2p? >;yz]~j endstream endobj 50 0 obj << /Length1 2079 /Length2 12166 /Length3 0 /Length 13438 /Filter /FlateDecode >> stream xڍveT\[&N ;-)@MF[YoF`cfYvdePgyfm]݌lMJ )0~_:[9\]lW[% [9M:#wpͭbȢao \zZK~`V b]>7B`cY&@ +{?hm <zoC`ϓۜ9zQYTEdSĢo&vV; oGVJ2޿}kԿsv kOKm?j=yߜ$]mmҠalge/vR-VYTd"o7m"i4SZ5&b0mLmޮK|[*ao`{عƞoCf{[N3_ `aw*;8#>Zn^o/m N`A,&ЛO 7[f893vvWb`rFNoCG-Q?!~#W?ox+h7-?1R}ouo[ߎ23v/[Ύo߮j{[9/7v%C/O[99([?pu43Go)L~#?vm1x'gY:Y[op.,xcSۑxn-[_@Yo[o?4EXs0 j!tgָyu%DbVij)#̻~%);瞖=갚1؁Q|'C*61nq ,xj#^i6ha_]V RIkHX#m޻Vfc-Y>)7_]_=C&˴'H9 E*_S $L̃]FLJEN:I#f/zY,<y7S{e Mqf7uݳu5ڂhe RKYIzM('Tk,EF?=H&I^v8aoyD>`YKy`0xGsRec;QXbRoWzr8˰$)=pr:䓞^ ~ӇoqlT&ϣ)5bn*7i4C2dF| *b;k,yz`hfQ1$9^_ee>Lֶ~/5pH>m~CM<)<7-Qw_h2PԊS؊b9xxi0A #{}J$͞gweSl+L]*_o>0`^Bg/_Ni G3jX. 'R"&Dj ka Gn'=Pj̦?eNehl9hdIלRXA#"DǤ‘iO' wZM Ǎ_)iK \zN:{tp3,zv :,A.{)(ar|Zga5 1RNU} ʔ y#8wv杁yAavM{RݛL5OO#˼(@P)2; iNa9\题:GHN:ْkހpņ^s]I̬KA5iq&dJ_`T?.'`6 ]H~c]{bHa q _8^?Lh^q@1-cCitމB/SXp4 9~B9Z̸ 3G= %*3t!oFf,zWgň>o4-OΈF*nZa#Z[ąj=iaB}+Ef~yٿ2`I"uEق#(QQRȊTȖq z3Kz#Yl.w)S! C!6x8z hLv4K&]msơJ!/:mQN7)Se?ՔI1‚g}E`aj^ET )oAj3Wr|wn6- a%]3:f2rn W< rFCzh_uh X%z<' &$NCVMzDM玫w":b`|WJpA2<sX$Wh?D{+jT)IiϺ慽 lQڛ͇S4}N >f{:'k''|=U×o<sٗ{z-ٛ@ٹA<?i5f#C_I\㗰XASd2/3/cbeb Lfoqme+99!iڄ'*`nLk;EKzθLdfDpT [d12X<ڝ.վwl))$/=Pd<ήƥF7Iw'3cv=~1N{XN 6.\hY*MD}ۧqz1kËLsX®@(f8Yg]H`*Gk҉ Ӷ%#} \9z߿fcjCǩ"VDvJlj!5Tqh'hw'.Vzy[]Bb 0)o1v@/pL{x #_wt\(f8$B_ݱE!یdj5XIl&!a%-R車UDڟwዓ% *ٔ H.F.l 4 fDXUD I>- 5 ߫ۦgK<8iTT)ڸG9R8b'B=EAJM1.k\ 6[{sabmms/xįz'e*4TpQS4TUjy۾?šC~teUF: |c :̞Z' ki'Ev-"Yw_f}^qOe2Sag̊7có*A:TO$E-z|k)q ǜ"ƅ^"O ΚXYK(j<4C^`4[9qMT93in2uRDQ;Uk EwЄJՋQ9OwO2}r&f֛k_uͶ~^p|ׁ@]^L5J hSb_ OO"-4ՑIE5 {invXJ -rKbnD:yV1FjO\tIؕXlk |1.ƺy8 O]3dET7zpH-X#F674)>hl!] V yJЛ}P{e yظw<;J^m%>rUb Mc%fL RA!z,MdBݴW+JN|"ڱ6.j3"gxL`⬋$)?PNL~FR6)^\\OѮ2P_Za1L1OҜ}\elNpPdx3v2¥BJlƼuOK j{?X%%r~StYܔ*TtLYa^t lYƃ_I%bba~] =q ,-\ra9d?7ky ^ !Mլ)I~n>I;LtZ׃%8.yHVrz%*4('7ᜉ?C+qp|h_%4i#s"B"yGu&qKe,\Bϔ ryFWɛ4)jYoDA6,"- mzha1y!(&JK7^*d7w XOǗ_%&ǚ d;G |j7iV?$ *xjOv%T!6QΡti AFknC/5:(dXh&?SFF GgKJfG:dP8C] !O8WIt՝ އ<̐Py )칶Mn*D9u a;R O'Prn à{*5,zhn?D7tQzY4*LV!C{X9$Cy1~Hl]r(!F+_06^dH„'-($ԿtI%8}|}!WݷQX@3J|tD=kRL %czbv~ZLV峽&fJ,nNM\J2]:JQө"3uXLV"n= L?gAιa t"S!(In]Pيf4 1.]CɢZv*˳+} ,U+f`_@Wqǚ86@JY3ʳfNЧq=!᪹Pj  š12!g"\J)gN^&=tO辿<@ vMƆMq hK+3 ݍ=pe\~ZŞh6Ul߃M,@S=4܀I$LL b~Dٜ{ǑQGTپ?^eU}WZ/.:S:{ZI0iL/6a πd1.3y 2eFsI%}[HDϖ_~Zm[,C1ܛvF(nUh^f8%á婵w:JmnYΩQKUe-!Lu$Wi9:Quq'<yoYnݍ ZgQHeJC%Ruέ`!8xb[ ^+rEc??}GD Z15$3u/["@d>%aF-_%LxmƞaG1THq?S+fSm%kl85oQqaq'ʝG{LI7S}).MM\y *SG P5TFy 7Pyǎp;\۬U6[ *;bGw8g, Ī\D`Ud BaG.{g (S dI;cfI躔 >7NW#њcdQikC'vs*-Q?gb=-f:Vp`x^z|3hQM*2eUjȫi*tĨDXdNwOdN RtJ;&m(Y'x:YY)2wQj wu@XK"݉`Ս:L}(mվNg]~NC4\%eH єMiƒ2[0db{dORY_y)(|ȐkOޭ;H9mxW9ģ ̅#P1FPz$٩]BZBd>g[ɲӽfLsРL-޿5toIՎtt~pT 傴(<8%mK3ϑ1tW ]5sXP@>ծt:т1'b!q曄Ek!1#' Uw.2ZHPPzgK>(EM Z%ޠbXnN͇|ؓg+L5+aJR|Sya(""1E|'r獕dVg~6#żxvd@|a7#picc5R/>3Wkrַ/i^z1eɺ}KF?_]5UQGHWSsw)l Q<%>*Bd*OȖeW{z>ڔ}L Ѭ}*c%LiIU\26؅;zx$ gPiMs@Z.u>$Ӱi7zT#S+̓ha]t?~_SSƗX] /AS%i).^7RBMw &Yy5+hG9hVړ OW0:V-3=^^VG/*ۆlP-qCkpv4~jqZ=0~O5drPKE{[9XFwi4!%HG"Ś݈G-%fu4v*/ܡq}.Zy=v=$ll]Yxp9Eѝ'l7ݥZ)JNǀo:T$2 Iߝ`a r9A ?+'ѵ€M .u%Q?f4 UF̭Y tl 'Ap! oix;ʷ{PPŭIzIX"ta8 3iFB_c$Cn ~d!/ |Xy#tΞoG+n,ddn"PP *M;VYѡI4Ҟ[{ ߩjOdfLygIFl;鰗M͍@wFjvFmdZ",[KFN"\[Ose4ϊwtDf'Kڝ-?_JH~:nF?'H8B U0M"m>Y8anI.r_RjΙV-;Q,I i6Gb0ˬ-?ʢ iES6_o4UAKa zgϨ]شtÔ"؇[㝟K~p(#{٤1i⧈7&'98gn}`0W]r=٩A*WWkSu%>ܐ!> stream xڍvTk6 %% 1 5tJ 130CK4"ҍ J wZfg}}}u?P׀[f VA<|E-C OOtcy @@`P@(zAHO D`P+_/"/*( -: F(G'$jv~qqQy7hN`7Ԋv WF !x`2\o F=_#An? 07 @9\!v`( {P 8X/yܟ_ ;;@W0@GE W A\A(Ay=5v8W6+Cann`(?%ᄐ m9@ưA!` ʅ  }A_n pq~ /0 -<~~= ;BxTG٨P%a0?G̫|g *(|܂"na~?? @T: ȟ>B`E-{p]Kb.-P_tc*OwG*8 b'-J Q R<hn~!> l A9ŚF uaȯ_1\PE!0JC^Wj%6aLJb0J{o2xy0$*1u^/oE5^^?&0axuhၒo*}7>`;dsmxyo!ž\ ej/zRǂsS[+_6PX}~+A9_ߌ`dT+BS`KFjHNDnps:kGU]Y>[H|,}11AJɩV 3Hn[ EFZB):d5.!\$kW&}SFf 0ɲѩ|{Isx-b@Ꝿ~"fJ}ӮwY(\MPQܗa ŵV*a)oJDL2j'쌬ƯkBNw"-g?~rJ8鹼~zX[r<J D8ОV`gE &>>Sz%Dtk"+W=xtE|`S:3,Eȶ΂ݼzC=B1KnrG0e0$ѷO "}ˈHZ-0 ^{ք Gf\@q>M]'y@;4zS]үpsW:' K - pR_7]`$ xlcY9\QBC2u85ieYi~N 3\wg<Ɯ4(6/~Y%Xiߒ݂k{9M‰Q;s3{ͅK=P4Rռ|VM)?P^Tb5 `H"4 o("ő~0EԮXZ vAl{ӎlTN\lR *ԔS4!A 5|O&|?B^@6ٱ%Jؠd~dVAP}ެiny@jH'+wIA=`").ƤVW~eKtZ~I~dd㑍ZNV49DK\a3?z@g.Oy?a]ޜ! q&BJ8A\,J{wcHh_4_"mLXeҦߵN^F }oeE|dylGzCЍ֟d~HKЀZ7 COr1/!Y?'[{ (>Ŭ7Q)m[bP?ŻkKG nxA (F8 ,vQ\p(צ-zu=O9˗Mkb#-Bu+4x'JqzE]/w5 2iu03EHH2SZ68rݗ͂&~xq!+R,ʕW-~fۦA_4}׶z#xXMiPލ NA< 24}̇`q'Gq4?D|U|Jbec\鏛o/"R!Ћu@Ǔcw^/%T{`T!< iBCh|&)ױFiЯ~ǥFs ʏ II0,3{>Q2GNc6a+y˼~6mimvI#ma{Zf/ fĻep&y/JT0YJy bjGZVGr#$9օ;w+owV0|$ӟ{9_t5,-͝u ߻[Ou5Z)'UQ[-3?Khvj(Fxt݅1$E-IųsbWߤJfy/S\ЮfTD]S#3|z4dȳgK)&t^Զ6GJ''(@&-ٜ3kQ.!rX4皂rz_إz}b98^3~+]Yűwŗ:rWUI,f&vx_+<|zȾ_9jp|QP*9^8zW ZOVvF85t3L|ɲgG1 X[( K=:SS$:e{vKٞVhѯR6vï|AlpQ2^2,gc[&/ŦgP/\F@XgƝHfO3UmInR)!vĤk@jc@o7Ɓ#[u 'X0WFbhyn6QKOQa^C$^*rE6=r~cơ\XWbrGF3YgGhxMtbl2P4exW :b3Shу.:}|)IRFU4WYx~%D ZO?>&Q'qGˬ3_,`i"m&}o  5KՃH@2}j4:ҹ9J+/!a1L=B Fd5#-O G,b&;eepۦjKtoگ|wg9_>,߳KƠpn/QYýeqʉw7"K,#0Zr)Bg974E 9GYnZ3?.2wJg]ĝPeH2|E Xev0rybdf7y+5m`,c`B[+p38'4U4CU)˻$b}hOS% ?q([cf+ :hؕ%hCY/tNoFx,&X+`W _$:Bm\Bҡo9\W>V/׌7U;H4`SwAJ8}loo>J%6ּ,[D:6Z(!a4DxDNFz>8b0Ț"yG(#)36廊GH'hH[!&|'5p[G$hKƯ1Go}TY|5Sbi*CݳpseL{g GĽ!0=We@p|ݼ5>-Vip]wl`+B|Է#wU݉mLGφoU^ܓrB?+t9pM0lM*sR&OQ4a =;-)2i ֒@7v3~ yt?W{2RiOX b,ҢYVdj%xG`@'X+n`ja;z1Q4yZXoLǣ_sq˵lشL)BoQX6 MLŽAJ$Ґө}Xec-YlEG| 8]ѣ|C:;1jij D~pmOQ2̈1˥I뤵iyt0Gz{ k>x9u@9S#GnF/8 Dx45`X DhN$뢢=˧$\ǩ[gSK}#gVwHFFѤ$r8>sE`*%=B䲏#:zHOU{Pʦ'0e ˎ3৞Jעŋ!~E GC&^nnw8]rUҜcI\Z4`В@W \LD}m##z{@=OFG,7 $V-5[S{m'b#;@7&!xdAPX8Xx+/tyюـ3 պ'=MZt.@FjM*xߙAIjYZw,ϔST-Mt7[FvTjF-+(ЦoSܑ)lT6kc9Ql'zXBC{gbT/T LȪL 魽 W!0V^~ WW-3znlO1CWY<4Td"RNyp6G*ۻD慓~rMCЇu1:1aϝݰA~Y 6'[歩Zj>4%$ɟе٭s4֍%Q3R@e~W,ICN3вu }JaKeGcۜ΄!L-W:b3ƙˏ.&)>woJ4㕟+.6SFrye[qb"@ؑpHgAGC8X>V3Ƃиwoc}ΗnHym)Ȑ*|sFOšT5{CV/H9™կ8m9@??KO '-ҫKlJB8I-%&b.j༱5ls0:%nS6< Q5|MEڸQƐ̅K\`-grVJYb:%bQt/ He&15myrJ _zȐ-)Ui˨ʵVg}5Ԟ5wTwh"D+跒T$6 ~BBkzX_EgUq*Dgu;#d‘]7ٟ8q>ӠW{컙QFP-Yw63ˆU`FJcwfcGkwX}sW>wb$g2kHn"*9eȩgdT_ > l&'[*=2S_fޔ*΅6rQFz.Crw~Kt1Ⱥ`a Ds;q6<º5vo & h#uFhn/< tuqwJ)i-Vv 2Jقm+Idk77c;M֧OK841e vZW/]֍Bo)叵q aDӫa?dh =vX =x%G'GU8}Q>~xVȮPA=߸ V,gv2E}WE9zßg{߱-s'[n;Ԛ,W \/Y5隭OY;=JD/)TaQ&*c!{u=ճDZm%;•trz5֣؟N/,or!HryRr%-Ͳ#qgڛF/G(-;A)O&u9'uBkMxmw >ud`QrP57ث~j. !l$Ť`(J|aG9["FxPR'aRuHƘ%#5g[Z=(.2ʊњG/|[Tx.)67-[-`E޿U%eL9}7ȂZ|lnA -ﲥaw`L";ȖW*3{ø G\w>%آFܝ蘏BmxȾQw ɫI7pNV6ϬTFeL‰ݞ]  a6Wk!]7 endstream endobj 54 0 obj << /Length1 2175 /Length2 8485 /Length3 0 /Length 9770 /Filter /FlateDecode >> stream xڍTk6 "0tJwIJ* 0C3tw4"H7"HHH4HZ߷f}{fzm=nYk%X Cr| Pefև"2? p.`%S!Qp@'@ .P\fy G;OLL/w#j4AH[#*Mtuww9"x.6R\w( F]րߔZ G?xpP =8rP@¬.Tv\7?޿Aa9N 'f@'J^? *%602Q J P?<~.8Lllo B %Q H9Qo!m(!+ 5mQQRwU;VGPAU+6ov B嶿i(JHw@TC(NDv;m Zw` wfn%bWr^)Kν:/0"ۺNő@AlEm_ Fd@ >d3-X\>cDn#4\L,`6d2ɹV'27%YlYwxcFcS  \JVU&ġnEzrl :t)zk끓qTF03J"e[qKH %vB Da CHKnh;uwDB8lLWyg57/Kfk4V)>-f4FzҍLN  NX=88˯ĊY:93I&KM pxr>{2q(,?k GNQPI( 딬 g'c%*tIT~w.ʥ05s\>?P.!l.8w0[z2d>gƲM^_S 7p`q:~\{ܟjR:&hؿCAX3k2è:|b9]!qYk9Ɠq$fp oűY%L^͸T%,:6:(4*/`*"_)kFӛǭHp[5ꮏΉX5sm|ᥰɦ: q4=CڤFG!~Ѣ ë[ q{]6oUp?Q4e8" FTm.w<$2dkaqL/=<)U%%&:TINC!Zov]$jDrաIij+|'x*HZ3@͂㺌Eڏn2wLPr,؟< *Li8sT:ܤMV‹sCMK/zD@#c/zn =>'6fGi*ۄfieQ%?'x\Z|ap>^7fEztЖN9% =^;%^z`DAbjQ )b3"HayWXlz̻5{2S7k"*0a_?_}xt ő+WBU}:Zkhqt3Θ7jZhL) Z@3(Dඟ\( ިʰNvgⅿ{E횪} -~Ρ5ὪER_Wq h?-hvZKU5w$Syu,KeyvoQs9m駧//J.а4O2|)ݣaM=Sp{1%$WFեYjeTv[|4°DZ:='&.DsHw ^VX k~V@Υn`\q5O+\-KTEZҐoМ[|aȜ21&!Cw#3]h-jԒ8#XDG~nާ~W󊕀fCL)'ƚ⽒Ȭp _24:#X˘89sr~ʒRkoPՉl /sԨ{\6;;e/9x1 =wg#sN!lEsR̠ 얤:1f _ϳ*ݷr@[8.Ut]~v|3cf Vpb5) LnAϏ7-J[Rm]Ru=su+)8MYaM)tn!.(ē|Ͷ}"S+5*,T5:ʸWPRDz{J|+9wU >+s |W[Sa1vj)ZxqmeγԭǙv͔+5䒕&?Wm0`*xg*i TFT)(O1j. /nw BZ'؛Op 7mAV$ʅ^~+;ǕkaI-/k[ UMs!o$U|fɲJPW_\mTQ/#db +dNOþȧeDyÌ(ъ#|*9Gbd~SiNHi{YaW4fF#2]vZ^d |[G҅>.3M>/챏Tzs(*|g^jWL!oMu7:L62ы˟h7$CS !1y:>ca{ҙǼ!̛ F2P:*V|_ln4qpu֘iJ8Ć.D|bm4 5Ƙ8?wCBah7}'vǮz6^/պ)}c.1a9szwWb$z1ThK?@>ڄ6-Pvdb G3EƎ˼gɧplWBW!Gj`㫥ѫ`>BVʼn;U؄nyP"ޗ0?g{Or˾T`Kz.IEpwwۛ{TibFO0ȱ۸ 0yv m}LVl:gBc6e?sM ]x } R#֫&ueQ [7K]-];|NPR u.]x+#dl[/vIl:Od1%X%X`Ϯ{ +!^ۋkj*RC,QEފCptG}e%om,Hʈk-YF}VЎ\1}*մ63%<[#ԱvHhIӹ+MJGTҎXd&"UgnO"=a /\|.LZZa>p V\ͳnLl)K84"A^ IN9qtC =;>C-lˍ *ެܙ ?^+^֕+we˶X!㛜ۧyDә,ؼ=s}ө$zV8t:sx59]3)}&R"DDH!ye7r45I}[J`uD wZ-m'?K}.;2Ϛ ik*ٹ4LSer֣Qհ57P(vErqFOˍ,7ysI~4*L?QiZpPX3w$w8Uh݈kDuOPeE$YGh\p=kO:1T չL7BrJs"E:ǭ\arcSn++,oRp^ 8r}4ԀƭT6C)Cbgt#1h/ _xu9}}ug`tv|tƗt{܂TZ!H*ut{ey8rt7٤ꋅCmEs6ϓNEC\Gi-Tx0gRkOG5Z(L| B&iX|p5nSN|2DYSIyzt ͈ -z)jwn$:[ K Ӏ J֌\y/egfau<=D&H6x񺱽re|MOc8kF}&_&UGJ ;\U0 a^V84~3, =_G8WS@Å{qUcx&&QӢ:T*NDyÀ/EpNע72~\lwDZH1)gcߑw&j/r.JDeew8 {~~KzM;buډ닋ĝazHKH[őNP-c嬺Eܮf)ܞxonoYhgLϐ͚p`oeEt0U _3F m3I1;itDZLF :[0-b &]oVJB>bEGng;C->+^ڀwLkzQBia+(WDގIsB/hn]٪|;ӻ"rSxwMkC4h3W? mc{+,%,Tbk„(cxp.htI旼zIlhCHSɇ\΅BJZeT)fI5Qz1O5>dUoMfϕ:].cOSNeut5S\)Q iD\Y?wF^|* rsh '3 Ũw^Rt#z+93|94e0psΛu0A%ȦDPeBMk3B>55Y G3wbw_or1̴C/Y@v)wqzy-G>w'cJg7xFG W$︶]'$'.hrpE!^YMe;~w Jxz BǥځnDkUgI@pT!K 4d:s.kh ̓s/0U[HiEo)sgm%9^`޲т-$+)(*?ߤIx.ίɃՉW\*ժk*D5Pj4dZyY2/33*DHmFֈd7Ⱥ͊8s[\_cF=Ԥ۱]4e]ThQ'[=1ga`GS mt<҈1ܡ ĕJ,7:6A8;b"/My~@B PO[l]Y C$cּQ(y}+{ꦦpg,oCOZӔ$TE tycs- gD*S_j9Kq3 Y]B/ZP66$ oaCgri~.{Za<<2#d>@p[*kh+L}~H>#'LIeB!)vnVN/͐A~)փi3X)ROV/7/—<0ؕbn |[~`Ms7a`1 ,kYJ:9Z$R͵ 턂Oi$-Wco b+8<)< h߱hd >IB~NԲ͐vxS̝+k 5;䫪;-zIGB<k')2Y6]d/:ޤNKŮGQU-.':A’ *Dp4h ϶ĭDVT=v]05܅:G3n3~vMtK)2c(3I ܫ[z܇Xg)9Eq^ɜs3tq$'I*:4[:[> nI+A54J]X/;ܑfӴ|EhNVBʦcݒ)]p!Q@of{ټwsd|W岋#bҺ*-kk?;*0K-r؝ˎa>}e8笏ﱇwuE-v,a Ӂȡ]+Q . R:o~c,{s7 :D=PޔxPEߗ[\C= MQo!i4祍nH |:pU./,f ω=ns"(a+Zm$ ~Xx|,*h^ 3S{3\̔PWpxsMr&;GG̨rh+DQr->x8Gyb}e˽4Ig!c3r & ;uIaAיfft /!Wyf:R֎Ӻz~OտVs;t΁]lZ_g*Ǥ"떾HZZ,]mE}]]˸w|u%*"sXV6\tSڍf! *;KЏ.4=2zOБBSaxrmFL2UB/2NL endstream endobj 56 0 obj << /Length1 737 /Length2 969 /Length3 0 /Length 1537 /Filter /FlateDecode >> stream xmT{4i\Q/1eBAE̋>f\:BrdS˶tR)*E-V)%i?t=?{}ykbA >"V< 8l[ (J @ S $E3!kAbTI0bB \.^.I 6]! |{='?xBŘxcBK! D$+ $p6Iʞ !I"HB||pY xE{]SR: xw>iMF8f aB H gXGN d_C4!)F2J 0hIC qcIl 8TKҢ⑴V\;%I=8((Z{A% s"L&Q^i} \U7B{ZDȟֳ:v?ZQś1ZͅWni|Rdj c6uQiy.COUwhan+JnYmPT5$VY.va;CJ~t쩢)Q:{O>XqkIkF6]^8UXy[s6!%l;._.6~^dc뱪Ϫ fF Ӂs1Q>QX03L8 u' 2Ɲ$YbݦZɖfgg v}5G]ߜ+IӼ蔿nm<`~e!i_Z <\m?_-[[\+kě5?:6xtvX0eƅ&eft*G~غd*#R /)xi`7ovmLsä.|ղ)C* endstream endobj 64 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.18)/Keywords() /CreationDate (D:20171209003337+01'00') /ModDate (D:20171209003337+01'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.18 (TeX Live 2017/Debian) kpathsea version 6.2.3) >> endobj 2 0 obj << /Type /ObjStm /N 51 /First 377 /Length 2067 /Filter /FlateDecode >> stream xY[s6}ׯc< ĝtƗ(q;is?02l,:"&= R"EYMNMgD],b%00˴a9DLh&f0iSEdJ4L[;fc2žYv̱4L, t%E&$Dyb@9BRcè ¤i ;K&L L$LCU{G * T<P$HcFRz R0caTKz)1dR*fUdV<0U`_yRIY J1p bPӧ3(?dO0b:;OլǺ²>/;<*̲kj0 ;c|W_|f7aiU'? e1CISkU_ه:A!ɷӄ8eM&!Ѐ h]##xfK<3^R:"o ]A3Oy৳b|*_+ RyXpKx~f~ pT'}$"0MܶW&o3 G `KÍ{M,*i*i˴ RuRW!6.T6Uj9,o&r=ڝClQ66g%KS=дuu 43ClىuCZٔTyZPRNSQ֩Mrdɭ!2ڢkXBaJkv?z15^F۵qh )}Oo8 CX SgR"Mɖ4Gu}-4Zk%T:mnۤm']fܖ&NBigv"CQtQ3h|G-l R雤jDH='@ím[=:_eOY`j  S6.դh ,cqٙv-߭{ -n^"$+2n]P$,6>~ e%x{;G9պ{H/Ol^קwkM]{P3 oo*4I1EzwEJuίq7jHh})+×0%ng!/w?¬XanwG66$il le3y# =@L.;uq!tW*7pd;XH%@)*]_Kj9G<&"?f! 4~j|[eg:7#B4҅+O%:Ɇ,'|*aBR RI=ٴxM1++3*k oUu[53W{n϶&6¶vo}i۴wUF+],ͫt{X3ƽ[n[~{3pk3sTX@o$k>G .Kq8p̯ws \Wz^M&f@沶[.rhxk{K0YNr(Гb{^ej>0'NA}ejj>0eC_bag#wUwi]eꩱɏ } (dA <1B7B4A646A910AD321CF73AEC52C75F0>] /Length 179 /Filter /FlateDecode >> stream x%9RBQs>= library(iterators) @ An {\em iterator} is a special type of object that supplies data on demand, one element\footnote{An ``element'' in this case can be basically any object. I don't mean to suggest that the data is necessarily returned as scalar values, for example.} at a time. This is a nice abstraction that can help simplify many programs. Iterators are particularly useful in parallel computing, since they facilitate splitting a problem into smaller pieces that can then be executed in parallel. Iterators can also be used to reduce the total memory that is needed at any one time. For example, if you want to process the lines of text in a file, it is common to write a loop that reads the file one line at a time, rather than reading the entire file in order to avoid running out of memory on huge files. That's the basic idea of iterators. Iterators provide a standard method for getting the next element, which allows us to write functions that take an iterator as an argument to provide a source of data. The function doesn't need to know what kind of iterator it is. It just needs to know how to get another piece of data. The data could be coming from a file, a database, a vector, or it could be dynamically generated. There are a number of iterators that come in the \texttt{iterators} package. The \texttt{iapply} function allows you to iterate over arrays, in much the same way as the standard \texttt{apply} function. \texttt{apply} has fixed rules on how the results are returned, which may require you to reshape the results, which can be inefficient, as well as inconvenient. But since \texttt{iapply} doesn't process any data or combine the results, it is more flexible. You can use \texttt{iapply} with the \texttt{foreach} package to perform a parallel \texttt{apply} operation, and combine the results any way you want via the \texttt{.combine} argument to \texttt{foreach}. Another iterator that comes in the \texttt{iterators} package is the \texttt{isplit} function, which works much like the standard \texttt{split} function. \texttt{split} returns a list containing all of the data divided into groups. \texttt{isplit} only generates one group at a time, as they are needed, which can reduce the amount memory that is needed. But of course, there will be times when you need an iterator that isn't provided by the \texttt{iterators} package. That is when you need to write your own custom iterator. Fortunately, that is fairly easy to do. \section{What methods are needed for an iterator?} Basically, an iterator is an S3 object whose base class is \texttt{iter}, and has \texttt{iter} and \texttt{nextElem} methods. The purpose of the \texttt{iter} method is to return an iterator for the specified object. For iterators, that usually just means returning itself, which seems odd at first. But the \texttt{iter} method can be defined for other objects that don't define a \texttt{nextElem} method. We call those objects {\em iterables}, meaning that you can iterate over them. The \texttt{iterators} package defines \texttt{iter} methods for vectors, lists, matrices, and data frames, making those objects iterables. By defining an \texttt{iter} method for iterators, they can be used in the same context as an iterable, which can be convenient. For example, the \texttt{foreach} function takes iterables as arguments. It calls the \texttt{iter} method on those arguments in order to create iterators for them. By defining the \texttt{iter} method for all iterators, we can pass iterators to \texttt{foreach} that we created using any method we choose. Thus, we can pass vectors, lists, or iterators to \texttt{foreach}, and they are all processed by \texttt{foreach} in exactly the same way. The \texttt{iterators} package comes with an \texttt{iter} method defined for the \texttt{iter} class that simply returns itself. That is usually all that is needed for an iterator. However, if you want to create an iterator for some existing class, you can do that by writing an \texttt{iter} method that returns an appropriate iterator. That will allow you to pass an instance of your class to \texttt{foreach}, which will automatically convert it into an iterator. The alternative is to write your own function that takes arbitrary arguments, and returns an iterator. You can choose whichever method is most natural. The most important method required for iterators is \texttt{nextElem}. This simply returns the next value, or throws an error. Calling the \texttt{stop} function with the string \texttt{'StopIteration'} indicates that there are no more values available in the iterator. Now before we write our own iterator, let's try calling the \texttt{iter} and \texttt{nextElem} methods on an existing one. Since a list is an iterable, we can create an iterator for that list by calling \texttt{iter} on it: <>= it <- iter(list(1:2, 3:4)) @ We can now call \texttt{nextElem} on the resulting iterator to get the values from the list: <>= nextElem(it) nextElem(it) tryCatch(nextElem(it), error=function(e) e) @ As you can see, it is possible to call these methods manually, but it's somewhat awkward, since you have to handle the \texttt{'StopIteration'} error. Later on, we'll see one solution to this difficulty, although, in general, you don't call these method explicitly. \section{A simple iterator} It's time to show the implementation of a very simple iterator. Although I've made it sound like you have to write your own \texttt{iter} and \texttt{nextElem} methods, you can inherit them. In fact, that's what all of the following examples do. I do that by inheriting from the \texttt{abstractiter} class. The \texttt{abstractiter} class uses the standard \texttt{iter} method which returns itself, and defines a \texttt{nextElem} method that calls the \texttt{nextElem} element of the object. Let's take a look at the implementation of these two methods: <>= iterators:::iter.iter iterators:::nextElem.abstractiter @ Now here's a function that creates a very simple iterator that uses these two methods: <>= iforever <- function(x) { nextEl <- function() x obj <- list(nextElem=nextEl) class(obj) <- c('iforever', 'abstractiter', 'iter') obj } @ Note that I called the internal function \texttt{nextEl} rather than \texttt{nextElem}. I do that by convention to avoid masking the standard \texttt{nextElem} generic function. That causes problems when you want your iterator to call the \texttt{nextElem} method of another iterator, which can be quite useful, as we'll see in a later example. We create an instance of this iterator by calling the \texttt{iforever} function, and then use it by calling the \texttt{nextElem} method on the resulting object: <>= it <- iforever(42) nextElem(it) nextElem(it) @ You can also get values from an iterator using \texttt{as.list}. But since this is an infinite iterator, you need to use the \texttt{n} argument to avoid using up a lot of memory and time: <>= unlist(as.list(it, n=6)) @ Notice that it doesn't make sense to implement this iterator by defining a new \texttt{iter} method, since there is no natural iterable on which to dispatch. The only argument that we need is the object for the iterator to return, which can be of any type. Instead, we implement this iterator by defining a normal function that returns the iterator. This iterator is quite simple to implement, and possibly even useful.\footnote{Be careful how you use this iterator! If you pass it to \texttt{foreach}, it will result in an infinite loop unless you pair it with a non-infinite iterator. Also, {\em never} pass this to the \texttt{as.list} function without the \texttt{n} argument.} The iterator returned by \texttt{iforever} is a list that has a single element named \texttt{nextElem}, whose value is a function that returns the value of \texttt{x}. Because we are subclassing \texttt{abstractiter}, we inherit a \texttt{nextElem} method that will call this function, and because we are subclassing \texttt{iter}, we inherit an \texttt{iter} method that will return itself. Of course, the reason this iterator is so simple is because it doesn't contain any state. Most iterators need to contain some state, or it will be difficult to make it return different values and eventually stop. Managing the state is usually the real trick to writing iterators. \section{A stateful iterator} Let's modify the previous iterator to put a limit on the number of values that it returns. I'll call the new function \texttt{irep}, and give it another argument called \texttt{times}: <>= irep <- function(x, times) { nextEl <- function() { if (times > 0) times <<- times - 1 else stop('StopIteration') x } obj <- list(nextElem=nextEl) class(obj) <- c('irep', 'abstractiter', 'iter') obj } @ Now let's try it out: <>= it <- irep(7, 6) unlist(as.list(it)) @ The real difference between \texttt{iforever} and \texttt{irep} is in the function that gets called by the \texttt{nextElem} method. This function not only accesses the values of the variables \texttt{x} and \texttt{times}, but it also modifies the value of \texttt{times}. This is accomplished by means of the ``\verb=<<-='' \footnote{It's commonly believed that ``$<<-$'' is only used to set variables in the global environment, but that isn't true. I think of it as an {\em inheriting} assignment operator.} operator, and the magic of lexical scoping. Technically, this kind of function is called a {\em closure}, and is a somewhat advanced feature of \texttt{R}. The important thing to remember is that \texttt{nextEl} is able to get the value of variables that were passed as arguments to \texttt{irep}, and it can modify those values using the ``\verb=<<-='' operator. These are {\em not} global variables: they are defined in the enclosing environment of the \texttt{nextEl} function. You can create as many iterators as you want using the \texttt{irep} function, and they will all work as expected without conflicts. Note that this iterator only uses the arguments to \texttt{irep} to store its state. If any other state variables are needed, they can be defined anywhere inside the \texttt{irep} function. \section{Using an iterator inside an iterator} The previous section described a general way of writing custom iterators. Almost any iterator can be written using those basic techniques. At times, it may be simpler to make use of an existing iterator to implement a new iterator. Let's say that you need an iterator that splits a vector into subvectors. That can allow you to process the vector in parallel, but still use vector operations, which is essential to getting good sequential performance in R. The following function returns just such an iterator: <>= ivector <- function(x, ...) { i <- 1 it <- idiv(length(x), ...) nextEl <- function() { n <- nextElem(it) ix <- seq(i, length=n) i <<- i + n x[ix] } obj <- list(nextElem=nextEl) class(obj) <- c('ivector', 'abstractiter', 'iter') obj } @ \texttt{ivector} uses \texttt{...} to pass options on to \texttt{idiv}. \texttt{idiv} supports the \texttt{chunks} argument to split its argument into a specified number of pieces, and the \texttt{chunkSize} argument to split it into pieces of a specified maximum size. Let's create an \texttt{ivector} iterator to split a vector into three pieces using the \texttt{chunks} argument: <>= it <- ivector(1:25, chunks=3) as.list(it) @ Note that the \texttt{nextEl} function doesn't seem to throw a \texttt{StopIteration} exception. It is actually throwing it indirectly, by calling \texttt{nextElem} on the iterator created via the \texttt{idiv} function. This function is fairly simple, because most of the tricky stuff is handled by \texttt{idiv}. \texttt{ivector} focuses on operating on the vector. It should be clear that only minor modification need to be made to this function to create an iterator over the blocks of rows or columns of a matrix or data frame. But I'll leave that as an exercise for the reader. \section{Adding a \texttt{hasNext} method to an iterator} At times it would be nice to write a loop that explicitly gets the values of an iterator. Although that is certainly possible with a standard iterator, it requires some rather awkward error handling. One solution to this problem is to add a method that indicates whether there is another value available in the iterator. Then you can write a simple while loop that stops when there are no more values. One way to do that would be to define a new S3 method called \texttt{hasNext}. Here's the definition of a \texttt{hasNext} generic function: <>= hasNext <- function(obj, ...) { UseMethod('hasNext') } @ We also need to define \texttt{hasNext} method for a iterator class that we'll call \texttt{ihasNext}: <>= hasNext.ihasNext <- function(obj, ...) { obj$hasNext() } @ As you can see, an \texttt{ihasNext} object must be a list with a \texttt{hasNext} element that is a function. That's the same technique that the \texttt{abstractiter} class uses to implement the \texttt{nextElem} method. Now we'll define a function, called \texttt{ihasNext}, that takes an arbitrary iterator and returns returns an \texttt{ihasNext} iterator that wraps the specified iterator. That allows us to turn any iterator into an \texttt{ihasNext} iterator, thus providing it with a \texttt{hasNext} method:\footnote{Thanks to Hadley Wickham for contributing this function, which I only hacked up a little. You can also find this function, along with \texttt{hasNext} and \texttt{hasNext.ihasNext} in the examples directory of the iterators packages.} <>= ihasNext <- function(it) { if (!is.null(it$hasNext)) return(it) cache <- NULL has_next <- NA nextEl <- function() { if (!hasNx()) stop('StopIteration', call.=FALSE) has_next <<- NA cache } hasNx <- function() { if (!is.na(has_next)) return(has_next) tryCatch({ cache <<- nextElem(it) has_next <<- TRUE }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { has_next <<- FALSE } else { stop(e) } }) has_next } obj <- list(nextElem=nextEl, hasNext=hasNx) class(obj) <- c('ihasNext', 'abstractiter', 'iter') obj } @ When the \texttt{hasNext} method is called, it calls the \texttt{nextElem} method on the underlying iterator, and the resulting value is saved. That value is then passed to the user when \texttt{nextElem} is called. Of course, it also does the right thing if you don't call \texttt{hasNext}, or if you call it multiple times before calling \texttt{nextElem}. So now we can easily create an \texttt{icount} iterator, and get its values in a while loop, without having to do any messy error handling: <>= it <- ihasNext(icount(3)) while (hasNext(it)) { print(nextElem(it)) } @ \section{A recycling iterator} The \texttt{ihasNext} function from the previous section is an interesting example of a function that takes an iterator and returns an iterator that wraps the specified iterator. In that case, we wanted to add another method to the iterator. In this example, we'll return an iterator that recycles the values of the wrapped iterator:\footnote{ Actually, some of the standard \texttt{iter} methods support a \texttt{recycle} argument. But this is a nice example, and a more general solution, since it works on any iterator.} <>= irecycle <- function(it) { values <- as.list(iter(it)) i <- length(values) nextEl <- function() { i <<- i + 1 if (i > length(values)) i <<- 1 values[[i]] } obj <- list(nextElem=nextEl) class(obj) <- c('irecycle', 'abstractiter', 'iter') obj } @ This is fairly nice, but note that this is another one of those infinite iterators that we need to be careful about. Also, make sure that you don't pass an infinite iterator to \texttt{irecycle}. That would be pointless of course, since there's no reason to recycle an iterator that never ends. It would be possible to write this to avoid that problem by not grabbing all of the values right up front, but you would still end up saving values that will never be recycled, so I've opted to keep this simple. Let's try it out: <>= it <- irecycle(icount(3)) unlist(as.list(it, n=9)) @ \section{Limiting infinite iterators} I was tempted to add an argument to the \texttt{irecycle} function to limit the number of values that it returns, because sometimes you want to recycle for awhile, but not forever. I didn't do that, because rather than make \texttt{irecycle} more complicated, I decided to write yet another function that takes an iterator and returns a modified iterator to handle that task: <>= ilimit <- function(it, times) { it <- iter(it) nextEl <- function() { if (times > 0) times <<- times - 1 else stop('StopIteration') nextElem(it) } obj <- list(nextElem=nextEl) class(obj) <- c('ilimit', 'abstractiter', 'iter') obj } @ Note that this looks an awful lot like the \texttt{irep} function that we implemented previously. In fact, using \texttt{ilimit}, we can implement \texttt{irep} using \texttt{iforever} much more simply, and without duplication of code: <>= irep2 <- function(x, times) ilimit(iforever(x), times) @ To demonstrate \texttt{irep2}, I'll use \texttt{ihasNext} and a while loop: <>= it <- ihasNext(irep2('foo', 3)) while (hasNext(it)) { print(nextElem(it)) } @ Here's one last example. Let's recycle a vector three times using \texttt{ilimit}, and convert it back into a vector using \texttt{as.list} and \texttt{unlist}: <>= iterable <- 1:3 n <- 3 it <- ilimit(irecycle(iterable), n * length(iterable)) unlist(as.list(it)) @ Sort of a complicated version of: <>= rep(iterable, n) @ Aren't iterators fun? \section{Conclusion} Writing your own iterators can be quite simple, and yet is very useful and powerful. It provides a very effective way to extend the capabilities of other packages that use iterators, such as the \texttt{foreach} package. By writing iterators that wrap other iterators, it is possible to put together a powerful and flexible set of tools that work well together, and that can solve many of the complex problems that come up in parallel computing. \end{document} iterators/inst/doc/writing.pdf0000644000177700017770000052672013212620523017530 0ustar herbrandtherbrandt%PDF-1.5 % 42 0 obj << /Length 2775 /Filter /FlateDecode >> stream xڝMs۸_e ! om֮g:=(m)$( 49<,ͻ.҄P qࢩBSܮ_gvvܞs;ÿ•vw>ÿt;Sw\Nz* B46b+[_y^5n`a`[4ֶF:=1QC^zcpp6Mi}pH`GB!Ls ÿⰞU0,-,*m4E(M,m k+OPvd`~^I,Xkں&@3>Q? L01u`y]Ζ$ԡނ-TixH?`%"|x^eA;j7hi؈vdG=ɿG k.!%PР5j[P=*`G@ ^B(*8,USҢXo+5;u.ƔE$%w|m݊T3`*h}ЃA7uˏd,URNaˊGc\"y=1l溹{eAh<$JŽAFJG:T4w瓀x:<@PSB1Mn((,cF׶ɺ<ѫ-~L{$[!mD_UFzJ I#Dp'n+5A7_d8#~ǁV\dY '?2լ')ɓi\9 +!VՑpI#"CFS󦚱$(Hrw_; l,k@(ie^ŁOpl?Q^`GeBC̎;9 I_4@q /Ok[ν){#Cv5תۍcyj{(PU| $0ꨔt%dDFdZ_ MM~>xԛm2^wjټBsԃJW)Ѹ:ǿӋf@eko2e=&n3.4ff"ft ͔"Hdm`܋嗩Bm;?Ik;O~9?LZMTkeYw1UH}J|R_894߅IChJL_$cMݣT-5fʹWI>d^XZ 9Rz| )띨?_~YJn#a|f@H ;ӿITDK e~.h h'a(BC*@ܱ.\ݒ%'J3طR逫.zM;D+ ί&^X/ޒYDx=<߼؝MFN*VZ͸(SKo\54 ?`,M)aCN>~!^4npK1$`mXt@GYl9n;Hk2EeAۡYv16&ϺЋʷZ,\X-ILFU,&F)uz70W9UFcb$VC<=98x20G/7X_hǽ(,:NcFmr?,& ;)OZSV;˿p>JKt^WTOTλ$ ^Hr㇡pMcBNyQyפfك<\ޚu-v#W1[ӴN{ I]m~o=߀)ȸZr,CJ'Yl/[l5DK&{&ѳ+k+qN?0glSM5T;t=V_Iх`}q.(w_:[dG?\M%wxg/Jŗ'JNC_.W'=p@AB.pvM޲hH$W/7qc- /V_/5Ck\/+Қ b,!ba^`߽o  NfY鉏ɤlG0Fq}I5Uw$@yu CsQ*/AO6ʎM}BUS di)tRi3eؤ^,Td]]}gJU?4~0{LvOCY/ٟx$ endstream endobj 57 0 obj << /Length 2950 /Filter /FlateDecode >> stream xڭZ[o~[d`8EYlC"EYo,+q;63H_}M̹~ E˳zTӋBۺj_xm+ݶoZ&/n?= `֊g8g\q"q Be]Xo>~ױE],pvj.>묞?@V6qk Q, < ~G:|)'";x^o]\ o,N!kũ{XM>e} i+xd# 55Q51)uڶj e+kZᎏ>~ܹ3l^_Hӥ(MGaQ*3^4 )v&OqȣOԗɘ`&ykq(#فFgܬ+#w?ܔF%G ee|U(86UЎ ]vZkn52:nX#qo|zRH1m&ξ^% ˌӾ]2i0)6}MbYiኗ5L@?e.UmԩL U烌 5EH4ζֽp3_yoele : EklS8]f]ߣQ;2:_ ;`MG^z]Bն j+$hGǃwԾʏ:r#4xKTVX?h4z #rq{%؁Wp$HE y{灷2z;v9(ZĘ). a_ۋy&G _htsyx4Slɜ;ĩ25<8IƵU/W%ۭs$ ebZ05F$m)!rXK@mb )uYvqT*?=1xZ툺"\{g:)f0 ܹJggz"snItcUմtލj}HȾ+cGhE=$/{0o0n+, Z"Vh&? hm]ڼ85pCo;X oY\5 %]%SԐWءmIVԴAeBHoV_Gްny`Ĝa 1gh:+1SVNS>Є*/ auz1n?J`)0Mvӆ"A/FWFƵ4_IG@uߏ4eSw@BCiL`YzƤ"?ND+tTM{#ȴadӆI2dt ˙OS:G }G9$Olx; rJ^5pd;r]^püM/Z0a( q6 {d=$ϟD#=MJkU45 jhUWcuՎ2ooyùvur]oգCCt-Nq4MvQ{黙XhlsAllC,Iw=.f zb7)vHT/À'9]Sˍk/ηĸ4%vYq Nb ,rQ4 ?o^>7!-W.PF oA_%H@ 7R0? *?OާM_^aWצAT~]Ybhc:8iP(<]aiMTWjp)KQ4֛ Y9}΀a!U)`O 1:2(m[WʴG'Q7Uk<~~5Br-]_E*VuuqYOɈ`MF)7q"4Q|P%|rd_ak-Bp$_A &r1ަlԅfRp`oAC>Q2AZ)}#ye]`_BUMlU endstream endobj 62 0 obj << /Length 1561 /Filter /FlateDecode >> stream xXKoFWP4`mK7H A"zp}%ʒ#%E1kDN{ȁ}{aQ͇8 VEh&Ryly0Ou8k#\w$w[x_\ %.pW)GZv38x?5 0RX](fx9  "UYU <@bYYkoNN&4(›x BTqBbOpk2kןQ-*{2l9^<k V[eLV'F_b4NE*Eo ~r>od p^vIef\Cp$3zRr/b$3SY4͢\Qވ,DTn&Dž}VAL@c0"ۮHv]/C)Oc0bI<+4l0dSdlƄYDZ8ocFؚ䠙K(}D1 1C80V8p0< "SЎP#o ",O ̒Rh@F'"`>\ײd mri.2̜GghP q;"ZwQ3%xd.gs^*n,b ;Hqٲ|wB7iiѭ؋=mUP;U5i @ulK jS9|Xքsf {"(QF誝;6p:" 󨙛5K·=$(7zʻKdbgd=mZ@/QB}9>ynU 9W~a0:vXa=K X'\>X{w^H#erh@\4z Y?To}]1Hґgp !LM>rѻ;̜+d=7dgE^>,xnaPvJjU⹔5IŻϚ N;d[j`X^DBF5okAS 4wTs#R!X A/! Tfvҁӝ/:B*J|s&pt@H[m!DG0`/+j&ru97yT: & S U >[gOlFj:W4'tPv岹E+ШU#&i\VΘ#V> stream xYK#WtNA,G`>H2@l\zB@e+nCY@OE)ڶ*p֮o2=@=9lV5Z"޿ZY['=Дoyg$g}߿K[7jJZw2`k%0"ZI[Ӫ/q}ҍ4дSnG|Bg< oI s ykOvd#v7<}TRYZ)<dzq33)j^K^x YWK<~)TiW3,ju-l +ZOhM̓(;/Qza;lޖ7njBHEq[7Z/oO=DhuG9Ah:g˒hs]j "@eIk7x@<G'g,OWF;"N*Pp‰GO6=o{:1l=2 `00`0zld%ARu|UTНg+y@/GFD8)6k@[<:Wd 8tOqYшQJV”zmh⨮(ԎIǑ)2ckr ?NNȪm%B2أ;vd HZnv6(˹I@Mʑ2%XG~=B%vʷq@L67vP)i ]GY86הmT OC(ɵc |TRT9恰1N 4awy^ɲt"cָ/kO8qt߬MJ $)@tΦm SM "ȭ !z$T ҄EKC܂t7/{j28 4K#g(NE{2Q~Ô*h$Gcf GO1Yg084w?HQᦅǰWš*z++v/X"AdD9Uу/?l dc{-cklg;ݛ89/N~L!ٺ&+qoѪ`1qi #\v3c51@SбtsrUЕF%@]!,)IJj>/{1&%lݘI+ t7$uc$pxLrj>8g:L 9 1a%0\YαZiY$s{jX,g jm&"lJ \; @ {fzFDt \` v+SrOjM١C!K{ŒdG`xrYɷЅyJ}G7|H=)y<_|2ƒ~^ҳ* SP!#+h)N͖[n#- OÝu)j(K0 M #nI>ʯLrи%Y(0΄ɌAZHHZ&iѱ&x>Ӏ]3st]! k$rܢVOMseޝ~rW?oVm$|,"ocnF2*vyH?bT)Ea= H7xY SEۈJ6~CSTILH!h>wDS8!B ?*_55w0aާ69ҍp ˊY%̯ "Е1Gi"E|zUN_?| . \>w9cŷ眏}*η*{%p^=V` گ8Ft10.y^\~CQAu/3MU%5iX1"nb5I=}ɩdj@x> stream xڭYݏbїP^~/$@SI6Z:V;CNKg3 /D]qΜ֢_UBլB14Cryg9@;{/0ymqPU-7 Ҫ1M޼|]W0CU3LSm+]+T?󦾼`fj'(-jZq9{?+8P/j@1" JG 6_(f"eKBa.lG/Kҭq]{d{!}}0GNn%2m 5o7`N ,g&pi|GSzh\E!ۨuM7ȸZ(0aU)ee|~hu.#{|{ ׇ@f]Nd=$U{zΝ- U -=] mJT;W+Iwf~ uol;<]pVBcu1b (f>_D'= @H"|$ q3$pFMD1J"ۦD23lZ)?C ݑN@Oƥ<4dyGg^)DKDU4FLc T 'NJG{s>Qcڬٹ^2E+1]BtH_y&^) :p Ï ?{계Cpg"|nmms4؊rc+.դj(&)3mOkD *4ewRM(JZ>ChpCLimy\@;d%هiϵt;k uE&}i8l⿲Xh+lL[dy8sTVD"wy+ .5U{qm34pIμH`hTNN2YT;*7BD6 )>LU‘2 0Ӥ(!4,y*ViM6<o=5QK@ArЦsnw4c#ۖSLWؽHj})c2O_wdR?/y\ 0^˧~{K-2>û] endstream endobj 83 0 obj << /Length 2398 /Filter /FlateDecode >> stream xڥY[~_!eed͐KHHH2EQזgf-;Is)Y'Ì%^Ν]oNQs6]'6תeR\٪JnWɛ߳ʤI7w7gH~Z.6kw;Zono>`O\V+͛w:YVu]$GZ86}^ VTҵe޻%4`ڤj6k*6˙-{?= S^~QCyAȮ=K5~|)4@~. 9Dߺz)K[n9ū8dXYLWg4eXO^m`ϿΜAdָ~2ab'gF+kdnr'"5r`nݟ$*ɝڲBx4@ꞃY=3m+wjf,-?'z`4鑋)BYS yƣO7 s, Ab"'5$HwYY[?R2wS@4Hi'O@2y;y;,Ӕq@0҅a5 ab/Lo+fe-4]yX? !u oE0FGISNպx`RyCjYOb2fwnLW8̳ڪʆN'9Uɝ7-ZHlhȒ/ Pz]aCï6m 3 ; R[Q[< hav[ eΪ,KL3p{`l*d]TzQ\< 9}d9-M- 99;Yz띹Wp|҈a#C.CG &\{Fza ڥRReXwڹ}+2JE:{bR#Hg?VRʗ] #@2z9ra )lDm @%j[=rPdTY&#q6K@aB8ˤatZAN 8sSId*vh* 8#6FipTS@6 '` mA$\k"PW Xh\˦x<εZOIRR ŮarSH{ Ƃmփiq\hΣT 9)e҂ְ6Y܄8F &k}А>o"q֢b_i'а'ſUK[Nē[GALa<E d/_p+Orʵ+{.z%q9?=:j[$PPf wʈ>B@稇r)D6ٶ7j#ƉOr25aџɟu1OscyI y=*x3 ]R=ַ۳]-5|ua_vglOKYWж^MBgnb:LP3U׉d*gDdtszojKpֱ :< tqɟ;L&X;>mCL]o\"M܆ b^[eᗥDBƞAn3;))N__qm jrՏ?CH1`/?Y+qS endstream endobj 87 0 obj << /Length 1976 /Filter /FlateDecode >> stream xYKo6WP 2eD-IMQE6fJa'(;/Z8Y98MVd?=8{֪qdBgXe:Xdkoug/kxޜJS?gD?ljjeUi/Ξ^?ӠϜͼnuU6ߜ,_dj*YٯgEj̪TEcXgΔ9~"Մgҧ5¡xa2$`sќ+IT<)Cfem/8QB@N&`g: I_H"K …|'z#Dnt}*`rs:=gZ4CM#3[0Fmq|:ouU.lP;i`i>gM~q5%ex:]embIJlvBK;^\6gG0ls̬Ag?I3B%.(L2k" /QCItügN.beO8 iŒ=?p No5<0hUz@dAܼ`u(-V IMu4HE)Ρq5EQ$dAϐZ5V L+e,%B+Acg[݁yv1#0Xe8ޜ8.%RP7b_2GX<5ljC&Y ]-ɟdc  2G۸jCQ1*@drn Q[eRPjSC̽$T.DZZ?^`\cynq֥2̀2dˎ\MjU6>,"7͠a{y+ j|8 :3]CiCc8+KeEBjn&o=|A.6o\ѩpGԿk虜oc21@6׌y!_pL%gZFF'+ihr*Y\Swir8d4=q1x)<^rV"ە endstream endobj 93 0 obj << /Length 1840 /Filter /FlateDecode >> stream xڭYYoF~ׯ`Pkͽɢ.q EP$AHDwwv\R$%~cvof$9K"JI&%..#&2i&KbS468S[sϖgno%,W-W@ˀ%HHӌ|CMQBLE@5d",z3stR"'IƜOF!wCVNqp'V81:eVsC4$5<պ`jׯrs|ݸeu}$'RSʊ8I*'~n C`Z8swo^4>Sw,2"§6W.0hXh" + iaw_Z:K{E)R B('b 25>" wn5 n_<bnMA[WӕmUDWlZɗiς u7ώ1ȃ$C+Cd{Z$a'@_&&11]HDdYF-m ?:ӝ.LW\q,m{>IK&Z4MF\DT/G O$I8ld |߶4 O-y?%~; v[$AwNNj/o41Qwo,DNA\KŞ QE`"pzFSDC $ ҋrkps={m٧0h^|Ħ wJ^WҡjƷSC-3i*spˉ#> h$ÑJaMZ)Ox'%d:Lakkge=KK+ HA B,z8m`zjַ4REJy@`ps,ͬo j\NEsh]Kj0*70RU&tJ[C|ѓPʄMv*H?z}Q endstream endobj 99 0 obj << /Length 1797 /Filter /FlateDecode >> stream xڥXKs6WiZ!HDLI2ɡ6A(ۍ([t߻/ MIN{E~@\%ivbI$*Kɕ)b\z wWifw\Éɪ펦}x?z}1{(Ol8Und]~L|"9Ьub~Wɇo (3zguRqՐQUWIߵ oR& *c5 47I{F*Lg?^4A??Sds+; Y}A_ jz>5eX69\E%<7*y2չA7ɘo  .3^(RkV<#dfhsfe8Z8Ր[M+ :bcIjY.lw=Z <˜¾yM*mLڠZhƟا˰=+Z:M)A K)m9r|XqmѪ}P-~oCx >'^߈<'CylphTf-)9T z$qRBWф5>.Gu;o#CHUkJHm]8ѧcHrwwvPUh Cxh-x9fYHqlvrx<͕$/&SkAGx_ک狸Ԧp.pƏ:WҮ;!*D,rdSG"d Enzz)a0_gAYsnBAvh1 5w mK,g0+r'S[t`g= /C|2yMQnB?l˶-,CC~`˝Cn,GD9\`] Ilz{!*%Cief?qgY fNb?#PBnbdSPm-%H-]+-,Am++ .o nhc\x^wJMOkD=bJ?H2)ٸ|&v1B96,7݃˂G9# P7k^HLbI1NZK֐ЍmrORyQtش&ۆfYIDzOT+9ZHelΥL '-%2`VVVa4+ϊGu'lNĊueFy+s݋sJOw*pĨonUsR,?ڇ BŢa]Kl_v"F$_V էl;&RG;F 'k0rĜs6tBu9;sΙXe#ҳ!N_0&Pk̀|,||x$'xEf@J^9?YPԖOd0eԿ|{Y~H46zS0Фꐮ .+ .LEuo+_:X|9{˫5vt2߸k+ \]]F5]P0 uSP-+c- {>PZHd2xuIH|1~uS>=r)ù8RHa" 70L-I ]3~0[W 'uYnή'y+3LKIgtnxҬi.?;n:l iԻ;s8sftG.}/} endstream endobj 104 0 obj << /Length 1926 /Filter /FlateDecode >> stream xڭYKoFW 6%)i (P@IDn,#Qwfg\R+N{7̮*J_'?]L^bHkUYkedD )S"1-u~;~w5&Cym-|JԿUUytz"dO~$K#UIeHkx %/.knBn@k7gXQƗwjt-kPӔx|ڟ ,nؾbuêmO?&:/S0SSNfA n _Ng`thgl{,-Qmtf*abB]yjJ'H{BطǂAB_5`7ﺟ# w<E$^> 2S@RXzа!yJ\1@>`Mg#[)4UUacH Hmmw4`L.2al9O/Yаf@5b5#5*qꮩx*hѬB8 &3<p밸(wv' G(^L$;LKYQ% k9|%]w-o֒9}ZK5\gc;*.Qضoj~[C0NPP$CەEw eF%-4^g,NKK}wҰB([lN0ؑr5%V[F\};^GUyk;ső ͔.9Τ2 ⬯00s$ED0=m7T Ј^jRǻ^> qEq$?,:5Wz2ʴtPFCEdJlAә&9N87]`sꕪ;=mɩ)v #w Ϊ5k%o-S4kq0"Ep7j>7TeœxbYǚUGʒ$uL)cCmUAUw.sfR%I9C89NY־)Xq4{zEf#P`ĖOr)̫SoAPsxdq 1c1VvѽJpj_vwAިn^MAz:$ӻTZ=6Ȏum+oa# endstream endobj 108 0 obj << /Length 1458 /Filter /FlateDecode >> stream xXnF}WyF[hiڠ(PD@?2e DG,E3䒢l(ry̒qtћ_TI)rkU4[D"Si*#TEr$DqTdv絻W onb*jӮfFf/# $`Ț(06U(yDllช>šiK2-\'S42v˗𻇟tJ 8ݳ]Ί>6#^~ƚqk%@o*0&!NҦ4<=rz|vIJgq\+ۍCX{XbC`3jhyTY?5g;fEטQk+dk9nlnhQ )avCƇInS;\|Oݬ* kRrk~ztC\.X -"W#L{#/&BZgL2_Ɖlja*S Z$=vDx7]oUBnzkQ}=nmtd帓/"`WMl^ YL}Y~E//0S*cKA"qV9[d(3]:x?rF :aɛZw-NO9!狥{ipO']N Y"W؎ MZX*TDz&,խ#k8ቈEbu~P6񿻷hˆ[1-i p?q/}]U_LK bz(<$>;5߿#g }`/R zldx@m -Q>Wk^'rpMrK#E7hC/wYplh77Pg7>"_֓.u.+z$0 ϣjSwb [qm8m#uTKղ KNu%duܮƣ'6PxTk"L ,UKb:Sd̊4 =_'oTюE$/nCbhuャ `v|vn>1VFiZ(םZTV s?n |trsr[%__| endstream endobj 125 0 obj << /Length1 1896 /Length2 12017 /Length3 0 /Length 13191 /Filter /FlateDecode >> stream xڍT-wиCp 4 4w=-;w'Gf̽굺{WSNա"SQg35IڀؘYlVVfVVvD** ?vD*M  & mmrNV67??++?D[~$ 9"RIڹ9X__1p5hPA֯' 4YX\\\֎̶ft 9@ rp~K(AIcFh[8P5@W15x=.PIV96f;@cc[k; PV`@Dk<ha4z%Q: - *KؑFi^,ec"akm ;"Odw7.? ';6N Yɿ8&lf 0\Y~f`*ea zAp:`'ǿ&`f,\`넙XCYTuS\`bbqxX^GhWژ,O)kAKurA]yYI;YY-bNu m_wZ?WW}`.٘YF Gi WqYY؀Tl-~?-&6Vn:@GJۚ2v.n:J\\u41fUrsX~D<E `Qƽi^`1b/` _%od7tW~['ſR9,2,y,V[^KW6w/ۿ!k_kկu>9\?Ump)9|TÆΏNÙq<QaTSx;G0A?w$cCX=15`NõRg?LϜ"T, cOOG/k׿z?gc+~D(^"33V9/& XJz sG`A,(λܠlp77>$,&l@d4ݻL6Ē:e#"Q*:1 IɴD w|BRڴ}n1J)p|E{x&\sڜ0-\Xd?%a+]G7-k`7'-O\o!@\$Ll7sبPۿ_»kfI*[(?=m+2Uu'=Q5jH~L ͞acʔ\m ,®'٥t:J9e;m`oWnyĪKJN1swwR^uh7j8$ӏкRٜXAvj,ZwL-~@CYݺxkR9Mk}zCiIS+=x-j/(#UpeDZT~nz|~Ff:^&^~F?}1J U AiOY*l-FUZ M},yI<,<]߄mԨ|vmEmv!_X;դ*4=bhsS~R_w޼\E+|܃+B^ : |Y,9+Q_d7R?vɗ^="Ff e*ToQ `=`谵GV=+OۖB7;NYԻMQ<@uS9yABoiΖw΁"XA;[2Ys_Erw/4Oi\a,B ~l:b9`8…R| DٰEt9sIGHv>L \e%KZ'.1.&l8 ʙȿXe$V?Έ1yU $װ`D8l7+S8b>xȀ9vgXO/s.v59DU{.Ah^UNx#Krc^/&1"PD[iTc+[R8ti?R))NP&=6k uZ"RΠ}.@Y&3>sCk^"~&ךPfVDOu3=}cvRDj!GY%1NP]t/" ̩ 1o9 [~Jga܄xN%/[״RCg087ό7tS:b8*0r*޴|=]/0tm!\{DBJS@%H69gXe3g=_NwױGduJO]r79I۰ۍV^v"!9n5;W<.\Tutr6Dζm>)H"[#ɐTjowڭR^qKA5Rxmk͔v> R νfLN-mow0XgOzcC0f#+dh`i8DO`Etk2BQ ~kuRa+vI4N(d9~D }h)@7ʢBNAN^6d3AE}zJI.sw ~ZhNda Vm$8"y/a3êSc:cQ88O^#n(>Dx)#*7{j]Ƒ]KlJYA]+O >Znjv'6j&MeG[0s6 >;ED+j<绻ʂK_޲RQ֗3ҜV1v릹m mHYw Vk褹'X #`ҮF!- \5Ai%CcݤsZ~iWRItTaZ)2b |6g1*%HTwGRXӓi kBqn=ħ#ķ&ڧ1uWQMR^U'AA -,++,'X @8iBGM%*UUX1tjoB_iU Y޳K%S.F4b%ZSOÖC˻#ǤХGorqF=馺pJ9~ 鮅~g|x*jIb7 ѻඍL9Yo"慐EB5-rFF;0Ԣn+~c9C "F}(_$֠Mޅk=R.ߠb;>Ϣ 鬖[&HO' 45z3~f#[xou  DJ|52B 6`|p m- b_y.fMkʦP◪1eag]&{'Gϫpu.++è ܱWSn2&MW EdToWcӶlp*xkI2x:hpWaisTSLq29ࢣr۠%],b&n0{CFKB/N^=vkX'vu%Kp%9g2p,ߘNV#XdW:S\泾Q@Wef{t QvF]5zG=-2 ;ReD`%Q>C#JR8WH4:#+4E]+FѸ6nRؼ^/xp.wV[,^0H b֥3&&&}칳->;}klꧯ']ɲo f"pv1T;΂YG*X/YZSAfxH͹ƆܬCX"yAF 3T@s݈"ߵc"M2X! dHqZeYȶ9ςн5 Q/x27=:dqRq^? x|ҭc>k<4Oտw ߣU2cZ;K|gA6Anvx9C|! *l?Uh ]7ce$ac] ct1qY +7M0M"00'8Ac7[k5JY&)RW<Љ;U73s*T"zpUw.9w%'L,) @!Aw.`aYοc(6v׼c*bM&kwNieDR+T]ӳ5J&K6m!*׵wS7_ zCze]F%֑*&*<V\|IUb\}Ne쓉Q)n4[[fn:!Iɮ=vy#{9ݔVV̛X }c]gleW%!= bH*B5e]}ϷvQš,Al`xv 2-[~٤i! 9)Η_ֽk٪QCܝb96)oˌ K*axK+zٷ]ݗKhbl_b1 H%wR~!~#ZK-M@(Y~5}OX?Hb]b7/ @J'+6Em8z3(5aB34RX!5v8s`Ia_| (=>Ӗ2FCoͼ<1 B.?RّxD#M%}87>Տ Rl|r}6(@#FG@ӖO&=>V#,&j~ &q14G%v SgET&n$l Q5vq#R{괄 RBVv{ ^$H[<wT;];c=ʞ\9c4\=Ej ϘZ&E+a8VU^JO*)c5ařyv?7uB0u71Gcix(d\r"gڮI>*o=Ii8sԦBSsGaif*% ՟NHu݋f7`>sIfGzK3ղ3r>=#v}`fg>D}C,KYaig-yyrއ%֩۝M1eїȱg4SYAqP/S7B l4 ŅVUݭ,hB^L/@uQz[U#~8X3o)k%96!YdwV/8F-0R)h᷃׎ GsqȻ$$򨒐muRoGH3#| #e]2/HK{W.,CYݨ~AQiDێƘ6^قqOQͧM|_35(G@2LUHUifWғ#Ţ% \C20;h|  1Mt ك4 s"i|1}AA\elghǠ:֐D: x!L LS%\kM3[b/d{SMi>`^ "mE\*ױ'iNHDJݤRL(iNeŋi',=?d<sRKW';v:-W_ mEQ'(7Gmt[^U}AcU'|TuS04G('j.r<{~5|G%A5uV<&~NWaZ'9}7 Tnpw>A cYݟ]0(D}9c.g%-LMOL&,4X|ӎdajr?M:V@[zhuՃ6HO :EU]~\l1*2,~b2dY_RGME>s*Qz'+U a\ ㇝Fi +C82Y'N^g{wO[mEH+2s@Vɢ d 9|)PϬ^K_ l9O@-0lb5Ω| s"R^#j H2q;zGEiJ%baBjsgڶ Kb@߅򒠠li6 =EuN$.{*k SԖ9zovRR5هԊfZ<>F(f 8=\Y1dx(;\JHն%>2u|XR&8{ηO:ekl=WP-  ׆˓j@|CVscxoڏsXh-Յ 7Hk/O[1d!vPYmȣ8ɽkɐ /IGl5@9͡Ձ~U*^H*6zb)w2,]"x?' Ҹ}d<7 Ք\Fc!&9e/+8Bɰ-h|vh;Za7 Yo?@0pl%#2\&4A W=K"AsiE7I5ԖD0ҠiIQ- 8Y?gG2c(heVH /giGOğ=ʰLELCI`^),62p|/Ĥ6<0-7[_aӐоko 1!e67*YiyУ)px o| 7#5Cqy~|?qҡqխMa%p޼ҳko/{%@BZn; w15`~}5k Zl`ʤYjspp .vYaz/_Eʗ yvY.S}W"eS7;18oR8 T3 Y9\%Z|0w1(@D۽HTWKV­!F*=-짫 :=l./}#M G~ͪYivkl+; hTTK˖&G+m` z=F9'~V$?ү QOyܐTNN0H0claU!vg67DE˲&לM7* |*޺//y!4䪁 3Qw/G :V>`4 ˒f&r&LN|nJUr0 @l# n'^% [ !#V 5o*xJ|IWK;Fv9c~Ptr? mJ/;!*3!BD⵮j  dC.~2 ~ꔺ4ْѧ/!P*tk~Saډ M#U"szmj&o Ŏe۲2$tAǤjW1Roo ?^=\U1 CHIVıQ$dF K (1=S=QI29`}x͐Ή=s`!Оhe# Eg\ IJ¬PXWHFORh I^`*]ݴɉ)U%A+.X>>V)ID cA`2(fT lUٸ<)y.`_ b5ֽ%oWg2а(NyrY{1}Q0_vA_!N .T7 ~VmD)/3Tv^%349};ƶg^ąGRBm6LFF> 0WP n~拧s]إLO|8Ird8"=ڥ%C#a F C#5M|{y`-=~[YR`r[n($m0JR˞\UO;oN{0l~ՓF.__Qm뮍4ۿ9ԉ.}L0qIt#Jx4НȲ2s}IH|<3b 80"2rHQinx Ҕ"TYlĨYӕڴvM!ߣҌ~'gqx԰2NuqGjq9rj 8;$=M>xsI\KVB) SM\,e! {d&:p{\qX!Tq*^⠯7D<ᭉ R5#,r`_n!&nC|İ!ǜn9rы ;pN{7AͬwiI|7 Pf_At\x,/_񤜮ʎ+tZ v/a"x1~vg=&~ޭ}aD 0]g >Pcu^E˝&0-9_Nn-|@F}BƸz%g=S\#q+Ig~Ȑ)E;WWWAm5JTqo)~ϋE?aiqoff3t|ў&uw?XΔqT;g$1+vV$r#*hh6:uee>@tbS7nXK8:2à;nj,[.Q >V nOb2$x$--#SX=BLBh#hdc>ZxsjM[/&eh:H*΁QL%LmvߴfXtCɻxx EP򨰫5ߞŚ{j5 17zl;aϩ?1l+O'7E[w:X; 3j":╘B ;m% {>܀ptj;e`)#0|u@[5v1yV [_RY@Jg#@ 0[qbyC*1-uFܮ0nW^:8MlQYNFVۍ>v]%7y1򻊬&9Z endstream endobj 127 0 obj << /Length1 1396 /Length2 5940 /Length3 0 /Length 6893 /Filter /FlateDecode >> stream xڍwX}?RP i7FIwƀF ]Jw) RJ  )!t3yv]9=~m"l!4(X$T 0$ 񮈿n3DdE@OQ@W X ߒ @4VD:hVEc|HG'A4FXO=g@Okn m0A;འXpE(e ف&z@C  s9@0_x Drh7 D90/84 EBaҡ@ e# pp, 㐮?{p({U~֧"{3\ D;l#bB{ `*uQ I 'H@?0aM޿ F  9hIPgBp,%i-9ፀ&'pP*e/a9;BÅ6QۅD)ݧ` ;~Ku>B I~7&˔`{ntR*;pSU!ɋTNXA{gUiٗOfX?dYbOnCc 2oʵ*ii^x_UgUXi6ʏύL:?U gs|5NK֜ɝb_|h1*h$} I8 Ol.:a>S]#?oظTS+DxZ:%eOdz},|ﴷLWƠb}k3 oE^3cU}+E徭n_>E9rwD1 D(^FoOTjx7u/H Y{{A 4`|ɞ޾&k6(XaRBKa2hXa߯]1C4Bc~SՏ.ߧ7YK|۪<ۜ7V2Rk|0b,;W8,m9ahkTX {^l6x!'rݡAc\.Mܶn\4ҋB!]z!on_eGG=x1 :_7 #8P<|Y?|uji9 `B4oD)ZVX_02|m_8ƭmw|q@'H2_U؝trٸ:QCօKMsZD*Ae0sbWhVM akdWW\Bɲ4+!NNv.(ׅ ?^G Y6<) JΕa: - ʑ0+&Ø/g9>+l_hNV[~ZϬQ &_) HzU IhkZf@<ЦY؋DJ$;@.*g ^w>iYUz{ҵ] ZʺuQ32ek96uP-0틗eN;+g9F=-,;\etٔ#T[}${إJ$XѰ<vT8%b[vv|-bi^h !E$Rbҫңw(,>}k9rfPPw өp/4j?kz bGdu#L{{”IabJ댥 dw`paibپ o4|ۃL?wvgxT>KqIaQ~\]PcҖNbSχؒkz_\o;=^DAҁIXAl $ dVBw9cs7tZ|Xz6#{F^° y#džg$~DdIy/ԖAbB}uՊwȭwR9\]Mu1\F蹁3)$Y{{Tm.~ nW t,&hHSI~n >. R=xj"H~BA3<3{QB|-x/LܔFN!՛ R'^RWiaV@oPXcUw6#G퀇B )fz>A;i U+|'Ŧ:!:+5gN=0(l%}3YŸZW3תkD}s}O-"șH3va+Dy-D #l|9w3vm4WLL_^.(GHy멽PNnwcP֘5ۡ{ET7*fj"#r:雑']q!U$;OHN]Y ) mK]~ ^*RyJG,YIa81'H%wt! wS3[xJx׾Ԝ Ѻ>oMu)Z=y^34k[λ-ct\Jq5K8L්oQTwOܔ}'>gڷXd$I,m̵]kbR,d6A,P$MxRuL%Y>4,$M% /ߎ8uyuȊB㹍?ƁmE=p-9aV/Z3Dj ~HD 2G,oN_ "\A "yKR lfmbt|Pq?MЊs#⛻>[(FV3^Ffr]8OU3d> =p QAMngN\*RC%Cosp FÃ̻1Εַ[!qu܂.`t=9ҠA .;W7 zImV^uL\h_(~y3^QNuyfs}L ~|Ik%Ԕ46# S]g޼g-P f:?: t1¼~}Xl&ܮ싮XW+[| [yZ[ܑ!ʖd-QylmL/BbuLlB̳ׄ/(p.\mU8-wQ##0Q4͘Y'+M;؅}(Taf#vJ̺U=;bhW$Kq2},Zam5u5pz3EBx""} 0Se9dtpЇ{IIirFa[_m6K9F䂛mHp>MmDR Lm\R)%{ޣ)[z u3G}/Z'b *D?vV%Ut|М~EHE^k F,FɄ~',g%LvuJШyp}H=}apV P獬6{~)aYr9c/ ib"݆}Y=H}μK o̓lw{vR ),N![6|ay(4lǒ* .qlj2OOx#by:#<Կ|5ّu7?϶]xp"!D*[YPVκ8wIIFVӥÙ5H x+qyO0jn at`b;FkijrUsG8z s'uI Lὢ?ZcgoS}`ZE/?Kݦvu/0@&jپ(bߩlҷ_hr!;s~˒S+U|+=k'da=. |rLUd*׃.]V/wu))vdbQQ>o+B'؟}5|&żQiaPQ%uukE}{|{k6q-ۛRbDxʩ&Ez$^AbxVp;)CoLݙy۰](iBD[ݰ־%2nW]P&49IUƨу .7gvLuwHYG=MS N 7SK,4EQc&kU['(SA\DͿf$s/1Ya)vUr9QJv^bc,R͏J2bxk\^+-R@"_^9P?I߅U~bϠ׋ D[o7dsLL5#.)j!vGJm_>!'#LE?ď0SyS 1jzc{h$5@.~ty'fw:skxT}J~W(3*M_xn!>$w792Esǘ'ΰ"<` HVGs%&ܬqɔŦ8Jek6 kyB6e96B\PWg%ۉy>mnBTBUp=:)mަo`?--q91srMy*sMc^s2??>E>6nUսəxGqs<` N*X{D{-_4־F^O%Au3BLT/ݿ厀d20|Mhbnh:M\Л;3wt5m7A]boCH>rVm4֎ROpvةm$s֌z={بb݋YNYmH=*`ˑtxTqoi=r2m J_UȗNixk .&.YgTMI}{/rYA{Nw!|^"c/N[-/nL$Ȩa$ ƔZsH6 M~;绂 9.>Xt:LHΈ%ze _u7,>Mu* \]J1EHqoկ5j7oI hC^pEĝ dMFl&]J WN֌<it41,\M&SJCKG|ʸtwV/X=LhK7q UmV~VaRO \ LnAQ8hAk{F%3U &jGA4[#VL׸<ЩjESsg>GPK PU ÐC`1l3o"wm&yAr^փ2L|2LPב^ߝ\SegFֿh=%d+.L'Vb{P9:SKݾP=D,>c).]\xLE,bs*٥Y YZG.od}v0@UUe*0ܴol7u\>d#e=4˜#|ahMlq|\@Ez˒pڅvӁZj\$GN% V e}qPt#$FzCyXv 3`l*)` |vWh: endstream endobj 129 0 obj << /Length1 1968 /Length2 15439 /Length3 0 /Length 16646 /Filter /FlateDecode >> stream xڍP.38www:ww;ew>W[S5>O 1P΅ * GAjb[ GtrC&fa'ooq09x9y,LLch3r43dpN.i@mB` l t41Xm?2TM,.Łݝ֙\nb t:M(bGPtKbon|l,Mvv@'Gr@h_t{`f`Odi9PcppٙahdlofdicdagF ae98Y:838[A0]3ڹ8Q힌jv@iM>Dṕ.v&&&NnV0`#O%@_K3 33` 4'h8|'K1IcLl<1|ehb @`c8?|;eWWm꿗߱?guؙL>GO #mwA66F6| 6@SKWv1Xa;sYhdbb״%Wcl,JΖ\+_2:?FOcs;+0rr28fESǟC `dwp|;qF?D!' Q `b08 n`4}X}3l#F GElleQ?d/퇇GBCoX ~Pf/A_}$"\:SG; hOQlpo13ӿG6/_#_fV#@ oUCHC0;$ŞF: St MmvІӝphڎ8 &$>/ g-Mc M 7Ы yuQ-CʅT> 8X:Cr>F-Z7l8gʅڅZ;L-I k&Kz*s.96!- A O򒵡%o|%ytik( ,YZƗwS!TCIN ]Y]f"wfVi+ܳyD-〶^&ѱ!ֱ^_2AAswO:kK'e~T8؇u杻{|CpH6˄yK5`Nͳ{g|S]ѶŻ) .G9ٚ|c]fu~S^{GQL_[,zWAiȮ"gP)3c׍ro;O Mc쐼zay rpbQ/*#K +ĺ%9ɥ,(l8”8,1u60MiPm^A!#I+spE! Kȸ[,gpBiצ%Z-4Ri*Dv_2m>%[?[s4d(D pY ʻUbV| X#o eg=ܹY2QT0TbstS9iR^s`{5؟2t^'v3w8(N5ӊ#BrɈpr+Y0B>z(% ;ZoysСEn=R< Ohz댥ɺ)}*,U.cwEa* q03OtJ^FnOK%QKZJO7pj'os= RT B˛.E=:4]/v9ZTF}-TNvv)2rX0ԩBp ?3᪛e%7V/a~~@s>Xk]ȖtÜNd+~朂7t}e);}w"< (q7 v9o&l;McPsgtSrݻ,J9>n6dto~YM\O -f^n[ "^5cya7,n0P`G?5AHpmRWqݗI`8$`g#cFZ9< eV1#cW#7?3Zn.2L>; ]TF%Q<"]\?Ep)d)n-KeEX^.5*MA9Fb_.Po!QiH @KqmB@MCBB9+^h\*o<.2VBG_ũ$x'1Wb+U];-ȉ2'i'~8Ζ FM{1)1GTX&YʤʯP_5Gme9A5^>4K"R7ղƨvߔCafH~j<̃JkR׶=g,K@1ȮQ-u,*T<JZ ӼD1z3Z XQB3xp 9bRV(;ΘNAkpVkk jVlx)SkW2뮀4f3^Yí;& B*R|g@7;. JkjaOώ9Z\" )/[fY?JwH%+RQg55^}_[۴cRXM HuG)JÌNpX0,k s*u:ıӏu]o! I%%U~b*uP1PBq K`s^'br+874KJ["NmqkGgH'Ev[ +?N`-Lk=O)@W YnTö hT*;}bǗm<_q8 nEm[j%] $K]6cƷ/6پ3WE< :@64 '|*:4\ҟ&){};Įp9pІkU@nU,!O\̊)u@ *1}e<vQeh|;>l"nꀪl&hRb6Gpp'4u{ \YtIQy6T_w*mlfe`0D 1ZAS c̳EZbNd$l׸xnQ;^/>Bo+9l4_Q=A-{vαLvjm+RТNf(Ge M}gݣΕn?|FWGҀgkni͛DgZRMT-~O2*H=+ZD0V2_GtPG֠lF.ml_0 d_T]RnvJxS±b"zQ+DEw $$`Eçaa+!po y.&ޮ;S&9=:"QT!Bj(!kw/<` ܟ|uI0aYV.G]w%ǗCo6h#^Jij.#`:lZ|]Ìv/pG&' .CZ<i}[4 ФY`V`Q'zx2hں"ֈETMperåˊyf(Kx-g w\ƭN)t*EW||6\KrH/>^MUA;zSk"*a1ٍ0P PU4I; $NZ^%|%aNi¦ҢpVP/6W㯑ٲlx&eqk)EMWJR` =a7Nώ,MK)qbjj7H'GwBop -:aaoRB'#b{n 5o;*zJ;X_Uʪ% u"_59*LH`׬R/~gBۦыӆ^@㶅{Nek*HFĿ엓դ\mq&~ jf}5{Xn{q2ʿTlg!*'d'a74?krtHኵe+?"RSՓ y ċ*fX80c"}WCk`a &ckX'q"cƇeEVK?~O:/[iPxJcMn)E_;w4|#ZF, JyD*A-d>yEf{Y6Gֈd5 oh|~daQ lӟ}~+< ϣX>Bqt %ET/anP7M?L'<9+ H{wxv849]1TxLn&EWgvz[`;0o$`^6[)+4#9aI86bouEy kllVl3\aՂ=CZ=GnÐJ%'R7yRtO?n9º&jΆ!I+GƲT0]2LuRECUt mָ17\~~ 02.]+?2IR@Q 4m?>3#`)%Id'CI]w:gIX ~ƻ0SǢF}?k`/c`N=Nw6P[FLjtMh4y-nz'9#. p[ڮQZO~cyH,[C$ M =#Zx~#X+0EkFgULiZ8XS oPF G21_`q$-6v|_ˋ4 Q7~]WdۮX=?T*pPU"h9 /e&ZU·Z&% ^?^Գ MucE T*<\TZgf48/.x`R 2ּ-RNl ?f?əįz/9!NE FgIrii32{7qˉ,yy4˨Ow$_'#k(_ren[Etrxŗ#s$_tccچg\X,p;1I!Cuq|fh"f2 %Rh%K`Vз.[DK^4aq*%lꦟ˟G5)MW8d:M_F&Xw[50#2C]2$*D9ú.Kt0 ˲b@k$tt][Q~%QUzGveUfla3%ZSeX[=d*#nD$eT r!E[W _YϸQ+Ju}iTrv*&dPGbZAZv)JZIt!jE.S']㕓9.w R }DT־Z݁[{X>YTiկ7hBT!o U]zPҳUGߪg>5 -]qQÓVM~ÆE Bo|vֶ)Ǽsi W4CzVk稑뉕~iek5k('w1)Bi, %t&q=_E$(uݏ^ڭ4w#]":,]tZ'`nD\VZK>mPqYƖRN܆ko"A&AbM{Ŏp_SKƯ %Yqk#8Tᑪwz usl[^sz&T1&,*R\ 8VE'g k?:[b>ީMtw1\=Fߒq_r2tz)5FzƮguޅraAҬpcݛGm|U1_>;h{Kvbxc- 6݅ybx\}SQL/&6.Bj&hV:s Lg+vE.Z">=sn{[AoЌoO>4eؤt0y$)!)GFC",ʖݘBߜfitrJ26(J[̅aCbKzsAQkEY0:UJ ^宦+;L֛0 W8wf:,y8xz11ٕ4bjs#;XiC%VO\30dF~Ob+xoe wV=?l2e~9ew3*E]=tФYJ7R~n:22Rnq2I|hq%ET`y*e{kA(ֳ+qq'\@?r/.n_T.nF'fGtssQ`=B,@CY˵@ZiDfw*͡-8( <W-w[6i֘,<AI(M AfMU4^M ,e%䛏2uXL T$z+t5>D\א<G8(lY- ISMfl1yD|Dd+|4j?$+=ǗZz-A)Ey~ Lv+[=Uuwm`Ay,ю|fzu'BfC+vcN[x-\ȗ)J*TC$!C$'kjoFEA¤n7ą\|bC0L|=7coڜѰG˾4)LVyR/-1a.wY2Y?JBd!{MtkA" mX}^ ^lɢ{g% 4/s ey 0!|Vd{[]ȍ9ѓ8FvDILc)␳7UC:"d; vbHCFvyN."bG }ٷ7ڭYu *P#I ;epT9zRQo.-y+\4K8Na㕈pO~GWd7\Ru:ҫed ){1! T*uquc>_ uY0/z\Z&`nע1v#~zIӐJv-…h1a/aЗ< BE|ry(4-17c-=[%z 'BU2v Wv"'GyY"ŧYEɒT/-: bvH ٕMk*lފzNk tOUx=$jŤVjY?\6p2d\pk-D+R%#qLZޏ}H<jcX~a=oUqciJ.5\6qQzv7^758"vD6w!7~VTfK{ 'FN a8@<h)k=otobpW`©rZG$CWKSP|YȈ;^W.6tYM֏ p6o4+]+k!Tr55qVR~HYp 4&8/_aZ:IEIK@q{}]9AYubeEg33Q?' Uᣭ%,ﻌtZHY=k"dk^= V-L猟NKo@3"S#W g ch;1yA;g"t8'B*c:j,:SvW]Sw1ڒg;WȘ!%QFM&WQK'j:w䵌U@;o`5LK!*\r J=UMAKZ d@sԀF50D9LYq]0 4j7v؜\{G&iZ0*U-s`XSARc1w/D5NgdP*_$u₴k)<8{XT}.Q=[dM6f[kᘩ fz&ɜxG+x:- )gC4^S U2Ez<b/HHoXC4efM)b4'j5Lh/Eg X\^zQ%:r}zWX&V]m- QEKT"W~rR̈́\ nMoɘؙe6f3GI + ^xfb֌6l %U˟6\vȞ;oc,D`9(ޛCnq[j wI{]V eAO@-i=6 /!(eC2<_E+]c\0&̣A羚Aya,"!)nFWB|.Ebٗ?!2 lczpGPZQald;1c/t.oAd@{ńn+#ssj¼9ub"uZuj0߀*\Adl'V`h8po/bM([%)2}4-8OI><{\ACax< t޴n HXewT$ޏ`>Fخ@M uUGuiXģCG_8 &:86] U{mAقcRcd:0Ƙ.ޡ!ufPh 2N=!bItwXr L0y@; #n LfD# {Oz_0} 8vf-GHs@FM0_sva.&En/N3!DE{uNCp7YW}+ ?:iRZWv̩4CQU/"2{)cX; DtiW67 7oeB jM,o)$ y6){p0U$kS9REMG?# GcUfs^lOppkv[iAG$ؘPNX"ĤUԢ}RCշ{WXԷ]>/<̙w,;R>GoŚ'5ܡÔ@vYkZկ$_kvK)8.6%鉃p6b/w*?(!KkԈ\~5y)dgy|VֲS?B*mrA L5>ߌ: endstream endobj 131 0 obj << /Length1 2355 /Length2 17901 /Length3 0 /Length 19278 /Filter /FlateDecode >> stream xڌPڲ-܃X; wwn ![wwwxd}OWWT-c=WAJL+hbguec*12`IIU,aIՀNv\ v:D dlR.Ff##;"&Y:- T00rr:Zd ́6'Z-EAclEOFghDghGIpp6(@r6+%[8mW3uv3t @[ [#p @hw401D%zXؚL-y1:gwg@Ck'|CWC kCnnTOyNƎNtNֿKM󮲨 D,{Y+[;7["L\Um-\"`̀VvNt76Ma^=)+,##`4nߛhfx=F|}/;[k?^\ICUYsx2hXvV(Zs ?vο/\S撳{Z ό02bR7m\rS m,= xY{{ge&.6+lfIh`llmWd@;'߯ 7pzȿ\#EmL~o+}XY^htktv)|v; m vbgЋALz?@/sA; xT9 Ωhq g~h3~XXX~[llnɿ #O{M{ ohYC? \u{ٿ;{um-u|W_]*.XSm߇_Bl_q_aKu{Lv@#kk߽8̜x](?F@W}wz$Wͣw6wk0rvW»b.b __SØ=e;'0vqt|eT5 a팹-kqhw&xgHw(i;\)o{D)n ^ZZ۞㕦v`80Yt$X׏VE`[- S4QޭOܽXn4ih(Y|9,"(gZTH73oR԰>^ZL1s+*LN]$ZXx7cSd^B)R?ʊR>vo$1ZSx);\ꑑNrQ`cуK~ZkH)%Lb>_Zsdo1rOxfcU~̭܇ՠ S2H#e ͭ#C /1|\4^YAohD4k4˪u 8XQ!^vw=آF?6δw2M&mhݯnM.喳'89+#AnP_v2j >p 7<," ؘ&q?6DVQ6c^)B +{ƿ_2}5SBNBʑ9ɏaE*n> ~,YyrhdKu?JU%=8;hVqn*Vk~1@Y'vk yO/??9&ܔP3_3؇OQ'Wzd>e+N& ]n:u}Q1'a$qZ)j3s:hnD zkPNNKe`o:oy7 mbv'[>&]qx_ïQ6><5Ƶ(NG:He_WL#֧7KZDaGɶKc\$ l@b9pdEW }0УLvJoT Vd꠨RU\݅˓g>J{f;U?U1< ꒇ9?S{NQ^wt @ZezO# ozWrs)s&ô`*3T#zy_ =΢Xo0ΛrU/[Sh3r%O9K Sl.(cI+|*VV9Q]?'.]b2C_CQcOzltLo/fήiFV+ a!ZSWIwfl/~jћ}2YDi 6HmqZ뮪 ޤj͈6?˳PQy a*>^K:&Cz-x{)D猤 Ʋ[J@`1G<¿ `P$|j=LWLoQ'kCgFJ kmȟɍ"ka ϋ3GʴP!ӃYluhZԴ@5yGF:&s)`PlXqAWq'eO,lbIUZjc^95ڀF8rPT08ZE!}"V2mBJHO;$~sw6`|*V]B5dm#\& Hq9ę_LG`qZ^U7n\6ӄ?kܐ+]G XN3~y9Om3ڛɝfi/E <6DRi8W-#gQR1 g*՛ zV|a[9A#4oc8^_5yd݇Ժ\Jz?([1ʇndk}6+VT*߾"*<"dvR .Cj~u7n>'|2O37eXmbgxpY:BKC4U=5ݭV#3n?3SłX:ϭIu ֗ AGo}hrR[Uhldy$ǙOqOi/x4Yʹ61/(}T0 -;rH%n(6#V"MQɋ°!Ԩ?bXvrS>b gf !SQ4̵/*<}Nt66hdȌZ)HO~(G S4;b/jaRSpHN9ϲGZ3dOxU3*ր3 :6e-8 OPW9jRk!J;n!@-&ך$AY:k]2ʇq_`E͍۾wm#}ı֫>a&qZRWc|Ggˍ-ұN鋨O4ds:8q? e'QkAλ^{/110 !R(Z2"Dצeg-{ɇ9)$ss@F"!xk8s~YUqvxJ~'(htDuj F@:qŃGpEcT,~G3k`жA "t#ᇹIvv\Wjj#?OZ5&Zxr): A{mg 6d0?!/A;\.ū0" j]06Hu ~ˉi{>>FP#_ݽ́#{=/#2YQLI5 O( 4ddSlat3ap-R9LK wԒWtuc_uPj[U -Tzb>8 1Pg)86IY \? "!Ck\kFEE{rAgu#:#m4+6dX#QwN#:>ai'+K1v&=A,Fh,>*-~saw@8n `%\>tL>‰9@6p e%3({PUMY*CjF7 08@`Zε%2HԓLԅ CMIAѴ5&{,3H(;z>ßF2.*9clA\s5Y=GP!f ~2who}ab (i9#;Ӫ핇 y|)POhS,O8FNk† X|^;Eʹ-/!+a& t5!k1_kv<}W]$(8'Hkpf 8^Ę`$l}DjN=n M˲Eoc蔐sA wR!'U/˨[THx"ƽ%ҬoϞ9rp:GS̒)eTvoj:40+1G1Z1S革2V&)UeJVփ=fmQ'5KuܕՎ,ү@x0@)!Ӑ<#<0h m zs8<\~vX1?C:)|3#v?dAɦf+TφxFygfGaPg$b8LX[[q=s"UmA`1JM|BvzS_ٍ/_+S2aAPN{-X=< vr@E:".&{Jo6! 4nvuM$7]$ȏAc0ԿbDj34ڮ|=Ƴ3N(|8#N:\ #v1 ڼqT¸*lRW=o(`"՚;ŶlaY ZAo l44 O6nA~RG'+$~_5DI2ǴkE(1TTkp=$UC÷Y\л:CPvKW1W6j_hUۯ  c/4MR87LӐ(P.^(qA`QII 6l*P( 㰘^kh ?a1|>JqH=-Dk^mWѻ?NU®} j6 'Z-{>?dN=VDÅ G߈I XA~BiIÝEp?UV5YG #*#Utf) <'rYL!ԱqZWŻoʅ!s]]6Ry:.t'h*!/p6f?o@p^,U=~0Xx"*U6HՓսSJ9_cAH|aj _KRoC|H 2S`a %+_Ⱥ#]n@:ACIgIc8u)V7>4nCwu'O#x@|M&JmF_l)p({'~R;>]> GkU-\W4UkoUۥ^W!6x6 ϲb!W9kqByof)Hf$`SU7C3Cԛ:c N0[ r-Pƣ \Ѧ+MRČ\.V9FT7g:V G>j j692UBsښI70x(QIť_nd`LHP,ݾqr[+O(H n/a .socmwHSK@ubmUjׅP,7y*{D+w7n jI拂˟~sAtPCdH:}S]Fkr  ֱ+m3"Ž\Wx(;NJ c 9mU5q7):nekZb9Q B0+̃ui(t5:)Q1"{-r rnyVkq2K?+*ηɖ#ctfkg)6T ũ=H%LdgϬ`OE}TF$\O̟Gi9H:R|W*J jjdfYGנ#&D/ i3U;le7o?ʗ -e7O}-?kġWW+#dYDC;W|. t, ?xeD- pwܖ!t[?o'N$a48eP#so$KϮ4݅R+ N:Vf۩}IKa򪘎)H5<"'Dt@ᆞ}%~ȶFN&YVL =BMYIQJù%@A ΩExaq0< |D&G- w#Y M'X2YP*$}Ta!F;Uõ0<=oq%AoC|1TX)5=tL?J^O*"s0\NS 7>}/ ~ ˑ>ɬ㘍i曣|\i,Au~"O¸+KY'0y_ћII[ژMD/RQy23F.CT~y[ &jG-iOǵ5;ƭT"89%l `M4fvŌA7ؿ19TκSfORJbLҴmݓ'>E.TWz-OLޔ׵ Rw1C'Q #w fEgpVUͯFd٪5^favZ, *|?zXDz$͇`*a4qzJJ<ﶈT){OL܅p.: mb~C+e ]ǿ7y_'!k17YhU $Cf#h5t fH'GH/lQ&;9ŧ  >Ww1p3gkJʑv8_QGp?!OnlvC1u`*($cUuײZ 9D**aTkH=jH≘VI8?_^'-{<BLy}1^?lwtYu\ӂ^c&*Y'YM;ª^R\A#%Y|&g4M5tj͹3e:{܄o7z4v',KΛ袖c*~E) gfƻ?չ)}2[2 ,+&"xF} {?uWW} % 2$y0шBRSe!f|[Ee?+K~'q-S{WP(PAqLbKŢg+'YghÁDmJ+Đ?}LKÀ<` ~!ℌ5V=>ze.# 0"&q][8MU'#LlԈmxl6<2>N\g39-Yk"W0릈>9qᥥRP05(w'5/F[, <`rIRNoHF#6gc®\Ɲ8sګ_lu֘<9/2+Y'2T9(HukYf4z$ZoF@tqSq7'/-]t"p8J_ipvG".SI8OȏYYʺdɃ}ruwqқ_;tDQ܄_e$|77֟l7YAOG$"`S0F3؋|RYQ3<AϘ,J>Uˀd\rh}T <9Hs$?>/0O͘ʏ9q^cמ}cJL>ߢpަŦnW}p'yCCr6Il5҆_Zeso (1 +3}q(3 HB nHQYj_;ExwP&v/&߶tYrƪa6>Hv}V^Kw T7)Qc¤ǚDM}S*߈%PS0ܚu 5j !}4bnfhIc>~ȖjffĨ\)H̴|ԕz9Qz&ڥdsυpMJ]| ;QzxΌ f םI!ꉭ{'c@4& <>)>9.+~&)Ռ(K^˘_džPan *%DYy^#t?}s.Gӫs)l-'I  'd/3.L6İ9nXĔ!3A/?E%7쐏AOX.e4qC9)v)=%:T-6*&<1a<+TieU,T NJΰjP+(v6IPdM_,"| ӰL_DN)+ҌL&Jmd+qdPT]8=/jD P,F\˕5*fz%? wpSg\Rodp4#|i\6vKߎϴ"&.,q|?Am6 U) bic0fit | =9x;Yݴa2L#dkP6w_F;(rÐsànU:,|P6P7~&SݲBճ.E&Y[KYȓEU;1IaϾny(𐄩𭞭lPC{[#ÈGipB׫g jÀ7V/Б~a_A{ʴp߮AضR>qĻ7HጎFFEVVJ0<u)s΢7G,(m%m49$-G! DDDk!#?GX#5#T()Eg؃8; \t3q$~aeѹ<2{łxXvu$΅O_^X(Haj.eGA}p) +U:4/̾!FS`RmvBՐO\FM)Bg\!2˩)vaGKQ7[g9Nv2,v!man`zCAqRBUٵzR4;icV&70oزpԭLn|@m?afem& i?H2*NI|CKnj`㴭T5z, J{3f7rN+Uib- Oossj*5'jO6EU+Poj4Y,`afQ`d|\fKU4 >; Ѱl/>f-g$:ZlJsW+gu> ; .+!'Z[U:i=s7 įk(}: ((ԓQs=vv޹u+&0x?x15{ї0UL-`?8!A#qiAI7Nryʴ\{n{ʼn(;\aAKe8@V=H-L:{Q/\XE5q_vy[ϛ_vIpխ˞x@(' G3Mc{\+ ӡX9v++>,;D#n<! _3!dDž'4Lr." d~4ٝ]3VaG5VwB IAm|qpCuc)˼n^Y(\0]zTcǖDӍH tE%z!y!9-FjZł%)1N)q|sGp9VGͳ#Mn4&evC^My&h4ɆCx BT1N:+J㜆u0KA–T|4DviL6 rVxxP> kh$aUtG?vJlβ*Fv@giOmg-9| ӜLaauTTTJm B<0Ho '[cMJ~=zy͙'YG?Ƌ:Լ8=Y.̌c/rc_}y oAZm&UU[i_F)!1þ$5YybCH/}|x\@+;Np# Q&pb*|QI=M`V\hh ˞{R yp,RLQh[oSn;QQLZ[8"M۳ekR--gfgF> ]彖,ٷl=dp%Zy_}N0\rk#p]Cl#èhSϏT3v^y%m/\ aHse䆃þQYX\H.'sN˓%}QDg3.}ESAMp~ȁF gk{NMԺ%p xdK3ӛN(zZWQC[CQWabCƧAvRK@~m懲Gs8\U/I!~ K(؎9PL:ȑDu[P# شA# c%OmB4WY3v.xNJK r2BHQg?aבylK[lVl` [`J%l67q8E Gy5<'(寔i̚5 &@dX'&;v!9uP'Rє8` ,Oqi{M9(Iڰ2?fKۍ5M{s0f g^m  iUemWXN,{3܉:-BO$J7x{]'|16e@$բl 69&$Dz th dEu{%Ͼw2_%Nzٱ~A+@sD-.FeZ]Ôƪ+B5q:S*OȂǾ-S1ʵw=8QV؄@'F=I$~嚰OA,hodU(HȮ}ҩx_2h** J*5mF!t4;F6'2 | Et* )쀵f5 3照J_$VY4Zi3F8'/$ALZDZs'.h,zz Qb}6m@ iSJIYj>Yf;#G· d{jKoxu_,l% :AhϤ+6 |<`Ȃ]DŜ]kw5_7Ly$"Р}fZqSqa( 7"q&TAlwE9NS1fd"1 1E2nC1qnIu/_98WoCVw:mt]g܄d[&~EEeQHCono1s]cWGKI"F@F; ',yق0ȇަ"`lh>)}$E79t?Ώr5ъ\!#g]Xڎd/R(ϵ'kت#cK7ڳDB2W#^ld (E;E6Yk:ClOt  7DNcFD>^a )nG9b)xE9|G5d}"S-q$'֛ t+ίnsc@`OƗ2՟lCPo!^KN<̀Gk d#L5/ *E)D5 a<mc\d݄4ЄVFݝ0=KY~8CMs%7\ DžB? F>ulei@eZtݷjV&Ks2rAC>]3F{R,B\25#ɯȾE#`ܠ`hEGX닟 6PShw'0Fp(P51:Hn:-I>.-T7aPQ4:R:D!&9F1Q4i<ѐ"tQ@ȉ86b$c}nzI5`]U>j*h+wR8:tKaYD$4AA竬yMhX xxDuH,(d3sەX,Ķ(:q6Mb=ߏob͛(qVĕ=禫fldSP:BydOwa0mڲZE~٨(b堲|&g,K!~z 'hB 2eV#]ۈ]&K AAx 9A߾KBdgh~΋.TZ9GNcT6wT(:6c<ev 4\IXXш Eږ$ezOv -3Ƞ`HB~#j4CRt%$ϜձΈVa0rV!DX ]nYG: 0zt!} g9I^-q! hrzS3k?O@d9x}o/8iϋؾ/sݐ%&Hy )L1G ׏sR+;񖭧hf)]U˔oyVS||;U}W2)`4l{ z0};#vj So|<מ5r+tײv8^h)Ʌze4BJA #PV.B̜]~Yiq_\$}H6/zx"#_ؼ  )1ڼܝ[0>\I̽.^ꇁ b7)Zcdjz0ثY IIjpMcG91znRaięt0G;>I;Ta\Lqq@'reFcp84U}Rѭo<s]guqhůݎQL+osV rmF| r;~'~9IO}xXDZS/Aj {i@Ky΀$Az$8AKN5Ӡ_#a̜bxÈC jtG' &FŬbۚJ4-ӎ\A7Dk>- [f4J=fVT"f|]"퍴(T'<3ӹy0֮xYymuK|2mME1߄)8'@E>J}`2Th"k.Jc˯LFͤ-"J_SkQ Tv5p8D $yzJ)5Cܯ38xdCc0&b] inD1CY̯i,Ddk<'0' QbVѦ^ 6GG;6g! zME,p9/{Y6|,G-A¤Pe^V]J{AOH2çez35߻vɲׁ<eb`%`Ҟqv{U .oshc,q*'z*TAnK% -J80I 9Kh(lYp12r" ܌'C.A:R3gqSka}t&~[bݨwݲ~au`3Z9HB7^n'"65y2T"-v&BdFbLj.[g6gXt{LcˤtvaFwEK/4DiZP9R=[jM(n$U8-yinsKTPb~h5tcC3|yk;$tm'kW I-M#]ljs_7(H^^^/)p0uo7 x m—jjWҖ~QMޯt0ՆĈzAoNܬH&k=.jNܪaR{a74#F)D7G~DNYYYTfo uDׇKam]nxSU)wb_6UF6;o*CMd*Qܔ5ic`ci"guyǭhxxc[8W_޴ fo h ho0.l5z#/HMRu*>_4ntBT@N"9<3E]My\FV?B9G˺(lnܖrx)LUXԛަ14 4{56`܍CCQ)=_FtsQ: rq-,vI\[ˣs6=ȣ݇^E" mT'RRf֦Iy;jEU45 ׿V/J]ס53K ZDՌY 4ND#, NZc <#eYz#WZǰp5x'^xף@N7]++OSRacrCz/!gAʉiR֢@K2#_:*E骃7ZLKSib]r/YNE\]KX5q0A @Q#x#n]Ju>E-]OI,|y>-K#Hfy{boeJ I~ga(m}?3k=q~@x> stream xڍT6!-!5t%9 0 ҭtJIKw#%)!Jw+_֬sz5%`98̕( V<@ 7= @l(p}SJn.00ewXC%8 A/ wrغ>W%$$ ;C@0-x" A^饭0'ԅl#.`gww5 (80:pkW g0Qa.n0+3p @ X/6߽pqp;޿A`-@ 8!` +fonq|4@NR`X幀!..%reY4 \]0~'q05fe+7GN] (ɣ?2+ N'Ȗwx/G%oc~>pGc`?5 puvS `,6?wxfH/+8?SZ[G@{|yx|@/@WQ4, g"+.+a`w,5#ip=>࿣8 ɹ98Q3Pus}*q `kkfUV7j]-@f6B\ `+ +/%=dXU\@' d9\G~>R[0n>~H||Q{0w}t<;cQ~GA<N#G޿#7z"' pBN?c(? /1? ?1+?rsv~\ س?[ 0f *I21)mTfvv[l$̠UKɤ=KLT?}P[iޛkMlb!/ؓ@'gבU=bN%Nny}_Gf5U+cޗNэ1,ϵ̚!Aqe@c?ęRgScf{\ۥԐdG{Oh&aJY&JL|ƔQe/עaө@3_ұF!c%WBx\:{-K;U@kآ!ͻP,S8/{$P <+e!6u;C.;"PʶEOYش.<:8 f5 leet0kC -l_}f Wus5 G3E=ƀRWQRZ(xػf 2Q+ie3,,} ݓЎ*gтC:ڵB8<^EWZMle uݝL*b\3ʅ\'UwH+A.!ZGGchPK1vʪPlm*"ƥ.L-օr*\#E%ʼnlQZY0}-?IzϠSt ~Nrj9+S9RhaU5JLQݶ&`12haYfn͞Fn}+û!ɘ1%~  V CnHo4vITk30,Gڻ4t1U_{M 5ZyEEllf1Q-ٴyJW73/ 8ż,2(EAy&6{:8F %*t6CEBY̥,) F6u,g7m D z^,?̀ nW ҝq;_N`?%s2n J8$7qnP%TǺ _=o\5 Fbb Aѣ?;+€'.οmSsqnlNiR= W٤+I]E䔃 6zL9$S݀+v-ZShLHB< r{aۮmvEڳu'cGJӟOTb#:*nmW+eR8LܭN!(*!8ؽh+ޱyu UĸAe5j;=dDCK}$@-Ѳ@T.u:pQoҙτuunyÃ;TNI K桘"/2 ͸UE_~cdo](=CԪ CY;9Z^VgwØGh~RWjԬ *rἉ7O . =ϴ~흨FfAyb~=.1z VQM'w_i"OXQc_+URDŽ\@G()}^꤬kGXyfbn~HBKB%Bُ;R qfGTUQ_<]!~ mmت)pCڗ. p'9DփT )Wp %┛_^Oq_ʟyҴU@NtİHy+ҧ ^,~ӭIfVri%V<СZzOHξhZ.d'CE lL{ơLވ&kTZun1J+>Sd!>F$_C؊NYMy:hD&\HI m*ʈS:_]:NP_مk9!ӫH{D 5]kW5dECK/j Vi>`˙َ $NjY[O|FY& ɉB& Hݟ1WⳒ'vou FıotrT0OK~|fS!6͸?y舌zۍG4@lX䉨7~ED@ZڎS+t$ !-- o+[Ӧ3)*D&7כ*`(BS g{M-nh3L|FՔ*jK>W2!fZZy2|F;+r)q0妟YY.9[b! ׳*$>s(N UĢDNJsD4:ޙ yBaڭ]-;B!ߑS'^W嵳h,Cmn,NhHTHzmSVWUW"(D|fznz|rrp4}>5gԎf w6QH{"f ؈)MNt}Ť*qe=VD"=2~l uxbgkBAӀ1zpߍP rI4Ĥ&4#!k`7 H?nJo F`{l̽;YuD6OI~X8ӟ$`_V&cf4X0mtci? eOH7c2RD[ɽ|ٯ· S@mR8 YUt5jFGU岼^"Df6{HaJb<\.˜O65UFdK _#ު"` d1N|_I#)>9c=RZPaϱ\r;)#suóL gx5 m}=ʗ*dmy*Rj1~)LCYܟK4(?rǖl)b1xAJS#FF4|~K]!XGOVDxMn5pn(0N?|&}ԻEd֓J^+zUJܖ[s5(<嗓k UtMD67!M澚UDJDIC hO/4w5 m엽nUw*74;ӬR< r0U63p+5Oy9inʴӗ۞2uNŎr_nJiH0"}=6?a>~TC?GEdNA+LEJgTa{mGSkbO4hC _e9s bye/|?.ޔ^ k)ԥHMDF9t]1mrHR-~^N :CՒ@;D*ZDz9 $FAL$%R}c\ N)qc^5tZs_w,NT=';/vFCZ B^cCdi ThvEgB 6(#M@NIhgLXWfs >A3j.O893q|}e+57V+BWiLi<)%1aEB!{ >iђm(Po)&|4?e#homOr3{utpZ)"Sny"NKXSIY+5: iv`^(-{V& '8J!J$"Ef5|@=sBƴmwG{ԝHOuP^ 7YPkvwLϖF%g濑!jtT. NmkV=+FQG=8b$Fq3@Q|ss* 2Z}4ݖLuѓNc`}`Rqv0PJ4S{p2uSK>C7nb]^eaS$j*"oV`# Y9[pުr]9(̵dj5 ԧKabIki/QW%6(zT{5mESzAy a;-4-or#IL}8Gb].GQMt G$ nj'&kkwN\ ߥ6GBۯ:&ꃦ"y9Ef<*@tN/ݢlxU٥|Գ1]cH^_m[N Bݞ} vez!Gt$Y;6xನiϨSeb,=oq>j| EĬϻ-t$abRĩ.ZaK&,]|` 39-'&Rs0n1ܩ~k-QY{W|T!LPAҎօd2gwwmvD/o6 )75:Er{T-gQejR+dt׋,{^DotNlՓ*")gk{~2ds,vO}WRf&Uu9(kz㕊De'q/s.kqX.(íCS:߷Q&65kJ2_@EG>-vQ v,LEKO;i/k%+ߜe\@4-ḅ70J3uŀKQWT]BIU1R"(BFV]}=i.7 W'QrOɽ'iw$݆%v;jLTDIn :Tyrkrn1M4q^G|7R`csnPvʌ&vWj VB| b+ɷPrQLA7J? b?V8gy( wWf`iZ([ZQ}yZL>}i<2SݢDL[g7m6]7*yԽuQ,*ZX%Z~=$^CA>^mmjLd?!ʜ/hB:#/?Z.QYOpN*J$xJ}YnLKGt?}ٓ"_LL'/_6Z96Z;cVty ?W:3J 3YNyQ,KK!G-KG+OdPeqRQI z{XTle'P$H1_7h(πz} nkyǪӋS,_hFnkj}$ѹ\8WLSE@Ap{&{O]q}5|ma?E52 !#̝ j7zҬ lv;tJM ׸e$bptw; # 5b>lΦtHzi.jyVRM@^ÇL!>PvJ-nd pn,Ls=12ZE/ma.zs%RVe0fC8u bG yz$Z>|(cSXba*Ơ3zC,-]>&je* Ysʓ^S$jry"LZiڼ[|+n 4"]F`|j-->%t*2'sJqՋ6ڳjyfHsӶԾzVPY-W +KqRŇ4kؼ " F6 -mۻZA4) ԥ!J~Ozkԫ1-V^gri9AX;verEwU,t77Hd*5>tSϚY3Q}'ѵåkgr^U\(@ExjGɖVk&fGCX^fDnI͉kD8-bBcwAPFbϜF ~a->L4XCTArC`W7ڰ.$^r1ŏV@^f )5 Y{8 6EY5WXLǞ8/_z>NEq^ a6CB"v;Dg_:[z%3/4Exi@δ?dhPi}>SjW!>$!u:tPX*%p7۲Mԅ AÑL,S;#؆3KxeIlj@,ixq%UG)*Zfw-x.AV͈ endstream endobj 135 0 obj << /Length1 1425 /Length2 6643 /Length3 0 /Length 7613 /Filter /FlateDecode >> stream xڍvTڲ6MJ@:%RNBUzBJB(M&T({iRTHE={Z73{f7{熡D` YD<';h 4@u Xpy Gv@HOG00# ~B<8/qNP6BpU7 Ga*w'U' O Aq g G89*%b{A1(d@@u4M($ + w~Xo/ AIsNp(s#G0?{\p]Nx` +[7WR_\MwTT@PHTEERE?BeW IwKJ5|G -pe_Qw>>Y_B<8`pC&ߦ?sx7f@K{kaNp Tf"/7UPwܣo "~M$FCv@,7N0 # W^0꧄P,߀ Ppm`\Ѱ@@8{>h4n4L!﻽pT'/?̳bO;n9$I{<|}F={4qݨ}OUdTtfh> )5naffb'<4t[j6o'?FlV3dlLJ.(Vƪf^ftds{e(յ3AV=m{1m;泗RG%cBnJE?PgN-)rNg97EYP :μ32$AmDv5FFd?*] 6 vo &+艆^LB(ZD'e&>kag''{ޞuur~ UT>ŔJ{ NdSv(DzwpiWQS~O8FN1og+ZPpeV3>$J]r7}燭S-5=qu!;___Qs{lDzlm#NY6_07,wgc"8Qz<|0~kj4([kWm{?els:9mIН׋ʓsecu X9>U~[N';(gJ %O~ mF-l;KSZH%)E:PGx aZ~#ǮQDԼŷϝ]˼s[;uu$WhٌfcMu=E>~5Pg\-G߫ }Uh {/49}6, z,g$>UTm+nސ"H߹3l5~ոo2/P^8{p}qfc /Wkj͋G%lB9م[@駏%!ʞ['畡 ѷêOζT9Qlp0VD^lҭl@`Z(́N_X\#dYn)_{f@I.gKNWTG9M*nk &OlX. tZ2TuK$Q dO<ݡvgU|1Mefs$f83y2UQ}ΏI:N2{!X 64>zʹž71_fz)mʑr MRNE+ ɌBn]>_[>StSJtm*3[A/ #mRYևYp=wP:ɔ[0KN֋s:&WxݮИEzɂ"1d9fu'GyUJt<<~iDcdvS$luOf;MWnqbӍy^D' IloOn#EX)hVή>,OOGc37nj=řVy2j=@zńYS 6xh:9Vf+`eEp \@Tnch27n؆=ri:Y+\z$KPlsRnHHlܕT !O feԓ9Md2y89% _^lAw"pp^G)A63YIjKs]s̝|LMѪZLΓ< G4BF x-Ҙ>)F/dܒ.ɎK2c{m$de,͆ns.\;^wk C"U _pfƐnsZI&% HY+Nl28gS=AiZ;=UV"V̵ʂv^od#VҔ{휚B'jƏQJP/QF=rjFC ;8 a@U{^yqhiU٭<+r+BujVqOW!UlFp(ʷ+n5rGӔZ]{CNz Oiኖ#f1?a-L#պIN}{4#x_ W\UڱVغ/ux5U59%pqb\*ۺ}H=Rw \g9Ph8N#I{NPjBk\ 1KAj0A5K5 2P>c+~s H$^utBEnQeCǀ,riu#j$Af.0IwDnOkLB}cߺ 0evu,t/y+?7YFwcTElO :`v`gW|RɪN͝%ܑ!Z]kՍ0o L|\>yu~\jO`V1YSJU-!6SSKn@Cs9&B9h/?Tevk=2nuOR\L @bCªjM8ٛyF5/uO b⢦hu{-SUZ}%h1MNdIV/bGCB=\VцV^Utmά YbfL#I'$>17*&cX r;V RJsX~b[pvcԨ(뻞CӄD! 0Ŕmd)1n.qwҦ{}$*3ms\DW9?)4BLV.N:vQFĐnlmE$ n*,TgzLjZݙNNО8IJ3T&1'LΣ3{br묅(uc5ӗʗzaFVlmco7˾,sbؼf5j8+YcFyQQrf Ģ;t u\fKR &!O|N$C:rkLZD&"q۽L7=h-)ro: 2zfcе v/MO8ÀJFc=D>B49xMB {2uJuPx0λxA(=:2X>;,'[Tȑ0ܪA7{wka0/6rw;™9cHU# S63v=oZꇑ&z)X%B{ A3l_ ƾhs rBN~=@ u)e($#j :U@2$u4wo pv]tObf!׳orӣwǬmU&gL _aE6c1GK(2 ,@(݄;ʻ dOBetrx@ 5Fg2,ZL|W/ ϿE\~g>B}dO +9Ѫ*oQ\'@'Yh\OJXߎ,E-,eqry>)jdyG\@o!o 8p7#tcwnMC` OR@ Zte%kԴdfCndv'k=q[_8umXGTɷ_`P@*+@l)81hZެ\sW>7Rfj5jCV?ɁAD:`:DWQ $?ÄJ+:"4CLx3gTtd Y7 7kNC9XxC =E{-*݊ ڛ9bWL'SJWO_P'L*GZS[৩;?,06q?? lюp`\iPNPS.]pIh:O{ʶĭ7ZMRTM #yHA geWyYĢmXf.)w7gpdf+5(7r)bROy ˩QHXJ]uUd<-ᔱ{6%+,6c7ܔue.Sk`=HɦI$L~S@3U";kh2xDV~qcxD%tFq_ Q lL{"9~(p; )]r|^@f/U#jh-$H_ :͔TҚ2(Y'ƭGXI 2u핌1݌b"Яc[x:go*/9(q9UmrKnx'=4hͷܕMҿËoZAwʷÝ*ZF`8&\@1HgYa{He ;e;wx|C, )uk<{.3O IY_,=Nxڋ`_sy"aØHG-dJ3 -0TR>Հ^ùMZ]`Y6U4w< s.jM+q('|e6bjNє@ J;0դ,YcM1FTobd[bh7 m*a-]OS"D%@o6F!##x׊`/ʮI)oPN|ɑZ'p1uDl~zh~ e0gge-Sa)|qf]'.g"nFCh`Js/^l7? NT>Cyjr٣P9>1I(:Eư݉GnFjMm aow=ɑ,[\?>Og';)B ]6{E(b+Kh;6:'}2ջ <2y =<?=T%=E1 GurQsk9BDxH`>0A/ftnXu6$8HNT˻54ʹ>`QjbUdӸVw2=nw*b|Eљ,uUVjl}q]uWSpdd3;qd;+kѸvV o"&ݙf;4iÔeyW͐50e0= s˲*>T?5 I+ ʲ5=e9X縺u}$u5 &47<>fJ8}wW]c(7FMqZɔZn&])Kv@;B?MzLԶ8\>ЧzCvg.pKhtp$Kd`*1|Fp!6׎I-!5y %8Wj>fHyo򓷼)"an}f(5߉zooF#tolFKIsEAhۗ9$zXrwJix`8i`wϘ~7ri/ӧECM?3I(ܗ9V Z ⷎPg3E,Z)? "JF*/s*7-?]-~Y)5Yג\,l_MRHZq|g6:[6Y\Df/㊅;4kݜc>*Te#I?؇*E G/]<h`av5t8IG`G2ZfyRu V:b J6dă1r^RAC$Ǎ\{5Gik*KoY2 ɋDx8U@$ՏhIAo*rڰ#KW T-rIC|/wWIrO1T[pŮJM譔CC^Kz]EI2Z2\1wp[s endstream endobj 137 0 obj << /Length1 1425 /Length2 6638 /Length3 0 /Length 7608 /Filter /FlateDecode >> stream xڍtT>]%)Cw ) ) 30 "%" ])!Ht# JK}Z߷fߜ<{>:0k  H5XY jaP +SB 4aP;E%bA+-@Xa.pyʿNP\\;@XAV3D+@f!"g?x=*e ]+և!< m@P7; j]@? x] wC;[]`= 4^ C(U psC~U+ 0gg+?0duomu<v`ݯl] `Ww_Ho WƁWpoo7CہxnV O;< ` AA`(ё0y8 `* 9R[0(oW3Q7~Srr0//(WPD!c+ }Uv0d=>_ g,-R 7A~gvWE;E?3ԫ;}Mrmg\5A`wfUVC}`7%Vq#? ׃ *'o .AQn升l1r'"[~>( t x)"#%DH7 ,G>\8?$ Gr6p8r4 d77|XZ֓wsDju+N^9xOBTΪ3ԁ_9Nen|6a7'\][&o}-*[KKk wgބڡƚP'³G٫ta(lfSwJTuoaYpi*&,/=$;Dnn,&T觤Clr;/]MS :!;>ZzlT1*IEIXG_ԖT5Yh'!b5=㵯D%R?e5V#Hx:U=Ԣz*3w% !b;[e TJJHq8VBz%6 0O%RFBv\Qz7Cbᨅ< K*uTN7Nnhug\d1jŶH>d>Q"5NLhB`ghIXRrzVC8!61 5=.ЋYg{L<?)X^DhOZTQ3- V'XKhj {8S34&l2FlD$ m[gafNW:;c5}Кnᷥ<4#1ELI(DjOKOG-E4Qa䠠ѕ̧*t;K 헼`ٿhoZ+&3"֛ TqVO2DjAwlо8AJCۨeϡol$?Z.Wn7>WС:s0M4=Dduu3N<40n'՘3],9e͹9[:wF,R(a3q׏[,{F[w{\@p9ҞؼWб݇ZuraW>2y] }HCϞBAڜ1bD5c.䢝郬+N53! <b~qn^k!&' bhٳ{ B>ӫMtoo'Kh o \~v"f"[^ o[N'oS2bMig1,Kf+.pOb3AHDnS(нpԅ-cJںcVMιzMkR;eMŽft ԩ00W z[עtF2'{5뮩V}6C_q$pGQBO)HwBǪ] Q5̂e2/˱&z4O5RCae 4ۣ#'Xo L6<Ƞ@Qe5G%,m{c9|ί%;D{ňv:'Rb)E+j{sTr.|Im<Іnz,D3Zqf5jm~9GxL '0L*`]z-@v"ME8GΎ3e֚=9]g=F_#[D*ƽyyygݳ U:z0}[1c+o M"C7L}e;aP¥/ d{]ԁ}͖nw" ?٥חqoA;]?O0[9]N&*۱z}pfAEa w}Jj>RBoqE,79B֜,-jAt8(>X?J6ge{0 19;J)܊JgS{rPDN45ȳqQߜp_ulka8+.\ oBjB[Ŏ.q oaRQ8CF,<'/qg/ŇtYɤ󿕵i#C)2Ԛb;xs!rZѩQ5'h$w=zEO~::O /!uMR8zI.-/ra1s<ŸYY}˽"dk{׈>tg`ȭRlg}LYV '_Ysi>/n%4Y~MoP.pޅv&ɽ_λaF e32={f߽' 机$vPA`MDEY—{<55R7jD!O*}zžЋwѲ-圏m^1OFiPSLYUe9"e5q",(a3UX#glݠ)ۣƕZM+xv٫?Yfa8˛y_W[Pj /\9y랑e'ٻՠch~jyg|зQruŢFQǩb*a4iTm XiA|3%{v9m]yL r3 c5yzm gvh #17~nW{QX ^F]YlZ<905 Q0* ;f.}$ʠ)MeQ5r#4kfbl}igGQ/Bʃ3 IKBҳ}ؘ3ddn =FYbIW?=Fqn/:~)AӁ@JǬs_gJcȉ ^5΂y%:ߌ_^N*orK'NE&[\ Pв/(4o' _]]z_*# l`lr*u1Vz[SR|hf@荠ɠSam|ǁo9n^f{jm QNp8>E+ǐç3a&oNnLB&Cmq 'ޜLXR.ѰXfSJӯ|FgW>E2V)0kp%V|F4<;lVbي-Q~*թz۳Aqt,V؜V31qBٽ՛&ԘPaYE\ =M^XŒXoa}mFz~r0;<5R\j 5~&8{`px U,j0Ju[RsdJd1r0򧌩یJ๰Zˑ v(s?桏/M-&ml[̬M.tkù$? * %?QJCn;٤=qm?GIڮN?<<#ΨB )y_8viݟT$vkvBUHri&Tn|&X*yFj 6Hti R$jh0pM> y2x=ۼI@+j6}rqDy7OVp\`&%ɹ cQ@ Uhx_^YH 7g " 4Bܥ 36&S~s-\ы{Ǿ\' -Dv $ ;EzTcҝyd&>ŻMvFhY|ŝ l(d<9t(Dk^/LU%?~ofm8`i3kϝPG/xU%PO2/~(lu>zC1IfOXQ}z{ҊrGA ).P"[rt|#yqo.5ELw$$IB0V3cRVRuibNE7 Hg7dnjB(tb /_s&U bGp*ǒiEQaZ[Ѷ#%xwarywt˂Lߔ Գ*4vKx[vyٮŋpnn N,s\ڱ[c\(c)k[_N7uZuvpGBj Oԛ*iϾ`[Q0͘y W+܇l./^ʉ )id;-Ғ*uY-'1u#6ԐOK#f 2Xc2Mao,)DG5gRMl5y0FH P9>+ahHvmX" '1+l6<[q'/g]Y-E4GcRDYpE yo# W뢆%CJvhCu͡km "fNdpn#i tܞF[CNgW"2$\r&(zvq\[ y ༹ fBH^HT;?}x]޷݋os 4Ɂt }`g_F{}Xn&΃;xOt\}'4!InRL.EgLzE@ȡB]@vs/6T@ׯE}├~WD}q6} 1J|# I@Xup K.`*lkZb Y퉷LFTQFIh,ɣuϬ ~ZaF#OݝD+V)ḔWKmM[bVw%3/ ӫo~ٳ$K%Acg86H8-byh]h.CF@_0s hir 麱r~QxI{R 誌QI[Ź(d\:z p<01'*^0vp\=5Z="Wơ)peb'ۣAxRjȩnL\Q*UF 5oj8f:3n15XPPst OMe/ڐ;|Pt`م{p`.[HX`_o,RR6n'H$,OoQTڧ7Dn|n)5!Bj(Mzj,]ry_oU5~bI+anZ>n, j}QLd]zuW*'\Ntu?BK˸BMY#;0iĒ^KaOzNSڃUdMՏJ%p[Ѵ9Ygj6Zڥəy3sckՅĴ I \jg20Se0+g-ᔒ?Iخd%Zrn#Or_+ endstream endobj 139 0 obj << /Length1 2436 /Length2 15438 /Length3 0 /Length 16871 /Filter /FlateDecode >> stream xڌveT\.\ ]CpơqNpM Kpw n9w2-jʫnJREez!PdDSUQaf01201 PRX8Yh(Հ [qDNo2QC7 l `f0s0s01XrX [#-|P0ssse:X ́6o  c hd`hr0@pp2|:\&e mǀ@ P1p[ 2ur5t@[7#g[->@YJ`,7qߎ,l2646ں[ؚL-qY'7':o#Wq!%[ɑwݼ5ZDdcurDjZؚ.َQ(%֛ `gbbz,t36gDoO;)  33 `4EM 4m@m Lg& [k?ͨ$$-@OAnOz&= ++oGI_R 5rv"PN>ۗ QO^0}ÏM9q.yFZqI/2 %?W! (W8OIk%١.Q&!)MS掠NUub #K 8՟hqtu2+ }EW4t( CNpX,*>:v#k?1K3j o\d.3#xȏcF,cbzԀ|*G>#vpEȂz١dPk uܮ8G~#\  Z>)RAw@Pԋv:}@fsGL\E-qbqߴyo^{pÄ3m\T/g*v x4!}|_3Uݤ(hX_0!H{j Rw@W#T" =LC,2^7Y};DH2` ([bCJ[t_?f zw ^$^y7] voimNFz"/ CwѸzQPy'\0#ﮅE\FէEl'U1ζf]#tF1lV&ծ3Qt@|Ih=73 x &֎]]l(L/g#Bo1v7<9uƫ8|3M)dDžn>ycOzKIWD%&3J!#"/q ƪE}o'M*uj;Yy;,oBŽ%}|ko9対"8`%q|lpIڟ` ,5 St' +*n 2-+^M4Nx<EC#,bJӔ,OK^;[;3^{C#SuL;mF#PfLV>ohTa 䦣9 "!V4;KYʇÅpԠ1=L;U /5fط ˒vs*4@3S14BP/%(7Uߥ^Női+@E;蘍ᴤqP/TΧ8U^AE 윂D>[LcAx_ X)ulӔ﫳Ų+½!)6uȰ\VYr=D}Gy3‹өHM(:&K)^ma'Bv,"(׌.C1LȖlƳ{ )sl]PcT_;]Xz>"|!\&7yR74SyF=]LV#`5HpW1-}sP1呙0JO=֕}O.)W}`ĭJ O٣PB{ ]s܇bKR6\/m'd`G#&<4 RհClHu ҨS> ]@xP. .2A|9Z7?k{+5M3A3ta&fa4KF3bDg箷4mOҐdJ.)a 7BG9*xVZ|kWO@x;Nt&] +."d.ffهDߚtaLCg*uwgc= lv&(M.Y %Nz?laK."1|b6~&fB\y%9ם lCԉ$} M@ m>XE'@=.!k{VU؝ XtiX R% 4O,7y*z[hHVљq-*mQi ~M/(i9!B ępr"A2 _W %Όsk4i&wr%E~0I|nל9Jy7ŘܬՍ.OSp"m].ЋmQk8"R_}am,O9 a<bGP_֋3z!eXоo^aZ#ZLւi kuG!HWjRg%D+$C#0yKW<F9J"Qi/ztp^l6_툆clBM~6*\Kz9G 'L]&'vo P~]k_sx[ӐE~"sc v!FC0]&۶J!WHUUjA$焱S3m2Љ6ȟ33&)q?vњF'1݈4)ȕ0WsSw$0K%#yB9Cl|p".<̃+g.gbgrɗLh||d#u(2ps,\xL5h<T)CeF^÷ @i}@tFCa, QV;ѺyQ9&ϖA.&l[2.4'dcmVSXցkbO\"?ZC r4,-$HM_WI"#IVH$H{ֺX(F1j5O(cTk\Q" zBn 4r;J2t l@/`:_f2;\Iwk*]7kޛDmYr6iuzep1z\E jwX8idX﬘ $ &'0.±ڲ8.;ip]Aby1U⚺ 9n) OK'|Uv[cyn~eW׍w>~]>AX߯<KqoL2=Q%ge\@$ @R5r Q+[aZmn`*|FvMz\:oz&(zycStr x)U2DԼ#:~ʣvU"m?"1,Wy2ݼ^5FahZ`?h?'&X#kCC>X;cWⰧxVK6E--LԽsZz|qݗ({j9.C_6ԖzhyR4+J?]Uˁo54s?REg$FTɡơBO1L[b>~3tFo֌<ī{L~hf< b$τjPu hȞ=IJɘ2a8˧œC3Z*!XKt!Pݤ܋ p0Y"X͋xgХ:c&οAa5l*5)OHx>Ήkp۸5AƯ ?s9 S*7i ykDgO+v?a ln8 `: Edl%úcn8.\ǼunVhiQ ۄ!kx%i93'"VJ؞}^RfzҮI7fY-қcw{ IՌISjs[_HH~ɩ-ZgۃRPf6xnEbq|~\ĝ糨d"˜jh HD4XTW~=\:n[ٓ9Mfz ,ɀ#5ǁ ӅrHRh-InG{6pxs]ynʂJ-WddpG$,6gC:fi} )q=xDEA0TUk$R6dnaZ?W6srX2D ql7(NgR[)G.Vl ?{l9DQg\U/5c0'gv:F%w^i&N(Ak&YwfgS$HKCcu 4BW;>ά}_20?h@*"V)>a| ⍃TsE!eT%%f3Pw-Y{_J{c|YJ~p` 8q}x:!g@ 1&h%ӯ "s4^R!d"$7KRFu= P'?JV1+EoĿ_31%ĬA'Kʞ̺0r^m'tЂx.gݵ?o*y32k=ҁUۘVIyaPΜ%u$ߴ9{J/z"Xt(@oﱏ9C # {!-G%7E=B9Hrą`G!Hwxm]74W]e!MnYbfMxpDʭwvT R,G=LW<&^~cG;[<_F*Z2 + D_v Pre% "k3=kt;$>ֿf+#}F4+dgG*B[ERA8emPg33󄈩PBp>K LrrRaYtgPuN|P~Ȇ:1cLיϰȌXc%I^hgBdq36o'A FU:RJ/TU:/R2IFt~i&[[[nIZ&?`Xۡy5!}VRLnl{>_X+ ӂ/%okJ7fM~^\QüB.hܖР9٠jAV/~V )Mv|y}. 'P%[p)bkGv3/t÷2l'18M^,i<,$h \}t.#N!WuM>l8J&ޚ ޑawB,:dwv%߶@4sbU:8̴KgT>g}'TG 55R 00Ӎo3P :%ƞƠNfLÙfIrd?U'c(3K{P~AlTAl5rsKWtKfub6,0_~ŲS-y}8YVN{$,i VN۝LwOi#f bŗ\4DM+"B r;ycu$r4#[S\ng^Ð~Ŋ_ ̙(?V떁B $YK ~LZmL#0'<+&IDB}9גQWL"˰;{~&^;~H: B-j:yDTΌJ!֫:>I[O.'@:檼PrKcΊ/:;l!?фD7` QՉ :Hcpwj2A 9(Xu'P4+}sIߩI2/5Xg3 b">zaVעc z c)>1AaWnI <-.*at#V⊰&|_+Lp(FX,}Myh!/ffg&6~o𺃟e 5ŏ_6.o1vb ەW;xMj sU8Oo^͹i 8ދ_:+b%޶1$TMhiCasuP佥mMp1Xu3O#V^L)r$EfX֮I}BZxcX9~(ZF0б) I[1MMXVy-tl8|yw+7/Akڀ#^˸x[?Wg_bGP!$F[bҼ dq_ y7f Χ>ves_92^_<N%WaԾ9gMt@?N%VjMH8t~sNeec fH~>:<φ X ;FS8F%;ӡVy/}{JDʓ}kL\t&odGqdE8Ⱥe&< !`^풻x6Hፇ(h&'dBM=VgjM7U3Vs[|Y(Ez;,?2Usî&7q𡒺W_vbw\b.ϳ8Ҝ `~2kѦ؆ʬ`yBɡnT-K;w:ɸSI/eF7d_sѫa/n:aJ9ʚEXc,,5p;vA-ad¢PٌӜˊOND]!:e WFe$o-l 43e!zڞ+|1Җ3x]Cv٬u/:@@s]nY𤒠Mށ-k= UW bځz |Z:>SVZNmq͇M +Z/PWs`'>ںѼ!qaC ,0MkLIog|)NNJ&Nˋggh˺O*JX;PF"khGj4g: ?f>\_UHчZe3^i9j}VZg]i%ƙO;H1O:x517A#f;tf/"bU˒%G\jD6r► WGgS?:V5۳ ;?Fv 5-B>1p~kK KE\˻dށdu V9C$e,Qzm 6JNƥxCtG­ĀѫؕQ.t;HjQ!+|b0"#q= wzSo096m%}SgJ,;Dıёyu|ΊR P.MTM:O\U[ /s鉭;DXN4%ybH0%q8q%Ts,znH{嬳QrM=-!nU?"hmXPg׺q՜#>YHJG5N7՚;Bk!]{ԁ1bXVʽ)9l/O|rیBOH D=Ǝd\vJMH%WW4,FCu@Uƫyt>6gǘtrpTiq9a2tcK ^~=/F,=W5a<PtiD)h@ԲR2h`k56c ;p"Y4;cL'8+}V0ִAMkmc&2Oҗ2!onu_y0>pԹٟ yCBig)<`zl2DgzZr(8jHC OkŊ4yltoA钰{N2*~TR faJ2Y~;~r!09Nބ()ėyzMg0ݟ ]5bU̥5g6 ct؜TSs?%oK76GPx_UB{t7<n[ra@v,;S,/OVq"܋D<p)/HV<͓Q|7b0=͠啓Ef#=<1lI8Gr{t5-xR2pZNm1~jZi`$juiCb #ÞX1' 3q\ܨPJzuz%w9\ۡ_sRL *J x^5t!}^y+ս4{U)0u8_9޷&z ;L!b*B3eaSa0_}LܪΦ"8(?Xh3>-!&IM?S"S^w3*?gº-.^.W=|? ؓk@܏Z<*" OӾk1ɫl6!ҡnN9.#@6 a[g 3~FG{}4kT?g,D2@(}I7/TO"oOKOq ()$0V~E&7Dk5[5L$ACzIɒU>?%ީ3^~mZR龄?ߵ6KqK!?k6ep)8xv J:;/k#]tLn"+ӡNQ!{'"9:*IyO9Gveנ=DCe^X@srmhk6"A˘.Tԫ-lߜ;t7^4V aB3PӿZJM@x(@ ~ ^cG_|vD+:3`|V@aً Mwuhk8¸a'8ctC :WJ3%_$ɚdx-DG7`om:]&¡s;`ɉ_!?$lg>/snS,Gn H-v|WXsYkê MC}G-4$F jnqR'l}{Cs}z /įG+*fw wg 7/}nazR Q5y"Q&>d+ 5a ^ZWdpޛ8[')Y-=b{XG}"ځBH ?ȂX7&E1W׫d4jWAnǃ AJDw]ׁ蛯]je]jBg|P4PTN]xr KN$M-`U vtkn|fc+,&Gmg=|.p@c̨-vwpq ͞)K,XheOϠ K9Dz6@ӣkC?hAg@s5.Z [FF>И́EsW[q&>}HJ@՞!QuZCN{Yp S,n"bL1Z|9wS>s|&}.Z N|mMB6bHpIZ8]鯮RA=i/$ |4Y^6 ᱳÐ{/|n96g0^J J#('65&!ʾq<%d}Ҡ@JLtdm[NЇr4jFwՆ FČn>՜Ճ-3ÝX1v%l"OY-Y>[kBR^їbľ<_~#͹A?@p΢8>NC7<}Son_˷ڊՁ~af_Jz}> ObȿB+We[J*7cDHCZlFMY=ז.΄[|\o|r+F\2?:@mMLBomHSȏjf][{\u~)w5n^1Pxb_΄=^$H=] 2攕,w K/=P6 " 78؆uu#qNr|.rca_MTE#и k5# 1mCP@C&K` oμ}ګѣf !Imi ڦ4\LB0s@)w} U}_0Ư5)q;O6^/Y\"cXZIRQIV<93rhIcJˡP`ZC{k7diJ=i K G8U>8CochWyĜ?brw~꘶2\>A3D,y5B?edHFo)Td5}"&@)⢮H588!w̼1جm0FJļ# 5Wd l3(f%6v*fc׺QƐ|Vyad*(1(vnM&5±˧6"@#{t&oѮ) ˏ4E[誶ibe>Lw߀q؂ӣUtSQX*T$Y<-bD sӌV)gK.tJ>A;P]o9(Ϊ1 Pad>[ #Fmh  7 Ocd D&[ei*d6yenXukrFgDicksog ӻGr)'QNȀz#m R`_O.5 !Cͅ.pitdTҔu#8y y2LYipIێjjk(aW|d=sj尕]|DP{E˷4!ļ;t %(r:N|8.Jle3u`*MayhMrLҬK{t ՈV0j6  g4/*ΒsNK=-NI?Ώ<įtkTD]?ȕaހʡzM&q<0C3+:XpWtY:,QwG<^q_};z+oP`SD;IHD/&wO4C3 UQ< wKG!0?]㖛\tRnI]d1r̉[]oubPQm*$&=2Ц+F D-s'7#.Xp] W(i M%K{ P0/zp\F8K$Xgmt19蒑BF/-J-V9f1P oل֍؆r|j3:ZR;X.PQӪ]\Դb& 8p X1c_. țJ?lζ"obU PypA7 kUMj5a u'"@ Rxe`uz7dN(nkzFgN1ͬf^:E0)ꎳrc߲{Qsþ ZC$@R0{Ԛ}g1s:%9T?ˇi&/31'TCUSf/'/B{4mMcw"%r뗃w*=;|QmD9OZH endstream endobj 141 0 obj << /Length1 1379 /Length2 5902 /Length3 0 /Length 6848 /Filter /FlateDecode >> stream xڍxTT6"̀t "90 % H()] JZ߷f=繮=6;1#Re]cK! M(o;> EGm*(4PhyB"!1)!q)  J DxHT콠]F+#}=N(to\ n8p tQ`7tE= `A(qFܥݐ'9n>7 0#^`Gzn? Lȿ @`PDxtu@ gsBBJ'W"(w=psBN|P|{/= @{Cahj{C<( 54mV;*#pW*P0ツ@᎐_c8z ¡<*0hmN`@()&&*?}@΂ ;3#@(G{(Op:8BA( wv k> ;k4p῏XPLr*)!|’~I1 @HHH .. g{>#VA$jO\ g.=`׿( /BgWݑ' ۻAahz*Eo9/nD٣ՠwB3__v(R v4@//p AGC ~ 5Ϻp؄EFDBhU:}~ (G!nP'Ahߚ} 9H:exe"71յ$hQ3glGJv54#O *"y/} Y(@ao(};}frD9M? =J6d$¶L5z @r(='aɠG+wa>da[C [>$I 44|MPꈣa5܁"'Eڽb5~Z,#)ɹZ-H %s$VH,;3EEyT++Ŧb4t-ԝA_X`.5>1_Iӱhb鱸yZe ?n}1u`;dIMn=Gjƣ*מGtr''cR~ 0ɚh&B\hB:owR*B1xR3Vt`[*$w {ݶIr8Ƴ.zlWǩmKV9[)PadK^a${׭ ņ 磌2_Ovroh4]c; K Eە? PƘZ tyBϾY]H qn;r^HI@F̹!)Q!MmBU~)Tx. i߄k/QY=i%mRw?>e@^ 5* Ue [_EDw-kG*m8іWN#[I,gG, Tun7lִU 4}i)v9;ðһN%|qQ)=5 ,Kf+?ۇ) OS{ҘreGlUu=d֜M=etpH9};PhF/j$ӕ*RԼ4l^&/us]|Ob 765lkW!",k; $NX}_`ja/TL%Y1Lz><7lZ+ְ'3.E4O-l P'NU(K9I1 iFs7Vg>OE W'(J1{N~z 񏚴!Uq~&Y䟕>;xz`1) T>]Y|1B$ZFv}W}YU s0'+ԟ]1e=²Zbٿj_؞yxj3ĚTقl#nÝb/؞spqa*ӘP:q;8_Q$KLIt eWX?1uQAn-3=50P0!Jtd?Zh8_IWq̎Vsh_+ Tm9>m_m}-?Gyp*f:%ԏ-1mL2`_yD!vFAv+/iUF4 Յ@(wR(ܺC<+{hC7v}ƘXH66︇:T-l8rV~ok&x+!H`Mm$5]_xib:6GG]|̯yAcJ rn+4pn9r''+PCĎ-(ɹ,".\̛,_-l+6d6,p-N/1o_ač3o+~j /#HM\b&;}T\ԗJxr+Ew`o^朑juΎ\4Pn;bU $('<-ȷn*TNzUǵf6e5V& 7[(=Yy$BPMӛ^yD'yoZAx@[-րͱtZOעޮ.*nD5n 0LB|E1m5GeNôɧG ۳oI~$Zy%H=?3vd܀ĬBK9Ka>K^_z5s`*:GDB. ሳNNIU0%Q\xH轧Q_ ʕrl?9LFCmG z.=s/*^1c=w)j#b0_*aQRP񜯳)GMOHvFE(ܵXLVo03m7A3望ɡVQ~=#tHٺ!NccIբv$Y'<۵Ģ"%jN3 󔲶7s˫:8!f^}2u 7)8iPݝS9 <ˬ?HT=;Bg}x@`aѴr]jcYiPY7[<#8[8}1F\ OA znO?<`y20"2:m}'Εz6e'}nIyg@&J/&UQ:Z8ٸOˌEx]h<NV,G9M`25Hx暣e(@fuEAJ4QMpLc_N}LN;mfaMRƣۙrDc]"rZ~*z:,X%xt \"c/1Oc46zU. :(P>Y]"`4[rCY߫>AZ jI^)cg(~; 3}j9+aRV3G]jSض?fIS{pi'sIvㄸlXAG'r䡺ydlr ~s=ēv]ڨc_')c0dr W} [JUճOTWPSKN ٮ^R} ϕuTqXTe2bj0eK+;>_˼=I['DrSFJG @29/֕fscpȵe&-⮟j)iێNhvByFd2} /^ME铧j_M/ X_iGFVuL[vU\xPGzlFi'W\7d\Iq0_f)>+NiH5xf ڴJcп;lr*Z 3:y\ߩm+jB{p յ 5ZbkF+PLClݑHew*4q.q(R`u=aWH)SK\$/dkm,H{?WwfED~>1B94sRImuJ)wb, 4 XLw[TX֛/Rd,bܽIm|󕭍qPzlC؉W/q6__zxvP0ĠVh!Bc{Ik;_:gnfizo9r|Uq|V+5V1S:{mÙp -LՔ^ABzmeZL@`H(qHEo5iIKukFSdh߭O}&qʢN8}$lQO8cP\KXXi˅U 2Qrc=no9jNLF$đ΋%f$efo;NKjA9żO6,^*th3Ҿp9)x[CJͲFzv }a!V35],|ˋIpý[V9~)l`eYѧFv\ I}序7宒k|>l3]JWCzq, ^cIl?P(߱{ss!Fg̠ NJexގ6/hg[箄I{}n1Gy+9M&w߼a8Igj>Tfd7ݣUEGHz&w8e|񹏝1{[hreu%+p'~*8EoYk-h×tgu0s@--Jcvrmz[T|`3iRY]j97hc4TܐPTVnCga7_}oҪ,9W/,L'Yd5_=SkŦ _fZ#x^7$~5˚0M}dv[0U;zQyAշ̧Cc[޳?|-ӎwg\(\#mbf+i'0C/t7G1mvRa4ud'y3"\V{\,Tnƾ CFo}f0¸"k d#*j{oVUK5M,KR|3);"мYO0> stream xڍtT].H7H2tPtwI 1%( ! R|wZY7}γ3IK9DC>Hj+pyqH{v\&]3 ! #m2`=Q(x<υx^qsx&2`W%@ ALpGg ~V 6 ?gP#m ;ZZp ("6Hv@p8nP @8B,[ ƅж"thn`g`!.0K3~w #'YO'po'[X0(`^ʩp!ݑ07lǃ]P{=9I ÿCX8C.wiYf) wp@!r`p7 ݆#Pur(Ź7f A@na#'o}>^pG} v.:pyxP $b 'b'g;xܿ2W%fW QTSUuJI^@g n/?yпG" sd׿4׀K ~\?B7q[xGM忳?ɹgP{uAO*~`MՃ9K{iY+?7v(BT"-lT͟vfA>|Cfaw r?CWf=l3s?? r}>+3@@WxOv|"@?pqv?vqXN-m+$=1O}y&K庮(-rq)jFugmZ;Gv&K)QBf1W9G^n#T\x*,}v,1Ftc2mS^Kg=,_\(7I5HKO4+2"%vm^twrBWRom8*mhNl6gZkzxjgNW\9T8\VԴг֕&~G9waDO>Ka{Q<^ $*彣q&ڈTu#iQ (TӓU? Xr"<&:ȃ 4χwWF`ׇqm] Qw^|xn{ćr0 #M2Y~ezMaE‹9``$,B7{> A2 [3 yNy] zd|D|m$^pSgDqWxev߽%H%JƄch%=A׸Yi?jFYE9,*{^蒍?dSE#W?% (gTDz2x8hگ@8~v zeO]~,LS*ٛ752wȄ;1Rq2mNRFDoJplous/{@|TS<ZWOls):4T\{|C2Jܼ)^sNyKC/:!mENo!:~nWs$\a1Ns0|S4Uz|7C2(^nTOzFV$7Wnٌ"rUAsM J'&lvcD؞q$%eČ.Y> ?1`Z \-1}mWֈ,2N0h=y`~YCA˓j Me}$}*:dQ/0d$2NԼ˚Q1k?Lz}"_Pj9OW 2C)l}ގt1^|\#i9,]1.)d/Ϟ:(Ac `,rWA:Tƞƴ=<2/Qe<ߤkHFsԜS?<'vf=AA !82is}TZzi{VW_Bw`hm% 0xFZ~rNvfU)|N^e"B=nZ^W`+Xo5vԖ[Ry^sK5VLvAjzZ֫BKDJ(B&YDLs~>qdv[O|"˭B}ST'hCk{'8'I-s/y G³qPdW5'C~B>M@YcLY{O.冼g+p/IgX5ryk5pSȨ,ІA|]b@|ҹ"} \mYX~(n,UQsFX@ϦefX\q&srʐ7lϴ>f#~ !wnM0 _ז)$CeP2#ʀR`IQѶ?<\ȗ²4mc(OS효XC?g:!u6>g?#/~/LZ&6M>EYۂXq{NϤi Iʵw2E5(z/- bT5*0+%؋R K/hO%OHm ze$OMHtxD#r9ltE LTgj\nЏ-<L=Y3yv͜LeL|09Y#qUsꨤI5Ou)?a:b{Y L}_nXG[R ryTйjАo n7YRS`X-jWʇ]Q@R]dɂrA)m·Ut#S?{TZɚmm@qd~XЄ py{//fIaU7YOuJ_/ }J\ylB>B%BHd#+ srh;@0btLk{-νlJuG×x*X4׉C<1dC]+Hcf^̺7e8~u <>N7 E꼏rz}*WNaĿh !9JqMxvM|TԻ4?(pzUg:N6ʶy u[ 3Ml^@&W§_, m3z,Ks!U4ܱ%> rWjY:AwJcVSk3v֣ZCaU !ƁV!ѡeSDМB/>r uo"wݢz~ 1ՃU-:2Y4O9SSyYYha6TPue(Sc5m[{$KDZwOHAߛjN%;)cvC+^8ynTP6(\%m6XAbے-"l²¯Z}/KG%'d,5L>X{kw56 @w&S&J1ffOE,2BK&Kd'E8Ư2>q''Q+on28*D촶vsA5{V$ʍL ^AFm?Gۦ_ss!1I6pj ]Dobv vP[YݲBϯyˏoDޣV:7_hHhG4٩ XQՉm}FWV(-=fL퍜)WR#ˉ~cc@x OX'bLiWu'ɴ ?5IlJ+WJ=xPw&|#Et"1􂷪}`"d<⹯8N{. SItnv8SUZwG/u|>ah|5;| [Н=ly1nC:G~fpCx;%&'cۨڗ<(SLc[3-8cJnKxjբBCl]@x;}KωIo-./_dN['~&E8 f-r30Vp%]h֡yG{Zma>aj""f牨a/pEћsJ "'DY`k>2RqfypFtq|m + 7z$gD: Ϟ@7g9Uv'"ܺwk$UVWn ' FU_fy(kijѴ04ڰH|Z>BEK{WH s4Tm ^]5)'v2FxJۺ9bq/CߎT?>]vNA xjWw+FykXw\)%hhVW" dfKlsl +4ȔzbxrT^,{E } gLYG0*h.MջAPHEa0JOW&oo\erQ@ + |, |l8̈́4zZ-*\k:Lٕ]C5?h=K_c[<+f_63< ƙ-`T:QjU]-0p7:YHi<Gl*2s c{ZZC(pjKBXڢ٫+ѮVڨdtnE~.N4y 6@*l;-ΗQ=e8oI@;DsMCB 6%ЇE4v"3Bۑp֞B UM5LCqv;a+ ιrJQ~$b [rsj2ߦ@i75K  H>OHP6Ty {&a"t5Tz i܂XQb.vLkUX@b]Ffn"ks$Qcc}?(„uBjr[53Oлm#~jR_fXy5Tk[v-ڣ 0 "<7ٺ=]`>ٗI0Q2V? -D .)en#{ͻP$Ns d-070,o2¦iSB‚U^Ԟob+ ]Go(d\ ʔLjco()*1!+ؙvV񋼍zjTvdR⤬W^$dwya])A6!Fjcs#?f=B뫧zhRof1x;b=Ѿ LVb>K"M6"Us/{S󞞈 [u~*n27צBP ӆ~߫|Rzd_BAR4][>+RbfB]%r0*rÓWfTX_13Q=H?[m9bvܿ.fӷQVC|EN킗ݹhp_ Mƚ*`1z2  ) ֖ ,aaF[#O 5o;>BcMLz -zW7cG0G LJ&c&1\vU]f7%yap[ oXf)/樼{Z})Ab*uj`?%8J/tn5E ]\ф4dD# ܼNP"N墊HCKk&!OKbTo? 8}7qhh$be}@e(a\ fAV`uMI8*#V"!E{N7xVOF* C"ތVPt^+`xݝu8@~l &\TWgx&Oxk}R*Q')Ix=Q̀ʊ /`xQ <=r[Y5}k|o s'V2.IubygFE1}bTE8@ܝBzCfbvs9mX5t Yeȋj{pcR\4{5%'ȟ6Z;]5M0bYۜ籘 MR?14Z<ӲN|l59;D VL~|mh˵IBs}6JY^.~ܔc|ZG`mԘF>'z,^םHݸh8"X,z1arm'`2ٽbiM蜍d/h景H^&̴|Pv^7 ?Kji3T,wjJ!Lu^h]DzEsʊ7)mԻ^R5ˢj P'b2d[؊4_߽Ab2^ ( %.cxYjS )mBʽd0xHGc៼@;44}JaʹţُKtӪ/\ ,)ۊ}i{V#PfęT`t;1x;X휀A,ӅLP%TC,m0T!l C~[׆ryfK9WwB``ICcxlՖ=b]РQz229A Jȳ/ k(R£t=I2?bwW$@CoHjx9_#}홖_*뿸Jm~'qꮎyfJt0yhXD @هH"!*3Jb 1ϭ3^b* MмѺ%~Ȑv?Cʗy)ځJPX̓mzꁝuh;lb8|bU=n= <',-\hKgL<ѰϺK%OP7C]_/\:<ʺ>:KqM#+܏}:G߿'on#ś1"3t/`5-q,7)Pw!V%;z&၀Vnޯv1c.eOZ>shFՠx{&ϚTa#!C&yS'9!Iv,[˒.}:D}}Y?A!'ќsہ#Qi>ŬVqau|ӺǢzK'eʟ wU/*SԎƧ@U%8ߏy3'є#|V՞\z&M6is^|goqVC]Zz5YCQ+Fǝ!zw>'Ro-Moպυ#րBMoFdMG*(Yl%Q5kina! XDN=!_Q%Vi3Ưv Q$hp ؆8^=bW֬хK2smp p-4 endstream endobj 145 0 obj << /Length1 1539 /Length2 7844 /Length3 0 /Length 8866 /Filter /FlateDecode >> stream xڍT]6 Ht!1t# C=33tRҠ ]! " ݍ}^k}εϰ1l*0(W( P2 @!> Ptme{@@`P1=6{ =]BQI1I  JMyHl ->: F)G':8b<;(@v_`S K{{{ٸ!`\<o F=-mƇ0t t6`b"C<`&@Iks|IWD6vv07 u8@\M>`MqEml 6?Jl;?D! {~0770]lw  9@۰A!`_{?6G0 %`wΉpN08 p|GxHOpp;$ vߟ`ϗŽaPW1ꣿZSA B1 @O,HY>]_k@Kv\0Ev?r#O忳_x۸A\}b+y?ZY/)C< BO<^Ѽ|@? l A9?F7}?!sE^Wj=l"_\རEDSiC~>( y1}b~ߦ?8$!?_Pu Xؿ0_>_P/_yzx_H~[9`wzf'\r^-Oͻ>$(L{2צ^űPAw%]Fc I Ug#$2MO vSk!#'r\<߲U?TU8cq4 `Q ᣅgV*ȏOXGrC?U/2{EVzgJyP!˙;;pٌ.Q 8Z2KГN[W |A;ށkp5!GIfa6+Cym\U"i ڱ|S-׎(eNY+m"nڢ[?.cŦ C'/\1Q}~@}7?`P-K$5 =`.lVj%GZl‘K4'Jz&2v4¾%`~}M9@ =su:\8S1Iv|Y>49)0G@izc~DIHFOWX''o_6VAe) YؿC&^>~2>(x?*6|FJ{! wcYӞ `sqw9KVn|*88BR 0vL'7KH~br%7S4B{1- 㩝ڇ8 oyo_!N3ixLN4n(QhF,aށ~X (ק`Duyv'F2ů^H|sAŢO@ ys,ۆy~⛝ 5՝d^MT%Z0<|%! VbjO`di>z4dгwɥ):taԖG ''8@&-ْ;e^ܙVxQM1(v{M_d?m_ĥzul>8.*f>G _t8AON~$ݠ`6ScJu z^ҟW&o=i+ZJc+)dgG}Z~(ˍ]֓*$[iq6sr\4;b}6`f+4-P <{63D*wlFe یrQ/ȬqD8ް8F^iͣK 68p*$98s >*{Y)z#J7PK> Ŋ䇯=_/ s c:B+ J)׆\΢ά Bhx~TV.Kf_.GVO40$RX߾x&-o??Brդp{6m-0p}"Ѯ}rp1~(4J-H gwZFU3uBfw˃*`{sMXA8VSi~R7gV#pe ЀJ3X߱>t_KBZ)`LnGa8"K97-Fi`]OLPBboA`G;Xktأo/oUb^r;³wn\ƛqiۃH`N*ɊQ`g4aJ(h%2z>Nj韧zpDV)'a{,hE~RÅ҆sY0^V(>k^((PU_<jŌHGCE#[ݸ8}F45Я )F1hK͜/EM]%M,Dͧb)?18X)rlBg+GnO>"ҹD450i,bd#`FszbjU1.[ab tTֳ˹dK$xN"C#hx Z^}A+%.#ov\r|N^] s p<-v(q_=-] +V-9B~~mn,V K%!JWKCF4:broKQ턱LQa}gḲ:ڦyQ6["P=rVߵmLD<LICcѠlљY;F#J^gu⟓234whkTĹth)4QgF%y)xh}CD߭|?KOqֳ,=5kQt9PԮ1g{9mRȏ5nޚJ&_'{tn{xd͵y~ 1"](x!C(mP h3ȘfCXzU+̌6k`A^ sK$&ӿ%Bq*eoB􇷥r_D┟I(ζPDBα81ld$?d!zVKH7Vu+׍ ohtfR\yJE|&t]J6ݒ",]2l&|&jF+Kn VWn3*wBpN}3:#P6ҹD`V 7b- .P؄-;|&XY$[z+֎.ֆ.lBIYKe  FQ`B[曄h7tIɭ쮾~!_mIؽ7UiYDUP%VRz7pkMm>P>dHo#ѩ:Mk@=%~2(>eu/ _%wlQU%%Aew]N!iHdMbw"⦟hx2jسIDp; h |FwGؓS>5>Zfw:/ \ܴNW9T"x]YC|KZ .CN}< %5Zl7 ·3OB7F!#Y/UzeY'_eߔ*|{{7Cu*|w~Kx)تpa*L~p5nMCl8Sǩ$el+g8Za=*moeƪp璮d[vYcѹ##v^;6벀{{I_jt/m~"^jv f.|kO#%!ΊՒ0{|ctr+ y$gzx`H*S_v[牒[DKdc Vbꁔ rf?<g(3ޖd̓%e1? Ie꽖0I wLȟ蜱e,㧗X p13+膤W(Td|2bIi-avS+s 1n>T)tUe3cCf!{in9E1n֝/ur G$\X24}0&>) 'I2A*#{ !d?lt`u4UpZ1U9 R gU;5?[ h;guhQ`yn%۱Ã^[)X[Np~tl[WqY}2X]>F]fB[M\)ŏ|~u9Y=FOZ@jsV>_¼Ap vO"*} * Σf56? Ƌw.:{!Z14>_ 5Ҷ7fQQ$=C} L+ڪhG*+=E ͩku8ts3c^iXTTD#0*Ml ;WT݄ˏSPx2}xǖ%~X$"{c{G{O؏h >ὐ[q+7"VT/Et.lTٍ E`p9f$H_2:$9V޼IQ7&eue2iA ,/6,ӿċe\a ӟ&-m zv:jSb)}6jX0c_d=fED4) U-V#R_sC͸j_i)tPΟ%].j)HΚnpBLr Ex{reRTu:zW'e'xn6:mxq|jKsʆ>#(LTRv maymz0c0#hy@#.0Zب@o'}G?->BhycaR&?㄄j:wbLBȋR endstream endobj 147 0 obj << /Length1 1595 /Length2 9569 /Length3 0 /Length 10611 /Filter /FlateDecode >> stream xڍT.-(];,ܥ(Z\[whšhϹ{VJ|3g7F]]j:9R*ZZ@.7=/;: !\l ' f@a..7пP0@p` z) bmT_L۟p9T@6` {&vL6Nœ (3ja`K ߭q`l .94V dX]B-0Su2@ Y/;w"` qXA5YeWOW67d} 'Ÿqrupw18ZJA.' -9B=} V۰tsv8<0cy`g†w-/''?'  r\an`?:aK+l qO'3/t0'I~@Ͽ?)h+攖Օe;%%v^;7G/, ߧG a׃߹TO#s#.>./iwDnL?~oƓn\v@ K*`Kz\AO hmAB\d!`KumegG:e\vO˓$Oe-@^\OJGNGS;?JM$7>ɏ p8!Oeotz.OO={59 7# y`OB$sHuiTfvE[$5إD`ʖ Ӆ/Z԰-wq;- }G5Z⻾}u鳝qs]{y,ޭW¼/b֎2 *10KJNBp;sq9M5HNJw`;f{Lۥ̀`dGr?Ydާ jG.f^jvaCe.{آ_K g^7z掦g#yRV+Y\Ƃ݁0p{,"҅хqC!CMtMU_a~*(绂t>ݶNӞ_Je`'=O~k^)bnl8H$|{3b*tAQe8^gN@mkwb@T ?7XT-|B\qٲB|E~T%lӴ$5ۣ "f >Rt)"T/#9D >&ˌ~2cȎVݟĎFI%qjW5,Ϥ'Q)%fT\cnzpc#nl٧%# U/SG ; <*>U2HMe04ϊ QUk[k]r^[u܍69Vifth%կH!yuyVʇK×_t/!geu*DLKݕ@~_=WR~Mi'_My/@I@XK@bENM'C$f}+$T도z2nԭy|-N%Z 6r"4NDrY˧c{NNubjp(y)/6S<-owʹQQ11~(}g0 J? OopuQ]ɖJAN LfPyȘ<^gR6]7h#Cw z\o53_Abf5[g~{u(/>Â:ԌD #KyUVaYFF')$J_B/%N6X%V? 22!=Hʕ`GrBf!H!lvJeh3Zo;Ÿ41eJ*fDqHTbUڜf|)&#ǭ#o.~:kB Klڍ|O>TR1Z4ZhV^~"TmJh=eA545W.݁h<(LchI0{/FBb2[1AҊU(u߮2#;ی`rn+(5r~XDTش{Y.[}XY ތ'TWC2$)}S~Ӕ*|'6{>"c=3[%@-j_w]UʠG2(UCJ"By%'"*ğK2FsP;z7P ) -J31>Ǻa?2<_pE&SKLwKv,x 4:H?uܞ@!5zCS>&AԵ$T gi/1>+'f ,=}C92 B-¥- F磉 T*;}aFo7&8M /6P#6x)ɚpZzn%sn ?L|i%D=_&֡w6 i%g.s+r6 ցNIRNU J/&Drʓ!g/h(hW)z m=2GEʁ=pHXgb6̂ #D <7 4$\ux *z\_kttD ~wAk@Ȧ/6j0|Um `Xy},G>Ix3?:"-͡Q.WfL;7/~)|;k"րoHOjV@dKte.5>6p?/軲,7w#fy, Ǿ  JOj1l :~S ub1ɫ$vwzx`h͆9V і-ZHϱZ[{q7葽ZU32cG ,v>Z6PPtG[3yaoIƘ Zv,81:7fRpDM ;9"({erɶc?ja V45] |-sOZ5>HRp 2#jl *ð}^Zuԗ1d{X.߰DܖܺZgHz[Է,t5~#)g,K)#]wA%ixIY1~!𹭽Tq[ N/X@lb羚=㔟qkQngMϐ!Q89u]9AOgx[.Ycp"uC_ٲve1kٶ|y^Z ~>;R2\rsDL_l8C 2XJ3 ‘ם8ۚ,&`_*1EW* 93>4E囕wYX!;9bCk+'r#}DMeZY8{$o/vK('yΗ[ŵɹ鎫Z[Yɽ}Ț>M[ة-`pTwu_zo)Lӄ`ki(fD\t̙/  "Y}y̛Ö)7[kb/F;4|o&^i+5!J%mhU\vme*NJk5GFA 23"oĀ̡F >Et٥ mΘy֔x2kD1 Y=UErI38|r!`A<1LrjStVR-Z*;LGm87 J^Vp͛5k4ϖ*ɓimnR_pW@U2 gkH>BnՂI~d:ޗn?{bĥ9JE? Y +1ʼnA6Q{t"He(;0+NvcVҙ^GXp؜&ꑶ`mxAxt)]֋|Hpp L_)T>1Δ-L說khGm/<-٫h-ùL~*ɏC|{ N&eRGJ *G"ʘ*hy8+0euMp3K]߲x3_WZz8Es^cǒz^d!`X1!7BDR 5RO/9^׸Yob1*"l >s-9Kc9J>GrR ?(%4C}&)wC/CP/ZΤƿS$Pi I[D:B15?xm~}&&[結l[P c{j"d CH2Ppbet[1Njp 1>}9E{wyO9D>.&PFfGBBsv|5^, ~r<1ڏ;" ߢ,#n]|^K0{Be6'b[J& 48mrM^\B ki'F2z,MAIjt;w{:r1מp04wﳽ73XpUjXc% ec??ReGJ<]E-,%cLSbeה֝݌( {O9 >Dop0Bb߾ZǬ[Hó:Zk軥#6YZ@{EY5oCIN^/eenY #>kCLZ0r9mpsCn]љ8 {ķ|E A0Y F6V885w)JVS8<Ģ1OӮrU}/ü=@E,cUPu6{ZShs?-e-݅׼*.C洬" M LmC)*+U=pUQYeݣ0"hCKl$ &x[g4P0͆ʣVo3 z{CĐPXˠ@@x yɄ;-lH;}54i\`^~xo5mH=-2igI(@KSC2E^;"SF:kk]5Heݑ3[ 5֗ A?Fi9;Zx2X61pHT.(*/l;d"b1 4y߶K&;r|j<(e-$@8I0"8**Fe'ޯ /hx\Uפ'M։U)TZOuG"vqQp B빭Z,҄T8$8߻jFb^x [q+ڕvTi +8XO^"4gb̯KYlв:^pE>Ĕ9k! Y0!ЌcMz_m`_D,fG6O?ޢ)/yJ$ۉw҂u=?0c9Mh* *8VS|!6}eՂM=+]M6SJ='ų xEHjzܥ81&²D.4J\a]tݕZ/׽etoq@^Ts2;Q2C@;*S~c/5f)1gsaxLNV$ﹴrP6C2"#T9.ؾ3\ Ѝ$= Z'"d=brL\J|h}=oMnRX sE3?H'D&yPs> 6ӷ3Ar YcDErSF|͎?l| Rm`3xnt 277Mjd%ӌ|ɸW|W8iUPgʼi|f99˃![gB0*UHaf7矅c6nJpD2(^{O<3<<wL9k z~ga?91?{&.iƍUrQGNf*/ma5iJٮ#[RW9E2FVƋJA[2YO+XwJ./Iwl1:RR@=Upn5ˇZ$]ZD U_x;(( Z]Ɵ.R p.RDR.[ vItEף7ϵ4듓&#c% *X4!-)ڞ33 !^Z'Gip %Ԕ6Z?<_)b콿 XBIkcwf2F;5Gg`Ƀ$?RWLxuVRj{^ S@H6>]^oh!XW7}S2 0lf6JZ(|F:=7T=c(gDxњcu58@S(LU7xO$]ٽ#BemāieB3#Bz2΢/Nx]TfreW= g~ԣUH)``Bx\'ų EV&_hrR ĐnH8+9(5JQR N3Y=d!<<4.5*pey,#-20KJ5ұGj< T̾#4Fѡdq)3= ybS%4hڻa*'36w+yIVwjxI=b\S=6P^k?ǽT^B{d/?-IAkFP &##%xHN]dmB&"щ&yGYx {]BZ&~UV/wS+n XlZDxO<7hl69I$M".T7qJ>% 2~*!& 3L)B 6)C YI ^"a'QEG]|4+2!ITYR{S͋n~ u'K:V!Q:ͻrGy *": 74}ar6vh3B[# ՜ +#g_ӡ&0z7πzA+ ;L.#MYov9yo9?_DFOעm"gәFpKsCO ]͘KS3T'׋)rx,Ӓrab7),m"mNh( Zp'MʤLƦ|%R|-"xs6 I?/A xd}]R\P]}x~:o~kO2d1E6N~Ԭgj)[cKH?:l%br1YF相mő (Ǽ}t$zhr@J5Lk%ͪd?~4X!1q xWUNI}M",(H r/77Re=߫&Twe#@dFk-U֏} (gߒTΤfLnӽVQzϻL8|>5. K$3#twF'9=9WsѦnϛ{& \hzN`1kJ~86&N׾ㇵvSe<"aв\7 4x`@+Qh7ՙA_q=_4[Z'e%ҟY.xD?70aU>\Tb?"1<-T|(wS,ykqɼ #JNk,-odydł >{ $_p]nû}ܷB 7udbIۉmj-nⵄ۵ saO ϫ fQQ(b3F>OB [h*jYᑩďbz-{J_ G AE{ K{X8jc.Uc Ay@d;8HF/ƎPe>zG~[Y{Br endstream endobj 149 0 obj << /Length1 2251 /Length2 8458 /Length3 0 /Length 9775 /Filter /FlateDecode >> stream xڍTZ6LH҂ ]C%R2CCttIH- )8Hz5k̳}#%,9y5]]^22B丌`g *C #e 8]<|AQ!Q  C9dAnK@2=!6pdX,X<""B ۀ-@ q8Qݝ s~pm`d:4.\F o r{4qZ%U#7YoWs<\|I#{3+;`oQ8uSJl0)G=%b2_Oe{ڰ_AxX8RP0Q&Ἢ4vugzxMfgr~埾>ax"mvpxzFoϗ'ྀݡm8u (#}ecY*6$s*l׋_kuY 0۔I~q*q5ӊ@AUat|L^g+m%.,37۲znW Vv IRju i*. ft94IebTO#)ع"L;a\ʐI9QAٯ҉k5JW쎬豱%_PH63 LK._J$"osol\$> R/>t 2 P eZ:+NJ]hÏMfdhk8 b_*a@cS.M ~2Fc[7dua *}^J5@ X-쁞)jg/-s}?\jB5&>Uu'% }&2em-mv+Zз>7w|mvPb(1Pe fbHs50־EcYWth,xSTP\#x)"CdҎB2`ˎ bMrql;yAH\;`,*SUaR9anܗuf7Ѓef]OtdjCC2[h^_S?N!Q6oQ~Ōa9`x'''C=Ky~;|Z >jjR$%BӖSקsclRqŝU?K|:;IvAfH3X>hWB5qHĮ0C)-")f|޻ȧۄx[?W S?%UUHGYINZfh :+Vp6${rxN):9f7Q*=,7 S,I6 b.7V6Tc}nld#߇'PX*%ϒSj:] 6 s[)tN$61ms G:XvQOgx/.4fII>xDE5НKl\ **̝&JwJmw+dUG!۩MVk]d#<̢9/l{@-vRD\!Z2W#z[|o2'>uY,Ek F&PR鑉3;g p}"pц0 i x]X{1Q;Sjc Iߨ^G2mrƖsw`кGC*Fs#MCE_aױxuAB?СW Ô- g$WGGmEDi#vÖ:F8qeZ| 7Zc Vǯi]0h{+8cj)g.y2/~1$ a>=|"sc#]E] LuoO)q1PF~hVx4i@ިR_0 (g q-w3jaeIt3yDH#qw AQURZ*i܇eP=Ph!ñhE܎.7sčM`z .62Cb'9Rhm"P.@MgmظGwܫ8΅w[K^OTf ( Si("Dh̨Ʀs7J,:6,cGakZuv>P Aӟp_D gi}i`gLQe_b}d0vrXOx3d%e"gÂw\^Y&#b{ rÂ=<+5*G%NL?xʊb<'ޚ"y_dzGmPq74/+BhRYdJZ8D-zh^QSKg,Aj(LRI~L0[ݔy[s*yO?b׻pvdK3p29זfy^$9lĥnc&#wr5m$ΒeǼWXzM.7QLmCESW_g1|͈,2W @5v[^-H=-jVRQpJfޠ;Rqe;CFW>mÔ1nw=wa|m24m#9i. >M^IIVY M 6n25 sL&%u:A7uM'&ۘyT,?*i-մʊܻ!Œ3=jtkb+lݖMOMfye:`%Ny%F$(Uӧ؝@Ss{3>M,P;D.2Ts_EI JQdhnt̢_/"bR_VM4Zsr3P\:!9?ntSzEfi4;6JAݨe qGfӉK^(9<DǮ/Ăo~^pff|Sw-=J_242B70KN?|o\1UqgIJn\cLEnzM2yW 3>K tgEec-ئ*i<޳t' QM{QSUn^Y7)CZf#AM@iQ|0 Q:kxMUa~}ܖ. XOTz5{#TZwMetU8^؉;(a{- \P^x݄Q(U53Yv͞ɕxqib=uM"t( t#ޚA025!9'Cs}.:ѕ+>סlkӯY1L͝Bg_R05+~nk6,Nש`ɫ5rM!37ls{S]/|_: Kbw7$'&UYZߪku O }/!:#t&"aş>ɎR܍ޯH{ ]mz.#,?BA-k ΕmWP2g~k7Ηb'y} gjǑj EuP6zʢD$Mޖ #_A66W=r7tL8{b皓Q_܃+=.irN$T/h^20F j^ܿwvε-(ojXV{M.CxKeYcW1D=Vd\>VΩ)pߟq>*e*M@up>FD3v o ';8`GPqŊ+xZ s.12󩩶_4 G +g?FdS jCRA=ڃ<.F8J;²09#. {>8tgj,~L/E"܏wzL, Ul@8ܑuNZILUIލ}zեvHq3}7`dZ/c۷c+IIqhQvy_;@jw@8 #TE[&hֻعvam5yWϓAm솱Gɥ%'m82z; Rp4Lt%KWTNIwW cbxd[wbe/0>Fts~rwdKХu$QŌQtL+|+?Z>~VCwf" b-ZJA+)f1]wKLnFㅨ-8r$Y1kMXɒY)ŵvrSbx3(DzB}#]oDe՛%]}^gy/bO&7T,(*o0 hf~3;ZId3;G3l]@%k߄An6ak[y3,B{9ĬS&Xd:N)X .ӷ}TX.w[i&jĚ{Ѓ[Ǜ3=iO2r*-8-M3ViUקrhOs7w,0ʜȓCEBj }BWVib t3}򽖰'kG`aqdPZ[3loꛯ,'Ac BK`1W2zіI&xjQLm@)S4R7ɱKt%sW>&R2w z|S8 &Oj]. X3UǼ&a!7#ߟ.J jB:ޣ"j<_\^8i|\mXxͤsSmV n_shh%eqKv{[+ncƨ> stream xmT{4i\Q/1eBAE̋>f\:BrdS˶tR)*E-V)%i?t=?{}ykbA >"V< 8l[ (J @ S $E3!kAbTI0bB \.^.I 6]! |{='?xBŘxcBK! D$+ $p6Iʞ !I"HB||pY xE{]SR: xw>iMF8f aB H gXGN d_C4!)F2J 0hIC qcIl 8TKҢ⑴V\;%I=8((Z{A% s"L&Q^i} \U7B{ZDȟֳ:v?ZQś1ZͅWni|Rdj c6uQiy.COUwhan+JnYmPT5$VY.va;CJ~t쩢)Q:{O>XqkIkF6]^8UXy[s6!%l;._.6~^dc뱪Ϫ fF Ӂs1Q>QX03L8 u' 2Ɲ$YbݦZɖfgg v}5G]ߜ+IӼ蔿nm<`~e!i_Z <\m?_-[[\+kě5?:6xtvX0eƅ&eft*G~غd*#R /)xi`7ovmLsä.|ղ)C* endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 807 /Length 3178 /Filter /FlateDecode >> stream x[[s۶~ׯc;cǍ[R_?(D\N~ P"%dyL~XЊ`93L2mX`03!< fy&eΤ`)Un)TiH!bZ㦙v9fr<3ҁ; 傁4J2żH ĂQX O  KXq+f di kF:fB {RrẼ`U3Th,i1 V $&b[`"TKQyN%;^1MOi00eWV["GJ(A 6΅ /HL@-+82 a#}GAV9\¢dAo' >V LJk@3*$ [ZLd1XGA*G6OӴ.$[8-`2o;@E02L WkrR_uT"BG}akA`:P4j܆[yCa?M^923O{r2w? $[;)ب(E]';bt?4żK{=QvfBOͅh:Wj~?.7ŷ6R4Ý|?b0Byi{ߐnG.~}AyNϟwwEoY)";o&bJ߼.71 pAw0=Ilk4c8yga7?}Iās">Jz%TkY, dy6>Sb[lWqيu489=cjLf8K VqEPBطPCcn=Ҝv7OJ,~J!٘)?`NlNB-id.@>եd6-yD]\fX(Iz-%iZSJ\7˻kam4vT7CxZ>֐b#+r&r6[Wbjt7 NS 1 ]+\k@Ѩ7.TcT0IBb;x ֤@ǒ< wƏGyOI%WI׬Yoה''R0V.*) 4ӈ`{z7k+z Ɩ;3ΘSY7$#kpA tu!$=ћBp;x%I%Zt8R2(A\`R#T Ghq:ʅU5׶yh452dxāMZdEmo.ڵuhTlKz,ɇqj//l$] T1[Kwgr qMi&=Y0cY*Z(unruY*G97UkQ*R(B'2) Cf㥞ؒf¾s;0/(Xhd4#Mk%Ls63-7붴TOe D`IU c8l* G$|t88wU&9N!I2Mxc:xV&srf]$L7Xz㜌X3(&tMz88ӑt&r-&#J8Tj)*b۶IXtgÇ]RdtA8f|MLU>ILEg{{Gg-+f麶d/ADhNY¶z֒/ZK Fymm4yk5_̜1gp endstream endobj 164 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.18)/Keywords() /CreationDate (D:20171209003339+01'00') /ModDate (D:20171209003339+01'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.18 (TeX Live 2017/Debian) kpathsea version 6.2.3) >> endobj 153 0 obj << /Type /ObjStm /N 36 /First 285 /Length 1108 /Filter /FlateDecode >> stream xڝWn6}WVDv8qb;ȃ(YY;EI,]9$93H"1HqH?ɁG)iAi"(t( jBr$ h^*UA @MvMs"F?1+`ȣ3z21h!,$ic 2&(`h2cR% RO987J GŀKr *| )ˇc|^C?x MׯΞ2۟y14F oMjf  GoSdAnkZgfHlɻ?E= IV=~؟;=GΣ_ٿӂyZ`gNtf}=e7{jvq87+}䭤C.w}8b:1íEsc_҉Vq8v8p2ޙͼs-8;8&E+0j/[3_ڥUC$^< ވBy}=ӌ@ Ît~܅-P8bJk^>6wE步edKL젺L-^Rom[T~Fu7f٭ZuZK%N.G5ۇ98L{p){{K:/=VD:θ/n:=1C~bc#WSo(_k>>V[wqmdFсDnet[+a?[2kR]Vj9 t-h,c!R;cR\ ZC.ű:3iRk;eH7C{%2D$|F4I&r]ZgܞRe<ExY=#ww|:e^vk<*53E! endstream endobj 165 0 obj << /Type /XRef /Index [0 166] /Size 166 /W [1 3 1] /Root 163 0 R /Info 164 0 R /ID [<0CFE814A187557B4283E9034EB04B5B9> <0CFE814A187557B4283E9034EB04B5B9>] /Length 429 /Filter /FlateDecode >> stream x%ӹRA{uPpea7WD\`PEp%4|32o%>U?MDĿQBx:Ƚ$AjݤuQ"mpZ'605^Z68MmpnVvڠ$mץ6WFdIGɒgIoz[Q8t3PUtzj0nӝ!8lN> GaS =8_bdYQ0yыpb0 W]3pn,{tn-۰w.܃U?@L/Ic NF'!%ÒӲSoJJyU^;PYReAJ>CJ~VM\|@MSs-gG endstream endobj startxref 174883 %%EOF iterators/inst/doc/writing.R0000644000177700017770000001325013212620523017145 0ustar herbrandtherbrandt### R code from vignette source 'writing.Rnw' ################################################### ### code chunk number 1: loadLibs ################################################### library(iterators) ################################################### ### code chunk number 2: iterable1 ################################################### it <- iter(list(1:2, 3:4)) ################################################### ### code chunk number 3: iterable2 ################################################### nextElem(it) nextElem(it) tryCatch(nextElem(it), error=function(e) e) ################################################### ### code chunk number 4: nextElem.abstractiter ################################################### iterators:::iter.iter iterators:::nextElem.abstractiter ################################################### ### code chunk number 5: iter1 ################################################### iforever <- function(x) { nextEl <- function() x obj <- list(nextElem=nextEl) class(obj) <- c('iforever', 'abstractiter', 'iter') obj } ################################################### ### code chunk number 6: runiter1 ################################################### it <- iforever(42) nextElem(it) nextElem(it) ################################################### ### code chunk number 7: runiter1.part2 ################################################### unlist(as.list(it, n=6)) ################################################### ### code chunk number 8: iter2 ################################################### irep <- function(x, times) { nextEl <- function() { if (times > 0) times <<- times - 1 else stop('StopIteration') x } obj <- list(nextElem=nextEl) class(obj) <- c('irep', 'abstractiter', 'iter') obj } ################################################### ### code chunk number 9: runiter2 ################################################### it <- irep(7, 6) unlist(as.list(it)) ################################################### ### code chunk number 10: iter3 ################################################### ivector <- function(x, ...) { i <- 1 it <- idiv(length(x), ...) nextEl <- function() { n <- nextElem(it) ix <- seq(i, length=n) i <<- i + n x[ix] } obj <- list(nextElem=nextEl) class(obj) <- c('ivector', 'abstractiter', 'iter') obj } ################################################### ### code chunk number 11: runiter3 ################################################### it <- ivector(1:25, chunks=3) as.list(it) ################################################### ### code chunk number 12: generichasnext ################################################### hasNext <- function(obj, ...) { UseMethod('hasNext') } ################################################### ### code chunk number 13: hasnextmethod ################################################### hasNext.ihasNext <- function(obj, ...) { obj$hasNext() } ################################################### ### code chunk number 14: ihasnext ################################################### ihasNext <- function(it) { if (!is.null(it$hasNext)) return(it) cache <- NULL has_next <- NA nextEl <- function() { if (!hasNx()) stop('StopIteration', call.=FALSE) has_next <<- NA cache } hasNx <- function() { if (!is.na(has_next)) return(has_next) tryCatch({ cache <<- nextElem(it) has_next <<- TRUE }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { has_next <<- FALSE } else { stop(e) } }) has_next } obj <- list(nextElem=nextEl, hasNext=hasNx) class(obj) <- c('ihasNext', 'abstractiter', 'iter') obj } ################################################### ### code chunk number 15: hasnextexample ################################################### it <- ihasNext(icount(3)) while (hasNext(it)) { print(nextElem(it)) } ################################################### ### code chunk number 16: recyle ################################################### irecycle <- function(it) { values <- as.list(iter(it)) i <- length(values) nextEl <- function() { i <<- i + 1 if (i > length(values)) i <<- 1 values[[i]] } obj <- list(nextElem=nextEl) class(obj) <- c('irecycle', 'abstractiter', 'iter') obj } ################################################### ### code chunk number 17: recyleexample ################################################### it <- irecycle(icount(3)) unlist(as.list(it, n=9)) ################################################### ### code chunk number 18: ilimit ################################################### ilimit <- function(it, times) { it <- iter(it) nextEl <- function() { if (times > 0) times <<- times - 1 else stop('StopIteration') nextElem(it) } obj <- list(nextElem=nextEl) class(obj) <- c('ilimit', 'abstractiter', 'iter') obj } ################################################### ### code chunk number 19: irep2 ################################################### irep2 <- function(x, times) ilimit(iforever(x), times) ################################################### ### code chunk number 20: testirep2 ################################################### it <- ihasNext(irep2('foo', 3)) while (hasNext(it)) { print(nextElem(it)) } ################################################### ### code chunk number 21: testirecycle ################################################### iterable <- 1:3 n <- 3 it <- ilimit(irecycle(iterable), n * length(iterable)) unlist(as.list(it)) ################################################### ### code chunk number 22: rep ################################################### rep(iterable, n) iterators/inst/doc/iterators.Rnw0000644000177700017770000001415111472542406020055 0ustar herbrandtherbrandt% \VignetteIndexEntry{iterators Manual} % \VignetteDepends{iterators} % \VignettePackage{iterators} \documentclass[12pt]{article} \usepackage{amsmath} \usepackage[pdftex]{graphicx} \usepackage{color} \usepackage{xspace} \usepackage{fancyvrb} \usepackage{fancyhdr} \usepackage[ colorlinks=true, linkcolor=blue, citecolor=blue, urlcolor=blue] {hyperref} \usepackage{lscape} \usepackage{Sweave} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % define new colors for use \definecolor{darkgreen}{rgb}{0,0.6,0} \definecolor{darkred}{rgb}{0.6,0.0,0} \definecolor{lightbrown}{rgb}{1,0.9,0.8} \definecolor{brown}{rgb}{0.6,0.3,0.3} \definecolor{darkblue}{rgb}{0,0,0.8} \definecolor{darkmagenta}{rgb}{0.5,0,0.5} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\bld}[1]{\mbox{\boldmath $#1$}} \newcommand{\shell}[1]{\mbox{$#1$}} \renewcommand{\vec}[1]{\mbox{\bf {#1}}} \newcommand{\ReallySmallSpacing}{\renewcommand{\baselinestretch}{.6}\Large\normalsize} \newcommand{\SmallSpacing}{\renewcommand{\baselinestretch}{1.1}\Large\normalsize} \newcommand{\halfs}{\frac{1}{2}} \setlength{\oddsidemargin}{-.25 truein} \setlength{\evensidemargin}{0truein} \setlength{\topmargin}{-0.2truein} \setlength{\textwidth}{7 truein} \setlength{\textheight}{8.5 truein} \setlength{\parindent}{0.20truein} \setlength{\parskip}{0.10truein} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagestyle{fancy} \lhead{} \chead{Using The {\tt iterators} Package} \rhead{} \lfoot{} \cfoot{} \rfoot{\thepage} \renewcommand{\headrulewidth}{1pt} \renewcommand{\footrulewidth}{1pt} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \title{Using The {\tt iterators} Package} \author{Rich Calaway \\ doc@revolutionanalytics.com} \begin{document} \maketitle \thispagestyle{empty} \section{Introduction} An {\em iterator} is a special type of object that generalizes the notion of a looping variable. When passed as an argument to a function that knows what to do with it, the iterator supplies a sequence of values. The iterator also maintains information about its state, in particular its current index. The \texttt{iterators} package includes a number of functions for creating iterators, the simplest of which is \texttt{iter}, which takes virtually any R object and turns it into an iterator object. The simplest function that operates on iterators is the \texttt{nextElem} function, which when given an iterator, returns the next value of the iterator. For example, here we create an iterator object from the sequence 1 to 10, and then use \texttt{nextElem} to iterate through the values: <>= library(iterators) i1 <- iter(1:10) nextElem(i1) nextElem(i1) @ You can create iterators from matrices and data frames, using the \texttt{by} argument to specify whether to iterate by row or column: <>= istate <- iter(state.x77, by='row') nextElem(istate) nextElem(istate) @ Iterators can also be created from functions, in which case the iterator can be an endless source of values: <>= ifun <- iter(function() sample(0:9, 4, replace=TRUE)) nextElem(ifun) nextElem(ifun) @ For practical applications, iterators can be paired with \texttt{foreach} to obtain parallel results quite easily: \begin{Schunk} \begin{Sinput} > library(foreach) \end{Sinput} \begin{Soutput} foreach: simple, scalable parallel programming from Revolution Analytics Use Revolution R for scalability, fault tolerance and more. http://www.revolutionanalytics.com \end{Soutput} \begin{Sinput} > x <- matrix(rnorm(1e+06), ncol = 10000) > itx <- iter(x, by = "row") > foreach(i = itx, .combine = c) %dopar% mean(i) \end{Sinput} \begin{Soutput} [1] -0.0069652059 0.0161112989 0.0080068074 -0.0120020610 0.0017168149 [6] 0.0139835943 -0.0078172106 -0.0024762273 -0.0031558268 -0.0072662893 [11] -0.0055142639 0.0015717907 -0.0100842965 -0.0123601527 0.0136420084 [16] -0.0242922105 -0.0126416949 -0.0052951152 0.0216329326 -0.0262476648 [21] 0.0041937609 0.0121253368 -0.0110165729 0.0044267635 0.0080241894 [26] 0.0042995539 -0.0102826632 0.0051185628 -0.0013970812 -0.0172380786 [31] 0.0096079613 0.0046837729 -0.0080726970 0.0083781727 -0.0234620163 [36] -0.0099883966 0.0026883628 0.0029367320 0.0205825899 0.0035303940 [41] 0.0204990426 -0.0010804987 -0.0033665481 -0.0127492019 -0.0147443195 [46] 0.0027046346 0.0016449793 0.0155575490 -0.0003488394 -0.0079238019 [51] 0.0086390030 -0.0039033309 0.0168593825 -0.0067189572 -0.0009925288 [56] -0.0162907048 -0.0059171838 0.0093806072 0.0100886929 -0.0111677408 [61] 0.0021754963 -0.0056770907 0.0081200698 -0.0029828717 -0.0163704350 [66] 0.0057266267 -0.0017156156 0.0214172738 -0.0141379874 -0.0126593342 [71] 0.0087124575 0.0040231519 0.0038515673 0.0066066908 0.0023586046 [76] -0.0044167901 -0.0090543553 0.0010806096 0.0102288061 0.0039881702 [81] -0.0054549319 -0.0127997275 -0.0031697122 -0.0016100996 -0.0143468118 [86] 0.0035904125 -0.0059399479 0.0085565480 -0.0159064868 0.0054120554 [91] -0.0084420572 0.0194448129 -0.0103192553 -0.0062924628 0.0215069258 [96] 0.0015749065 0.0109657488 0.0152237842 -0.0057181022 0.0035530715 \end{Soutput} \end{Schunk} \section{Some Special Iterators} The notion of an iterator is new to R, but should be familiar to users of languages such as Python. The \texttt{iterators} package includes a number of special functions that generate iterators for some common scenarios. For example, the \texttt{irnorm} function creates an iterator for which each value is drawn from a specified random normal distribution: <>= library(iterators) itrn <- irnorm(10) nextElem(itrn) nextElem(itrn) @ Similarly, the \texttt{irunif}, \texttt{irbinom}, and \texttt{irpois} functions create iterators which drawn their values from uniform, binomial, and Poisson distributions, respectively. We can then use these functions just as we used \texttt{irnorm}: <>= itru <- irunif(10) nextElem(itru) nextElem(itru) @ The \texttt{icount} function returns an iterator that counts starting from one: <>= it <- icount(3) nextElem(it) nextElem(it) nextElem(it) @ \end{document} iterators/inst/doc/iterators.R0000644000177700017770000000233713212620522017501 0ustar herbrandtherbrandt### R code from vignette source 'iterators.Rnw' ################################################### ### code chunk number 1: ex1 ################################################### library(iterators) i1 <- iter(1:10) nextElem(i1) nextElem(i1) ################################################### ### code chunk number 2: ex2 ################################################### istate <- iter(state.x77, by='row') nextElem(istate) nextElem(istate) ################################################### ### code chunk number 3: ex3 ################################################### ifun <- iter(function() sample(0:9, 4, replace=TRUE)) nextElem(ifun) nextElem(ifun) ################################################### ### code chunk number 4: ex5 ################################################### library(iterators) itrn <- irnorm(10) nextElem(itrn) nextElem(itrn) ################################################### ### code chunk number 5: ex6 ################################################### itru <- irunif(10) nextElem(itru) nextElem(itru) ################################################### ### code chunk number 6: ex7 ################################################### it <- icount(3) nextElem(it) nextElem(it) nextElem(it) iterators/inst/unitTests/0000755000177700017770000000000013212617761016605 5ustar herbrandtherbrandtiterators/inst/unitTests/isplitTest.R0000644000177700017770000000165011472542406021075 0ustar herbrandtherbrandtlibrary(iterators) # test isplit with a single factor test01 <- function() { x <- rnorm(200) f <- factor(sample(1:10, length(x), replace=TRUE)) it <- isplit(x, f) expected <- split(x, f) for (i in expected) { actual <- nextElem(it) checkEquals(actual$value, i) } it <- isplit(x, f, drop=TRUE) expected <- split(x, f, drop=TRUE) for (i in expected) { actual <- nextElem(it) checkEquals(actual$value, i) } } # test isplit with two factors test02 <- function() { x <- rnorm(200) f <- list(factor(sample(1:10, length(x), replace=TRUE)), factor(sample(1:10, length(x), replace=TRUE))) it <- isplit(x, f) expected <- split(x, f) for (i in expected) { actual <- nextElem(it) checkEquals(actual$value, i) } it <- isplit(x, f, drop=TRUE) expected <- split(x, f, drop=TRUE) for (i in expected) { actual <- nextElem(it) checkEquals(actual$value, i) } } iterators/inst/unitTests/icountnTest.R0000644000177700017770000000126512321564330021244 0ustar herbrandtherbrandttest01 <- function() { if (require(foreach, quietly=TRUE)) { xcountn <- function(x) { iter(do.call('expand.grid', lapply(x, seq_len)), by='row') } vv <- list(0, 1, 2, 10, 100, c(0, 1), c(0, 2), c(3, 0), c(1, 1), c(1, 2), c(1, 3), c(2, 1), c(2, 2), c(2, 3), c(10, 10, 0, 10), c(1, 1, 2, 1, 1, 3, 1, 1, 1, 2, 1, 1, 1), c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), c(10, 10, 10, 10)) for (v in vv) { ait <- icountn(v) xit <- xcountn(v) foreach(actual=ait, expected=xit) %do% { checkEquals(actual, unname(unlist(expected))) } } } } iterators/inst/unitTests/iapplyTest.R0000644000177700017770000000170211472542406021065 0ustar herbrandtherbrandtlibrary(iterators) # test iapply on 3D arrays test01 <- function() { test <- function(actual, it) { expected <- nextElem(it) checkEquals(expected, actual) NULL } a <- array(1:24, c(2,3,4)) margins <- list(1, 2, 3, c(1, 2), c(1, 3), c(2, 1), c(2, 3), c(3, 1), c(3, 2), c(1, 2, 3), c(1, 3, 2), c(2, 1, 3), c(2, 3, 1), c(3, 1, 2), c(3, 2, 1)) for(MARGIN in margins) { # cat(sprintf('testing %s\n', paste(MARGIN, collapse=', '))) it <- iapply(a, MARGIN) apply(a, MARGIN, test, it) } } # test iapply on matrices test02 <- function() { test <- function(actual, it) { expected <- nextElem(it) checkEquals(expected, actual) NULL } m <- matrix(1:24, c(6,4)) margins <- list(1, 2, c(1, 2), c(2, 1)) for(MARGIN in margins) { # cat(sprintf('testing %s\n', paste(MARGIN, collapse=', '))) it <- iapply(m, MARGIN) apply(m, MARGIN, test, it) } } iterators/inst/unitTests/chunksizeTest.R0000644000177700017770000000130311472542406021567 0ustar herbrandtherbrandtlibrary(iterators) # test that various values of chunksize test01 <- function() { nr <- 13 nc <- 21 mat <- matrix(rnorm(nr * nc), nr) for (n in 1:(nc+2)) { it <- iter(mat, by='col', chunksize=n) bcols <- as.list(it) for (bcol in bcols) { checkTrue(nrow(bcol) == nr) checkTrue(ncol(bcol) <= n && ncol(bcol) >= 1) } actual <- do.call('cbind', bcols) checkEquals(mat, actual) } for (n in 1:(nr+2)) { it <- iter(mat, by='row', chunksize=n) brows <- as.list(it) for (brow in brows) { checkTrue(ncol(bcol) == nc) checkTrue(nrow(brow) <= n && nrow(brow) >= 1) } actual <- do.call('rbind', brows) checkEquals(mat, actual) } } iterators/inst/unitTests/basicTest.R0000644000177700017770000000672511564522003020653 0ustar herbrandtherbrandtlibrary(iterators) test00 <- function() {} # test vector iterator creation test01 <- function() { x <- iter(1:10) } # test hasNext, nextElem test02 <- function() { x <- iter(1:10) checkEquals(nextElem(x), 1) for(i in 1:9) nextElem(x) checkException(nextElem(x)) } # check checkFunc test03 <- function() { x <- iter(1:100, checkFunc=function(i) i%%10==0) checkEquals(nextElem(x), 10) for(i in 1:9) nextElem(x) checkException(nextElem(x)) } # test matrix iterator creation test04 <- function() { x <- matrix(1:10,ncol=2) } # test hasNext, nextElem test05 <- function() { x <- matrix(1:10,ncol=2) # by cell y <- iter(x,by='cell') checkEquals(nextElem(y), 1) for(i in 1:9) nextElem(y) checkException(nextElem(y)) # by col y <- iter(x,by='column') checkEquals(nextElem(y), matrix(1:5, ncol=1)) nextElem(y) checkException(nextElem(y)) # by row y <- iter(x,by='row') checkEquals(nextElem(y), matrix(c(1,6),nrow=1)) for(i in 1:4) nextElem(y) checkException(nextElem(y)) } # test checkFunc test06 <- function() { # create a larger matrix x <- matrix(1:100, ncol=20) # by cell y <- iter(x, by='cell', checkFunc=function(i) i%%10==0) checkEquals(nextElem(y), 10) for(i in 1:9) nextElem(y) checkException(nextElem(y)) # by col y <- iter(x, by='column', checkFunc=function(i) i[5]%%10==0) checkEquals(nextElem(y), as.matrix(x[,2])) for(i in 1:9) nextElem(y) checkException(nextElem(y)) # by row # create an easier matrix to deal with x <- matrix(1:100, nrow=20, byrow=TRUE) y <- iter(x, by='row', checkFunc=function(i) i[5]%%10==0) checkEquals(as.vector(nextElem(y)), x[2,]) for(i in 1:9) nextElem(y) checkException(nextElem(y)) } # test data frame iterator creation test07 <- function() { x <- data.frame(1:10, 11:20) y <- iter(x) } # test hasNext, nextElem test08 <- function() { x <- data.frame(1:10, 11:20) # by row y <- iter(x, by='row') checkEquals(nextElem(y), x[1,]) for(i in 1:9) nextElem(y) checkException(nextElem(y)) # by col y <- iter(x, by='column') checkEquals(nextElem(y), x[,1]) nextElem(y) checkException(nextElem(y)) } # test checkFunc test09 <- function() { x <- data.frame(1:10, 11:20) # by row y <- iter(x, by='row', checkFunc=function(i) i[[1]][1]%%2==0) checkEquals(nextElem(y),x[2,]) for(i in 1:4) nextElem(y) checkException(nextElem(y)) # by col y <- iter(x, by='column', checkFunc=function(i) i[[1]][1]%%11==0) checkEquals(nextElem(y), x[,2]) checkException(nextElem(y)) } # test function iterator creation # we need to test a function that takes no arguement as # well as one that takes the index test10 <- function() { noArgFunc <- function() 1 needArgFunc <- function(i) if(i>100) stop('too high') else i } # test hasNext, nextElem test11 <- function() { noArgFunc <- function() 1 needArgFunc <- function(i) if(i>100) stop('too high') else i y <- iter(noArgFunc) checkEquals(nextElem(y), 1) nextElem(y) y <- iter(needArgFunc) checkEquals(nextElem(y), 1) for (i in 1:99) nextElem(y) checkException(nextElem(y)) } # test checkFunc test12 <- function() { noArgFunc <- function() 1 needArgFunc <- function(i) if(i>100) stop('too high') else i y <- iter(noArgFunc, checkFunc=function(i) i==1) checkEquals(nextElem(y), 1) nextElem(y) y <- iter(needArgFunc, checkFunc=function(i) i%%10==0) checkEquals(nextElem(y), 10) for(i in 1:9) nextElem(y) checkException(nextElem(y)) } iterators/inst/unitTests/recycleTest.R0000644000177700017770000000051412321564330021207 0ustar herbrandtherbrandt# simple test of recycle test01 <- function() { if (require(foreach, quietly=TRUE)) { nr <- 21 nc <- 17 x <- rnorm(nr) it <- iter(x, recycle=TRUE) actual <- foreach(y=it, icount(nr*nc), .combine='c') %do% y dim(actual) <- c(nr, nc) expected <- matrix(x, nr, nc) checkEquals(actual, expected) } } iterators/inst/unitTests/runTestSuite.sh0000644000177700017770000000134611564522174021624 0ustar herbrandtherbrandt#!/bin/sh LOGFILE=test.log R --vanilla --slave > ${LOGFILE} 2>&1 <<'EOF' library(iterators) library(RUnit) options(warn=1) options(showWarnCalls=TRUE) cat('Starting test at', date(), '\n') tests <- c('basicTest.R', 'iapplyTest.R', 'isplitTest.R', 'icountnTest.R', 'chunksizeTest.R', 'recycleTest.R') errcase <- list() for (f in tests) { cat('\nRunning test file:', f, '\n') t <- runTestFile(f) e <- getErrors(t) if (e$nErr + e$nFail > 0) { errcase <- c(errcase, t) print(t) } } if (length(errcase) == 0) { cat('*** Ran all tests successfully ***\n') } else { cat('!!! Encountered', length(errcase), 'problems !!!\n') for (t in errcase) { print(t) } } cat('Finished test at', date(), '\n') EOF iterators/tests/0000755000177700017770000000000013212617760014767 5ustar herbrandtherbrandtiterators/tests/doRUnit.R0000644000177700017770000000533313212615543016477 0ustar herbrandtherbrandt## unit tests will not be done if RUnit is not available if(require("RUnit", quietly=TRUE)) { ## --- Setup --- pkg <- "iterators" # <-- Change to package name! if(Sys.getenv("RCMDCHECK") == "FALSE") { ## Path to unit tests for standalone running under Makefile (not R CMD check) ## PKG/tests/../inst/unitTests path <- file.path(getwd(), "..", "inst", "unitTests") } else { ## Path to unit tests for R CMD check ## PKG.Rcheck/tests/../PKG/unitTests path <- system.file(package=pkg, "unitTests") } cat("\nRunning unit tests\n") print(list(pkg=pkg, getwd=getwd(), pathToUnitTests=path)) library(package=pkg, character.only=TRUE) ################################################################ ## BEGIN PACKAGE SPECIFIC CONFIGURATION # ################################################################ ################################################################ ## END PACKAGE SPECIFIC CONFIGURATION # ################################################################ ## If desired, load the name space to allow testing of private functions ## if (is.element(pkg, loadedNamespaces())) ## attach(loadNamespace(pkg), name=paste("namespace", pkg, sep=":"), pos=3) ## ## or simply call PKG:::myPrivateFunction() in tests ## --- Testing --- ## Define tests testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs=path, testFileRegexp = "^.+Test\\.R$") ## Run tests <- runTestSuite(testSuite) ## Default report name pathReport <- file.path(tempdir(), "report") ## Report to stdout and text files cat("------------------- UNIT TEST SUMMARY ---------------------\n\n") printTextProtocol(tests, showDetails=FALSE) printTextProtocol(tests, showDetails=FALSE, fileName=paste(pathReport, "Summary.txt", sep="")) printTextProtocol(tests, showDetails=TRUE, fileName=paste(pathReport, ".txt", sep="")) ## Report to HTML file printHTMLProtocol(tests, fileName=paste(pathReport, ".html", sep="")) # printHTMLProtocol(tests, fileName=file.path(dirname(dirname(getwd())),pkg,"gsDesign-RUnit-Test-Summary.html")) #paste(pathReport, ".html", sep="")) ## Return stop() to cause R CMD check stop in case of ## - failures i.e. FALSE to unit tests or ## - errors i.e. R errors tmp <- getErrors(tests) if(tmp$nFail > 0 | tmp$nErr > 0) { stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail, ", #R errors: ", tmp$nErr, ")\n\n", sep="")) } } else { warning("cannot run unit tests -- package RUnit is not available") } iterators/NAMESPACE0000644000177700017770000000106211472542406015043 0ustar herbrandtherbrandtexport(iter, nextElem, isplit) export(irnorm, irunif, irbinom, irnbinom, irpois) export(icount, idiv, ireadLines, iread.table) export(icountn, iapply) S3method("iter", "default") S3method("iter", "iter") S3method("iter", "matrix") S3method("iter", "data.frame") S3method("iter", "function") S3method("nextElem", "containeriter") S3method("nextElem", "matrixiter") S3method("nextElem", "dataframeiter") S3method("nextElem", "funiter") S3method("nextElem", "abstractiter") S3method("as.list", "iter") S3method("isplit", "default") S3method("isplit", "data.frame") iterators/R/0000755000177700017770000000000013212617760014026 5ustar herbrandtherbrandtiterators/R/extra.R0000644000177700017770000001744011472542406015302 0ustar herbrandtherbrandt# # Copyright (c) 2008-2010 Revolution Analytics # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # # This function makes iterator makers. The resulting iterator makers all take # an optional "count" argument which specifies the number of times the # resulting iterator should fire. The iterators are wrappers around functions # that return different values each time they are called. All this is done to # avoid cutting and pasting the same code repeatedly. We could make this # function available to the user, but I'm not sure if we will immediately. makeIwrapper <- function(FUN) { function(..., count) { if (!missing(count) && (!is.numeric(count) || length(count) != 1)) stop('count must be a numeric value') # construct the call object to put into the nextElem function m <- as.call(c(as.name(FUN), list(...))) # construct the body of the nextElem function fbody <- if (missing(count)) { m } else { substitute({ if (count > 0) { count <<- count - 1L REPLACETHIS } else { stop('StopIteration', call.=FALSE) } }, list(REPLACETHIS=m)) } # create the nextElem function using fbody nextEl <- function() NULL body(nextEl) <- fbody # create and return the iterator object it <- list(nextElem=nextEl) class(it) <- c('abstractiter', 'iter') it } } # define some iterator makers using makeIwrapper irunif <- makeIwrapper('runif') irnorm <- makeIwrapper('rnorm') irbinom <- makeIwrapper('rbinom') irnbinom <- makeIwrapper('rnbinom') irpois <- makeIwrapper('rpois') isample <- makeIwrapper('sample') # not in the NAMESPACE currently # a counting iterator icount <- function(count) { if (missing(count)) count <- NULL else if (!is.numeric(count) || length(count) != 1) stop('count must be a numeric value') i <- 0L nextEl <- function() { if (is.null(count) || i < count) (i <<- i + 1L) else stop('StopIteration', call.=FALSE) } it <- list(nextElem=nextEl) class(it) <- c('abstractiter', 'iter') it } # an iterator over pieces of a number idiv <- function(n, ..., chunks, chunkSize) { if (!is.numeric(n) || length(n) != 1) stop('n must be a numeric value') if (length(list(...)) > 0) stop('chunks and chunkSize must be specified as named arguments') if ((missing(chunkSize) && missing(chunks)) || (!missing(chunkSize) && !missing(chunks))) stop('either chunks or chunkSize must be specified, but not both') if (missing(chunks)) { if (!is.numeric(chunkSize) || length(chunkSize) != 1 || chunkSize < 1) stop('chunkSize must be a numeric value >= 1') chunks <- ceiling(n / chunkSize) } nextEl <- function() { if (chunks <= 0 || n <= 0) stop('StopIteration', call.=FALSE) m <- ceiling(n / chunks) n <<- n - m chunks <<- chunks - 1 m } it <- list(nextElem=nextEl) class(it) <- c('abstractiter', 'iter') it } # an iterator over text lines from a connection ireadLines <- function(con, n=1, ...) { if (!is.numeric(n) || length(n) != 1 || n < 1) stop('n must be a numeric value >= 1') if (is.character(con)) { con <- file(con, open='r') doClose <- TRUE } else { doClose <- FALSE } nextEl <- function() { if (is.null(con)) stop('StopIteration', call.=FALSE) r <- readLines(con, n=n, ...) if (length(r) == 0) { if (doClose) close(con) con <<- NULL stop('StopIteration', call.=FALSE) } r } it <- list(nextElem=nextEl) class(it) <- c('abstractiter', 'iter') it } # an iterator over rows of a data frame read from a file iread.table <- function(file, ..., verbose=FALSE) { args <- list(...) argnames <- names(args) # need to do this (at least for now) because the default values for # header and row.names depend on the first few lines of the file, # which could cause a different number of columns to be returned from # the first versus the subsequent calls to read.table if (!all(c('header', 'row.names') %in% argnames)) stop('both header and row.names must be specified in this implementation') nrows <- if ('nrows' %in% argnames) args$nrows else 1 row.names <- args$row.names # it doesn't seem to make sense to allow nrows < 1 for the "iterator" # version of read.table if (!is.numeric(nrows) || length(nrows) != 1 || nrows < 1) stop('nrows must be a numeric value >= 1') # open the file if necessary and remember to close it if (is.character(file)) { file <- file(file, open='r') doClose <- TRUE } else { doClose <- FALSE } # create the call object that we'll use to call read.table m <- as.call(c(as.name('read.table'), file='', list(...))) m$file <- file m$nrows <- nrows # needed since we use a different default than read.table env <- sys.frame(sys.nframe()) # compute these once rather than repeatedly rnlen <- length(row.names) gotrownames <- is.character(row.names) && rnlen > 1 # initialize a few state variables first.time <- TRUE irow <- 1 errmsg <- NULL nextEl <- function() { if (!is.null(errmsg)) stop(paste('iterator failed previously:', errmsg), call.=FALSE) if (is.null(file)) stop('StopIteration', call.=FALSE) if (gotrownames) { rem <- rnlen - irow + 1 # remaining strings in row.names nrows <<- min(nrows, rem) # possibly decrease nrows to match row.names # there is a problem if nrows is one: we would have to set row.names # to a character vector of length one, which is interpreted # incorrectly by read.table if (nrows > 1) m$row.names <<- row.names[seq(irow, length=nrows)] else m['row.names'] <<- list(NULL) # we'll fix the row names later m$nrows <<- nrows } # call read.table to actually read the file r <- tryCatch({ # handle the case where we've run out of row names if (nrows > 0) { if (verbose) print(m) eval(m, env) } else { NULL } }, error=function(e) { # this error is thrown at the end of input sometimes # but other times a data frame with no rows is returned # (for instance when col.names is specified) if (!identical(conditionMessage(e), 'no lines available in input')) { if (doClose) close(file) file <<- NULL errmsg <<- conditionMessage(e) stop(e) } NULL }) # set header to FALSE, skip to 0, and col.names to names(r) # after the first call to read.table if (first.time) { first.time <<- FALSE m$header <<- FALSE m$skip <<- 0 nms <- names(r) if (is.numeric(row.names)) { nms <- if (row.names == 1) c('', nms) else if (row.names >= length(nms)) c(nms, '') else c(nms[1:(row.names-1)], '', nms[row.names:length(nms)]) } m$col.names <<- nms } # check if we're done reading if (is.null(r) || nrow(r) == 0) { if (doClose) close(file) file <<- NULL stop('StopIteration', call.=FALSE) } if (gotrownames) { # fix the row names for this particular case if (nrows == 1) rownames(r) <- row.names[irow] # update the index into row.names irow <<- irow + nrows } r } it <- list(nextElem=nextEl) class(it) <- c('abstractiter', 'iter') it } iterators/R/iapply.R0000644000177700017770000000167011472542406015453 0ustar herbrandtherbrandt# # Copyright (c) 2008-2010 Revolution Analytics # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # iapply <- function(X, MARGIN) { xit <- icountn(dim(X)[MARGIN]) nextEl <- function() { i <- nextElem(xit) j <- rep('', length(dim(X))) j[MARGIN] <- as.character(i) s <- paste('X[', paste(j, collapse=','), ']', sep='') x <- parse(text=s) eval(x) } it <- list(nextElem=nextEl) class(it) <- c('abstractiter', 'iter') it } iterators/R/isplit.R0000644000177700017770000000525511472542406015464 0ustar herbrandtherbrandt# # Copyright (c) 2008-2010 Revolution Analytics # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # icountn <- function(vn) { n <- length(vn) if (n == 0) stop('illegal zero length vector') icar <- icount(vn[n]) if (n > 1) { icdr <- icountn(vn[-n]) hasVal <- FALSE nextVal <- NULL } nextEl <- if (n == 1) { function() nextElem(icar) } else { function() { repeat { if (!hasVal) { nextVal <<- nextElem(icar) hasVal <<- TRUE } tryCatch({ return(c(nextElem(icdr), nextVal)) }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { icdr <<- icountn(vn[-n]) hasVal <<- FALSE } else { stop(e) } }) } } } structure(list(nextElem=nextEl), class=c('abstractiter', 'iter')) } iwhich <- function(nf, ind) { n <- length(ind) if (n == 0) stop('illegal zero length vector') x <- rep(TRUE, length(nf[[1]])) for (i in seq_len(n)) x <- x & nf[[i]] == ind[i] which(x) } # define the generic function isplit <- function(x, f, drop=FALSE, ...) { UseMethod('isplit') } # define the default method isplit.default <- function(x, f, drop=FALSE, ...) { if (!is.list(f)) f <- list(f) cf <- lapply(f, function(a) if (is.factor(a)) a else as.factor(a)) nf <- lapply(cf, as.integer) flevels <- lapply(f, function(a) if (is.factor(a)) levels(a) else sort(unique.default(a))) it <- icountn(unlist(lapply(cf, nlevels))) nextEl <- function() { repeat { i <- nextElem(it) j <- iwhich(nf, i) if (!drop || length(j) > 0) break } k <- seq_along(i) names(k) <- names(cf) key <- lapply(k, function(x) flevels[[x]][i[x]]) list(value=x[j], key=key) } structure(list(nextElem=nextEl), class=c('abstractiter', 'iter')) } # define the data frame method which uses the default method isplit.data.frame <- function(x, f, drop=FALSE, ...) { it <- isplit(seq_len(nrow(x)), f, drop=drop, ...) nextEl <- function() { i <- nextElem(it) list(value=x[i$value,, drop=FALSE], key=i$key) } structure(list(nextElem=nextEl), class=c('abstractiter', 'iter')) } iterators/R/aslist.R0000644000177700017770000000177411472542406015461 0ustar herbrandtherbrandt# # Copyright (c) 2008-2010 Revolution Analytics # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # as.list.iter <- function(x, n=as.integer(2^31-1), ...) { size <- 64 a <- vector('list', length=size) i <- 0 tryCatch({ while (i < n) { if (i >= size) { size <- min(2 * size, n) length(a) <- size } a[i + 1] <- list(nextElem(x)) i <- i + 1 } }, error=function(e) { if (!identical(conditionMessage(e), 'StopIteration')) stop(e) }) length(a) <- i a } iterators/R/iterators.R0000644000177700017770000001576511605621044016175 0ustar herbrandtherbrandt# # Copyright (c) 2008-2010 Revolution Analytics # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # # generic function for creating an iterator object iter <- function(obj, ...) { UseMethod('iter') } # calling iter on an iter object returns itself iter.iter <- function(obj, ...) { obj } # default method creates an iterator from a vector or list iter.default <- function(obj, checkFunc=function(...) TRUE, recycle=FALSE, ...) { state <- new.env() state$i <- 0L state$obj <- obj n <- length(obj) it <- list(state=state, length=n, checkFunc=checkFunc, recycle=recycle) class(it) <- c('containeriter', 'iter') it } # allow a matrix to be iterated over in different ways iter.matrix <- function(obj, by=c('column', 'cell', 'row'), chunksize=1L, checkFunc=function(...) TRUE, recycle=FALSE, ...) { by <- match.arg(by) if ((chunksize > 1L) && (by=='cell')) { warning("Chunksize greater than 1 not allowed when using by='cell'\n Setting chunksize=1") chunksize <- 1L } state <- new.env() state$i <- 0L state$obj <- obj n <- switch(by, column=ncol(obj), row=nrow(obj), length(obj)) it <- list(state=state, by=by, length=n, checkFunc=checkFunc, recycle=recycle, chunksize=chunksize) class(it) <- c('matrixiter', 'iter') it } # allow a data frame to be iterated over in different ways iter.data.frame <- function(obj, by=c('column', 'row'), checkFunc=function(...) TRUE, recycle=FALSE, ...) { by <- match.arg(by) state <- new.env() state$i <- 0L state$obj <- obj n <- switch(by, column=length(obj), nrow(obj)) it <- list(state=state, by=by, length=n, checkFunc=checkFunc, recycle=recycle) class(it) <- c('dataframeiter', 'iter') it } # allow a closure to be turned into an iterator object iter.function <- function(obj, checkFunc=function(...) TRUE, recycle=FALSE, ...) { state <- new.env() state$i <- 0L state$fun <- obj args <- !is.null(formals(obj)) it <- list(state=state, args=args, checkFunc=checkFunc, recycle=recycle) class(it) <- c('funiter', 'iter') it } getIterVal <- function(obj, plus, ...) { UseMethod('getIterVal') } getIterVal.containeriter <- function(obj, plus=0L, ...) { i <- obj$state$i + plus if (i > obj$length) stop('SubscriptOutOfBounds', call.=FALSE) obj$state$obj[[i]] } getIterVal.matrixiter <- function(obj, plus=0L, ...) { i <- obj$state$i + plus n <- obj$length if (i > n) stop('SubscriptOutOfBounds', call.=FALSE) j <- i + obj$chunksize - 1L switch(obj$by, column=obj$state$obj[, i:min(j, n), drop=FALSE], row=obj$state$obj[i:min(j, n), , drop=FALSE], obj$state$obj[[i]]) } getIterVal.dataframeiter <- function(obj, plus=0L, check=TRUE, ...) { i <- obj$state$i + plus n <- obj$length if (i > n) stop('StopIteration', call.=FALSE) switch(obj$by, column=obj$state$obj[, i], obj$state$obj[i, ]) } nextElem <- function(obj, ...) { UseMethod('nextElem') } nextElem.containeriter <- function(obj, ...) { repeat { tryCatch({ if (obj$checkFunc(getIterVal(obj,1L))) { obj$state$i <- obj$state$i + 1L return(getIterVal(obj)) } obj$state$i <- obj$state$i + 1L }, error=function(e) { if (any(nzchar(e$message))) { if (identical(e$message, "SubscriptOutOfBounds")) { if (obj$recycle) { obj$state$i <- 0L } else { stop('StopIteration', call.=FALSE) } } else { stop(e$message, call.=FALSE) } } else { stop('Abort', call.=e) } }) } } nextElem.matrixiter <- function(obj, ...) { repeat { tryCatch({ if (obj$checkFunc(getIterVal(obj,1L))) { obj$state$i <- obj$state$i + obj$chunksize return(getIterVal(obj,plus=(1L-obj$chunksize))) } obj$state$i <- obj$state$i + obj$chunksize }, error=function(e) { if (any(nzchar(e$message))) { if (identical(e$message, "SubscriptOutOfBounds") || identical(e$message, "attempt to select more than one element")) { if (obj$recycle) { obj$state$i <- 0L } else { stop('StopIteration', call.=FALSE) } } else { stop(e$message, call.=FALSE) } } else { stop('Abort', call.=e) } }) } } nextElem.dataframeiter <- function(obj, ...) { repeat { tryCatch({ if (obj$checkFunc(getIterVal(obj,1L))) { obj$state$i <- obj$state$i + 1L return(getIterVal(obj)) } obj$state$i <- obj$state$i + 1L }, error=function(e) { if (any(nzchar(e$message))) { if (identical(e$message, "StopIteration")) { if (obj$recycle) { obj$state$i <- 0L } else { stop('StopIteration', call.=FALSE) } } else { stop(e$message, call.=FALSE) } } else { stop('Abort', call.=e) } }) } } nextElem.funiter <- function(obj, ...) { repeat { tryCatch({ if (obj$args) { val <- obj$state$fun(obj$state$i+1L) } else { val <- obj$state$fun() } if (obj$checkFunc(val)) { if (obj$args) obj$state$i <- obj$state$i + 1L return(val) } if (obj$args) obj$state$i <- obj$state$i + 1L }, error=function(e) { if (any(nzchar(e$message))) { if (identical(e$message, "StopIteration")) { if (obj$recycle) { if (obj$args) obj$state$i <- 0L } else { stop('StopIteration', call.=FALSE) } } else { stop(e$message, call.=FALSE) } } else { stop('Abort', call.=e) } }) } } nextElem.abstractiter <- function(obj, ...) { obj$nextElem() } #print.containeriter <- function(x, ...) { # repr <- sprintf('<%s iterator, current value %d\n', # class(x$state$obj)[1], getIterVal(x)) # cat(repr) #} #print.matrixiter <- function(x, ...) { # repr <- sprintf('<%s iterator, current value %d\n', # class(x$state$obj)[1], getIterVal(x)) # cat(repr) #} #print.dataframeiter <- function(x, ...) { # repr <- sprintf('<%s iterator, current value %d\n', # class(x$state$obj)[1], getIterVal(x, check=FALSE)) # cat(repr) #} #print.funiter <- function(x, ...) { # cat('function iterator\n') #} #print.abstractiter <- function(x, ...) { # cat(x$toString()) #} iterators/vignettes/0000755000177700017770000000000013212620524015625 5ustar herbrandtherbrandtiterators/vignettes/writing.Rnw0000644000177700017770000005011711472542406020014 0ustar herbrandtherbrandt% \VignetteIndexEntry{Writing Custom Iterators} % \VignetteDepends{iterators} % \VignettePackage{iterators} \documentclass[12pt]{article} \usepackage{amsmath} \usepackage[pdftex]{graphicx} \usepackage{color} \usepackage{xspace} \usepackage{fancyvrb} \usepackage{fancyhdr} \usepackage[ colorlinks=true, linkcolor=blue, citecolor=blue, urlcolor=blue] {hyperref} \usepackage{lscape} \usepackage{Sweave} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % define new colors for use \definecolor{darkgreen}{rgb}{0,0.6,0} \definecolor{darkred}{rgb}{0.6,0.0,0} \definecolor{lightbrown}{rgb}{1,0.9,0.8} \definecolor{brown}{rgb}{0.6,0.3,0.3} \definecolor{darkblue}{rgb}{0,0,0.8} \definecolor{darkmagenta}{rgb}{0.5,0,0.5} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\bld}[1]{\mbox{\boldmath $#1$}} \newcommand{\shell}[1]{\mbox{$#1$}} \renewcommand{\vec}[1]{\mbox{\bf {#1}}} \newcommand{\ReallySmallSpacing}{\renewcommand{\baselinestretch}{.6}\Large\normalsize} \newcommand{\SmallSpacing}{\renewcommand{\baselinestretch}{1.1}\Large\normalsize} \newcommand{\halfs}{\frac{1}{2}} \setlength{\oddsidemargin}{-.25 truein} \setlength{\evensidemargin}{0truein} \setlength{\topmargin}{-0.2truein} \setlength{\textwidth}{7 truein} \setlength{\textheight}{8.5 truein} \setlength{\parindent}{0.20truein} \setlength{\parskip}{0.10truein} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagestyle{fancy} \lhead{} \chead{Writing Custom Iterators} \rhead{} \lfoot{} \cfoot{} \rfoot{\thepage} \renewcommand{\headrulewidth}{1pt} \renewcommand{\footrulewidth}{1pt} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \title{Writing Custom Iterators} \author{Steve Weston \\ doc@revolutionanalytics.com} \begin{document} \maketitle \thispagestyle{empty} \section{Introduction} <>= library(iterators) @ An {\em iterator} is a special type of object that supplies data on demand, one element\footnote{An ``element'' in this case can be basically any object. I don't mean to suggest that the data is necessarily returned as scalar values, for example.} at a time. This is a nice abstraction that can help simplify many programs. Iterators are particularly useful in parallel computing, since they facilitate splitting a problem into smaller pieces that can then be executed in parallel. Iterators can also be used to reduce the total memory that is needed at any one time. For example, if you want to process the lines of text in a file, it is common to write a loop that reads the file one line at a time, rather than reading the entire file in order to avoid running out of memory on huge files. That's the basic idea of iterators. Iterators provide a standard method for getting the next element, which allows us to write functions that take an iterator as an argument to provide a source of data. The function doesn't need to know what kind of iterator it is. It just needs to know how to get another piece of data. The data could be coming from a file, a database, a vector, or it could be dynamically generated. There are a number of iterators that come in the \texttt{iterators} package. The \texttt{iapply} function allows you to iterate over arrays, in much the same way as the standard \texttt{apply} function. \texttt{apply} has fixed rules on how the results are returned, which may require you to reshape the results, which can be inefficient, as well as inconvenient. But since \texttt{iapply} doesn't process any data or combine the results, it is more flexible. You can use \texttt{iapply} with the \texttt{foreach} package to perform a parallel \texttt{apply} operation, and combine the results any way you want via the \texttt{.combine} argument to \texttt{foreach}. Another iterator that comes in the \texttt{iterators} package is the \texttt{isplit} function, which works much like the standard \texttt{split} function. \texttt{split} returns a list containing all of the data divided into groups. \texttt{isplit} only generates one group at a time, as they are needed, which can reduce the amount memory that is needed. But of course, there will be times when you need an iterator that isn't provided by the \texttt{iterators} package. That is when you need to write your own custom iterator. Fortunately, that is fairly easy to do. \section{What methods are needed for an iterator?} Basically, an iterator is an S3 object whose base class is \texttt{iter}, and has \texttt{iter} and \texttt{nextElem} methods. The purpose of the \texttt{iter} method is to return an iterator for the specified object. For iterators, that usually just means returning itself, which seems odd at first. But the \texttt{iter} method can be defined for other objects that don't define a \texttt{nextElem} method. We call those objects {\em iterables}, meaning that you can iterate over them. The \texttt{iterators} package defines \texttt{iter} methods for vectors, lists, matrices, and data frames, making those objects iterables. By defining an \texttt{iter} method for iterators, they can be used in the same context as an iterable, which can be convenient. For example, the \texttt{foreach} function takes iterables as arguments. It calls the \texttt{iter} method on those arguments in order to create iterators for them. By defining the \texttt{iter} method for all iterators, we can pass iterators to \texttt{foreach} that we created using any method we choose. Thus, we can pass vectors, lists, or iterators to \texttt{foreach}, and they are all processed by \texttt{foreach} in exactly the same way. The \texttt{iterators} package comes with an \texttt{iter} method defined for the \texttt{iter} class that simply returns itself. That is usually all that is needed for an iterator. However, if you want to create an iterator for some existing class, you can do that by writing an \texttt{iter} method that returns an appropriate iterator. That will allow you to pass an instance of your class to \texttt{foreach}, which will automatically convert it into an iterator. The alternative is to write your own function that takes arbitrary arguments, and returns an iterator. You can choose whichever method is most natural. The most important method required for iterators is \texttt{nextElem}. This simply returns the next value, or throws an error. Calling the \texttt{stop} function with the string \texttt{'StopIteration'} indicates that there are no more values available in the iterator. Now before we write our own iterator, let's try calling the \texttt{iter} and \texttt{nextElem} methods on an existing one. Since a list is an iterable, we can create an iterator for that list by calling \texttt{iter} on it: <>= it <- iter(list(1:2, 3:4)) @ We can now call \texttt{nextElem} on the resulting iterator to get the values from the list: <>= nextElem(it) nextElem(it) tryCatch(nextElem(it), error=function(e) e) @ As you can see, it is possible to call these methods manually, but it's somewhat awkward, since you have to handle the \texttt{'StopIteration'} error. Later on, we'll see one solution to this difficulty, although, in general, you don't call these method explicitly. \section{A simple iterator} It's time to show the implementation of a very simple iterator. Although I've made it sound like you have to write your own \texttt{iter} and \texttt{nextElem} methods, you can inherit them. In fact, that's what all of the following examples do. I do that by inheriting from the \texttt{abstractiter} class. The \texttt{abstractiter} class uses the standard \texttt{iter} method which returns itself, and defines a \texttt{nextElem} method that calls the \texttt{nextElem} element of the object. Let's take a look at the implementation of these two methods: <>= iterators:::iter.iter iterators:::nextElem.abstractiter @ Now here's a function that creates a very simple iterator that uses these two methods: <>= iforever <- function(x) { nextEl <- function() x obj <- list(nextElem=nextEl) class(obj) <- c('iforever', 'abstractiter', 'iter') obj } @ Note that I called the internal function \texttt{nextEl} rather than \texttt{nextElem}. I do that by convention to avoid masking the standard \texttt{nextElem} generic function. That causes problems when you want your iterator to call the \texttt{nextElem} method of another iterator, which can be quite useful, as we'll see in a later example. We create an instance of this iterator by calling the \texttt{iforever} function, and then use it by calling the \texttt{nextElem} method on the resulting object: <>= it <- iforever(42) nextElem(it) nextElem(it) @ You can also get values from an iterator using \texttt{as.list}. But since this is an infinite iterator, you need to use the \texttt{n} argument to avoid using up a lot of memory and time: <>= unlist(as.list(it, n=6)) @ Notice that it doesn't make sense to implement this iterator by defining a new \texttt{iter} method, since there is no natural iterable on which to dispatch. The only argument that we need is the object for the iterator to return, which can be of any type. Instead, we implement this iterator by defining a normal function that returns the iterator. This iterator is quite simple to implement, and possibly even useful.\footnote{Be careful how you use this iterator! If you pass it to \texttt{foreach}, it will result in an infinite loop unless you pair it with a non-infinite iterator. Also, {\em never} pass this to the \texttt{as.list} function without the \texttt{n} argument.} The iterator returned by \texttt{iforever} is a list that has a single element named \texttt{nextElem}, whose value is a function that returns the value of \texttt{x}. Because we are subclassing \texttt{abstractiter}, we inherit a \texttt{nextElem} method that will call this function, and because we are subclassing \texttt{iter}, we inherit an \texttt{iter} method that will return itself. Of course, the reason this iterator is so simple is because it doesn't contain any state. Most iterators need to contain some state, or it will be difficult to make it return different values and eventually stop. Managing the state is usually the real trick to writing iterators. \section{A stateful iterator} Let's modify the previous iterator to put a limit on the number of values that it returns. I'll call the new function \texttt{irep}, and give it another argument called \texttt{times}: <>= irep <- function(x, times) { nextEl <- function() { if (times > 0) times <<- times - 1 else stop('StopIteration') x } obj <- list(nextElem=nextEl) class(obj) <- c('irep', 'abstractiter', 'iter') obj } @ Now let's try it out: <>= it <- irep(7, 6) unlist(as.list(it)) @ The real difference between \texttt{iforever} and \texttt{irep} is in the function that gets called by the \texttt{nextElem} method. This function not only accesses the values of the variables \texttt{x} and \texttt{times}, but it also modifies the value of \texttt{times}. This is accomplished by means of the ``\verb=<<-='' \footnote{It's commonly believed that ``$<<-$'' is only used to set variables in the global environment, but that isn't true. I think of it as an {\em inheriting} assignment operator.} operator, and the magic of lexical scoping. Technically, this kind of function is called a {\em closure}, and is a somewhat advanced feature of \texttt{R}. The important thing to remember is that \texttt{nextEl} is able to get the value of variables that were passed as arguments to \texttt{irep}, and it can modify those values using the ``\verb=<<-='' operator. These are {\em not} global variables: they are defined in the enclosing environment of the \texttt{nextEl} function. You can create as many iterators as you want using the \texttt{irep} function, and they will all work as expected without conflicts. Note that this iterator only uses the arguments to \texttt{irep} to store its state. If any other state variables are needed, they can be defined anywhere inside the \texttt{irep} function. \section{Using an iterator inside an iterator} The previous section described a general way of writing custom iterators. Almost any iterator can be written using those basic techniques. At times, it may be simpler to make use of an existing iterator to implement a new iterator. Let's say that you need an iterator that splits a vector into subvectors. That can allow you to process the vector in parallel, but still use vector operations, which is essential to getting good sequential performance in R. The following function returns just such an iterator: <>= ivector <- function(x, ...) { i <- 1 it <- idiv(length(x), ...) nextEl <- function() { n <- nextElem(it) ix <- seq(i, length=n) i <<- i + n x[ix] } obj <- list(nextElem=nextEl) class(obj) <- c('ivector', 'abstractiter', 'iter') obj } @ \texttt{ivector} uses \texttt{...} to pass options on to \texttt{idiv}. \texttt{idiv} supports the \texttt{chunks} argument to split its argument into a specified number of pieces, and the \texttt{chunkSize} argument to split it into pieces of a specified maximum size. Let's create an \texttt{ivector} iterator to split a vector into three pieces using the \texttt{chunks} argument: <>= it <- ivector(1:25, chunks=3) as.list(it) @ Note that the \texttt{nextEl} function doesn't seem to throw a \texttt{StopIteration} exception. It is actually throwing it indirectly, by calling \texttt{nextElem} on the iterator created via the \texttt{idiv} function. This function is fairly simple, because most of the tricky stuff is handled by \texttt{idiv}. \texttt{ivector} focuses on operating on the vector. It should be clear that only minor modification need to be made to this function to create an iterator over the blocks of rows or columns of a matrix or data frame. But I'll leave that as an exercise for the reader. \section{Adding a \texttt{hasNext} method to an iterator} At times it would be nice to write a loop that explicitly gets the values of an iterator. Although that is certainly possible with a standard iterator, it requires some rather awkward error handling. One solution to this problem is to add a method that indicates whether there is another value available in the iterator. Then you can write a simple while loop that stops when there are no more values. One way to do that would be to define a new S3 method called \texttt{hasNext}. Here's the definition of a \texttt{hasNext} generic function: <>= hasNext <- function(obj, ...) { UseMethod('hasNext') } @ We also need to define \texttt{hasNext} method for a iterator class that we'll call \texttt{ihasNext}: <>= hasNext.ihasNext <- function(obj, ...) { obj$hasNext() } @ As you can see, an \texttt{ihasNext} object must be a list with a \texttt{hasNext} element that is a function. That's the same technique that the \texttt{abstractiter} class uses to implement the \texttt{nextElem} method. Now we'll define a function, called \texttt{ihasNext}, that takes an arbitrary iterator and returns returns an \texttt{ihasNext} iterator that wraps the specified iterator. That allows us to turn any iterator into an \texttt{ihasNext} iterator, thus providing it with a \texttt{hasNext} method:\footnote{Thanks to Hadley Wickham for contributing this function, which I only hacked up a little. You can also find this function, along with \texttt{hasNext} and \texttt{hasNext.ihasNext} in the examples directory of the iterators packages.} <>= ihasNext <- function(it) { if (!is.null(it$hasNext)) return(it) cache <- NULL has_next <- NA nextEl <- function() { if (!hasNx()) stop('StopIteration', call.=FALSE) has_next <<- NA cache } hasNx <- function() { if (!is.na(has_next)) return(has_next) tryCatch({ cache <<- nextElem(it) has_next <<- TRUE }, error=function(e) { if (identical(conditionMessage(e), 'StopIteration')) { has_next <<- FALSE } else { stop(e) } }) has_next } obj <- list(nextElem=nextEl, hasNext=hasNx) class(obj) <- c('ihasNext', 'abstractiter', 'iter') obj } @ When the \texttt{hasNext} method is called, it calls the \texttt{nextElem} method on the underlying iterator, and the resulting value is saved. That value is then passed to the user when \texttt{nextElem} is called. Of course, it also does the right thing if you don't call \texttt{hasNext}, or if you call it multiple times before calling \texttt{nextElem}. So now we can easily create an \texttt{icount} iterator, and get its values in a while loop, without having to do any messy error handling: <>= it <- ihasNext(icount(3)) while (hasNext(it)) { print(nextElem(it)) } @ \section{A recycling iterator} The \texttt{ihasNext} function from the previous section is an interesting example of a function that takes an iterator and returns an iterator that wraps the specified iterator. In that case, we wanted to add another method to the iterator. In this example, we'll return an iterator that recycles the values of the wrapped iterator:\footnote{ Actually, some of the standard \texttt{iter} methods support a \texttt{recycle} argument. But this is a nice example, and a more general solution, since it works on any iterator.} <>= irecycle <- function(it) { values <- as.list(iter(it)) i <- length(values) nextEl <- function() { i <<- i + 1 if (i > length(values)) i <<- 1 values[[i]] } obj <- list(nextElem=nextEl) class(obj) <- c('irecycle', 'abstractiter', 'iter') obj } @ This is fairly nice, but note that this is another one of those infinite iterators that we need to be careful about. Also, make sure that you don't pass an infinite iterator to \texttt{irecycle}. That would be pointless of course, since there's no reason to recycle an iterator that never ends. It would be possible to write this to avoid that problem by not grabbing all of the values right up front, but you would still end up saving values that will never be recycled, so I've opted to keep this simple. Let's try it out: <>= it <- irecycle(icount(3)) unlist(as.list(it, n=9)) @ \section{Limiting infinite iterators} I was tempted to add an argument to the \texttt{irecycle} function to limit the number of values that it returns, because sometimes you want to recycle for awhile, but not forever. I didn't do that, because rather than make \texttt{irecycle} more complicated, I decided to write yet another function that takes an iterator and returns a modified iterator to handle that task: <>= ilimit <- function(it, times) { it <- iter(it) nextEl <- function() { if (times > 0) times <<- times - 1 else stop('StopIteration') nextElem(it) } obj <- list(nextElem=nextEl) class(obj) <- c('ilimit', 'abstractiter', 'iter') obj } @ Note that this looks an awful lot like the \texttt{irep} function that we implemented previously. In fact, using \texttt{ilimit}, we can implement \texttt{irep} using \texttt{iforever} much more simply, and without duplication of code: <>= irep2 <- function(x, times) ilimit(iforever(x), times) @ To demonstrate \texttt{irep2}, I'll use \texttt{ihasNext} and a while loop: <>= it <- ihasNext(irep2('foo', 3)) while (hasNext(it)) { print(nextElem(it)) } @ Here's one last example. Let's recycle a vector three times using \texttt{ilimit}, and convert it back into a vector using \texttt{as.list} and \texttt{unlist}: <>= iterable <- 1:3 n <- 3 it <- ilimit(irecycle(iterable), n * length(iterable)) unlist(as.list(it)) @ Sort of a complicated version of: <>= rep(iterable, n) @ Aren't iterators fun? \section{Conclusion} Writing your own iterators can be quite simple, and yet is very useful and powerful. It provides a very effective way to extend the capabilities of other packages that use iterators, such as the \texttt{foreach} package. By writing iterators that wrap other iterators, it is possible to put together a powerful and flexible set of tools that work well together, and that can solve many of the complex problems that come up in parallel computing. \end{document} iterators/vignettes/iterators.Rnw0000644000177700017770000001415111472542406020343 0ustar herbrandtherbrandt% \VignetteIndexEntry{iterators Manual} % \VignetteDepends{iterators} % \VignettePackage{iterators} \documentclass[12pt]{article} \usepackage{amsmath} \usepackage[pdftex]{graphicx} \usepackage{color} \usepackage{xspace} \usepackage{fancyvrb} \usepackage{fancyhdr} \usepackage[ colorlinks=true, linkcolor=blue, citecolor=blue, urlcolor=blue] {hyperref} \usepackage{lscape} \usepackage{Sweave} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % define new colors for use \definecolor{darkgreen}{rgb}{0,0.6,0} \definecolor{darkred}{rgb}{0.6,0.0,0} \definecolor{lightbrown}{rgb}{1,0.9,0.8} \definecolor{brown}{rgb}{0.6,0.3,0.3} \definecolor{darkblue}{rgb}{0,0,0.8} \definecolor{darkmagenta}{rgb}{0.5,0,0.5} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \newcommand{\bld}[1]{\mbox{\boldmath $#1$}} \newcommand{\shell}[1]{\mbox{$#1$}} \renewcommand{\vec}[1]{\mbox{\bf {#1}}} \newcommand{\ReallySmallSpacing}{\renewcommand{\baselinestretch}{.6}\Large\normalsize} \newcommand{\SmallSpacing}{\renewcommand{\baselinestretch}{1.1}\Large\normalsize} \newcommand{\halfs}{\frac{1}{2}} \setlength{\oddsidemargin}{-.25 truein} \setlength{\evensidemargin}{0truein} \setlength{\topmargin}{-0.2truein} \setlength{\textwidth}{7 truein} \setlength{\textheight}{8.5 truein} \setlength{\parindent}{0.20truein} \setlength{\parskip}{0.10truein} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagestyle{fancy} \lhead{} \chead{Using The {\tt iterators} Package} \rhead{} \lfoot{} \cfoot{} \rfoot{\thepage} \renewcommand{\headrulewidth}{1pt} \renewcommand{\footrulewidth}{1pt} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \title{Using The {\tt iterators} Package} \author{Rich Calaway \\ doc@revolutionanalytics.com} \begin{document} \maketitle \thispagestyle{empty} \section{Introduction} An {\em iterator} is a special type of object that generalizes the notion of a looping variable. When passed as an argument to a function that knows what to do with it, the iterator supplies a sequence of values. The iterator also maintains information about its state, in particular its current index. The \texttt{iterators} package includes a number of functions for creating iterators, the simplest of which is \texttt{iter}, which takes virtually any R object and turns it into an iterator object. The simplest function that operates on iterators is the \texttt{nextElem} function, which when given an iterator, returns the next value of the iterator. For example, here we create an iterator object from the sequence 1 to 10, and then use \texttt{nextElem} to iterate through the values: <>= library(iterators) i1 <- iter(1:10) nextElem(i1) nextElem(i1) @ You can create iterators from matrices and data frames, using the \texttt{by} argument to specify whether to iterate by row or column: <>= istate <- iter(state.x77, by='row') nextElem(istate) nextElem(istate) @ Iterators can also be created from functions, in which case the iterator can be an endless source of values: <>= ifun <- iter(function() sample(0:9, 4, replace=TRUE)) nextElem(ifun) nextElem(ifun) @ For practical applications, iterators can be paired with \texttt{foreach} to obtain parallel results quite easily: \begin{Schunk} \begin{Sinput} > library(foreach) \end{Sinput} \begin{Soutput} foreach: simple, scalable parallel programming from Revolution Analytics Use Revolution R for scalability, fault tolerance and more. http://www.revolutionanalytics.com \end{Soutput} \begin{Sinput} > x <- matrix(rnorm(1e+06), ncol = 10000) > itx <- iter(x, by = "row") > foreach(i = itx, .combine = c) %dopar% mean(i) \end{Sinput} \begin{Soutput} [1] -0.0069652059 0.0161112989 0.0080068074 -0.0120020610 0.0017168149 [6] 0.0139835943 -0.0078172106 -0.0024762273 -0.0031558268 -0.0072662893 [11] -0.0055142639 0.0015717907 -0.0100842965 -0.0123601527 0.0136420084 [16] -0.0242922105 -0.0126416949 -0.0052951152 0.0216329326 -0.0262476648 [21] 0.0041937609 0.0121253368 -0.0110165729 0.0044267635 0.0080241894 [26] 0.0042995539 -0.0102826632 0.0051185628 -0.0013970812 -0.0172380786 [31] 0.0096079613 0.0046837729 -0.0080726970 0.0083781727 -0.0234620163 [36] -0.0099883966 0.0026883628 0.0029367320 0.0205825899 0.0035303940 [41] 0.0204990426 -0.0010804987 -0.0033665481 -0.0127492019 -0.0147443195 [46] 0.0027046346 0.0016449793 0.0155575490 -0.0003488394 -0.0079238019 [51] 0.0086390030 -0.0039033309 0.0168593825 -0.0067189572 -0.0009925288 [56] -0.0162907048 -0.0059171838 0.0093806072 0.0100886929 -0.0111677408 [61] 0.0021754963 -0.0056770907 0.0081200698 -0.0029828717 -0.0163704350 [66] 0.0057266267 -0.0017156156 0.0214172738 -0.0141379874 -0.0126593342 [71] 0.0087124575 0.0040231519 0.0038515673 0.0066066908 0.0023586046 [76] -0.0044167901 -0.0090543553 0.0010806096 0.0102288061 0.0039881702 [81] -0.0054549319 -0.0127997275 -0.0031697122 -0.0016100996 -0.0143468118 [86] 0.0035904125 -0.0059399479 0.0085565480 -0.0159064868 0.0054120554 [91] -0.0084420572 0.0194448129 -0.0103192553 -0.0062924628 0.0215069258 [96] 0.0015749065 0.0109657488 0.0152237842 -0.0057181022 0.0035530715 \end{Soutput} \end{Schunk} \section{Some Special Iterators} The notion of an iterator is new to R, but should be familiar to users of languages such as Python. The \texttt{iterators} package includes a number of special functions that generate iterators for some common scenarios. For example, the \texttt{irnorm} function creates an iterator for which each value is drawn from a specified random normal distribution: <>= library(iterators) itrn <- irnorm(10) nextElem(itrn) nextElem(itrn) @ Similarly, the \texttt{irunif}, \texttt{irbinom}, and \texttt{irpois} functions create iterators which drawn their values from uniform, binomial, and Poisson distributions, respectively. We can then use these functions just as we used \texttt{irnorm}: <>= itru <- irunif(10) nextElem(itru) nextElem(itru) @ The \texttt{icount} function returns an iterator that counts starting from one: <>= it <- icount(3) nextElem(it) nextElem(it) nextElem(it) @ \end{document} iterators/MD50000644000177700017770000000460613213772427014146 0ustar herbrandtherbrandt90531e068d600d95a3e58cbd4f6e7922 *DESCRIPTION 2629bffccd2eb911ef7d4d643b9cfee3 *NAMESPACE c13851fc6f99c89fe043628da55f10f3 *R/aslist.R 6332d5f20627dcebde24b861057b2dbd *R/extra.R ccdc22e9988d39851bdf3abdc0e2cbcf *R/iapply.R a61f4333fe27b6ddddcea9379a24c1a3 *R/isplit.R 0e1f2118fad28b3d2de245c137235f06 *R/iterators.R 8ade42698f48ecfae01760560c402e3d *build/vignette.rds 522f033d6595bc491193cc9a37fad0cf *inst/doc/iterators.R 8bebfb445e51c53c15131df111732305 *inst/doc/iterators.Rnw f9309e403180423b116119db32a852e8 *inst/doc/iterators.pdf 27383417d57f64f44327a215c224aee9 *inst/doc/writing.R cd51c0a69bba68b5a0a86c6fa06cdf87 *inst/doc/writing.Rnw c2eee228ce4cd53dd0744d37c83a78ac *inst/doc/writing.pdf efc4aa1c29a21aee9b2259811d5d128b *inst/examples/ifilter.R cd088a2cccbadd9a4d5c9c97c9d6cea1 *inst/examples/iforever.R 771899b2dce53fef9c19fef2aa2be1b8 *inst/examples/ihasNext.R 7d36a109d61d1e4159d34e31410a02f6 *inst/examples/ilimit.R d6c12d3fc2188b2e225346088ecc2050 *inst/examples/ipermn.R 9d4437887a11be2186086a0f8e40b453 *inst/examples/irecycle.R c45c26d6d4a6e77f2ac01ba023bcc3db *inst/examples/irep.R 5a7f81cd5479d0d08f6a75fbecc47ece *inst/examples/iseq.R b29b453b78f72a4b3841b9506bd96797 *inst/examples/itimer.R c85115fbfc13732bead938f79e3c476f *inst/examples/ivector.R 0aabbdb9be56dd8a89df9f1b945c9538 *inst/examples/ivector2.R f046692a4e2b7c087e020f04698fcb87 *inst/unitTests/basicTest.R 0efb5c13190ea6dc26b293fd35b4523d *inst/unitTests/chunksizeTest.R ee81404b0f6f3201973ef3a745ba7a5e *inst/unitTests/iapplyTest.R 6f71e4bb43764d1897a5034e7ecb7639 *inst/unitTests/icountnTest.R cae9aeded839388cbc29684b1f993ef5 *inst/unitTests/isplitTest.R 0b32d8e74e2eef0cca3cf21d837f8958 *inst/unitTests/recycleTest.R c9cebb9af84ef3ea1197f222a1b51265 *inst/unitTests/runTestSuite.sh ae52a4bd3803d2c7412350616f97d067 *man/iapply.Rd 061ef555146a3d5148e7465887ccfd4c *man/icount.Rd baed914594734a2e58bc80ba226dbf35 *man/idiv.Rd eb9d0fc60440fb5ed2458130c4cba0d7 *man/iread.table.Rd b74b194a671a3748e3745167cb0d914f *man/ireadLines.Rd 09c714a81258b8c1aee0973d06f7542a *man/irnorm.Rd 3eb1a7a987fdb890546e3b0092b0ca57 *man/isplit.Rd 2afbca4442f48c670d2025c5cd506271 *man/iter.Rd 3e911bc606d4da3fd4d41e34bb92c0eb *man/iterators-package.Rd 0134407cacb5a399e25941fe83fb2570 *man/nextElem.Rd 0d6cdfbe259eca9d473fa6cb41a6e963 *tests/doRUnit.R 8bebfb445e51c53c15131df111732305 *vignettes/iterators.Rnw cd51c0a69bba68b5a0a86c6fa06cdf87 *vignettes/writing.Rnw iterators/build/0000755000177700017770000000000013212620524014714 5ustar herbrandtherbrandtiterators/build/vignette.rds0000644000177700017770000000035013212620524017251 0ustar herbrandtherbrandtuO 0nX7]DDAݎ1)s"ٗm.}윝 !"L0r18m oy<8\1IU.(jMkNhc WU,"N75{4uq[?/N=3͘yeI)3WF);Ypc:AȄ-5M]SZT(|~7Citerators/DESCRIPTION0000644000177700017770000000161013213772427015334 0ustar herbrandtherbrandtPackage: iterators Type: Package Title: Provides Iterator Construct for R Version: 1.0.9 Authors@R: c(person("Rich", "Calaway", role="cre", email="richcala@microsoft.com"), person("Revolution", "Analytics", role=c("aut", "cph")), person("Steve", "Weston", role="aut")) Description: Support for iterators, which allow a programmer to traverse through all the elements of a vector, list, or other collection of data. Depends: R (>= 2.5.0), utils Suggests: RUnit License: Apache License (== 2.0) Author: Rich Calaway [cre], Revolution Analytics [aut, cph], Steve Weston [aut] Maintainer: Rich Calaway Repository: CRAN Repository/R-Forge/Project: foreach Repository/R-Forge/Revision: 31 Repository/R-Forge/DateTimeStamp: 2017-12-08 23:08:19 Date/Publication: 2017-12-12 15:26:15 UTC NeedsCompilation: no Packaged: 2017-12-08 23:33:40 UTC; rforge iterators/man/0000755000177700017770000000000013212617760014400 5ustar herbrandtherbrandtiterators/man/isplit.Rd0000644000177700017770000000140411472542406016172 0ustar herbrandtherbrandt\name{isplit} \alias{isplit} \title{Split Iterator} \description{ Returns an iterator that divides the data in the vector \code{x} into the groups defined by \code{f}. } \usage{ isplit(x, f, drop=FALSE, \dots) } \arguments{ \item{x}{vector or data frame of values to be split into groups.} \item{f}{a factor or list of factors used to categorize \code{x}.} \item{drop}{logical indicating if levels that do not occur should be dropped.} \item{\dots}{current ignored.} } \value{ The split iterator. } \seealso{ \code{\link{split}} } \examples{ x <- rnorm(200) f <- factor(sample(1:10, length(x), replace=TRUE)) it <- isplit(x, f) expected <- split(x, f) for (i in expected) { actual <- nextElem(it) stopifnot(actual$value == i) } } \keyword{utilities} iterators/man/iterators-package.Rd0000644000177700017770000000201711472542406020274 0ustar herbrandtherbrandt\name{iterators-package} \alias{iterators-package} \alias{iterators} \docType{package} \title{ The Iterators Package } \description{ The iterators package provides tools for iterating over various R data structures. Iterators are available for vectors, lists, matrices, data frames, and files. By following very simple conventions, new iterators can be written to support any type of data source, such as database queries or dynamically generated data. } \details{ Further information is available in the following help topics: \tabular{ll}{ \code{iter} \tab Generic function used to create iterator objects.\cr \code{nextElem} \tab Generic function used to get the next element of a iterator.\cr \code{icount} \tab A function used to create a counting iterator.\cr \code{idiv} \tab A function used to create a number dividing iterator.\cr \code{ireadLines} \tab A function used to create a file reading iterator.\cr } For a complete list of functions with individual help pages, use \code{library(help="iterators")}. } \keyword{package} iterators/man/ireadLines.Rd0000644000177700017770000000152111472542406016745 0ustar herbrandtherbrandt\name{ireadLines} \alias{ireadLines} \title{Iterator over Lines of Text from a Connection} \description{ Returns an iterator over the lines of text from a connection. It is a wrapper around the standard \code{readLines} function. } \usage{ ireadLines(con, n=1, ...) } \arguments{ \item{con}{a connection object or a character string.} \item{n}{integer. The maximum number of lines to read. Negative values indicate that one should read up to the end of the connection. The default value is 1.} \item{\dots}{passed on to the \code{readLines} function.} } \value{ The line reading iterator. } \seealso{ \code{\link[base]{readLines}} } \examples{ # create an iterator over the lines of COPYING it <- ireadLines(file.path(R.home(), 'COPYING')) nextElem(it) nextElem(it) nextElem(it) } \keyword{utilities} iterators/man/irnorm.Rd0000644000177700017770000000164711472542406016205 0ustar herbrandtherbrandt\name{irnorm} \alias{irnorm} \alias{irunif} \alias{irbinom} \alias{irnbinom} \alias{irpois} \title{Random Number Iterators} \description{ These function returns an iterators that return random numbers of various distributions. Each one is a wrapper around a standard \code{R} function. } \usage{ irnorm(..., count) irunif(..., count) irbinom(..., count) irnbinom(..., count) irpois(..., count) } \arguments{ \item{count}{number of times that the iterator will fire. If not specified, it will fire values forever.} \item{\dots}{arguments to pass to the underlying \code{rnorm} function.} } \value{ An iterator that is a wrapper around the corresponding random number generator function. } \examples{ # create an iterator that returns three random numbers it <- irnorm(1, count=3) nextElem(it) nextElem(it) nextElem(it) try(nextElem(it)) # expect a StopIteration exception } \keyword{utilities} iterators/man/nextElem.Rd0000644000177700017770000000151311472542406016450 0ustar herbrandtherbrandt\name{nextElem} \alias{nextElem} \alias{nextElem.containeriter} \alias{nextElem.funiter} \title{Get Next Element of Iterator} \description{ \code{nextElem} is a generic function used to produce values. If a \code{checkFunc} was specified to the constructor, the potential iterated values will be passed to the \code{checkFunc} until the \code{checkFunc} returns \code{TRUE}. When the iterator has no more values, it calls stop with the message 'StopIteration'. } \usage{ nextElem(obj, \dots) \method{nextElem}{containeriter}(obj, \dots) \method{nextElem}{funiter}(obj, \dots) } \arguments{ \item{obj}{an iterator object.} \item{\dots}{additional arguments that are ignored.} } \value{ The value. } \examples{ it <- iter(c('a', 'b', 'c')) print(nextElem(it)) print(nextElem(it)) print(nextElem(it)) } \keyword{methods} iterators/man/icount.Rd0000644000177700017770000000106111472542406016166 0ustar herbrandtherbrandt\name{icount} \alias{icount} \alias{icountn} \title{Counting Iterators} \description{ Returns an iterator that counts starting from one. } \usage{ icount(count) icountn(vn) } \arguments{ \item{count}{number of times that the iterator will fire. If not specified, it will count forever.} \item{vn}{vector of counts.} } \value{ The counting iterator. } \examples{ # create an iterator that counts from 1 to 3. it <- icount(3) nextElem(it) nextElem(it) nextElem(it) try(nextElem(it)) # expect a StopIteration exception } \keyword{utilities} iterators/man/iapply.Rd0000644000177700017770000000143711564527453016201 0ustar herbrandtherbrandt\name{iapply} \alias{iapply} \title{Array/Apply Iterator} \description{ Returns an iterator over an array, which iterates over the array in much the same manner as the \code{apply} function. } \usage{ iapply(X, MARGIN) } \arguments{ \item{X}{the array to iterate over.} \item{MARGIN}{a vector of subscripts. \code{1} indicates the first dimension (rows), \code{2} indicates the second dimension (columns), etc.} } \value{ The apply iterator. } \seealso{ \code{\link{apply}} } \examples{ a <- array(1:8, c(2, 2, 2)) # iterate over all the matrices it <- iapply(a, 3) as.list(it) # iterate over all the columns of all the matrices it <- iapply(a, c(2, 3)) as.list(it) # iterate over all the rows of all the matrices it <- iapply(a, c(1, 3)) as.list(it) } \keyword{utilities} iterators/man/iter.Rd0000644000177700017770000000352711472542406015641 0ustar herbrandtherbrandt\name{iter} \alias{iter} \alias{iter.default} \alias{iter.iter} \alias{iter.matrix} \alias{iter.data.frame} \alias{iter.function} \title{Iterator Factory Functions} \description{ \code{iter} is a generic function used to create iterator objects. } \usage{ iter(obj, \dots) \method{iter}{default}(obj, checkFunc=function(...) TRUE, recycle=FALSE, \dots) \method{iter}{iter}(obj, \dots) \method{iter}{matrix}(obj, by=c('column', 'cell', 'row'), chunksize=1L, checkFunc=function(...) TRUE, recycle=FALSE, \dots) \method{iter}{data.frame}(obj, by=c('column', 'row'), checkFunc=function(...) TRUE, recycle=FALSE, \dots) \method{iter}{function}(obj, checkFunc=function(...) TRUE, recycle=FALSE, \dots) } \arguments{ \item{obj}{an object from which to generate an iterator.} \item{by}{how to iterate.} \item{chunksize}{the number of elements of \code{by} to return with each call to \code{nextElem}.} \item{checkFunc}{a function which, when passed an iterator value, return \code{TRUE} or \code{FALSE}. If \code{FALSE}, the value is skipped in the iteration.} \item{recycle}{a boolean describing whether the iterator should reset after running through all it's values.} \item{\dots}{additional arguments affecting the iterator.} } \value{ The iterator. } \examples{ # a vector iterator i1 <- iter(1:3) nextElem(i1) nextElem(i1) nextElem(i1) # a vector iterator with a checkFunc i1 <- iter(1:3, checkFunc=function(i) i \%\% 2 == 0) nextElem(i1) # a data frame iterator by column i2 <- iter(data.frame(x=1:3, y=10, z=c('a', 'b', 'c'))) nextElem(i2) nextElem(i2) nextElem(i2) # a data frame iterator by row i3 <- iter(data.frame(x=1:3, y=10), by='row') nextElem(i3) nextElem(i3) nextElem(i3) # a function iterator i4 <- iter(function() rnorm(1)) nextElem(i4) nextElem(i4) nextElem(i4) } \keyword{methods} iterators/man/idiv.Rd0000644000177700017770000000226111472542406015623 0ustar herbrandtherbrandt\name{idiv} \alias{idiv} \title{Dividing Iterator} \description{ Returns an iterator that returns pieces of numeric value. } \usage{ idiv(n, ..., chunks, chunkSize) } \arguments{ \item{n}{number of times that the iterator will fire. If not specified, it will count forever.} \item{\dots}{unused.} \item{chunks}{the number of pieces that \code{n} should be divided into. This is useful when you know the number of pieces that you want. If specified, then \code{chunkSize} should not be.} \item{chunkSize}{the maximum size of the pieces that \code{n} should be divided into. This is useful when you know the size of the pieces that you want. If specified, then \code{chunks} should not be.} } \value{ The dividing iterator. } \examples{ # divide the value 10 into 3 pieces it <- idiv(10, chunks=3) nextElem(it) nextElem(it) nextElem(it) try(nextElem(it)) # expect a StopIteration exception # divide the value 10 into pieces no larger than 3 it <- idiv(10, chunkSize=3) nextElem(it) nextElem(it) nextElem(it) nextElem(it) try(nextElem(it)) # expect a StopIteration exception } \keyword{utilities} iterators/man/iread.table.Rd0000644000177700017770000000231511472542406017042 0ustar herbrandtherbrandt\name{iread.table} \alias{iread.table} \title{Iterator over Rows of a Data Frame Stored in a File} \description{ Returns an iterator over the rows of a data frame stored in a file in table format. It is a wrapper around the standard \code{read.table} function. } \usage{ iread.table(file, ..., verbose=FALSE) } \arguments{ \item{file}{the name of the file to read the data from.} \item{\dots}{all additional arguments are passed on to the \code{read.table} function. See the documentation for \code{read.table} for more information.} \item{verbose}{logical value indicating whether or not to print the calls to \code{read.table}.} } \value{ The file reading iterator. } \note{ In this version of \code{iread.table}, both the \code{read.table} arguments \code{header} and \code{row.names} must be specified. This is because the default values of these arguments depend on the contents of the beginning of the file. In order to make the subsequent calls to \code{read.table} work consistently, the user must specify those arguments explicitly. A future version of \code{iread.table} may remove this requirement. } \seealso{ \code{\link[utils]{read.table}} } \keyword{utilities}