r - Factoextra - change line width for ellipses and variables -


i'm making pca factominer , factoextra packages.

an example of code data iris :

library(factominer)  library(factoextra)  data(iris) res.pca<-pca(iris , scale.unit=true, ncp=2, quali.sup=c(5), graph =  false)  fviz_pca_biplot(res.pca, label="var", habillage=5,                 addellipses=true) + theme_minimal() 

http://i.stack.imgur.com/s7jo4.png

i want change width of lines surrounding ellipses , same width of variables. tried several methods couldn't figure how want.

any ideas?

i create copies of functions needed , change code inside them. specifically, increase width of ellipses can add size=.. in call ggplot2::stat_ellipse command.

my_fviz_pca_biplot <- function (x, axes = c(1, 2), geom = c("point", "text"), label = "all",                                  invisible = "none", labelsize = 4, pointsize = 2, habillage = "none",                                  addellipses = false, ellipse.level = 0.95, col.ind = "black",                                  col.ind.sup = "blue", alpha.ind = 1, col.var = "steelblue",                                  alpha.var = 1, col.quanti.sup = "blue", col.circle = "grey70",                                  repel = false, axes.linetype = "dashed", select.var = list(name = null,                                                                                             cos2 = null, contrib = null), select.ind = list(name = null,                                                                                                                                             cos2 = null, contrib = null), title = "biplot of variables , individuals",                                  jitter = list(what = "label", width = null, height = null),                                  ...)  {   if (is.null(jitter$what))      jitter$what <- "label"   if (length(axes) != 2)      stop("axes should of length 2")   scale.unit <- .get_scale_unit(x)   var <- facto_summarize(x, element = "var", result = c("coord",                                                          "contrib", "cos2"), axes = axes)   colnames(var)[2:3] <- c("x", "y")   var.all <- var   if (!is.null(select.var))      var <- .select(var, select.var)   lab <- .label(label)   hide <- .hide(invisible)   alpha.limits <- null   if (alpha.var %in% c("cos2", "contrib", "coord", "x", "y"))      alpha.limits = range(var.all[, alpha.var])   pca.ind <- get_pca_ind(x)   ind <- data.frame(pca.ind$coord[, axes, drop = false])   colnames(ind) <- c("x", "y")   r <- min((max(ind[, "x"]) - min(ind[, "x"])/(max(var[, "x"]) -                                                   min(var[, "x"]))), (max(ind[, "y"]) - min(ind[, "y"])/(max(var[,                                                                                                                  "y"]) - min(var[, "y"]))))   var[, c("x", "y")] <- var[, c("x", "y")] * r * 0.7   p <- my_fviz_pca_ind(x, axes = axes, geom = geom, repel = repel,                         label = label, invisible = invisible, labelsize = labelsize,                         pointsize = pointsize, axes.linetype = axes.linetype,                         col.ind = col.ind, col.ind.sup = col.ind.sup, alpha.ind = alpha.ind,                         habillage = habillage, addellipses = addellipses, ellipse.level = ellipse.level,                         select.ind = select.ind, jitter = jitter)   if (!hide$var) {     p <- .ggscatter(p = p, data = var, x = "x", y = "y",                      col = col.var, alpha = alpha.var, alpha.limits = alpha.limits,                      geom = c("arrow", "text"), repel = repel, lab = lab$var,                      labelsize = labelsize, jitter = jitter)   }   if (inherits(x, "pca") & !hide$quanti) {     quanti_sup <- .get_supp(x, element = "quanti", axes = axes,                              select = select.var)     if (!is.null(quanti_sup))        colnames(quanti_sup)[2:3] <- c("x", "y")     if (!is.null(quanti_sup)) {       p <- fviz_add(p, df = quanti_sup[, 2:3, drop = false] *                        r * 0.7, geom = c("arrow", "text"), color = col.quanti.sup,                      linetype = 2, labelsize = labelsize, addlabel = (lab$quanti),                      jitter = jitter)     }   }   title2 <- title   p + labs(title = title2) }  environment(my_fviz_pca_biplot) <-  environment(fviz_pca_biplot)  my_fviz_pca_ind <- function (x, axes = c(1, 2), geom = c("point", "text"), repel = false,                               label = "all", invisible = "none", labelsize = 4, pointsize = 2,                               habillage = "none", addellipses = false, ellipse.level = 0.95,                               ellipse.type = "norm", ellipse.alpha = 0.1, col.ind = "black",                               col.ind.sup = "blue", alpha.ind = 1, select.ind = list(name = null,                                                                                      cos2 = null, contrib = null), jitter = list(what = "label",                                                                                                                                  width = null, height = null), title = "individuals factor map - pca",                               axes.linetype = "dashed", ...)  {   if (length(intersect(geom, c("point", "text", "arrow"))) ==        0)      stop("the specified value(s) argument geom not allowed ")   if (length(axes) != 2)      stop("axes should of length 2")   if (is.null(jitter$what))      jitter$what <- "label"   ind <- facto_summarize(x, element = "ind", result = c("coord",                                                          "contrib", "cos2"), axes = axes)   colnames(ind)[2:3] <- c("x", "y")   ind.all <- ind   if (!is.null(select.ind))      ind <- .select(ind, select.ind)   lab <- .label(label)   hide <- .hide(invisible)   alpha.limits <- null   if (alpha.ind %in% c("cos2", "contrib", "coord", "x", "y"))      alpha.limits = range(ind.all[, alpha.ind])   if (habillage[1] == "none") {     p <- ggplot()     if (hide$ind)        p <- ggplot() + geom_blank(data = ind, aes_string("x",                                                          "y"))     else p <- .ggscatter(data = ind, x = "x", y = "y", col = col.ind,                           alpha = alpha.ind, repel = repel, alpha.limits = alpha.limits,                           shape = 19, geom = geom, lab = lab$ind, labelsize = labelsize,                           pointsize = pointsize, jitter = jitter)   }   else {     p <- ggplot()     if (hide$ind & hide$quali)        p <- ggplot() + geom_blank(data = ind, aes_string("x",                                                          "y"))     if (inherits(x, "pca") & length(habillage) == 1) {       data <- x$call$x       if (is.numeric(habillage))          name.quali <- colnames(data)[habillage]       else name.quali <- habillage       ind <- cbind.data.frame(data[rownames(ind), name.quali],                                ind)       colnames(ind)[1] <- name.quali       ind[, 1] <- as.factor(ind[, 1])     }     else {       if (nrow(ind) != length(habillage))          stop("the number of active individuals used in pca different ",               "from length of factor habillage. please, remove supplementary ",               "individuals in variable habillage.")       name.quali <- "groups"       ind <- cbind.data.frame(groups = habillage, ind)       ind[, 1] <- as.factor(ind[, 1])     }     if (!hide$ind) {       label_coord <- ind       if (jitter$what %in% c("both", "b")) {         label_coord <- ind <- .jitter(ind, jitter)       }       else if (jitter$what %in% c("point", "p")) {         ind <- .jitter(ind, jitter)       }       else if (jitter$what %in% c("label", "l")) {         label_coord <- .jitter(label_coord, jitter)       }       if ("point" %in% geom)          p <- p + geom_point(data = ind, aes_string("x",                                                     "y", color = name.quali, shape = name.quali),                              size = pointsize)       if (lab$ind & "text" %in% geom) {         if (repel)            p <- p + ggrepel::geom_text_repel(data = label_coord,                                              aes_string("x", "y", label = "name", color = name.quali,                                                         shape = name.quali), size = labelsize)         else p <- p + geom_text(data = label_coord, aes_string("x",                                                                 "y", label = "name", color = name.quali, shape = name.quali),                                  size = labelsize, vjust = -0.7)       }     }     if (!hide$quali) {       coord_quali.sup <- .get_coord_quali(ind$x, ind$y,                                            groups = ind[, 1])       coord_quali.sup <- cbind.data.frame(name = rownames(coord_quali.sup),                                            coord_quali.sup)       colnames(coord_quali.sup)[1] <- name.quali       coord_quali.sup[, 1] <- as.factor(coord_quali.sup[,                                                          1])       if ("point" %in% geom) {         p <- p + geom_point(data = coord_quali.sup, aes_string("x",                                                                 "y", color = name.quali, shape = name.quali),                              size = pointsize * 2)       }       if (lab$quali & "text" %in% geom) {         if (repel)            p <- p + ggrepel::geom_text_repel(data = coord_quali.sup,                                              aes_string("x", "y", color = name.quali),                                              label = rownames(coord_quali.sup), size = labelsize)         else p <- p + geom_text(data = coord_quali.sup,                                  aes_string("x", "y", color = name.quali), label = rownames(coord_quali.sup),                                  size = labelsize, vjust = -1)       }     }     if (addellipses) {       if (ellipse.type == "convex") {         frame.data <- .cluster_chull(ind[, c("x", "y")],                                       ind[, name.quali])         colnames(frame.data)[which(colnames(frame.data) ==                                       "cluster")] <- name.quali         mapping = aes_string(x = "x", y = "y", colour = name.quali,                               fill = name.quali, group = name.quali)         p <- p + ggplot2::geom_polygon(data = frame.data,                                         mapping = mapping, alpha = ellipse.alpha)       }       else if (ellipse.type %in% c("t", "norm", "euclid")) {         mapping = aes_string(x = "x", y = "y", colour = name.quali,                               group = name.quali, fill = name.quali)         p <- p + ggplot2::stat_ellipse(mapping = mapping,                                         data = ind, level = ellipse.level, type = ellipse.type,                                         alpha = ellipse.alpha, geom = "polygon", size=5)       }     }   }   if (inherits(x, "pca") & !hide$ind.sup) {     ind_sup <- .get_supp(x, element = "ind.sup", axes = axes,                           select = select.ind)     if (!is.null(ind_sup))        colnames(ind_sup)[2:3] <- c("x", "y")     if (!is.null(ind_sup)) {       p <- fviz_add(p, df = ind_sup[, 2:3, drop = false],                      geom = geom, color = col.ind.sup, shape = 19,                      pointsize = pointsize, labelsize = labelsize,                      addlabel = (lab$ind.sup & "text" %in% geom),                      jitter = jitter)     }   }   title2 <- title   p <- .fviz_finish(p, x, axes, axes.linetype) + labs(title = title2)   p }  environment(my_fviz_pca_ind) <-  environment(fviz_pca_ind) 

then use new functions.

my_fviz_pca_biplot(res.pca, label="var", habillage=5,                                   addellipses=true) + theme_minimal() 

Comments

Popular posts from this blog

javascript - Laravel datatable invalid JSON response -

java - Exception in thread "main" org.springframework.context.ApplicationContextException: Unable to start embedded container; -

sql server 2008 - My Sql Code Get An Error Of Msg 245, Level 16, State 1, Line 1 Conversion failed when converting the varchar value '8:45 AM' to data type int -