Question

我有一个数字对的两列数据框：

ODD <- c(1,1,1,3,3,3,5,7,7,9,9)
EVEN <- c(10,8,2,2,6,4,2,6,8,4,8)

dfPairs <- data.frame(ODD, EVEN)

> dfPairs
   ODD EVEN
1    1   10
2    1    8
3    1    2
4    3    2
5    3    6
6    3    4
7    5    2
8    7    6
9    7    8
10   9    4
11   9    8

这个数据帧的每一行都是一对数字，我想找到最长的数值增加对的组合。从概念上讲，这类似于建立数字对的链节;附加条件1）链接只能使用相同的数字形成2）最终链必须在数字上增加。在视觉上，我正在寻找的程序将实现这一目标：

例如，第三行是对（1,2），它从左到右增加。链中的下一个链接需要在EVEN列中有一个2并从右到左增加，例如第四行（3,2）。然后模式重复，所以下一个链接需要在ODD列中有一个3，并从左到右增加，例如行5或6.链不必从1开始，或者从9结束 - 这只是一个方便的例子。

如果您尝试制作所有可能的链接对，您会发现许多不同长度的独特链都是可能的。我想找到最长的链条。在我的真实数据中，我可能会遇到一种情况，其中不止一个链条最长，在这种情况下我希望所有这些都返回。

最终结果应该返回满足这些要求的最长链作为数据帧，或者如果可能有多个解决方案，则返回数据帧列表，仅包含链中的行。

提前致谢。整个上午这个让我很困惑。

Answer 1

编辑处理不是从1开始并返回最大链而不是链长的df

使用igraph

利用图表数据结构

您的数据dfPairs

ODD <- c(1,1,1,3,3,3,5,7,7,9,9)
EVEN <- c(10,8,2,2,6,4,2,6,8,4,8)
dfPairs <- data.frame(ODD, EVEN)

新数据dfTest

ODD <- c(3,3,3,5,7,7,9,9)
EVEN <- c(2,6,4,2,6,8,4,8)
dfTest <- data.frame(ODD, EVEN)

制作数据图表。我的解决方案的关键是rbind数据帧的反向（rev(dfPairs)）到原始数据帧。这将允许构建从奇数到偶数的方向边。图可以非常容易地用于构建有向路径。

library(igraph)
library(dplyr)
GPairs <- graph_from_data_frame(dplyr::arrange(rbind(setNames(dfPairs, c("X1", "X2")), setNames(rev(dfPairs), c("X1", "X2"))), X1))
GTest <- graph_from_data_frame(dplyr::arrange(rbind(setNames(dfTest, c("X1", "X2")), setNames(rev(dfTest), c("X1", "X2"))), X1))

这里是all_simple_paths(GPairs, 1)的前三个元素（从1开始）

[[1]]
+ 2/10 vertices, named, from f8e4f01:
[1] 1 2

[[2]]
+ 3/10 vertices, named, from f8e4f01:
[1] 1 2 3

[[3]]
+ 4/10 vertices, named, from f8e4f01:
[1] 1 2 3 4

我创建了一个函数，1）将所有简单路径转换为数字向量列表，2）仅对满足left-＆gt; right增加的元素过滤每个数字向量，3）返回left-＆gt;的最大链。正确增加数值向量

max_chain_only_increasing <- function(gpath) {
                            list_vec <- lapply(gpath, function(v) as.numeric(names(unclass(v))))    # convert to list of numeric vector
                            only_increasing <- lapply(list_vec, function(v) v[1:min(which(v >= dplyr::lead(v, default=tail(v, 1))))])   # subset vector for only elements that are left->right increasing
                            return(unique(only_increasing[lengths(only_increasing) == max(lengths(only_increasing))]))                     # return maximum chain length
                        }

这是使用从1

开始的所有路径的上述函数的输出

max_chain_only_increasing(all_simple_paths(GPairs, 1))
# [[1]]
# [1] 1 2 3 6 7 8 9

现在，我将从dfPairs中的每个唯一元素开始输出（标题）最大链，您的原始数据

start_vals <- sort(unique(unlist(dfPairs)))
# [1]  1  2  3  4  5  6  7  8  9 10
max_chains <- sapply(seq_len(length(start_vals)), function(i) max_chain_only_increasing(all_simple_paths(GPairs, i)))
names(max_chains) <- start_vals
# $`1`
# [1] 1 2 3 6 7 8 9

