Question

由于Excel可以处理的数据量有限，我正在R中重建我的Excel模型。该模型的肉需要两列飞行数据（入站腿，出站腿），并通过将出站腿与入站腿匹配，将新出站腿放在原始线上并重复此过程直到有不再有出站航线的入站匹配。以下是此过程的工作VBA代码。

{
"key": "]",
"command": "editor.action.insertSnippet",
"when": "editorTextFocus",
"args": {
    "snippet": "]"
}
},
{
"key": "Shift+]",
"command": "editor.action.insertSnippet",
"when": "editorTextFocus",
"args": {
    "snippet": "}"
}
},
{
"key": "Shift+0",
"command": "editor.action.insertSnippet",
"when": "editorTextFocus",
"args": {
    "snippet": ")"
}
}

样本数据将是

输出

    For i = f To l
        If i Mod 100 = 0 Then Application.StatusBar = "Progress: Step 4 of 18 - Building lines for " & ref.Cells(a, 39) & " (" & (a - 3) & " A/C types of " & (g - 3) & "), Line " & i - f & " of " & l - f & ")"
        DoEvents

    y = 0
    b = 0

        x = .Cells(i, 2)

        y = Application.Match(.Cells(i, 2), LegTable, 0)
        j = FirstTurn(y, 1)
        If .Cells(i, 2) <> FirstTurn(y, 1) Then GoTo Nexti

        NextLeg = NextLeg + 1
        ReDim Preserve NextTurn(0, 1 To NextLeg)
        NextTurn(0, NextLeg) = FirstTurn(y, 2)

            Do
                FTtext = FirstTurn(y, 2)
                On Error GoTo errhdlr
                b = Application.Match(FTtext, LegTable, 1)
                If FTtext <> FirstTurn(b, 1) Then GoTo Nexti

                NextLeg = NextLeg + 1
                ReDim Preserve NextTurn(0, 1 To NextLeg)
                NextTurn(0, NextLeg) = FirstTurn(b, 2)
                y = b
            Loop

errhdlr:
    Resume Nexti
Nexti:

    If NextLeg > 0 Then Range(.Cells(i, 3), .Cells(i, NextLeg + 2)).Value = NextTurn
    Erase NextTurn
    NextLeg = 0

    Next i

在R中，我有以下代码

这一切都给了我原来的两列。谢谢你的帮助。

Answer 1

没有谈论效率，是的，你可以做一个递归加入，如：

DF <- data.frame(In = c(1,2,4,5), Out = c(4,3,5,2))

dplyr::left_join(DF, DF, by = c("Out" = "In"))

#   In Out Out.y
# 1  1   4     5
# 2  2   3    NA
# 3  4   5     2
# 4  5   2     3

依旧...... 如果你不喜欢NAs

，可能会重新塑造成一个列表

Answer 2

我喜欢您的问题的挑战，所以这是使用base R的不那么优雅的解决方案。你提到你正在处理大数据集，这将在较慢的解决方案中排名，但我会分享它，至少在其他解决方案到来之前：

lines_list <- split(df, df$In)
for (i in 1:length(lines_list)) {
  while (TRUE) {
    n <- length(lines_list[[i]])
    row <- which(lines_list[[i]][[n]] == df$In)
    if (any(row)) {
      lines_list[[i]][paste0("Out", n)] <- df$Out[row]
    } else {
      break
    }
  }
}
lines_list
$`1`
  In Out Out2 Out3 Out4
1  1   4    5    2    3

$`2`
  In Out
2  2   3

$`4`
  In Out Out2 Out3
3  4   5    2    3

$`5`
  In Out Out2
4  5   2    3

或者您可以将其带回data.frame，例如：

data.table::rbindlist(lines_list, fill = TRUE)  
   In Out Out2 Out3 Out4
1:  1   4    5    2    3
2:  2   3   NA   NA   NA
3:  4   5    2    3   NA
4:  5   2    3   NA   NA

Answer 3

因此，如果您正在使用非常大的数据，那么目标应该是尽量减少工作量。在你给出的例子中，实际上只有一条完整路径，其他一切只是该路径的一部分（从1开始）。我假设您的数据不包含任何循环（4 - ＆gt; 3 - ＆gt; 2 - > 4），因为这会破坏这一点。

首先，让我们找到所有独特的起点 - 这些是in中永远不会出现的out值。如果我假设的非循环条件为真，则至少应该有一个。我们还可以提取具有in

的所有其他out位置

b = data.frame(In = c(1,2,4,5), Out = c(4,3,5,2))

onlyStarting = b$In[!(b$In %in% b$Out)]
allOthers = b$In[b$In %in% b$Out]

现在我们想要一个可以获取起点路径的函数。我写了一个递归函数来做到这一点。它找到下一步并调用自己，直到没有更多步骤。

getNextStep = function(IN){
  nextStep = b$Out[b$In == IN]
  if(length(nextStep) == 0) return(IN)
  return(c(IN,getNextStep(nextStep)))
}
possiblePaths = lapply(onlyStarting,getNextStep)
#> [[1]]
#> [1] 1 4 5 2 3

我们得到了完整的道路。现在我们只需要找到所有的子路径。我们通过检查in存在的每个完整路径，然后返回我们需要的子路径部分来完成此操作。这避免了许多我们不需要打扰的昂贵的重新计算。

findMatch = function(IN,possiblePaths){
  fullPath = possiblePaths[[which(sapply(possiblePaths,`%in%`,x=IN))[1]]]
  partialPath = fullPath[which(fullPath == IN):length(fullPath)]
  return(partialPath)
}
otherPaths = lapply(allOthers,findMatch,possiblePaths)
otherPaths
#> [[1]]
#> [1] 2 3
#> 
#> [[2]]
#> [1] 4 5 2 3
#> 
#> [[3]]
#> [1] 5 2 3

Answer 4

感谢Mark，Roland和Snoram提出的建议。在尝试使这些工作时，我创建了一个适用于我的数据的解决方案。不确定它真正有多高效，但是它在不到6秒的时间内完成了128K行（最终总长度为248行），所以我不能抱怨（我的excel模型对于同一个数据集需要5分钟）。再次感谢您的帮助。这是我的代码：

## Build Lines of Flight
nr <- nrow(b.data)
c <- 2
c.df <- b.df
nlegname <- paste("leg", c, sep = "")
y <- match(leg2, leg1)

while(all(is.na(y)) == FALSE)
  {
y <- match(c.df[[c]], leg1)
d <- all(is.na(y))
nl <- b.df[y,"leg2"]
c.df <- add_column(c.df, nleg = nl)
c <-c+1
nlegname <- paste("leg", c, sep = "")
names(c.df)[names(c.df) == "nleg"] <- nlegname
}
c.df[[c]] <- NULL

R递归连接没有得到理想的结果

4 个答案: