Farbänderung Simplexplot

Wie erstelle ich Grafiken, was ist zu beachten?

Moderatoren: EDi, jogo

Antworten
Joe_Gerner

Farbänderung Simplexplot

Beitrag von Joe_Gerner »

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

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)
}


und hier der Code von meinem Script

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
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
Dateianhänge
out_all.zip
(66.78 KiB) 99-mal heruntergeladen
Antworten