From: emilie Date: Wed, 12 Apr 2017 16:31:21 +0000 (+0200) Subject: fix few things X-Git-Url: https://git.auder.net/variants/Chakart/doc/scripts/assets/rpsls.css?a=commitdiff_plain;h=5965d116de1595372c8d34281551183fd3799038;p=valse.git fix few things --- diff --git a/pkg/R/constructionModelesLassoMLE.R b/pkg/R/constructionModelesLassoMLE.R index b864985..ac54319 100644 --- a/pkg/R/constructionModelesLassoMLE.R +++ b/pkg/R/constructionModelesLassoMLE.R @@ -1,6 +1,7 @@ #' constructionModelesLassoMLE #' -#' TODO: description +#' Construct a collection of models with the Lasso-MLE procedure. +#' #' #' @param ... #' diff --git a/pkg/R/main.R b/pkg/R/main.R index 72ee724..6d315cd 100644 --- a/pkg/R/main.R +++ b/pkg/R/main.R @@ -148,7 +148,7 @@ valse = function(X, Y, procedure='LassoMLE', selecMod='DDSE', gamma=1, mini=10, modelSel$proba = Gam if (plot){ - print(plot_valse(modelSel,n)) + print(plot_valse(X,Y,modelSel,n)) } return(modelSel) diff --git a/pkg/R/plot.R b/pkg/R/plot.R deleted file mode 100644 index 7fdaa71..0000000 --- a/pkg/R/plot.R +++ /dev/null @@ -1,78 +0,0 @@ -#' Plot -#' -#' It is a function which plots relevant parameters -#' -#' -#' @return several plots -#' -#' @examples TODO -#' -#' @export -#' -plot_valse = function(){ - require("gridExtra") - require("ggplot2") - require("reshape2") - - ## 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)) + geom_tile() + - scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, space = "Lab") + - ggtitle(paste("Regression matrices in cluster",r)) - } - gReg - - ## Differences between two clusters - k1 = 1 - k2 = 2 - Melt = melt(t(model$phi[,,k1]-model$phi[,,k2])) - 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") + - ggtitle(paste("Difference between regression matrices in cluster",k1, "and", k2)) - gDiff - - ### Covariance matrices - matCov = matrix(NA, nrow = dim(model$rho[,,1])[1], ncol = K) - 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() + - scale_fill_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0, space = "Lab") + - ggtitle(paste("Regression matrices in cluster",r)) - gCov - - ### proportions - Gam = matrix(0, ncol = K, nrow = n) - gam = Gam - for (i in 1:n){ - for (r in 1:K){ - sqNorm2 = sum( (Y[i,]%*%model$rho[,,r]-X[i,]%*%model$phi[,,r])^2 ) - Gam[i,r] = model$pi[r] * exp(-0.5*sqNorm2)* det(model$rho[,,r]) - } - gam[i,] = Gam[i,] / sum(Gam[i,]) - } - affec = apply(gam, 1,which.max) - gam2 = matrix(NA, ncol = K, nrow = n) - for (i in 1:n){ - gam2[i, ] = c(gam[i, affec[i]], affec[i]) - } - bp <- ggplot(data.frame(gam2), aes(x=X2, y=X1, color=X2, group = X2)) + - geom_boxplot() + theme(legend.position = "none") - bp + background_grid(major = "xy", minor = "none") - - ### Mean in each cluster - XY = cbind(X,Y) - XY_class= list() - meanPerClass= matrix(0, ncol = K, nrow = dim(XY)[2]) - for (r in 1:K){ - XY_class[[r]] = XY[affec == r, ] - meanPerClass[,r] = apply(XY_class[[r]], 2, mean) - } - 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)) - g + geom_line(aes(linetype=cluster, color=cluster))+ geom_point(aes(color=cluster)) - -} \ No newline at end of file diff --git a/pkg/R/plot_valse.R b/pkg/R/plot_valse.R index 0963946..0a6fa9e 100644 --- a/pkg/R/plot_valse.R +++ b/pkg/R/plot_valse.R @@ -2,6 +2,8 @@ #' #' It is a function which plots relevant parameters #' +#' @param X matrix of covariates (of size n*p) +#' @param Y matrix of responses (of size n*m) #' @param model the model constructed by valse procedure #' @param n sample size #' @return several plots @@ -10,7 +12,7 @@ #' #' @export #' -plot_valse = function(model,n, comp = FALSE, k1 = NA, k2 = NA){ +plot_valse = function(X,Y,model,n, comp = FALSE, k1 = NA, k2 = NA){ require("gridExtra") require("ggplot2") require("reshape2") diff --git a/reports/simulData_17mars.R b/reports/simulData_17mars.R index 52148fd..93a8f20 100644 --- a/reports/simulData_17mars.R +++ b/reports/simulData_17mars.R @@ -15,7 +15,7 @@ simulData_17mars = function(ite){ beta = list() p1= 0.5 beta[[1]] =diag(c(rep(p1,5),rep(1,5), rep(p1,5), rep(1, p-15))) - p2 = 1 + p2 = 2 beta[[2]] = diag(c(rep(p2,5),rep(1,5), rep(p2,5), rep(1, p-15))) ARI1 = ARI2 = ARI3 = 0 @@ -48,8 +48,8 @@ simulData_17mars = function(ite){ XYproj[,i] = c(Ax,Dx,Ay,Dy) } - res_valse = valse(x,y, kmax=2, verbose=TRUE, plot=FALSE, size_coll_mod = 200) - res_valse_proj = valse(XYproj[1:p,],XYproj[(p+1):(2*p),], kmax=2, verbose=TRUE, plot=FALSE, size_coll_mod = 200) + res_valse = valse(t(x),t(y), kmax=2, verbose=TRUE, plot=FALSE, size_coll_mod = 1000) + res_valse_proj = valse(t(XYproj[1:p,]),t(XYproj[(p+1):(2*p),]), kmax=2, verbose=TRUE, plot=FALSE, size_coll_mod = 1000) save(res_valse,file=paste("Res_",ite, ".RData",sep="")) save(res_valse_proj,file=paste("ResProj_",ite, ".RData",sep=""))