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