代码之家  ›  专栏  ›  技术社区  ›  agenis

按组计算所有点对的x和y差异,保留初始列

  •  1
  • agenis  · 技术社区  · 6 年前

    我有一个data.frame,其中包含如下坐标和组信息:

    set.seed(1)
    df = data.frame(x=round(runif(6,1,100)), y=round(runif(6,100,200)), group=c("A", "A", "B", "B", "B", "A"))
    

    我想创建一个“differences”data.frame,从2个点的所有组合中,计算第一列中x坐标的差异,第二列中y坐标的差异。我想出了一个绝对没有效率的代码imo:

    comp.diff = function(H, data) {(data[H[1], 1:2]- data[H[2], 1:2])}
    comb = df %>% nrow %>% combn(2) %>% {cbind(., .[2:1, ])} # make all combinations in both ways
    apply(comb, 2, comp.diff, data = df) %>% do.call('rbind.data.frame', .)
    

    但我不能再做到两件事:

    • 我只想计算(或保持)从 同组
    • 对于输出矩阵中的每一行,我想保留有关初始x、初始y和相关组id的信息

    我怎么能在一个 有效途径 (很明显,与N…的组合数量增长很快。) 谢谢

    预期产出结构(摘录):

    ####   delta.x delta.y old.x old.y group
    #### 1     -11      28    27   166     A
    #### 5     -63      76    27   118     A
    #### ...
    
    1 回复  |  直到 6 年前
        1
  •  2
  •   Roman    6 年前

    你可以试试

    library(tidyverse)
    # calculate the combinations per group
    combs <- df %>% 
      split(.$group) %>% 
      map(~combn(1:nrow(.),2)) 
    
    # the calcualtion
    df %>% 
      mutate(index=1:n()) %>% 
      split(.$group) %>% 
      map2(combs, ., ~data.frame(t(apply(.x, 2, function(i) 
        cbind(paste(.y$index[i], collapse = "-"),
              .y$x[i[1]],.y$x[i[2]],.y$y[i[1]],.y$y[i[2]],
              -diff(.y$x[i]), -diff(.y$y[i])))),stringsAsFactors = F)) %>% 
      bind_rows(.id = "group") %>% 
      dplyr::select(1, index_diff=2, 
                    x1_old=3, x2_old=4,
                    y1_old=5, y2_old=6,
                    diff_x=7,diff_y=8)
    

    编辑

    并在一个管道中组合,包括转换为整数

    df %>% 
      mutate(index=1:n()) %>% 
      split(.$group) %>% 
      map(~data.frame(t(apply(combn(1:nrow(.),2), 2, function(i) 
        cbind(paste(.$index[i], collapse = "-"),
              .$x[i[1]],.$x[i[2]],.$y[i[1]],.$y[i[2]],
              -diff(.$x[i]), -diff(.$y[i])))),stringsAsFactors = F)) %>% 
      bind_rows(.id = "group") %>% 
      dplyr::select(1, index_diff=2, 
                    x1_old=3, x2_old=4,
                    y1_old=5, y2_old=6,
                    diff_x=7,diff_y=8) %>% 
      mutate_at(vars(x1_old:diff_y), as.numeric) %>% 
      as.tibble()
    # A tibble: 6 x 8
      group index_diff x1_old x2_old y1_old y2_old diff_x diff_y
      <chr> <chr>       <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
    1 A     1-2            27     38    194    166    -11     28
    2 A     1-6            27     90    194    118    -63     76
    3 A     2-6            38     90    166    118    -52     48
    4 B     3-4            58     91    163    106    -33     57
    5 B     3-5            58     21    163    121     37     42
    6 B     4-5            91     21    106    121     70    -15