Order a dataset so that geom_path() connects the points in the same way as the human eye does

user_10556906 0
Viewed 62

Below is a reproducible example with what the desired output would look like.

# Example
library(tidyverse)
df <- tribble(
  ~x,~y,
  4,6,
  4.5,5.5,
  5,5,
  5.4,4.5,
  5.6,3.8,
  5.7,3,
  5.4,2.5,
  5,2,
  4.8,3)
# arbitrarily scaling because ordering needs to handle different x and y scales
df <- df %>% mutate(y = y*100)
# human eye draws the rough spiral connecting the points 
ggplot(df, aes(x=x,y=y)) + geom_point() 
# geom_line moves along x-axis, not desired output
ggplot(df, aes(x=x,y=y)) + geom_point() + geom_line() 
# geom_path does it right - exactly what I'm after
ggplot(df, aes(x=x,y=y)) + geom_point() + geom_path()

# ...but I can't guarantee the df is going to start in the desired order:
df <- df %>% arrange(y) # arbitrarily sort by something else as orig order not guaranteed
# now geom_path doesn't work
ggplot(df, aes(x=x,y=y)) + geom_point() + geom_path()

#Q: how to go from an unordered df to a line plot with geom_path() that matches the dots in 
# the same way as the human eye when just given the points.

I think I want a function that takes an original dataset, orders it like the human eye would, then can be plotted using geom_path(). I already have tried one method, that I've called the "second_min", but it doesn't work:

second_min_func <- function(df){
  
  # try scaling (though not finished as need to scale back to orig axis after ordered)
  df <- df %>% scale() %>% as_tibble()
  
  # nest the dataframe back onto itself so can rowwise perform operations on all data
  df2 <- df  %>% 
    mutate(orig_order = row_number(),
           temp=1) %>% 
    left_join(nest(df, data=everything()) %>% mutate(temp=1),
              by="temp") %>%
    select(-temp)
  
  df3 <- df2 %>% 
    rowwise() %>% 
    mutate(
      # euclidean distance for each point against all others
      vec = list((x-df$x)^2 + (y-df$y)^2)
    ) %>%
    ungroup() %>% 
    group_by(orig_order) %>% 
    mutate(
      # the first minimum is 0 always as it's the point itself
      second_min = which(vec[[1]]==vec[[1]][topn(vec[[1]],decreasing=FALSE)][2])
    ) %>%
    select(x,y,orig_order,second_min)
  
  df3 <- df3 %>% arrange(second_min)
  return(df3)
}

# not desired output!
ggplot(second_min_func(df),aes(x=x,y=y)) + geom_point() + geom_path()
dplyr ggplot2 r
2 Answers

It's late and I have a half assed solution that I wanted to post before going to bed. I'd propose to compute a k-nearest neighbour graph, find the shortest path in the minimum spanning tree and use the visited vertices as the order.

Just showing that I messed up the order properly:

library(tidyverse)
library(scales)
library(igraph)

df <- tribble(
  ~x,~y,
  4,6,
  4.5,5.5,
  5,5,
  5.4,4.5,
  5.6,3.8,
  5.7,3,
  5.4,2.5,
  5,2,
  4.8,3)
# arbitrarily scaling because ordering needs to handle different x and y scales
df <- df %>% mutate(y = y*100)

# Random order
set.seed(42)
df <- df[sample(seq_len(nrow(df))),]

# Show order is scrambled
ggplot(df, aes(x, y)) +
  geom_point() +
  geom_path()

Approach is as follows:

# Rescale
df <- df %>%
  mutate(x = rescale(x)) %>%
  mutate(y = rescale(y))

# Euclidean distance
d <- dist(df[, c("x", "y")], method = "euclidean")
d <- as.matrix(d)

# Find k nearest neighbours
k <- 2
diag(d) <- Inf # Don't allow self to be nearest neighbour
nn <- apply(d, 1, rank, ties.method = "random")
nn <- apply(nn, 2, function(x) {which(x <= k)})

# Make graph from nn list
elist <- cbind(rep(as.numeric(colnames(nn)), each = nrow(nn)),
               as.vector(nn))
g <- graph_from_edgelist(elist, directed = FALSE)
E(g)$weight <- d[elist]

# Calculate longest shortest path (?) through minimum spanning tree
g <- mst(g)
path <- all_shortest_paths(g, from = V(g))
path <- path$res[which.max(lengths(path$res))][[1]]

# Order is the vertices the shortest path visits
order <- as.integer(path)

# Reorder scrambled df
ggplot(df[order,], aes(x=x,y=y)) + 
  geom_point() +
  geom_path()

Created on 2021-08-06 by the reprex package (v2.0.0)

It works on this particular dataset with this seed for this particular k and I have no clue how well this generalises to more challenging datasets. But at least it's something.

user_113748270

If your goal is minimize distances between points, then one possible solution is to find the minimal Hamiltonian path through all the points. In that case it's a lot like the Traveling Salesman Problem so you can use the TSP package to help with this. Here's a helper function

library(TSP)
minimize_distances <- function(df) {
  tsp <- insert_dummy(TSP(dist(df)), label = "cut")
  tour <- solve_TSP(tsp, 
                   method="cheapest_insertion")
  path <- cut_tour(tour, "cut")
  df[as.numeric(path), ]
}

which you can run with

ggplot(minimize_distances(df)) + 
  aes(x=x,y=y) + geom_point() + geom_path()
user_23720640
Related