# $`2`
# [1] 2 3 6 7 8 9

# $`3`
# [1] 3 6 7 8 9

# $`4`
# [1] 4 9

# $`5`
# [1] 5
# etc

最后使用dfTest，更新的数据

start_vals <- sort(unique(unlist(dfTest)))
max_chains <- sapply(seq_len(length(start_vals)), function(i) max_chain_only_increasing(all_simple_paths(GTest, i)))
names(max_chains) <- start_vals
# $`2`
# [1] 2 3 6 7 8 9

# $`3`
# [1] 3 6 7 8 9

# $`4`
# [1] 4 9

# $`5`
# [1] 5

# $`6`
# [1] 6 7 8 9

Answer 2

尽管有Cpak的努力，我最终还是编写了自己的功能来解决这个问题。从本质上讲，我意识到我可以通过使用Cpak答案的这部分代码从左到右创建左链接的权利：

output <- arrange(rbind(setNames(dfPairs, c("X1", "X2")), setNames(rev(dfPairs), c("X1", "X2")))`, X1)

为了确保结果链是连续的，我删除了所有递减链接：

output$increase <- with(output, ifelse(X2>X1, "Greater", "Less"))
output <- filter(output, increase == "Greater")
output <- select(output, -increase)

我意识到如果我将数据帧输出分割为X1中的唯一值，我可以通过将第一个数据帧的最后一列连接到下一个数据帧的第一列来顺序连接每个数据帧，这将按顺序创建行增加链条。我需要解决的唯一问题是在mered数据帧的最后一列中的NAs问题。因此，最终在每次合并后拆分连接的数据帧，然后移动数据帧以移除NA，并将结果重新绑定在一起。

这是实际代码：

out_split <- split(output, output$X1)
df_final <-  Reduce(join_shift, out_split)

函数join_shift就是：

join_shift <- function(dtf1,dtf2){
  abcd <- full_join(dtf1, dtf2, setNames(colnames(dtf2)[1], colnames(dtf1)[ncol(dtf1)]))
  abcd[is.na(abcd)]<-0
  colnames(abcd)[ncol(abcd)] <- "end"
  # print(abcd)
  abcd_na <- filter(abcd, end==0)
  # print(abcd_na)
  abcd <- filter(abcd, end != 0)
  abcd_na <- abcd_na[moveme(names(abcd_na), "end first")]
  # print(abcd_na)

  names(abcd_na) <- names(abcd)
  abcd<- rbind(abcd, abcd_na)
  z <- length(colnames(abcd))
  colnames(abcd)<- c(paste0("X", 1:z))
  # print(abcd)
  return(abcd)

}

最后，我发现有很多列只有零，所以我写这个删除它们并修剪最终的数据帧：

df_final_trim = df_final[,colSums(df_final) > 0]

总体而言，我很高兴。我想它可能会更优雅，但它适用于任何东西，它适用于一些相当庞大，复杂的数据。这将从700对数据集中产生~247,700个解决方案。

我还使用了stackoverflow上的moveme函数（见下文）。我用它来移动NA值来实现join_shift函数的移位方面。

moveme <- function (invec, movecommand) {
  movecommand <- lapply(strsplit(strsplit(movecommand, ";")[[1]], 
                                 ",|\\s+"), function(x) x[x != ""])
  movelist <- lapply(movecommand, function(x) {
    Where <- x[which(x %in% c("before", "after", "first", 
                              "last")):length(x)]
    ToMove <- setdiff(x, Where)
    list(ToMove, Where)
  })
  myVec <- invec
  for (i in seq_along(movelist)) {
    temp <- setdiff(myVec, movelist[[i]][[1]])
    A <- movelist[[i]][[2]][1]
    if (A %in% c("before", "after")) {
      ba <- movelist[[i]][[2]][2]
      if (A == "before") {
        after <- match(ba, temp) - 1
      }
      else if (A == "after") {
        after <- match(ba, temp)
      }
    }
    else if (A == "first") {
      after <- 0
    }
    else if (A == "last") {
      after <- length(myVec)
    }
    myVec <- append(temp, values = movelist[[i]][[1]], after = after)
  }
  myVec
}

r - 找到数值增加的数字对的最大长度“链”

2 个答案: