在 lappy 函数中查找意外删除的原因答案

【问题标题】：Finding the cause of an unwanted deletion within an lappy function在 lappy 函数中查找意外删除的原因
【发布时间】：2019-12-16 11:13:28
【问题描述】：

我在 R 中上传了一个 .txt 文件，如下：Election_Parties <- readr::read_lines("Election_Parties.txt") 文件中包含以下文本：pastebin link。

文字大致如下（请使用实际文件解决！）：

BOLIVIA
P1-Nationalist Revolutionary Movement-Free Bolivia Movement (Movimiento 
Nacionalista Revolucionario [MNR])
P19-Liberty and Justice (Libertad y Justicia [LJ])
P20-Tupak Katari Revolutionary Movement (Movimiento Revolucionario Tupak Katari [MRTK])

COLOMBIA
P1-Democratic Aliance M-19 (Alianza Democratica M-19 [AD-M19])
P2-National Popular Alliance (Alianza Nacional Popular [ANAPO])
P3-Indigenous Authorities of Colombia (Autoridades Indígenas 
de Colombia)

我想在一条线上获得有关派对的所有信息，无论它有多长。

期望的输出：

BOLIVIA
P1-Nationalist Revolutionary Movement-Free Bolivia Movement (Movimiento Nacionalista Revolucionario 
P19-Liberty and Justice (Libertad y Justicia [LJ])
P20-Tupak Katari Revolutionary Movement (Movimiento Revolucionario Tupak Katari [MRTK])

COLOMBIA
P1-Democratic Aliance M-19 (Alianza Democratica M-19 [AD-M19])
P2-National Popular Alliance (Alianza Nacional Popular [ANAPO])
P3-Indigenous Authorities of Colombia (Autoridades Indígenas de Colombia)

我有一个几乎完全可以解决@JBGruber 的问题的解决方案，可以在here 找到：

lines <- readr::read_lines("https://pastebin.com/raw/jSrvTa7G")
head(lines)
entries <- split(lines, cumsum(grepl("^$|^ $", lines)))

library(stringr)
library(dplyr)
df <- lapply(entries, function(entry) {
  entry <- entry[!grepl("^$|^ $", entry)] # remove empty elements
  header <- entry[1] # first non empty is the header
  entry <- tail(entry, -1)  # remove header from entry
  desc <- str_extract(entry, "^P\\d+-")  # extract description

  for (l in which(is.na(desc))) { # collapse lines that go over 2 elements
    entry[l - 1] <- paste(entry[l - 1], entry[l], sep = " ")
  }

  entry <- entry[!is.na(desc)]
  desc <- desc[!is.na(desc)]

  # turn into nice format
  df <- tibble::tibble(
    header,
    desc,
    entry
  )
  df$entry <- str_replace_all(df$entry, fixed(df$desc), "") # remove description from entry
  return(df)
}) %>% 
  bind_rows() # turn list into one data.frame

但它以某种方式删除了信息。比如这个信息：

P1-Movement for a Prosperous Czechoslovakia (Hnutie za prosperujúce Česko + Slovensko
[HZPČS])
P2-Social Democracy (Sociálna demokracia [SD])
P3-Association for Workers in Slovakia (Združenie robotníkov Slovenska [ZRS])

我对代码的理解不够深入，无法了解删除可能发生的位置，或者如何逐步检查删除发生的位置（因为所有事情都发生在 lapply 内）。有人可以帮忙吗？

请注意，使用data.table 的解决方案同样受欢迎。

编辑：

【问题讨论】：

你认为它为什么会删除信息？您上面列出的三个都在data.frame 中。使用grep("Movement for a Prosperous Czechoslovakia", df$entry, value = TRUE) 等或在 RStudio Viewer 中进行测试。
您链接的文件似乎与原始问题中的不同。答案是基于条目由空行分隔的事实。在这个文件中没有任何空行。由于这个原因，解析会有些不同。
@JBGruber 抱歉，我现在已经修改了文件。我已经手动检查了，因为有些东西没有加起来。然后我注意到斯洛文尼亚的前 49 个派对不在那里。我会添加你的建议。
嗯，好的。我调整了答案以使用新结构。还要检查答案的最后一段。让我知道还有什么不清楚的地方。

标签： r dplyr data.table stringr readr

【解决方案1】：

答案不再正常工作的原因是文件略有更改。最初的答案是基于条目由空行分隔的事实。这些行不见了。但是条目现在由仅包含“P00-”的行分隔。我们可以使用它作为分隔符。

lines <- readr::read_lines("https://pastebin.com/raw/KKu9FmF6")

entries <- split(lines, cumsum(grepl("P00-$", lines)))

library(stringr)
library(dplyr)

df <- lapply(entries, function(entry) {
  entry <- entry[!grepl("P00-$", entry)] # remove empty elements
  header <- entry[1] # first non empty is the header
  entry <- tail(entry, -1)  # remove header from entry
  desc <- str_extract(entry, "^P\\d+-")  # extract description

  for (l in which(is.na(desc))) { # collapse lines that go over 2 elements
    entry[l - 1] <- paste(entry[l - 1], entry[l], sep = " ")
  }

  entry <- entry[!is.na(desc)]
  desc <- desc[!is.na(desc)]

  # turn into nice format
  df <- tibble::tibble(
    header,
    desc,
    entry
  )
  df$entry <- str_replace_all(df$entry, fixed(df$desc), "") # remove description from entry
  return(df)
}) %>% 
  bind_rows() # turn list into one data.frame

我检查了您上面列出的信息是否仍然丢失，但事实并非如此：

df %>% 
  filter(str_detect(entry, "Movement for a Prosperous Czechoslovakia|Sociálna demokraci|Association for Workers in Slovakia"))
#> # A tibble: 3 x 3
#>   header      desc  entry                                                       
#>   <chr>       <chr> <chr>                                                       
#> 1 P00-SLOVAK… P1-   Movement for a Prosperous Czechoslovakia (Hnutie za prosper…
#> 2 P00-SLOVAK… P2-   Social Democracy (Sociálna demokracia [SD])                 
#> 3 P00-SLOVAK… P3-   Association for Workers in Slovakia (Združenie robotníkov S…

^{由reprex package (v0.3.0) 于 2019 年 12 月 16 日创建}

我试图让答案尽可能清楚，但我知道通常很难将你的头脑围绕在其他人的代码上。总是对我有帮助的一件事是逐行运行解决方案并检查对象如何变化。由于大多数重要的东西都隐藏在循环中，您可以通过创建如下示例条目来模拟lapply 的运行：entry <- entries[[1]]。现在您可以在lapply 中添加行了。

【讨论】：

感谢您的帮助。我能帮个忙吗？出于某种奇怪的原因，在第一次正常工作后，问题又回来了（见编辑）。是否可以将解决方案的pastebin链接放入？

【解决方案2】：

@JBGruber 答案的纯基础 R 替代方案：

txt <- readLines("https://pastebin.com/raw/KKu9FmF6")

txtgrps <- split(txt, cumsum(grepl("P00-$", txt)))

l <- lapply(txtgrps, function(grp) {
  grp <- tail(grp, -1)
  country <- gsub("^P\\d+-", "", grp[1])
  grp <- tail(grp, -1)
  grp <- tapply(grp, cumsum(grepl("^P\\d+-", grp)), paste, collapse = " ")
  code <- sub("(P\\d+)-.*", "\\1", grp)
  party <- gsub("^P\\d+-", "", grp)
  df <- data.frame(country, code, party)
  return(df)
})

df <- do.call(rbind, l)

给出：

> head(df)
    country code                                                                                                                                                   party
1.1 ALBANIA   P1                                                                                             Democratic Alliance Party (Partia Aleanca Democratike [AD])
1.2 ALBANIA   P2                                                                                                    National Unity Party (Partia Uniteti Kombëtar [PUK])
1.3 ALBANIA   P3                                       Social Spectrum Parties-Party of National Unity (Partitë e Spektrit Social-Partia e Unitetit Kombëtar [PSHS-PUK])
1.4 ALBANIA   P4                                                          Alliance Party for Solidarity and Welfare (Partia Aleanca për Mirëqenie dhe Solidaritet [AMS])
1.5 ALBANIA   P5 Albanian Democratic Union-Alliance for Freedom, Justice and Welfare (Partia Bashkimi Demokrat Shqiptar-Aleanca për Liri, Drejtësi dhe Mirëqenie [BDSH])
1.6 ALBANIA   P6                                                                                         Liberal Democrat Party (Partia Bashkimi Liberal Demokrat [BLD])

对于新输入，您可以将解决方案调整为：

txt <- readLines("https://pastebin.com/raw/FTV3Gded")

txtgrps <- split(txt, cumsum(grepl("^$|^ $", txt)))
# based on: https://stackoverflow.com/a/59006739/2204410

l <- lapply(txtgrps, function(grp) {
  grp <- tail(grp, -1)
  country <- grp[1]
  grp <- tail(grp, -1)
  grp <- tapply(grp, cumsum(grepl("^P\\d+", grp)), paste, collapse = " ")
  code <- sub("(P\\d+).*", "\\1", grp)
  party <- substring(sub("^P\\d+", "", grp), 2)
  df <- data.frame(country, code, party)
  return(df)
})

df <- do.call(rbind, l)

【讨论】：

嗨，Jaap，我能帮个忙吗？出于某种奇怪的原因，在第一次正常工作后，问题又回来了（见编辑）。是否可以将解决方案的pastebin链接放入？
谢谢 Jaap，但您的代码在第一个实例中运行良好（我有两个文件可用，所以我可以使用其中一个）。我认为我更有可能遇到某种编码问题（如果我应用你的最后一种方法，几乎所有各方都来自百慕大）。我认为任何代码或文件都没有问题，但可能是我的计算机，这就是我要求使用 pastebin 的原因。
@Tom 检查输出 df 后，我发现我有同样的问题：-/
有效！从心底里感谢你。我以为我要疯了..
@Tom 对于未来：如果您怀疑自己有编码问题，charToRaw-function 可能会有所帮助。使用slov <- tail(txtgrps[[46]], -2); s <- sapply(substr(slov, 1, 4), charToRaw); s[which(names(s) == "P33-") + (-3:0)] 我可以看到- 在P33- 之前的编码不同（这是您屏幕截图中斯洛文尼亚的第一个正确编码）。