Farbänderung Simplexplot
Verfasst: Do Jun 21, 2018 2:14 pm
Hallo,
ich arbeite gerade mit dem Package Archetypes und versuche meine Ergebnisse mit der Simplexplotfunktion zu visualisieren. Das Problem ist dabei jedoch, dass alle Punkte die gleiche Farbe erhalten und ich gern einzelne Punkte anders einfärben würde.
Momentaner Plot:
Hier mal der Code zur Simplexfunktion
und hier der Code von meinem Script
Momentan werden sämtliche Punkte in der gleichen Farbe gezeichnet. Ich möchte aber das bestimmte Punkte eine andere Farbe erhalten.
Hat jemand vielleicht eine gute Idee?
Die RDS Datei packe ich mit in den Anhang.
Vielen Dank für eure Mühen und viele Grüße
ich arbeite gerade mit dem Package Archetypes und versuche meine Ergebnisse mit der Simplexplotfunktion zu visualisieren. Das Problem ist dabei jedoch, dass alle Punkte die gleiche Farbe erhalten und ich gern einzelne Punkte anders einfärben würde.
Momentaner Plot:
Hier mal der Code zur Simplexfunktion
Code: Alles auswählen
function (object, radius = 10, order = NULL, labels_cex = 1,
labels = NULL, show_labels = TRUE, points_col = "#00000044",
points_pch = 19, points_cex = 1, projection = simplex_projection,
show_points = TRUE, show_circle = TRUE, circle_col = "lightgray",
show_edges = TRUE, edges_col = "lightgray", show_direction = FALSE,
direction_length = 1, directions_col = points_col, ...)
{
stopifnot("archetypes" %in% class(object))
stopifnot(is.function(projection))
k <- object$k
if (is.null(order))
order <- 1:k
if (is.null(labels))
labels <- sprintf("A%s", order)
if (length(points_col) == 1)
points_col <- rep(points_col, nrow(coef(object)))
if (length(points_cex) == 1)
points_cex <- rep(points_cex, nrow(coef(object)))
if (length(directions_col) == 1)
directions_col <- rep(directions_col, nrow(coef(object)))
params <- parameters(object)[order, ]
coefs <- coef(object)[, order]
proj_z <- projection(params, r = radius - 1)
proj_h <- coefs %*% proj_z
proj_labels <- proj_z
t <- cbind(x = acos(proj_z[, "x"]/(radius - 1)), y = asin(proj_z[,
"y"]/(radius - 1)))
proj_labels <- cbind(x = radius * cos(t[, "x"]), y = radius *
sin(t[, "y"]))
proj_circle <- list(center = cbind(x = 0, y = 0), radius = radius -
1)
proj_edges <- proj_z[as.integer(combn(1:k, 2)), ]
proj_directions <- vector("list", length = nrow(object$alphas))
for (j in 1:nrow(object$alphas)) {
s <- proj_h[j, , drop = FALSE]
d <- matrix(NA_real_, ncol = 2, nrow = ncol(object$alphas))
for (i in 1:ncol(object$alphas)) {
e <- proj_z[i, , drop = FALSE]
v <- e - s
m <- sqrt(sum(v^2))
v <- v/m
px <- s[1] + v[1] * direction_length * object$alphas[j,
i]
py <- s[2] + v[2] * direction_length * object$alphas[j,
i]
d[i, ] <- c(px, py)
}
proj_directions[[j]] <- list(s = s, e = d)
}
plot(proj_z, type = "n", asp = TRUE, xlim = c(-radius, radius),
ylim = c(-radius, radius), axes = FALSE, xlab = "",
ylab = "")
if (show_circle) {
symbols(proj_circle$center, circles = radius - 1, inches = FALSE,
add = TRUE, asp = TRUE, fg = circle_col)
}
if (show_edges) {
lines(proj_edges, col = edges_col)
}
if (show_labels) {
text(proj_labels, labels = labels, cex = labels_cex)
}
if (show_direction) {
for (d in proj_directions) {
for (i in 1:nrow(d$e)) {
lines(rbind(d$s, d$e[i, , drop = FALSE]), col = directions_col)
}
}
}
if (show_points) {
points(proj_h, col = points_col, pch = points_pch, cex = points_cex)
}
ret <- list(proj_z = proj_z, proj_h = proj_h, proj_labels = proj_labels,
proj_directions = proj_directions, proj_circle = proj_circle,
proj_edges = proj_edges)
class(ret) <- "simplexplot"
invisible(ret)
}
Code: Alles auswählen
library('archetypes') #package
RDS <-readRDS("out_all.RDS") #RDS File
a7 <-bestModel(RDS[[7]]) #calculate Bestmodel for Simplexplot
coef <- coef(a7, "alphas")
point_selection <- which(coef[, 1]>=0 & coef[, 2]>= 0& #selection of points which get another color
coef[,3] == 0 & coef[,4]==0 &coef[,5]>=0&
coef[,6]==0 & coef[,7]==0)
simplexplot(a7) #plot function
Hat jemand vielleicht eine gute Idee?
Die RDS Datei packe ich mit in den Anhang.
Vielen Dank für eure Mühen und viele Grüße