From 06d20315c18303753a343dea8d6361c8637336a7 Mon Sep 17 00:00:00 2001 From: John Flournoy Date: Fri, 13 Oct 2017 15:23:55 -0400 Subject: [PATCH] initial commit --- app.R | 199 ++++++++++++++++++ rsconnect/shinyapps.io/jflournoy/rw_model.dcf | 10 + www/optimality_plot.png | Bin 0 -> 8675 bytes 3 files changed, 209 insertions(+) create mode 100644 app.R create mode 100644 rsconnect/shinyapps.io/jflournoy/rw_model.dcf create mode 100644 www/optimality_plot.png diff --git a/app.R b/app.R new file mode 100644 index 0000000..2ceb602 --- /dev/null +++ b/app.R @@ -0,0 +1,199 @@ +# +# This is a Shiny web application. You can run the application by clicking +# the 'Run App' button above. +# +# Find out more about building applications with Shiny here: +# +# http://shiny.rstudio.com/ +# + +library(shiny) +library(tidyverse) +library(wesanderson) + +# Define UI for application that draws a histogram +ui <- fluidPage( + + # Application title + titlePanel("Associative Learning Simulation"), + + withMathJax(), + + # Sidebar with a slider input for number of bins + sidebarLayout( + sidebarPanel( + h3('Set parameter levels'), + sliderInput("xi", + HTML("\\(\\xi\\) (noise)"), + min = -3, + max = 3, + value = 0, + step=.05), + sliderInput("ep", + HTML("\\(\\epsilon\\) (learning rate)"), + min = -3, + max = 3, + value = 0, + step=.05), + # sliderInput("b", + # "Bias", + # min = -2, + # max = 2, + # value = 0, + # step=.05), + sliderInput("rho", + HTML("\\(\\rho\\) (inverse temperature)"), + min = -3, + max = 3, + value = 0, + step=.05), + h3('Parameter optimality across 40 random runs'), + p('When noise parameter is set very low'), + img(src = 'optimality_plot.png', style = 'max-width: 100%') + ), + + # Show a plot of the generated distribution + mainPanel( + plotOutput("trialsPlot"), + helpText("RW Equation: \n + $$p(a_t|s_t) = \\text{logit}^{-1}\\Big(Q_{t-1}(a_{t},s_{t}) + \\epsilon\\big(\\rho r_{t} - Q_{t-1}(a_{t},s_{t})\\big)\\Big)\\cdot (1-\\xi) + \\frac{\\xi}{2}$$"), + uiOutput('rw_eq') + # , + # tableOutput('runTable') + ) + ) +) + +# Define server logic required to draw a histogram +server <- function(input, output) { + + generateTrials <- function() { + p_right <- data.frame(expand.grid(cue=1:2, reward = c(1,5)), pcorrect_if_pressed_r=c(rep(.2,1), rep(.8,1))) + + cue1Indxs <- sample(c(1,3), size = 60, replace = T) + cue2Indxs <- sample(c(2,4), size = 60, replace = T) + + manyTrialIndxs <- c(cue1Indxs,cue2Indxs) + + manyTrialIndxsShuffled <- manyTrialIndxs[sample(1:length(manyTrialIndxs), + size = length(manyTrialIndxs), + replace = F)] + + Trials <- p_right[manyTrialIndxsShuffled,] + Trials$crct_if_right <- rbinom(dim(Trials)[1], size = 1, prob = Trials$pcorrect_if_pressed_r) + Trials$outcome_r <- Trials$crct_if_right*Trials$reward + Trials$outcome_l <- (1-Trials$crct_if_right)*Trials$reward + return(Trials) + } + + inv_logit <- function(x) exp(x)/(1+exp(x)) + Phi_approx <- function(x) pnorm(x) + + rw_strategy <- function(trialdf, mu_p){ + xi <- Phi_approx( mu_p[1])# + sigma[1] * xi_pr[i] ) + ep <- Phi_approx( mu_p[2])# + sigma[2] * ep_pr[i] ) + b <- mu_p[3]# + sigma[3] * b_pr; # vectorization + rho <- exp( mu_p[4])# + sigma[4] * rho_pr ); + + K <- length(unique(trialdf$cue)) + Tsubj <- dim(trialdf)[1] + wv_g <- c(rep(0, K)) # action wegith for go + wv_ng <- c(rep(0, K)) # action wegith for nogo + qv_g <- c(rep(0, K)) # Q value for go + qv_ng <- c(rep(0, K)) # Q value for nogo + pGo <- c(rep(0, K)) # prob of go (press) + + trialdf$pressed_r <- NA + trialdf$Qgo <- NA + trialdf$Qnogo <- NA + trialdf$Wgo <- NA + trialdf$Wnogo <- NA + trialdf$pGo <- NA + trialdf$outcome <- NA + + for (t in 1:Tsubj) { + wv_g[ trialdf$cue[t] ] <- qv_g[ trialdf$cue[t] ] + b + wv_ng[ trialdf$cue[t] ] <- qv_ng[ trialdf$cue[t] ] # qv_ng is always equal to wv_ng (regardless of action) + pGo[ trialdf$cue[t] ] = inv_logit( wv_g[ trialdf$cue[t] ] - wv_ng[ trialdf$cue[t] ] ) + pGo[ trialdf$cue[t] ] = pGo[ trialdf$cue[t] ] * (1 - xi) + xi/2; # noise + + trialdf$pressed_r[t] <- rbinom(n = 1, size = 1, prob = , pGo[ trialdf$cue[t] ]); + + trialdf$Qgo[t] <- qv_g[ trialdf$cue[t] ]; + trialdf$Qnogo[t] <- qv_ng[ trialdf$cue[t] ]; + trialdf$Wgo[t] <- wv_g[ trialdf$cue[t] ]; + trialdf$Wnogo[t] <- wv_ng[ trialdf$cue[t] ]; + trialdf$pGo[t] <- pGo[ trialdf$cue[t] ]; + + # update action values + if(trialdf$pressed_r[t] == 1){ + qv_g[ trialdf$cue[t] ] <- qv_g[ trialdf$cue[t] ] + ep * (rho * trialdf$outcome_r[t] - qv_g[ trialdf$cue[t] ]); + trialdf$outcome[t] <- trialdf$outcome_r[t] + } else { + qv_ng[ trialdf$cue[t] ] <- qv_ng[ trialdf$cue[t] ] + ep * (rho * trialdf$outcome_l[t] - qv_ng[ trialdf$cue[t] ]); + trialdf$outcome[t] <- trialdf$outcome_l[t] + } + } # end of t loop + return(trialdf) + } + + plot_RW_run <- function(trials, mu_p){ + single_run <- rw_strategy(trialdf = trials, + mu_p = mu_p) + + aplot <- single_run %>% + mutate(cue = factor(cue)) %>% + group_by(cue) %>% + mutate(t = 1:n(), last_outcome = as.numeric( ifelse(lag(pressed_r) == 1 & lag(outcome) == 5, 1, + ifelse(lag(pressed_r) == 1 & lag(outcome) == 1, .95, + ifelse(lag(pressed_r) == 1 & lag(outcome) == 0, .1, + ifelse(lag(pressed_r) == 0 & lag(outcome) == 5, 0, + ifelse(lag(pressed_r) == 0 & lag(outcome) == 1, .05, + .9)))))), + last_press = lag(pressed_r)) %>% + ggplot(aes(x = t, y = pGo)) + + geom_line(alpha = .1) + + geom_line(stat = 'smooth', method = 'gam', formula = y ~ s(x, k = 15, bs = "cr"), alpha = .5) + + geom_segment(aes(xend = t, yend = last_outcome), alpha = .1, color = 'black') + + geom_point(aes(y = last_outcome, shape = factor(last_press))) + + scale_shape_manual(values = c(25,24), name = 'Last press was...', breaks = c(1,0), labels = c('Right', 'left')) + + scale_y_continuous(breaks = c(0,.5, 1), labels = c('left', '', 'right'))+ + geom_point() + + facet_wrap(~cue, nrow = 2)+ + theme(panel.background = element_blank(), + # strip.text = element_blank(), + strip.background = element_rect(fill = '#eeeeee'))+ + labs(y = "More likely to press...", x = 'Trial number') + return(list(plot = aplot, runData = single_run)) + } + + someTrials <- generateTrials() + + simulatedTrials <- reactive({ + plot_RW_run(trials = someTrials, + mu_p = c(xi = input$xi, ep = input$ep, b = 0, rho = input$rho)) + }) + + output$trialsPlot <- renderPlot({ + simulatedTrials()$plot + }) + + output$rw_eq <- renderUI({ + xi <- Phi_approx( input$xi ) + ep <- Phi_approx( input$ep ) + b <- input$b + rho <- exp( input$rho ) + + withMathJax(sprintf("RW Equation with transformed values: \n + $$p(a_t|s_t) = \\text{logit}^{-1}\\Big(Q_{t-1}(a_{t},s_{t}) + %.02f\\big(%.02f r_{t} - Q_{t-1}(a_{t},s_{t})\\big)\\Big)\\cdot (1-%.02f) + \\frac{%.02f}{2}$$", + ep, rho, xi, xi)) + }) + + output$runTable <- renderTable({ + simulatedTrials()$runData + }) +} + +# Run the application +shinyApp(ui = ui, server = server) + diff --git a/rsconnect/shinyapps.io/jflournoy/rw_model.dcf b/rsconnect/shinyapps.io/jflournoy/rw_model.dcf new file mode 100644 index 0000000..419d5a5 --- /dev/null +++ b/rsconnect/shinyapps.io/jflournoy/rw_model.dcf @@ -0,0 +1,10 @@ +name: rw_model +title: rw_model +account: jflournoy +server: shinyapps.io +appId: 188785 +bundleId: 909163 +url: https://jflournoy.shinyapps.io/rw_model/ +when: 1500486751.98579 +asMultiple: FALSE +asStatic: FALSE diff --git a/www/optimality_plot.png b/www/optimality_plot.png new file mode 100644 index 0000000000000000000000000000000000000000..8a3233cb7acfe2340781e6bb2e0bcea4f3777628 GIT binary patch literal 8675 zcma)i1z1$yyY8mD1O<^s0coXMM?$&;2`NP>=^k22Q9z_?kd_#_8&QT3>27Ih7`pD_ z_ndR@Ip_bs&%Nt;h}nD3?7i0dzW00I_nQwIY6>KTw1f}@ktjZu)q)@lOYr{~J|_6B zD8BUs{2_37s_zUzL^rN~Fb1Z5&mo8jQj~rC%p+xU+Uwb~;Y(;|`!?=p)GvNX?{wmLhyiVAU3igG2x?1qs_hU;bHHX#L9;UGey)xh3mmKQ+RVf{mB1o#=_iq=c4fBm1z06McU)$@?OODOfqW_1jFx4 zcW}WXhZW&r;lZ8?6Vu@{kMlb)1(~y!R^{v-XBe8;)$W%j~E4hdX{Px5L(XZirw1B=x#4?-XYOv;U<~Meh z6!z?(ddA8d{ZjAeWf|g#99nkLf^PXxc~e&2h%k`1Y`RjySC2fCRX?GmWYOTFAQ6fq z;)t1{5k1A8$^Y+@`?vF;?pT{%w?Fu6kNkTP@fOm*zNbeW%?&KR;6QEiW%iUmh=Xc6P4x zrd3alv#TSxgE{^Du3Xngf`fy{=d*;>q3+JklQzanhlTd=Jnh`A>3a9`$@tfSh#IXo%Aa( z+D=xfa%$`7R9X$@9L;!bm-kAaU7l^5c<;(VB^pgOmEc}vQs}<S3%V{(k z9ezgyA>~ztMB0MQ7%?idwbyymlO$w2A-LvgW@ct-`7LeMK3eIM{3~ByX=rG8nBrwL z>0Q`isr_t|&)H$3uZp_5NrOiz6F#&vpv>2Z9#DpM4n|EzhlZ$b-n0^=g)FVC^qYMz z;&=?9ua%Xq+cS*<7QeCm!B|~gO-f4QdR~Oq1&;@{IHrKvf-!`I{Qb@s7;pKC@bK7< z6zW4ed)<6~$Md1r4~P{C)-dl`(C27&^_<+??aAuM1<|$a!^1<7S#L^+7&j1oi*+#r zgk+gn8!j{_YB%&v^YZd4ndf9RGg3*ttGk<(g(d5%6XLg>s5m`^=V29TaJ+o=DtkdY zSM6YLkCTsY8`+?g{nr4gALl2+$*CkhQ<>^C?(I;Ko^JLt?B?+B@c8(64#r)m&r&d+ z*9g-;KR^EiCHq9(ZTxYy(bj%DZ*T7`_UXD|!eC4&D^evG#(ZH3|FGgov{bKa6Sp)A z?vi0l5o?PQMZ&IO3d2+4i{ugxJN7u3=Ft!PP`VR9WB(SWMpK#apMLZ-IU>p-PF`n zkx{+d(UwuAfvVJVlTzC`u<(pZN=owKr?YRKx^GPp5EECdDN;DWl(P3W#>>~%*2*n< zM=S-ctgMoSZNC_66%5-q9*h(eHyN0i$ao!YkVzl6IGxymoB-LwjsIO@yWt7==y|%! z@DRavv%k6rE(^0J?iEv|F9_0kFS3R-3}Ke9ze$u}KxT?i=4+LHkxcA4?5;~II(7B> zKgYOA1R&+{Ys$x)BR@GY#XEh$#sc+uQ9=3j7^g>@>U(9(~#l&PbAt50t ziFQpkp3lVhd>7^8?Tv|v8OLihF#x-&n|6Eg74?{E=0|wdJ5t+7p+9f#S6?*;TRLx2 zaXZE_%S6WIv=SiE;@C>RG5Mcivb;`Z$Px1RW<|@L{JX!4JcMWOn(zzi>ti6{OlN> zP}@>*`nT*nVx&IC;B;|ak2X$8FK5QNV%ulDDI(iPvx}b<0cUwxn5hfOq-`gRVB;0Y>MbG_D&S6m-Ke<(^0E35rZ6Z)NU>RWfg01H#wfaoJblJ^K_9EcE3 z7Ln=0UxpU-uTmpZz8941eRsf%5@K@GFkZRObpbsI&4{cDTwlO0!65RY!#|LsPUY?; z{a0@F`2e0QJ?mTmPgSdaJ6;B=DjqIw(_R;st!=aFeQBq~ryd?P@$t`PWq$yEz(W_K z6Nm%}w%U|1ZDag$LK{I|=CS)SRm~m52CG8E`MSxKlBz0>e_2`C;^N}#?l_;b&1!(R zswyf}*sU9n^@Yaf^Nr@$^@36o#@F_rgb)YtdUajxw2=XT%`Yg3KD3o`S?!}#mt+q6 z(<^heF+acC#Z`QKauOUGiu(EUHZg8FUa@gwm+_Od4N{xiV0*Vdf)CP~N5unt~?P0o(^<4ti~nT_u4Zj$XZ|9LKF!!o6I+DE8-9ovF8`^XqMeyKSA0)DWHAd+tSj~*VlK{gqVx5 z-364kwsxg~t+DY;U-}a-h8V*qX(n$(gvr!AJw3bQ`S>_F%MLz}JK>jm^|*5h*iF^k z5wYWl?V@0n|3vd3BR~Ids{4$iyL)d>&vc{LQM9_W=UhubS65d^NQiyYN&9~+vhB=5 zjrU1e^*;lt9`yN1LaOwvZEPyQug++8b~ZM<*``KN>89&k0fAZ)Ey~P%b#Z!NY-}7A z6-CWwJhbKl0DW$Avf7Iw<>6~WFA}#J>twu$gY{9YN4+P_@|l`{-9e2M^A6#K=?c`3 zdW+DZ01tB-&ez#r>2-H^_uHynxjaV6V74@P?$5y2k-vWZIz2t@>+1uQLTayrHRv+} z55vFldM8qIh9hYnu!x9MuhS@KYY&3-f?7=ZpFMk4QGEpeXy_wUof#{v946fUSdXo? zUnD8_*E_8C6Dus+Pfu1|dxCgl$6kG6wfsfY##Wd!+EzHLp0*v{)}+&KDL9atUcnHW znG`@?hRNp7{Ew#id~kY!KAADaq=Ajt*z~U*5O+&p)YN<$F)}DFGCbW=PD!nl`m1wD1iuil$G*+M;uNs z=~~+--7$URQ}t>rxj_iS;2)!k=7()d9Rpcs>dp&(dP?v!%Tw(+(?*?nPiX-G0S=Ci z*;yG54i0{PegT2OQp4{|L3F{DsHnt5&z-r}!otFY1e#!&<&7{Q2XBD>XNQ{rozu|^SY(oO3k&=0ckE5)9%0c^_?yk*LQo0nt$V#0 z37Fb7UoeWq#=}!iUS|<>D8(afkNEJ>lz!oTcsPiMf{Ho{NKiKwz-io3=!smU{hYUQN> zqM9P+{C1SK{C!iL%QHjXHc#U8Az1R|-C@{$Cbw<%!yjeyG<{tqi;f!ZJg@SC#GOCk z6L&JPY&rp%xS1MbPR^>HX0|Hzeh-1q?MLs44cXu-_?;|K4^koDzklD=rKCxvN`whW z_!ghvNjG2f`9t%L&rd>0g#-mFDl5gTU%|`uuuzpYqr$cmE+7f*P^!uaOoEUnvDOJr zIHteuwCao{TfNHsauF#$4ir2o#i$GdG+Rrtci38}cOO(e>q-OhFCe$m(ij;Sq%Hft z-sIAS9w{h({6@t+3Bs_doe zEp=t(kARvN7ZcYlnCsIsyl zcM{TFb_@y*-W)GifE(-T-lCXax{2S#!RW7F zDprv=xv(`y01Qvnh3%$}fn;bt7%?Q1Id>SXkL}M?m@IL{7ZbCgY>82N?dIkNYQo-9 z_rk)0h}{$iy}F_z*!wYnN75JQ!Qq1ESS{eJ5ud}S+X6Z3k==1T>$*@pksMZ14AlOt z%xig-HBu4~+JVil_eX8|Gvq$r;;Gv{94EZzKojoMOojuyz|ToZ&V0rhtMuB!f}L5` zlMf{7`LW|!#SLcmd(-(Hj0+B~F$^dGo6%psfG7ls8J&{S00YHC?&ag2~&&Nn!uVqs7_Fgk%vgFXZi*XTv--T*K)(>I3*Vu zG&7^vU5Ld`bN`Bpq@pqjYU$7($vYB2pL}u8a3wG;irAAbGH$FZD%$FZVx5_psdw8< z5_h!*2%E1{@b29^Zyz5}A5GJASr)T!|8D3h%>fuX2KCtQ>TDM45vcnK4_=j(ms4}= znZ{Q!FP_W3h-@QHRinOfgGDMnr-Fo0dTKcw)*(mELcZac@Y-Pcd6!XirThcf1s%nh zt|sns#0Q&}O$zclM$z{Ek4VF6TpSz>e~vICzZg16k3P5XCmrJ-M%evp1(oI!fIw!# z2dZ88j1`7OhcWVi^x;=b)Y@R~<{)X%iyOZ5HmpB?{sbcETVdgg64TZIEIdi6`}f7A zc2Cp7Q>V30>ovn(aZ}Gx1+H3Tu=ziD8_qmXmhNx1E&wwG-hpg-t5X1}l+?#h)ExRc zJxKHvPv#@VBGw@3uXc;~Ut>oZcQTQ6F+R2b%E!tU4Yi2!WSWpfOt^h%Ub?AI;p8cM zH^>5xE|w&n#3k+KDq~qZbtnoW(bJ0>wiH}mS;2Y)420i33cO+D0VPY0#D%T>XXa*d zBZr4>R@L}{txWhAf2HKG@JS;k-UZ*(7orWXfWdWiV)LHA`&?kQ>4+}>r8yaKok>QG za2@!Jvz%_w3q*|5@4Xg#ow0)|7B1KY76yWxbrK5;PryoUqc$X zC2mECGPy9~tG^G}?DrwA{BL#P=&kZ~bU!{4_q&vYe*FBI81Vyzn%sWq1(aCd1-U;> z0>javC^x%KGms84m!n{R6(SifK+s{e01RxpJhfRno@w;jgr^^UKM*A^LvZY6bi_e! z+Z$fmT0#(zBZYdUETB@Ntsh+vf3!C!eT;tRrGV}9TNV}+cmZV=tAx6${s|P_2y4s7 zA1#M9>`e)(`CIx|z*@n1?1AoA!1!8MH__dFo!4ZNJ1x$=Qtta~uEFp--+^R2kZkZ< zp_ZKF^Qihh{hW$Kit($45>A8Qypdo3TP@e>E;&ta07VF zgV@ke1sLodJ#UFf#P&YZVjbFcIJ~kJVxlqZd1L)v-k5W4fpPetCOFGFIwON6R!PWi zN^}i{V(|JEqgLy_ZCq*K13avv?%i=pAOp$}Oci&;*GWY?xM z<(&fkXCxxY#mRYkIBB1~!oa{_XJ@yywI$pj{1GToP1nhNU7>sT%u3>%m;)uzaYT^+ zQ$x;n)mHwG@tMupLvl9XcrZeOZ6_qwVl@P~#Se&+M-Ltoz$u(rA*rrD>otD#F6~7| zhbHxtFZh3?eyS)AJ32ZVMdvr4?{$M}GdE`n>j0jJN)#p}E-sGnTu!`Z`@k?mMbMX) zmID6k<9>h7G!lz>efQn>4go2Tc|^jnp_Z$XQrA*26jkPD`w#JP)LitKcpocEe(fSdkUzB;tD)>%DGIpB?^$-<24DeIls=39?%m35 zJcS3>*F4gV#Io1fD6GUvGPrMF7nRHA-yi*%s-l^@o0pXPjug7H`K#_klAw|Z-0&NL z=Fkx~^r_;ewcd=#Uq6|+4T*rb-jUYNy=)(u9wPbg#%`#;U~*tutiX=CHWi*SM3s<5 zOw{qX1q0(@od9#^t<8s*z^S;9|6zDD=<^Fv(XjutXrrVY=4ilM-kG2#$p4ExK@Ug` zO)urIbJ*9V@n!peX=1+JNUW@M)0KkLv?KpzUQo%~Ncq7DwY;ELPjlTeg?@DGn00H; zQs(INbKr=tt+#ZtW}*VBIm;H8mgvQtvc7%m7-5HXT$+D!L>C+0Oy;BaIN5t`|IaW? z!)HE=#>DH+w1{l`e(N*jus(tW3b0`KFR=5#qK~h^6UHSS3Qd}QL45}7VbU?PKj9x= z&rn0-ksg}>)1tR5g$H7-ABi&aBzg+z0pDOyUB<}RSQ;2|@g~0GzVScW%>pwwH#dQ9 zVS{LhansXW7yA5}$wzL&>r`9H8*t2ltEH^m4fa_qVzTrV%74}InuqjWk8L2IZiQJ1 zCMg5$Sm&}fl&Af>gqjVeOFnL|vvuK6(SWlU%k{iH{7$vgQWtnLxN0b1k_nx&jfDc$ zkM_>>$hHjAkP&t{9ve$ker3UXpoxS=d;J`o}p9upaW zUcIAw@bsU;!#7Xz_gjF2^7$>zwR7>mUAVhH;ht1i^(Mc4gAvzLgRnw?JMGB@kyg2!KeJiTQX0m~0IC1$C;!je zt?VEPfKkh)mNGUqwK4XFDQL_Lz|Vg?$N#+gpNESuiEJAkb^n#{;PUeFP%@7RKZx97 ztX!8$4zVI7X=!6H7HnL6gf<@wXg>tTbA7!;x4f_qu$iR|fF~~1yIMz=hQfdj4i4OY zFB~sMt1Brh1F3J-8=VB$9s0M#wl|2J2s?b>>jNXLwxMC_wlGODfIDC`v9Pdgcn$#P z#eF)ILVxZ!@&$wsoY(!P1Plxe&R9-v?q3LYp#o5;+S=M~8w?B$VMD;O|4l9m2(E)e zi9iES2RGdUFg=&4syPpHN7p?ON4vX@E>HYdP5|||ZkUBY%vq(S{fdViw$|2r2M4Yp zO=J&k{K4e=E?Tbf=Pj1F134@sGqby^i*DHe&!0aX9Z!+E$zQ%?j0(JEF;yn@6S*rU zCI(y*X=!O7m>S>*`LFH-!UY_#6o8WfNHlP^>4t%S4H`mM6E?-MadCjZznyKG*5tup z_Yk@Jugw^Tw_Y0dxOQ{@$EV1o{roT5O;e!~J7sSAGu5qIYDt1tTT`{xmGJ%Lp6u*w z@zmd?s<1a=atxtQ01`1kfT+?B`f&Kr~UN?sthu^l%Z-&m2+6W|o1ggfV-aSqS51`;rXi35!Bxw<&o zOmU5%A^F-;>UCr%b3K}YiW95jfuL&vl`RLK85sDpyc}}!8v-^*iO23AzW*D7ZJft?r7wR1g;@j;891LK^w!q`Qi{LfMM$cfQR(cEU2^paQj^YX7feaRm2p4Y5xD0WNr5)4~Dc~ zkbz~+E>r@>lW2s5-z4HwE$#D1ni(}se!X7F!n4`@x*+fCOMDJjfc`y884>c>F}3=5KLru_mc(8s#o+Pd$3SraJ^`|qhK42~C578I85>fF zpd%n7JKEa|d;eb4>yR7Tk?eJR0RVZF7I=n0+W|XGPj3ux2Tz1ZEcgBUo`3UlL5ojC zMa9#z_M(`ymY10BH*7+-ipz>tQ%7ewM>QEBawBM+Z2;%n4>-aYUkeMl#l$?v%U%OU zw+U(qB_(CgZlS7U08w>>Bxs=I4X)ucgH9x%ySDcBBDCSq&VH|q z@;cTu=<57R6liK{0%r$`8Ku2N`T0MSv&5bQG|5_E^xkRBQjDf^81HyJPZL_c3RLsk zv65sFdrqpbu`#{14)DN@4Gq9k2klyEv+qGb2=nQenYX^fAs`?i42IQ_tmQW}NV2fN zGW(y(s3i*{o0?`S%*~!Xi*cC(vc76GgKmizq^fJDZLP9zP!^=xc2U9i4Q}u7&J&Rn+Y47eXh%Ck+p%HDL-|#>*yR3ad zH`LVBfR^LNSZQr-ZN2-p?_MYSb(>RPf4r}6r$=NKeLfB9a$H=Tu!xAVjB$-aEAYXX zm|A?13Kvv|qA7B=wn)JsGvJnxgAN}rXcLYW8Odil0&{+McNcg$*PWSW-$vk2o0~6! z#oXS24Dd-v|WHaDNDbG2y;At`uX-0s?@$>@M)B4WvkZ|w(t(e0)) zwak8R5CFi0=(n!yl{%UNCO-jl28Z2v**#IwvB5#-sTxP1Egqa~f3_HH)r55bDG%uR z`pOCr!C#`H%miuc<6?gMqE|KP=;X@g1_IQOU%#4yJ}=ly0Q#__|56v{L09Cd@P_06 eyZc{tg|}g6;v?Le;SIjE0V&F<$riy(-~BJy?Egss literal 0 HcmV?d00001