From 1196a43d961a95abc18d3c8e777e9a4e8233e562 Mon Sep 17 00:00:00 2001 From: Benjamin Auder Date: Wed, 11 Mar 2020 13:20:33 +0100 Subject: [PATCH] Pass R CMD check --as-cran --- pkg/DESCRIPTION | 10 ++++---- pkg/R/EMGLLF.R | 9 ++------ pkg/R/EMGrank.R | 10 +++----- pkg/R/computeGridLambda.R | 1 + pkg/R/generateXY.R | 10 ++++---- pkg/R/initSmallEM.R | 2 +- pkg/R/main.R | 1 + pkg/R/plot_valse.R | 29 ++++++++++++----------- pkg/R/selectVariables.R | 1 + pkg/data/data.RData | Bin 1010 -> 0 bytes pkg/data/data2.RData | Bin 18385 -> 0 bytes pkg/src/{sources => }/EMGLLF.c | 36 ++++++++++++++--------------- pkg/src/{sources => }/EMGLLF.h | 0 pkg/src/{sources => }/EMGrank.c | 18 +++++++-------- pkg/src/{sources => }/EMGrank.h | 0 pkg/src/Makevars | 10 -------- pkg/src/{adapters => }/a.EMGLLF.c | 0 pkg/src/{adapters => }/a.EMGrank.c | 0 pkg/src/{sources => }/utils.h | 0 pkg/src/valse_init.c | 19 +++++++++++++++ 20 files changed, 81 insertions(+), 75 deletions(-) delete mode 100644 pkg/data/data.RData delete mode 100644 pkg/data/data2.RData rename pkg/src/{sources => }/EMGLLF.c (91%) rename pkg/src/{sources => }/EMGLLF.h (100%) rename pkg/src/{sources => }/EMGrank.c (93%) rename pkg/src/{sources => }/EMGrank.h (100%) rename pkg/src/{adapters => }/a.EMGLLF.c (100%) rename pkg/src/{adapters => }/a.EMGrank.c (100%) rename pkg/src/{sources => }/utils.h (100%) create mode 100644 pkg/src/valse_init.c diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION index 8dd0fcb..77812ed 100644 --- a/pkg/DESCRIPTION +++ b/pkg/DESCRIPTION @@ -1,6 +1,6 @@ Package: valse -Title: Variable Selection With Mixture Of Models -Date: 2020-01-11 +Title: Variable Selection with Mixture of Models +Date: 2020-03-11 Version: 0.1-0 Description: Two methods are implemented to cluster data with finite mixture regression models. Those procedures deal with high-dimensional covariates and @@ -19,10 +19,12 @@ Depends: R (>= 3.5.0) Imports: MASS, - parallel + parallel, + ggplot2, + cowplot, + reshape2 Suggests: capushe, - methods, roxygen2 URL: http://git.auder.net/?p=valse.git License: MIT + file LICENSE diff --git a/pkg/R/EMGLLF.R b/pkg/R/EMGLLF.R index 93012fb..dada0ef 100644 --- a/pkg/R/EMGLLF.R +++ b/pkg/R/EMGLLF.R @@ -16,6 +16,7 @@ #' @param X matrix of covariates (of size n*p) #' @param Y matrix of responses (of size n*m) #' @param eps real, threshold to say the EM algorithm converges, by default = 1e-4 +#' @param fast boolean to enable or not the C function call #' #' @return A list (corresponding to the model collection) defined by (phi,rho,pi,LLF,S,affec): #' phi : regression mean for each cluster @@ -37,14 +38,8 @@ EMGLLF <- function(phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda, } # Function in C - n <- nrow(X) #nombre d'echantillons - p <- ncol(X) #nombre de covariables - m <- ncol(Y) #taille de Y (multivarie) - k <- length(piInit) #nombre de composantes dans le melange .Call("EMGLLF", phiInit, rhoInit, piInit, gamInit, mini, maxi, gamma, lambda, - X, Y, eps, phi = double(p * m * k), rho = double(m * m * k), pi = double(k), - llh = double(1), S = double(p * m * k), affec = integer(n), n, p, m, k, - PACKAGE = "valse") + X, Y, eps, PACKAGE = "valse") } # R version - slow but easy to read diff --git a/pkg/R/EMGrank.R b/pkg/R/EMGrank.R index 2dc6c37..fa66b3d 100644 --- a/pkg/R/EMGrank.R +++ b/pkg/R/EMGrank.R @@ -13,13 +13,14 @@ #' @param Y matrix of responses (of size n*m) #' @param eps real, threshold to say the EM algorithm converges, by default = 1e-4 #' @param rank vector of possible ranks +#' @param fast boolean to enable or not the C function call #' #' @return A list (corresponding to the model collection) defined by (phi,LLF): #' phi : regression mean for each cluster #' LLF : log likelihood with respect to the training set #' #' @export -EMGrank <- function(Pi, Rho, mini, maxi, X, Y, eps, rank, fast = TRUE) +EMGrank <- function(Pi, Rho, mini, maxi, X, Y, eps, rank, fast) { if (!fast) { @@ -28,12 +29,7 @@ EMGrank <- function(Pi, Rho, mini, maxi, X, Y, eps, rank, fast = TRUE) } # Function in C - n <- nrow(X) #nombre d'echantillons - p <- ncol(X) #nombre de covariables - m <- ncol(Y) #taille de Y (multivarie) - k <- length(Pi) #nombre de composantes dans le melange - .Call("EMGrank", Pi, Rho, mini, maxi, X, Y, eps, as.integer(rank), phi = double(p * m * k), - LLF = double(1), n, p, m, k, PACKAGE = "valse") + .Call("EMGrank", Pi, Rho, mini, maxi, X, Y, eps, as.integer(rank), PACKAGE = "valse") } # helper to always have matrices as arg (TODO: put this elsewhere? improve?) --> diff --git a/pkg/R/computeGridLambda.R b/pkg/R/computeGridLambda.R index f087ba7..3dae84c 100644 --- a/pkg/R/computeGridLambda.R +++ b/pkg/R/computeGridLambda.R @@ -12,6 +12,7 @@ #' @param mini minimum number of iterations in EM algorithm #' @param maxi maximum number of iterations in EM algorithm #' @param eps threshold to stop EM algorithm +#' @param fast boolean to enable or not the C function call #' #' @return the grid of regularization parameters #' diff --git a/pkg/R/generateXY.R b/pkg/R/generateXY.R index f13598a..d2e00ef 100644 --- a/pkg/R/generateXY.R +++ b/pkg/R/generateXY.R @@ -3,16 +3,16 @@ #' Generate a sample of (X,Y) of size n #' #' @param n sample size -#' @param π proportion for each cluster +#' @param p proportion for each cluster #' @param meanX matrix of group means for covariates (of size p) #' @param covX covariance for covariates (of size p*p) -#' @param β regression matrix, of size p*m*k +#' @param beta regression matrix, of size p*m*k #' @param covY covariance for the response vector (of size m*m*K) #' #' @return list with X and Y #' #' @export -generateXY <- function(n, π, meanX, β, covX, covY) +generateXY <- function(n, p, meanX, beta, covX, covY) { p <- dim(covX)[1] m <- dim(covY)[1] @@ -22,7 +22,7 @@ generateXY <- function(n, π, meanX, β, covX, covY) Y <- matrix(nrow = 0, ncol = m) # random generation of the size of each population in X~Y (unordered) - sizePop <- rmultinom(1, n, π) + sizePop <- stats::rmultinom(1, n, p) class <- c() #map i in 1:n --> index of class in 1:k for (i in 1:k) @@ -31,7 +31,7 @@ generateXY <- function(n, π, meanX, β, covX, covY) newBlockX <- MASS::mvrnorm(sizePop[i], meanX, covX) X <- rbind(X, newBlockX) Y <- rbind(Y, t(apply(newBlockX, 1, function(row) MASS::mvrnorm(1, row %*% - β[, , i], covY[, , i])))) + beta[, , i], covY[, , i])))) } shuffle <- sample(n) diff --git a/pkg/R/initSmallEM.R b/pkg/R/initSmallEM.R index fccd51d..487a4e1 100644 --- a/pkg/R/initSmallEM.R +++ b/pkg/R/initSmallEM.R @@ -3,10 +3,10 @@ #' @param k number of components #' @param X matrix of covariates (of size n*p) #' @param Y matrix of responses (of size n*m) +#' @param fast boolean to enable or not the C function call #' #' @return a list with phiInit, rhoInit, piInit, gamInit #' -#' @importFrom methods new #' @importFrom stats cutree dist hclust runif #' @export initSmallEM <- function(k, X, Y, fast) diff --git a/pkg/R/main.R b/pkg/R/main.R index 85a41b7..d750fec 100644 --- a/pkg/R/main.R +++ b/pkg/R/main.R @@ -21,6 +21,7 @@ #' @param size_coll_mod (Maximum) size of a collection of models #' @param fast TRUE to use compiled C code, FALSE for R code only #' @param verbose TRUE to show some execution traces +#' @param plot TRUE to plot the selected models after run #' #' @return a list with estimators of parameters #' diff --git a/pkg/R/plot_valse.R b/pkg/R/plot_valse.R index 3160067..73188d2 100644 --- a/pkg/R/plot_valse.R +++ b/pkg/R/plot_valse.R @@ -6,23 +6,24 @@ #' @param Y matrix of responses (of size n*m) #' @param model the model constructed by valse procedure #' @param n sample size -#' @return several plots +#' @param comp TRUE to enable pairwise clusters comparison +#' @param k1 index of the first cluster to be compared +#' @param k2 index of the second cluster to be compared +#' +#' @importFrom ggplot2 ggplot aes ggtitle geom_tile geom_line geom_point scale_fill_gradient2 geom_boxplot theme +#' @importFrom cowplot background_grid +#' @importFrom reshape2 melt #' #' @export plot_valse <- function(X, Y, model, n, comp = FALSE, k1 = NA, k2 = NA) { - require("gridExtra") - require("ggplot2") - require("reshape2") - require("cowplot") - K <- length(model$pi) ## regression matrices gReg <- list() for (r in 1:K) { Melt <- melt(t((model$phi[, , r]))) - gReg[[r]] <- ggplot(data = Melt, aes(x = Var1, y = Var2, fill = value)) + + gReg[[r]] <- ggplot(data = Melt, aes(x = "Var1", y = "Var2", fill = "value")) + geom_tile() + scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, space = "Lab") + ggtitle(paste("Regression matrices in cluster", r)) } @@ -31,10 +32,10 @@ plot_valse <- function(X, Y, model, n, comp = FALSE, k1 = NA, k2 = NA) ## Differences between two clusters if (comp) { - if (is.na(k1) || is.na(k)) + if (is.na(k1) || is.na(k2)) print("k1 and k2 must be integers, representing the clusters you want to compare") Melt <- melt(t(model$phi[, , k1] - model$phi[, , k2])) - gDiff <- ggplot(data = Melt, aes(x = Var1, y = Var2, fill = value)) + gDiff <- ggplot(data = Melt, aes(x = "Var1", y = "Var2", fill = "value")) + geom_tile() + scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, space = "Lab") @@ -48,7 +49,7 @@ plot_valse <- function(X, Y, model, n, comp = FALSE, k1 = NA, k2 = NA) for (r in 1:K) matCov[, r] <- diag(model$rho[, , r]) MeltCov <- melt(matCov) - gCov <- ggplot(data = MeltCov, aes(x = Var1, y = Var2, fill = value)) + geom_tile() + gCov <- ggplot(data = MeltCov, aes(x = "Var1", y = "Var2", fill = "value")) + geom_tile() + scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, space = "Lab") + ggtitle("Covariance matrices") @@ -59,7 +60,7 @@ plot_valse <- function(X, Y, model, n, comp = FALSE, k1 = NA, k2 = NA) for (i in 1:n) gam2[i, ] <- c(model$proba[i, model$affec[i]], model$affec[i]) - bp <- ggplot(data.frame(gam2), aes(x = X2, y = X1, color = X2, group = X2)) + bp <- ggplot(data.frame(gam2), aes(x = "X2", y = "X1", color = "X2", group = "X2")) + geom_boxplot() + theme(legend.position = "none") + background_grid(major = "xy", minor = "none") @@ -80,7 +81,7 @@ plot_valse <- function(X, Y, model, n, comp = FALSE, k1 = NA, k2 = NA) } data <- data.frame(mean = as.vector(meanPerClass), cluster = as.character(rep(1:K, each = dim(XY)[2])), time = rep(1:dim(XY)[2], K)) - g <- ggplot(data, aes(x = time, y = mean, group = cluster, color = cluster)) - print(g + geom_line(aes(linetype = cluster, color = cluster)) - + geom_point(aes(color = cluster)) + ggtitle("Mean per cluster")) + g <- ggplot(data, aes(x = "time", y = "mean", group = "cluster", color = "cluster")) + print(g + geom_line(aes(linetype = "cluster", color = "cluster")) + + geom_point(aes(color = "cluster")) + ggtitle("Mean per cluster")) } diff --git a/pkg/R/selectVariables.R b/pkg/R/selectVariables.R index 0c18c67..e08a941 100644 --- a/pkg/R/selectVariables.R +++ b/pkg/R/selectVariables.R @@ -15,6 +15,7 @@ #' @param thresh real, threshold to say a variable is relevant, by default = 1e-8 #' @param eps threshold to say that EM algorithm has converged #' @param ncores Number or cores for parallel execution (1 to disable) +#' @param fast boolean to enable or not the C function call #' #' @return a list of outputs, for each lambda in grid: selected,Rho,Pi #' diff --git a/pkg/data/data.RData b/pkg/data/data.RData deleted file mode 100644 index a9f09e143adfa04f595a40b993efa688ebd05a4b..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 1010 zcmVp&WZl>sV;MkEktY=rRsmk}pa$Ymf| zh%+!j5MfYaWQj0NjSwZ8tauaP}k|=7GfR?3xiC$wy8cy^2&Ku+%x#Sd9>t$ zLmDm^dp4WeYeFCEnoB`wICgw3@@~y4gPhV+@xcK*P%!AO`$5DRkTD)oXS7Ic^{*?? zW@d4z1MdXuj-ykhk3R&r1yFrc`xn~9sSvAlM@y(*Vfi)3U6 z6_Z?=CI9l)hCa+Y{C)q>;4LnlH&A!>UOY(J`%@WB*Kw+7R_I|=538Xe^IaxaV6LQE z${Gm5C2JFkVyl*<7&)30u6P0er*eaKb_bUdxM{YW--RQw)~7G!8eyO2PzAB0kEF)t z?XHy_!ZphSLNwX1fD4Q6{c8^!k<;Mak*tgWMAQeqci5;=}*!@7W0`L#=>CsH@lls&U?r! zc@iF6c@hNYlSY*_w~^;y75Te$4sIR|=P-7f!9+gWnOy2Zp&>Z7CWgV{3%AEc$_DH_ zI>bpVy9f&=2Rmjjlt7nvW^AOd048cSvZ`JygnrlCayPGi$Zr}>`8kaSB7KiJ-K~$X zKP>8Li?SOh8ynTuGYsIVqt0dNolu+}p1ZeL@fJ*RK52ejSBxS*_1**vLzoeFJ*W;i g2h$j?5gPyHEAZ5@~ diff --git a/pkg/data/data2.RData b/pkg/data/data2.RData deleted file mode 100644 index 80003e3c090402d85e308401bb23159ebe1d53ca..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 18385 zcmV(vK9w!7o5D=RJ-5M3~85y5TpT4>flw+^-(2AySBs3Udj4#=a}%qfT$rVfI8z-ra~% zB1xchqLg+qfo#aw;oL|PtlrVP(vazZfxnE>z8k!Q1sa;lxS#eg*2mVMqI4QZjXz&$ z=U5<+SF6AIny?qAF1q<2=_SRMapSSLsP{Nd^Vu_(`zA~~Uv8{9l?Y3(FE5@^|A`~{ zL(C#dNjMO5t(z;!yk5<;1I0 zutCP|XY;iM#;nxnGzG@6+1fjqucrg1pE)!fN`JD`?%oNV%hWhG)M(%sVFdj=jqw9w z!7ywawBTE2kALO!Xt#}pVa`?XTlryEEWcu=okqul?e3d{GULy1{9yZ@yciW|Y4vqa zmKem*^iulLv)V^2m^v&+WQ)ka82~-)A`af z(D?nb*GUz62xqo6C-*YM^j(F{Jyl)U+KaLd*X3ZVBQof(Jr|lK|LA1VC&6vai8fs| zQtT6nW%E+!z_EY}F3wtZVC(yM@seFH^oyk&u=j1n>2bkJw!RWrC;US?EJYYLfAS6$ z*@Z!>$)Q_n3kEn}@g*R3ngW}&9A}`40*1m;64f=%!CW5yletb(Y_Q%M3DkRzjeEFH zf2JD2!7JR~u6`DT7QPSe-&Q7ZrY}cxZTT)Vi(J-QKV5`#N^Cq$1ztoFyw_lw!GX4k zKW-ZaghM{*_;b&`0%*NtW}D1m zm0ersEqe6C^CgIOvRvNI;u3Jn>Y6nGq64c7Fe_>kH@A2NvT3n1J(Ykos z3-H*Go5~y&wk%x+)`MqpINpL~m*YKHYdm6+?P!aG(=OxnSsFOUSoZZ#`XShOF#q}& z-5F?lzCSy!<1O@4X>DAdUWe8WPhp*03LHDT_40gGDGW3kIlId}g}Jrm*HdP(P_rlF z!F`+C*vGN?_V9;aSaFk{g>sh$Haxybmc(F-bJ6jF)zKoj_WZHHG(j7N&gxt4K23!^ z)*VEPgg_Yckf{1Y9Rf2ql=sO|X=24Bt%EVc64bHF=kecrid*t2Pt(Ki!`#tm;a0m{ z*prof=bXnkBB{f1+0$BHm@iLrj`CI;u4r5TD(g{zNwX7%Q1=D$1Eixgx#*#xN`XM{DKzLT;im!Vf~{Ro#@ z437LQ=2z0b0bR2BF$GEGIGJ!slYW&JN5omfnmuQsC8+bbQ_?Zqc;ULNKU4x8MA7v# z-s(7S;2dMw+XaKPo*g##f523_!nOE2{y4BO_04rI3Tnyihc-T0Le||6-DeMU;Exra z6I*){phd^;o);|x7H7z5^raR+bd2FXGtV!udWurS!g2{4Z)I`$7q~!{74d4Oof=NA zFj~~wT4B4VyQJfv6ko!Fu$Mf;v-fSc_*FeaawBBwg$!262rU^RSS5ChT zb|sRZ5xC^e_ZgcmD}TPOk%nV~+_(0a?7=Qn$>hw^lJxONI)R<+4$ z+a>7iScuwi-s%55No7RN7PQ5RZ{m0ctoK!#-=O!FWi(Oc{e5PG1kW%4%DN^Wg?UxfV${70~-fUG@je z-@i{i^F~@&$5I?U|7K`g8nog4mNlFR3J0JMe&wHMVu$Fqctqp z<%l<|UR=#OJspA*$33o7ktjpq!-EeE2E}pPSn0v75_T928n)FG*aLH)q>hOOtYItr zu#&-YD$ch*j+Lg##MzF!JU+cXP#~@vV!cQQB~OIo6gXONPMRf$YK9sXZ%}KD1yw_O zPIu5piX{Yfg zb3{St)TJc&mMB8`MMVv4hR!idwz3jQQq-kQVi0GyFL#6)mEiajN?X^;EnFpC7ae5X zfT`g#BX{P;p~3jqXw8-$F8r=nepfGvi#e(TIV7tDiU3mo!6scCHr_A9lqL@I*>zdF zM*cuul=#*aZdPcCQE-qbz7E4`95?GZdazTn|BlZ#J4Qd+Jmy+y05%7-?f6;SaA|bc zne6Y~FkI2znX6fVGc>>SJ>AaXNZf0SJZ4##J7YoQqge*x-L>2$pIn$fyTmR*@PeKj z?#nW>uV918?qtP$6pkh8gfYBJf$8*oiO%*Om}5U`T5GM0MN|^Hsd+;%SWa#zLqd+- z)1^oM@QPuZ@xU8xOI4U@`dTw_?IDg_(B@hU7J??BM~-PCAvjrM?CtzV3|8%&+MA~6 zq1Mrz>S&WV3}2VA{m{@&pzA(rWUg9+`6ZjA&U*0#GEbGygjZS6nz^Unq?sRjnce%6 z$#&u7ZL7NT?b$HE>=`y*-U{gj#5`&3PdKgDO)6+fg-s>RE9)zixV+DI;f1>-E-jvY z!zU__4L)C`DBV9{ky=Olr1c1_z0JQo`s*n4$joW-O=QE*mx@|n9-bhQFh3)n|9Jvu zk!fnwH3b@1@7!j|JdO)ri+y&HRl(wV|6c#PqcHQnE9F+YF6L6zOk24(!eFd#7RNRp z3{%T#{W)|BMsz#kzE3_SP#F39+NOFyW#?ozOQ9;Ho`1pcLt6y?Ud*yOyzeWN%GmO< zR#w3zv!i3M7!^#_{|KQupNJc+y`guX-iDC{KUN9_UKpkjV{eOn39CM&cQefFaqv}L zjd!0i&LnG*YrVPzlNw_#=XG`w$i+-2o#;}DWI^OV1(^zAL8SA3|NVZ*eYP|-yLJd8 zE$o(3e}9Djrl(gQe6NMRJF8~b;(1_I%|GY&Yi$^aYH)g8QjSyf#cTJYcblk4hEly#ZQLBs+4YVoUD&H9&vx2K&g1?)3(?$L?4@27YaCpL#{Gy zUdxxD>M+$vuEasCWLnX_oZ$w&`$J>+lxDFmLS*xX%OZ?P?qlC4p$dt^K0cp3F5^;Z zR%V3kH(a9ZAg$I?0^;j#*Rhf|-01oArlR~ZWRUC~wih2G(y*&>*-+-;bj;ee)k!Cq zprw*9s6GcvKaC$|?K=UbwY@|)b61=qEI*iHD}xbnz7lumAOh)4a>Ih`K$vLva#XdB zfx!`T_c!jFFhPI$y3KQQ4E`izety#kW^DF9XS7nr*^vk0`v*i}@uB@ICL=3c+`jXn z;l4GrRSpQ66$|4cQ{ATv4|n{46H6Qo{+95Elr#I%U?J4$gl}H3XCP3V@aQ%ELBL-p z^YlVV#Gqk;`L3NKEmWZA&yVZRao~Pk=p8ph0_EEHNSkm64)AwRHeY)Ujg!9>KC-dH zIJH8F_Tg_t%CCyoLY1{}BiJ-Q-|8~Y8I#W3ny}bv&+cT58?7 zlminc?|(h+JBADNPPaDs?qkz{+-tLYj?k5D1-|hs&?*!gDAe^B`#et_VRUiBp55x{ zcKO#}CfwO_UrZ&Wlq<2nGbzCCqH~TOk!{dBPrm!FnLdmc$#I^~vx1oSGYxeoK42Q_ z(@*Sox?qHl!YEVuHl(z79Cx~+0X@z2y36;tfp~D2c;ihT*lH~%4?NWbU(}8<(ecYd zd(X=gPmUGh=<9g3sK=(TC7{pv3J7#K*5^*caM^^k(Z;fL6vU`}21;R8V?{TtFw~}$B8de`Y zeD9)n3~Fi3wvQzmU{l$bR#8(kC|^!|PHa(y;=1oY_x6=t&nA!}ur}*R2Q@>^Y#eQ5jHyQBAHf)(K zG`PW_34^x;EAY@xT)6+^w#)moM9PvY;sl{wBX$)#vV>*GMl=|{$=3~#1CE7+3ifa`a&hbQ!3}HrzY{#QhB2Eahdm!Ybusl3#%Rr}+=)c2nWn zO)Fcuk{y3Bkn_y}1__+M)Ny4jwF_5OKc*j{s(}_sPfOCzMOadl!pb)ziRF*(ObXIu z5=r>qEc7u6V`usFp9%UpoMxs;Q2Fx>=i+@oXIPwo5sJ63|iqFe!?E zJD~y11!ouSh*=o5H%;C(M-p0U6eLTvIk2Grud?U$7SY>@RVaw78MP@rA-c5(^!DQ1{Qc+|j1 zl;lFr~`#1b!`!J*|SSpX~59C5L$#03r@H%f_IKAe2$wC9mCD{9zYN#&w6zzqUv=jvuOPH(hs zu{G2|pL|E-`;HYH_!Ppc(H4&jPro0J^tg>Rk1VX7KbM06{R;JwiE(J;i+rEoWruzI zKVvvjL~&Tx{wY51!kV(Xw|;z$$Myr|S;K?-G5vnT{Ft@@3^6q|K6M|1*jDE7+BSVG z^41Vx3?adiOBV4Ars8<8m5j~9OHk(0VBmX6RY^5U`o6+ zRG?`RHtv18c{4X23t~J;=cl=FWZKW`p7|z@R4cx?!@-W5e)jJke>n#2u44-FOC2!e zzVx|#C=oYx7K#*p3POhF8TE+blAU;n_9_`k8w?M-Q2bUkfibPa$F6fJU^6+j$QR~x zOz*h#uB@I876b|_%#1=IrM~&qCmI&$A-S%W zD?qCw5BFCyVFIaeR-@CNSJ?ON#IumA(zq#=YyF4i0k+<@l9;hEB9J&9*{Y2>gPR-i z9&|zS*p$n*Aar&c=ga!XNN;vx+y0m)Qj&YHY!N_N#cv1gRXGuFv3;k#=V`~h8KK!T zN9^~dA*>Ph7HZhF4+@W)ujxpK;`U@Arg8q{* zRm&x7A8`)bA{fqX?wN$9iUPgCuKU0gw}yEZ^9q0op>y~WrP1S&aOQ3lDkib^D2AD z4W|jv!ug=mV4W(CwiceofE_1!o)pR6WLAq<q-xXf`~Wdp_WVNlof$p*Ju^y{pKj>e!BbQ$=yV>Z%kpBKtZig0dAxGr> z?e|fGE!`9!L_&YU1ztJMi#WmRRBp=i0GDZPXwoMSV+%)M{A*J~=yx&q(G+dL z{9VY9DY-->**||T&{PW&EwAtz#V+Dsl40$!-gi(M>)ZP&{KTn>E8#Ggg3{J_^LE+QbE&kUXI2+j~P&y<5-POD6UV}WAc=|`~=}dw~zvV-` z(Xr5RigLro*BiEF$&)glr$Bq$)HBP+Dp2`Xe)QaXY68X5m-%1pv)E(adXjUz0hWC7 zw0r{0T~)HVUJ?ug7fdykdGcUdTfpm~r9Y8m z`D>48MJd*ERm8`vR!~hvA2R9g#9>Qy<6~L>r?EB56aJp zB!PhuI_WUqzdQD8d)JFQRyaSuoV!MH4C<(ijtZO@!rb}Sq;Ir>U@^LuaLPg!R=-%$ zE=6SFIF(9aU%wYNaFShCevyQ;CkLZy!Y@J3)brruSurrDsdU%ya4arACJ~OQ2!XEL z)}*}J*95YRXPgANW$a;!p%2X%#LklfBrH{PFuRJ=x#pjtujBB@r!0M3y}16Fb1NDa zt`WRdt3P0s^a_z=^)qxHu*r=){tOq4eNT%g`a|zS4%f&iTUdMIePC?E7#6t1*6N>| z;XnjWw8=skt|<(?W=PM1>!a?E1V=^1%J*qxW>se?{5On#T#}Is}>)E_}sadW(@W zi8rCAW|8v5Vlr;>&k2m03}eHC*3(udmk1;o@`Q$cG#K4%Z8Gbig;Vv!mZGQD&?}I6 z=d+9kOwl)^l<^#_+$xxws@s`&%*-AFrVn@GszXJzG{UpuIzaCgVgzpf)K zXpSxGBUiW^%pi3(=uuUfG4|By9^#*C#U28sPLXFmd}moIzH2iF9m`a@!x!SPwKaO- zxTqI&%df<}j%>#%X7%MjRwi7K)l6Mt-SNY9hlQm-sN>{>ZPTqrLs-32o-0=115M^n zt;03wu;!rF;pYLVILVpJ&#Uqari$8h_n&+U?RsuMeMl>?|4TTtLzOJL|9QmdN4*T? zyjzcD?t4S)-$aIQ!A3Y5s)~KR-*8Ha`JMd4I?O42z3g&%6jM}qjxitS!r2>RD_`~q z!PxS19{V^gSeKp4_B8awzUEbZyxdn*~L1WmS6i#C7 zSi|ACO&vpNXKWrc8hQcyVf~?4r}2h1ft(p7oA_5?-9bmG_3bovQrvnHw`jKGuXuO= z<#fR2k`)TEsgLl7MojI;CI`;51Tft;a)zxK>kigO89VE>dRb^|1dN1d6ZaPCV_tk@ zlw`w4taaG3=2tw0y*(PGUP(6Csqkze^Dqti`z>1v(OiNW3io1Lt!bEx*=j%YqzmVd zo&KTt$O>!f6i0^7+r!+1mZQ9fE%g4Pe$VU63maF74xIZZV03!grk89Q`f9kYM)r5& z(8+Owl#27v{-&AUzf%p?{HNl2MHH~g?(px_>}{+s3{#zITflIwr;P)YB{=rp z;6SN@6gExW%U!m~!zRkPuiR<_Fx~3O!qC_84>@*n!v|(N1>?V`;YmmgcaDEc$#4Ci z>GlczRtuG|k3_~(`Q62@gb7soGFPfUZxNX(`~quLpF?NFTEy$_yF`j3X%V%Qo>)6} z{ARukAI@GI(dhIxg~b?mG1KWz0_h8(->P&CFqlOC@=N~)I?`QnIu-B>nk|-+i`@-j z{*vOU$VfT@$>+#RKk7?}BznQOD}xLn5m^kK*hmPh>}`=`!c{OM+C8(shYVNNE)jqC zDG>LQL`8d4ED%}Nf9pK9NFuN@s~?$Rvw-KbM#l4A-wDiImG(BzMTq1ZdlS62QwWrG z4TE~iY{cE!!W=b1H*n)g>4yvwAtDuzq5GuoPWx-U_dYQFC6Jc2vuBVo6Y12yCMn*1 ziJJqT{lfwe5J-~>*bJ{w6S-bY?{%UUAuwHS8N93^fos1%KiMm&4+GCrrw+xRA(HH! zzrU`vm%ui6G(BN>96J=l#qLE&VC{wV){(&&0`ra7zP_OYM4HpqPi&^8h}4$noqs|q zOjDxEcddF{l`~`gLN?&4Gn`*m7Rflt{-c`};x9 z!JX;U@JCKJiAb7uz?^^{+cXK0WGnx`L$5#r8RMRV@m0SGE=C~W7J-wgPhiz(H_irG zTl!!5Kwu73e{pl~CnB|6lzdav0&cl|AbX2UIHW+bJs@?GK$@^D6soZZi%yTj8yyN@ zgTH?E)3!%o1#8};#eYs{;mj^xwol%Jm?gT$QbK{5%v-(Yzz{+ zLMot5<1(9{_!sD<3*{eM=7sT@sNallA~52OXms4%FCwd2VFAZE2iR_#lp4rLBGUbK zHjkjxBXYj|9e(GI49p8!KRy=52@}fSp9|tEoI&Q~YqsG;8mqjb-+eoJxO7S2z!)VC z@_5^*c&ihrmP!VL4oxGKac8OS%6jg)+ym9Pl(hy*Pe&8M#I(;L-W^y z1tMFee05z>A}%iZk+uqy0g>s@-?!v}1nPk^%4ctk5NJPYqg1#y%&X;pcqEt&^Cb+C z_t=?;+@B_=uT>L?*qml-yYEEETG8FLNP#XIhW_WbB3=woMWKBut|0sqLKPn@|)N1#1(rd#e1 zFJUjkfa^+6EzFXS*?vE-2Fp1ro40N1aW?I+rsB;F;_iFfA`)s(A?1RK_8zNW#NEN% zA=3wF2^5XZ=^5r*uxh`z?78<6f#UX==&9hB7_RZ+OXWKP%+?=EKCpNQ7irwh==zUB zy@;n_L1hb(nx7%klXDfutXOwnnj6O6$R-ow=|qsTIAOYDS^$EG}-i%YOthIz++PQ3udRe7j9KPCXi=* z<8BB(Ngz|b@7ulFMqqj@Xn%=w50PHaxzfoXhQR1@@ms@@leiwIT^JK1L!{FG9xu7? zBh-&SrA~ED#3r`p=A$bTILmQdh2{A#7*#ueNa-*YfwXJ*x|ZiYTy4M5Z+=Y>`lzG2 zpXu)=uzi{eZKdUcuC9$4DGeKFYl~e~5S1aaK#;9gfG>1Esr;4RDoZ3MWOI=Ox8S@! z+2gyvDhVtD`V9f%L;^eaD^YP-VZ!e7Nh!>?4#MKFn(jk|Hk`2V_7wj37B+o8-uz=M zh)WBjDKXuF#9j7BJtf|}B`{Mw;Tm1d{7#JRy84{HeI!98L*;3Lu(AO~5)!h`>!9Is!F)bbOZ?MIB75@>&-YizF>_o` zUo_ztZlpZvUN;-tx!)QTFCQI*xs@?bgTkB89BFvpQ~M)MR4I2fB)lTh=iR5(rt^cv z69xwzcI#o|q(f4U_W^7~49^=mhxPeeZA)IiaC_*<&nl)M0tFe(3ty2EB8B9Hrd?(@ zku_ppYf5Mo&L;46>tA*xQtI(ar8Nd%`pxn0SH>!dtdHs6w`NlAgf-)O%+At8ved(F z@BdiAO3K%}cO}CKWMzhqyzlPAc2M{^Z#hbs=|0>_zDt+D@+MS5?1~Z$?BUNKjj1iHYm7U_<7=(~R*Bdz z@w+cI5$WY7wO4jGz$W+g9?QEXM1~TZ_(X9(B1K`_+an})L>9@DyDpPlg_VHIPq>V> zU{>iCn_kc~E*|I4HAqIBRA8GuU%gES$%{k3iu}eLZOPAc6MV8JiP9%>;^hhL9g$dSLbVfyqea zPF!z)*_6Gz61G1T#@Bf$!qPPclFS311eU8LS>fl&aJg4w?;n$gkig^AVkzx}F)wJp zUoBg}Y*G&Ow?TC<{H@9?-`<Gt zZ{Cr*M{7VJDUf}Y^wf$#vhZwAeFO=CIjSYV!+ef#P~>yC%XM#D5<2#jtWuLe?G@E1 zclb5V@RbZ^H%yK$g|m*vKzV?+kJj*0xCE}WTWzHb%sg1~%Sv2}ue z2FK*Qsw@61684CzMUI@-B#=dYd6HnxKqRLFgO|mLL~>>W-q(FRxbdv*SbR+wfsXm& z*K?1!VMD>vsBtL=$Aj9=U&sz7FxQYMFp-rLXi|U4-0Pbol4Y%rj3)IES#&>f`15n& zs*rN48rx-C@eAc zjhLbVVOQU9QFJ;NxOtnINMQKu><!6^cD zPRt{4pM(|K4eoU7H6j)Lr3-Dc{X6rNBeeZt368e2cgatA5NO9&7EO;dVO1pYMY-mC z0(oZjn=)%z*k--*@Ss2khG?4%7u)6HsJX7!htyywzpBQvuSO24wNHxM+x~*J6ZeG# z{T^Z`uN>EfnJ8Q$NWCP~M?)Rcdi^ykL+lx`bEuB~j>CK+RRbc&p~+`OP4k{KjyNtq z9xG_WF@|uqvP@=3&HJeGyfg}CN#j~kgbPQx9jAD9{Gi#VF}Z4cbFg*urM{CJInMtO zy!%y34VMm6QOPGqz?Q}1v+lu{cJ$!Zad#sarnGM}?+;7C(bzGnMwuumsP3{J&Ao%$ zjAw_=%jV)>L1u-b4I8$~9Xk8)9xwC-UFbC`@`VBF`x)AqLa<@(lhz>M3Tp>*ocRS} zaXOP?JD%egtYi*+);m*-L$h_J>brFa)K4fPt+MDK|8GOtC~-G5?3KLU|5FSnCr&Es zniye;!@b90gN3+gLYWkFy$7}*WJ$V3G+^5ows2<8_#MBLg6yyN3^si-%8b3V8^*W! z1j=+TLh$Mfj?Bm7xYTdLsp;N?YsUw2Lm7`@d+lfKo02J zdihd9T>^f<(%M;?Eh8!T+oncF>9>jz4naDmVi#d4e2>tO8z(lAkDs?0F(i<^ziq4g z<_T1$)Cn8Ec@D!V9&JYgmvMRK@P)BOUaYy~V`ZpdhchoUJwJ_Dqo-(@v{FzAq#sQ1 zes^3A=Y>_vGxhIb{ro8n*RKlDZ*+X4WY2yW4GJxj&x^!v7SqY(>MpFR+uNTpy@V|y zE58T(9kK4__GiEHEtn2Cob)nGddKeGl!z3u!6g|(FZzR7IC5S2;j4(35F=*tIaBW- z4n1Iu_*Hg}NYdh|eocN4zVPx$@4u6dlMUZ$Itxx?JEQEwFy&eJ`SkgGaTOi*ov;`C z!5xmp78iajQ##?y{F><=!73Q!8!^@R%!$25(ld;YgRy#e*XZ}hMX+oh!u)e~duM&4 zQP^J~gEPhU7jjyTLz&>CBeKp#FtSfJtacv}d&We(eomV~YP_P?Zgn!~JYALGGWQOb zf3efo86U;LAS!$l8-!!-{$wq113G#&UdQeCCy)+W4%Isp!vOO~SILGTm?_HIo}Q$D zf@T+m@RHroWxbTgqp1e%WuI;4PNx#dxt(8S4pk6HbkfPvxp@kgLWnDSZ52R#BA z!OqdN<{FWtpW#Zf1T!>q%=U-;Y=*Wa%G;Z5Q!uc=D4PAC0)M^xU2se{8`r|R0@%U| zp!)H3Pp|Pj=*lMJNU!XIV2`CZ$qRfi=|?ZuIGc#b!I0oN@E50Q?@BH>b7Swxh`KeY zqZpLnK1K2FJg%|Sbwu0OLuGCX4QPAe?HZ9I5zKABe3+4=@P?2A9w z_eBH7NSIYls^-EvulvV?yBJ~aR>fhLS6(o8B`>K>=rm5rvp9K5+CxKUB>8>SAzV3l zjgT8~0)|HGM#o-WhtS{VzA=KKSQlKk&3fw?E`0MyIhy$ZMiV-pfhx zvrH^lC932k=H-P|GnA%8irp~J5)v}SbO73f0@vr9)FJSEi+!+uBUDzKcb|&*2s6RK zYBR*WFzwVf-}IscW<-B~e?8lbOQ{boTQ4f(xT||8BlkSE3~mMx0;Vumb%x^**BO}k zD!)~C?GDb>#Kyeb>w!HaXG5$l$8p5^L5sKOHjK3&4v`xAjWut@3FnSlz?4R-c8YE{ zPAGTzDq5{V9{B|0uD4}7hbSUI;L0Vjbo$@S<2YJq@maCgF=az2lmZxoDToPzO$ZWoR1^M!q}UQgA`xuU@5-D zsqb4pO!CV1kZ29yP_f}OnOO`>8(7F5+vkkMhFirlRjSzUAhXQs`wjatc;&p4+hHYJ z#XscF5Y%{S3{&dlW9&KPq?ww6deMN77i8pc{NA!r?7^$p7+626K+`Z)5LFpLAyaB&PjD7d7u* zSSC!Xd1mE9kEl$>?TlWS_MTzCvG*3vzjj0OXH?kqdcBeSLJ%Yunq(iz6vwi<)!Fiv zeX#I2+U&!WAI#WayQuS_3Yye2I-WEK;ov=m4ws6Z=WO2rM&|e{xcqYeUHA;vj=zIH>xdZ8QEhw8q_0OS|d}wTq$icJ+^8>Bd%tS3?V| zopG486F&-_kExgr)y?4a%e5}yOle$lc@*C@aU7@2s`nF!%gt`LH3dys_VPNje(O9u_u-=gudn>mBXPpnLNJ(D8C2e+t(76$8HEJ~? zJ>QCxaji-P(ac0riky+7mkVI&&U;n4tG}@3>ZSe4d%a<6ygRmEpABZJTvoqWT4R3U zDZWI3GB98pP`v3J4|Nx1Ma#t#A&_4kYcA4@a^w8gEQ)jykgN0kizIrO- zdbU@vS1=upT^7kNDYN@?%azobg?beAsMyn&78TfG3)9ed6eNY_8lM<+FU*jgWp&8|$^S^Wj6 zVLfu}edEHQJ7A2J!v}U1NGoC!jf20g2p5d$Y}aw})x%V#QX|(NJLu!^vTeQY3#07T zy5yH{z=+H92>!AC@qvjjpQ$hfJowj~YM3 z>HEIF<$~YihE;~0?BQ3~Ql0s@)#N*F-Z$epZ4cfyFDcEkseN^I26wIg}p?sJ77mH&Kzhbo2#qf(=j^9envDRPHDJ+K+x4T1U z8J8~r@yGtEkku;a9n;H2Ra0zP@f@~wl)>8A$sc(vmvLF5Eiy_a633fNsJYy4@5E^e zN!8syp-)ld#xJ9t>s6ObwGyZS4P&^3e=I(FsMRpQ*1`J+R@JL4~X zSe+ikjROiHjmh8c!CZ}0fDg|HZ2H`*mOXtLW~7{MGrSDN{^WogF)XUM7@L^5#&{I^ zqi;M~ytM*-Mcab5SFCYNf6zutZ3ssB-7XQBePFeqGRG?5CC)uFAd*(-;ozCh=Fm?e z@KK|0>6Ex44vg5Oeqd6=vCUhXq*_QMl_Swmxjl)we!s3=I=+OvZcK8h0hZ$j0}gJ~CFE`1($jPSz2c66bF$edopnYlNT&f|6#1_ zEfdJC}8z^57gz#RY*2ZMb<{t-3}r3i~PyMg4m?5t-$v->KJY)?KJO%}vyU&AD^<$E|dnMCsZ<0woy zC&?}L8Q}Eo4V7!P;jmyV!1*=V99NUxI?Ab&;PCe|cf`~0VafKnAn%twP{EVGJ>V?` zje;|*u4n29q)Y*_!Khh7yH3XW!p>FmYMVj0<+X9lt1&Pe}~1vO0WJ^Yj2 zE*pAfkEOKnDr1LT=)e*+H{^Y5Vwb(IhP~x4Iae-=5$P29t807rK|gP%qLY#bfo!r{ zCp}po+vPtLWNMV*%;eIWG%HuEUJO2SJl`0$WY%u#+n86vSb{2N_=kbD_v!BDV9fHVl0jv7NsWiwlmvexlxXxMDF@Z5bU5 zV-`J6RBN?i>lE#;xQ~0WR4g%Z%%cWpaGo%6BNAE!hHJuZ+<;z_pPrB6f_C&Yx7q1# z2Wzhr#P8=&Lf2ZLZrgVnY@|s3b7QFrM!(~}h-7XkJsJ~Ao+t$is=Uh!qwJ7&j7|OP zco1$Jo4=a2=z=o^5tZ=@*P!jwt+b&R^RU@zEu-;H4o5BX4cD2iprJ(Al-xNVJ9Q4G z*L~S(pD*+b&jCGH+UPvfdiE3KB;0T4jTgb5bKkdQ-0gAUSy1j4$r-3KxjXpG^cl`p zTx(_9eGz(lIfqrh-NeOHcO~}K=tA2={?A)!J}`gy)^Bp2M63>BquV`44dXG_)&(ZN z;&zCVvAfa-9GXtGYwwanyU%xg_g0qSLZP&N!+a7pF$XZcj$y;T_zD6Y=YAM`Pstl< z{Q)*<6mE|n>4ZM6wvSp-e6aY_!=BUmJ(0FkaNUBr9I8Iw+*{)eFjlR~X;b|a#?Fj9 zbt(=;;v&!~KH7(UQytmVQg2|CB;+a2^9<;zDm+2s6$kyU%g!G5uQ2OPY)t4XId=c7 z=DTuyFE$bg&c7s~6$&T%>x!RSik>5*khBAH9IOnJlr_F775+|RxNON>G(c4sdV zX#eC2pH8fRh2tOp^7T!@vP)pBh}&Tt^!uDrw8sbsv&9_rzu$%Kz(2pN9zDmJ@ofvi zGnKfpZ|I0dk`N{}wDGA;R6|2(%O@qaoptc{bAf|GmbkiW#Jg@@2bNc&m4@a|;Y@?g z=iPtoVRk{*VD`&2_D-c|k)?y?M@ zC4r4z!~r438S*$UY-aL~6b?VPv#x8s3Q2khGs+|VmnRmm)8J%$ zi0T1YILj+3yQzo)shW)fj@20VbD#Tw`aYOAHy`)Tu;M?`?PS~k;~e|HpELaTbo_tF z$o?Bo`VahnFDLs4Iobb2{?F?FGmL+%^N;mO{|WB@tl$5mHvg~c{lHT}FM&~~-yJxEZQl)3qGjplKIC*^-&Vo;-=)%@N*)R4FGjqhuuvk8{O z9MhJHj^GasbL1Mqso!Fw3AEC-%!$kIIRexQ)>353*rO|!<6V;Lb(~H2SC2%gUaEL! zXr*FMF4LhkzbiWGwJ@8bb~|&KnxJH!-_JCma5%JWmRv%uCVe_);_uYcTZbEH&LNvb zGM_rtqK0A=dyB6_Z;MOLZsn>2NBwO^Zmxe@>28$!sHFcY?Y^subzhCcfjXMM)HjW? zQsm!9u`L@G+@dB^G94{frV~p)?m-L_rIvQiTc>s%Pi-F3Os7(|4|z^x$t>aeV{<%h zp_<~`>j>^QQJrNu%c87;V@!-M?OJ2v&W>$-KfO};YN08aH<&z3uJNm<)t_Un*+mEKWW|EA{p4_y%qCGqAoyE!hsNs`F-k*_XGLXUD zmUtRj%@notT@iKZshFp4_CmKezZdee9-3hmn4b{8=jh{E4YW)2#3l0lWu8_|ns5@O|?%F<|RgvGo;W zg?HI6oAy%pO@EqNHS`%jFdM77RolqX1~IwW64M3wJkPs}r$7CPCmcdu>wJ_aVA zdus0`Fpzg^LSOEa$ZoyQrQ^mVlzckXA0KlLy*(YnQ)9QfJH6BRmd_)GnsN!RZ`|$O zhA(&&%x}bnP~POCsX2Gu)mSfaWsLrUm!{1r-JGzkDXsB@kNFu7I_C#?;giz${Tawr zqC=si5nGWy>vu=MLgd!TFP7nVdUfgH+i7`0Ub4ef7JD@3FHk&Ka7k(I+vQue3jL79yx6@>iM%+){tp*qujmw8gL+SSl)(-G~cwLf}3 z2F;INd^xoITkk`~#6_x{b7HQyZsZ|-%eU$IBZ+27PnzG-a{J#`q`-CNNQ43C$=D(P`T+l>r{DnXqMOF$Y~MvRB@y8F5l{R7aqD~7SHgNYm79WXVTZk z_VL+)7`j&{s!vew&(+;+It6Y^$cW6SbAg+zSPrsyxHxgR}?OY4=j?7ury{%y^dM zrj%ddbW*?tJ)x@2zF52Oiz+U4TT2HGBQ&+M3>?#{_WU-dNj)|3=ek^#rG)VrfvmnO z)bY*lLV7iv=#Or~6Y+HF$(Oc?*)){N7kMT=tNR`?_DbstW9A^gpKDZU^nzzx_)Jh7 zduW-*>AXq*G~MxYuXd@-iT6|K#jAWTf0L_yhUDFnWEf9!*~sdx$XYvtM^PU#e@ZaT zyN76o*&62G5LEpheD$sJtuuMcQhG99JO*Ma`Hp=Y<0E~SmNT<0zA%19@k-J~RTsMl zOW9^bjieyk{Ak6Rkwz)0!)DG>Uv8w7TG(Aoc*-0n#P?Y7NW_gB>mx<1F68a4LlrOY zc>gsmSNP5KQNl^EeBlmb_oIuW18j7Av*;bZn^_%lB;BK9$7nr%L!5V6Z7#~)>Q)+^>-gw57n5Ib(qtDY2{Z>QanKPdPiFf+T!>ot?yvyY#CEcL!yn*4L{ z>aPglMV_gKsl&|ySL9T_jh=Ql3auXMy?AY=_d-S?^X<51iwB{;H|2Gu>Du40=QoH% z5%Y=CYGctE96iydn_|Z#OGKS-DgP$;oeiP*s^@OzM?QDXfhP!EQ_|PX9+CMS+%=@q zn^Y~V6;eGdBmREFQ?0=Eb%J7d@39=B5P@ufn*SsX%NyfKdv)ae%NCKZe4V~Xk; zt`USu=umq&aqR+g_4N>BxTuy_KC(xjz8V| zX+UJesWqVdO85;XBcOeakAQ9lnG>L-N0b{)PK5`rmCwM%|AqU%1MdG{`~5H6f8qXrgZn?TJtSNI2e2Gl*uqx;0L*yv5C8xG diff --git a/pkg/src/sources/EMGLLF.c b/pkg/src/EMGLLF.c similarity index 91% rename from pkg/src/sources/EMGLLF.c rename to pkg/src/EMGLLF.c index b77f24a..978f253 100644 --- a/pkg/src/sources/EMGLLF.c +++ b/pkg/src/EMGLLF.c @@ -6,30 +6,30 @@ // TODO: don't recompute indexes ai(...) and mi(...) when possible void EMGLLF_core( // IN parameters - const Real* phiInit, // parametre initial de moyenne renormalisé - const Real* rhoInit, // parametre initial de variance renormalisé + const Real* phiInit, // parametre initial de moyenne renormalise + const Real* rhoInit, // parametre initial de variance renormalise const Real* piInit, // parametre initial des proportions - const Real* gamInit, // paramètre initial des probabilités a posteriori de chaque échantillon - int mini, // nombre minimal d'itérations dans l'algorithme EM - int maxi, // nombre maximal d'itérations dans l'algorithme EM - Real gamma, // puissance des proportions dans la pénalisation pour un Lasso adaptatif - Real lambda, // valeur du paramètre de régularisation du Lasso - const Real* X, // régresseurs - const Real* Y, // réponse + const Real* gamInit, // parametre initial des probabilites a posteriori de chaque echantillon + int mini, // nombre minimal d'iterations dans l'algorithme EM + int maxi, // nombre maximal d'iterations dans l'algorithme EM + Real gamma, // puissance des proportions dans la penalisation pour un Lasso adaptatif + Real lambda, // valeur du parametre de regularisation du Lasso + const Real* X, // regresseurs + const Real* Y, // reponse Real eps, // seuil pour accepter la convergence // OUT parameters (all pointers, to be modified) - Real* phi, // parametre de moyenne renormalisé, calculé par l'EM - Real* rho, // parametre de variance renormalisé, calculé par l'EM - Real* pi, // parametre des proportions renormalisé, calculé par l'EM - Real* llh, // (derniere) log vraisemblance associée à cet échantillon, - // pour les valeurs estimées des paramètres + Real* phi, // parametre de moyenne renormalise, calcule par l'EM + Real* rho, // parametre de variance renormalise, calcule par l'EM + Real* pi, // parametre des proportions renormalise, calcule par l'EM + Real* llh, // (derniere) log vraisemblance associee a cet echantillon, + // pour les valeurs estimees des parametres Real* S, int* affec, // additional size parameters int n, // nombre d'echantillons int p, // nombre de covariables - int m, // taille de Y (multivarié) - int k) // nombre de composantes dans le mélange + int m, // taille de Y (multivarie) + int k) // nombre de composantes dans le melange { //Initialize outputs copyArray(phiInit, phi, p*m*k); @@ -67,7 +67,7 @@ void EMGLLF_core( copyArray(rho, Rho, m*m*k); copyArray(pi, Pi, k); - // Calculs associés a Y et X + // Calculs associes a Y et X for (int r=0; r // for NULL +#include +#include + +/* .Call calls */ +extern SEXP EMGLLF(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); +extern SEXP EMGrank(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); + +static const R_CallMethodDef CEntries[] = { + { "EMGLLF", (DL_FUNC) &EMGLLF, 11 }, + { "EMGrank", (DL_FUNC) &EMGrank, 8 }, + { NULL, NULL, 0 } +}; + +void R_init_valse(DllInfo *dll) +{ + R_registerRoutines(dll, NULL, CEntries, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); +} -- 2.44.0