R：找出每组直线上有多少个点

Question

我正在尝试找到解决问题的方法：

每组有多少点在直线上

我在 R 中找不到这个问题的任何解决方案...

下面你有一个样本数据和绘图只是为了向你展示它看起来像什么：

data <- structure(list(Group = c(22782L, 22782L, 22782L, 22782L, 22782L, 
22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 
22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 
22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 
22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 
22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 22782L, 
22782L, 11553L, 11553L, 11553L, 11553L, 11553L, 7059L, 7059L, 
7059L, 7059L, 22782L), x = c(100L, 150L, 250L, 287L, 312L, 387L, 
475L, 550L, 837L, 937L, 987L, 1087L, 1175L, 1300L, 1325L, 1487L, 
1662L, 1700L, 1725L, 1812L, 1912L, 2412L, 3012L, 3562L, 4162L, 
4762L, 5362L, 5750L, 5712L, 6225L, 6825L, 6887L, 7237L, 7850L, 
7800L, 7937L, 7975L, 8275L, 8362L, 8662L, 8725L, 8950L, 9100L, 
9312L, 9400L, 9600L, 4637L, 900L, 4187L, 5800L, 7075L, 1125L, 
3400L, 3562L, 3462L, 5412L), y = c(493L, 482L, 479L, 476L, 481L, 
479L, 474L, 480L, 480L, 491L, 489L, 490L, 485L, 485L, 485L, 479L, 
482L, 482L, 482L, 482L, 484L, 489L, 491L, 489L, 496L, 498L, 500L, 
0L, 498L, 500L, 502L, 506L, 497L, 0L, 495L, 506L, 497L, 494L, 
498L, 500L, 496L, 499L, 496L, 495L, 495L, 498L, 825L, 284L, 850L, 
360L, 790L, 861L, 883L, 882L, 881L, 502L)), row.names = c(23L, 
24L, 25L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 
37L, 38L, 39L, 40L, 41L, 42L, 43L, 44L, 45L, 46L, 47L, 48L, 49L, 
51L, 52L, 53L, 54L, 55L, 56L, 57L, 58L, 59L, 60L, 61L, 62L, 63L, 
64L, 65L, 66L, 67L, 68L, 69L, 281L, 312L, 313L, 315L, 316L, 377L, 
378L, 380L, 511L, 815L), class = "data.frame")

数据由组名列（本例中为 3 个组）、x 和 y 坐标组成：

 Group   x   y
22782 100 493
22782 150 482
22782 250 479
22782 287 476
22782 312 481

下面我们可以找到组 22782 的图：

如您所见，有很多点几乎完全位于同一条线上，我想知道每组中有多少点符合这种情况。

预期输出如下所示：

  Group Max Points  
  22782  20

如有任何帮助或提示，我将不胜感激！谢谢

Answer 1

因为我们不知道 ggplot 中的线条有什么值，所以我们需要找出默认设置的中断。这是回答并在我的代码中使用。

下面的函数表示每组线上有多少个点。您可以进一步设置一个 tolerance 值与您接受的线的偏差。此外，有时我会指向不同的线，例如 ggplot(subset(data, Group == 22782), aes(x=x,y=y)) + geom_point()，其中点位于两条不同的线（0 和 500）上。

对于这种情况，您可以决定是想知道任何线上所有点的总和，还是想知道在一条线上收集的最多点（这里有多少点是 500）。您可以选择 any_or_max_line.

函数

points.on.lines <- function(data, tolerance, any_or_max_line){
# runs the code below per group
sapply(unique(data$Group), function(group_i){
  # chooses i-th group
  data_group_i <- subset(data, Group == group_i)
# find on which y-values the lines are
line_values <- 
  with(data_group_i,
       labeling::extended(range(y)[1], range(y)[2], m = 5))
# find out per line how many points are on or around that line
points_on_lines <- sapply(line_values, function(line_values_i){
  sum(data_group_i$y >= line_values_i - tolerance &
        data_group_i$y <= line_values_i + tolerance)})
# decides whether to take into account the line with most points or all points on any line
if(any_or_max_line == "max"){
  points_on_lines <- max(points_on_lines)
} else {
  points_on_lines <- sum(points_on_lines)
}
# names results by group
names(points_on_lines) <- paste0("Group_", group_i)
return(points_on_lines)
})}

例子

points.on.lines(data= data, tolerance= 50,
                any_or_max_line= "max")
Group_22782 Group_11553  Group_7059 
     45           3           4

Answer 2

让我们假设您知道只有少数点不在线。您还提到您只想考虑水平线。

在这种情况下，您可以使用 median 作为水平线位置的稳健估计。您可以使用 mean 但它可能会受到无论如何都不在线的极端值的影响。

密码是self_explanatory:

tolerance <- 10

data %>%
  group_by(Group) %>%
  mutate(y_line = median(y), 
         on_line = abs(y - y_line) <= tolerance) %>%
  count(Group, on_line)

结果：

#   Group on_line     n
#   <int> <lgl>   <int>
# 1  7059 FALSE       1
# 2  7059 TRUE        3
# 3 11553 FALSE       4
# 4 11553 TRUE        1
# 5 22782 FALSE      13
# 6 22782 TRUE       34

您当然可以将其通过管道传输到 filter(on_line) 以仅保留线上的点数。

Answer 3

对我来说，这似乎是一个区间优化问题（或更普遍的 one-dimensional 数据聚类），也就是说，除非你有固定的断点或线，否则我能想到的解决此类问题的一种方法是Jenks 自然中断优化已在包 BAMMtools

中的 R 中实现

你基本上是先固定线，然后看哪些点属于哪条线（最近的线）

在函数 getJenksBreaks.

中，您必须设置的一个参数是行数（或者更确切地说是簇数）

可能还有其他方法可以对这些点进行聚类，但这里是 jenks

library(BAMMtools)
lines <- getJenksBreaks(mydata$y, 5)
lines
# [1]   0   0 360 506 883
mydata <- mydata %>% 
  rowwise() %>% 
  mutate(line_id = as.character(which.min(abs(y-unique(lines))))) 

mydata %>% 
  group_by(Group, line_id) %>% 
  summarise(cnt =n()) %>% 
  group_by(Group) %>% 
  summarise(max_points = max(cnt))
# 
# # A tibble: 3 x 2
#   Group max_points
#   <int>      <dbl>
# 1  7059          4
# 2 11553          3
# 3 22782         45

mydata %>% 
  #filter(Group == 22782) %>% 
  ggplot(aes(x,y, color = line_id)) + 
  geom_point() +
  geom_hline(yintercept = lines, 
             color = 'red', 
             #alpha = 0.5, 
             linetype ='dashed', 
             size = 0.3) +
  facet_grid(.~Group)

R：找出每组直线上有多少个点

R: Find out how many points lay on the straight line per group

algorithm

r

plane