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
Post a Comment