Как выделить путь ggplot2 в R?

Question

Итак, я написал программу R, где я смоделирую и визуализирую образец из стандартной коалесценционной модели.

library(ggplot2) 
library(grid) 

N <- 10 
K <- 20 

x <- matrix(0,N,K) 
x 
for(i in 2:K){ 
    x[,i] <- sort(sample(N,N,replace = T)) 
} 

f_grid <- expand.grid(x = 1:N, y = 1:K) 
df_arrow <- expand.grid(x2 = 1:N, y2 = 2:K, yend = 0, xend = 0) 
for(i in 1:nrow(df_arrow)){ 
    df_arrow[i,]$xend <- x[df_arrow[i,]$x2, df_arrow[i,]$y2] 
    df_arrow[i,]$yend <- df_arrow[i,]$y2 - 1 
} 

ggplot(df_grid, aes(x = x, y = y)) + geom_point() + 
geom_segment(data = df_arrow, aes(x = x2, y = y2, xend = xend, yend = yend)) 

Как я могу выделить путь случайного человека от самого молодого поколения до самого старого поколения. Генерация на вершине участка - самое молодое поколение.

Answer 1

Вам нужно добавить еще один столбец в свои data.frames df_grid и df_arrow и передать это эстетике цвета. Затем вам нужно пройти через ваши data.frames и определить всех дочерних элементов вашего базового узла, чтобы изменить значение этого нового столбца.

Это рекурсивное решение, но я уверен, что его можно улучшить. Просто замените свои последние две строки на это и измените параметр id на номер строки человека, которого вы хотите отслеживать.

df_arrow$color <- FALSE 
df_grid$color <- FALSE 
id <- 200 
start_point <- df_grid[id,] 
ended = FALSE 
while(!ended){ 
    # Find if a segment starts from current point 
    slice_iter <- df_arrow$x2 == start_point$x & df_arrow$y2 == start_point$y 
    # Update color of current point 
    df_grid$color[df_grid$x == start_point$x & df_grid$y == start_point$y] <- TRUE 
    if (any(slice_iter)){ 
    # If there is a segment, update its color 
    df_arrow$color[slice_iter] <- TRUE 
    # Update the start point to the end point of the segment 
    start_point$x <- df_arrow$xend[slice_iter] 
    start_point$y <- df_arrow$yend[slice_iter] 
    } else ended <- TRUE 
    # Do this until there is no segment starting from start_point 
} 

ggplot(df_grid, aes(x = x, y = y, colour = color)) + 
    geom_point(size = 4) + 
    geom_segment(data = df_arrow, aes(x = x2, y = y2, xend = xend, yend = yend, colour = color), size = 1.1) 

Примите к сведению, что это работает только тогда, когда есть только один сегмент происходит от молодых до старых, в противном случае вам придется настроить его немного.