Разбор иерархии в строковом значении

Question

Я пытаюсь создать список ребер из одного символьного вектора.Мой список, который должен быть обработан, содержит более 93 тыс. Элементов, но в качестве примера я приведу небольшую выдержку.

Строки chracter являются частью иерархии кода ICD10, и родительские дочерние отношения существуют внутри строки.Это означает, что одна строка «A0101» будет иметь родительский элемент «A010»

Это будет выглядеть так:

• A00
  • A000
  • A001
  • A009
• A01
  • A010
    • A0100
    • A0101
• A02
• A03
• и т. Д.

Мой вектор не содержит никаких других данных, кроме строкно мне нужно конвертировать

dat <- c("A00", "A000", "A001", "A009", "A01", "A010", "A0100", "A0101", "A02")

в список ребер, отформатированный следующим образом ...

# (A00, A000)
# (A00, A001)
# (A00, A009)
# (A01, A010)
# (A010, A0100)
# (A010, A0101)

Answer 1

Я вполне уверен, что есть более эффективные способы сделать это, но этот фрагмент кода должен загрузить данные CM ICD10 из пакета icd.data.Используйте систему обнаружения детей из пакета icd, а затем широко используйте тидиверс, чтобы вернуть список ребер.Мне нужно было проявить изобретательность, чтобы соединить «верх» иерархий, поскольку они не включают главы и подглавы данных ICD10 в виде отдельного 2-значного или 1-значного кода.

В основном подглавы становятся 2цифровые коды, главы становятся 1-значными кодами, а затем есть корневой узел для подключения всего наверху.

library(icd.data)
icd10 <- icd10cm2016

library(icd)
code_children <- lapply(icd10$code, children)

code_vec <- sapply(code_children, paste, collapse = ",")
code_df <- as.data.frame(code_vec, stringsAsFactors = F)

library(dplyr);library(stringr);library(tidyr)

code_df_new <- code_df %>% 
  mutate(parent = sapply(strsplit(code_vec,","), "[", 1)) %>%
  separate(code_vec, 
    paste("code", 1:max(str_count(code_df$code_vec, ",")), sep ="."),
    ",",extra = "merge")

library(reshape2)

edgelist <- melt(code_df_new, id = "parent") %>% 
  filter(!is.na(value)) %>%
  select(parent, child = value) %>%
  arrange(parent)

edgelist <- subset(edgelist, edgelist$parent != edgelist$child)
edgelist <- subset(edgelist, nchar(edgelist$child) == nchar(edgelist$parent) + 1)

subchaps <- icd10 %>% select(three_digit, sub_chapter, chapter) %>%
  mutate(two_digit = substr(three_digit, 1, 2)) %>%
  select(parent = two_digit, child = three_digit) %>%
  distinct()

chaps <- icd10 %>% select(three_digit, sub_chapter, chapter) %>%
  mutate(
    two_digit = substr(three_digit, 1, 2), 
    one_digit = substr(three_digit, 1, 1)) %>%
  select(parent = one_digit, child = two_digit) %>%
  distinct()

root <- icd10 %>% select(three_digit) %>%
  mutate(parent = "root", child = substr(three_digit, 1, 1)) %>%
  select(parent, child) %>%
  distinct()

edgelist_final <- edgelist %>%
  bind_rows(list(chaps, subchaps, root)) %>%
  arrange(parent)

Если у кого-нибудь есть какие-либо советы или методы для повышения эффективности этого кода, я весь слух,(глаз?)

Answer 2

Предполагая, что длина имен узлов в ICD10 полностью определяет порядок (более короткие из них являются родителями), вот подход, который связывает каждый узел с его непосредственным родителем, если он доступен.

Хотя я думаю, что логика здесь разборчива, мне было бы любопытно посмотреть, как будет выглядеть более рациональное решение.

# Some longer fake data to prove that it works acceptably
#   with 93k rows (took a few seconds). These are just
#   numbers of different lengths, converted to characters, but they 
#   should suffice if the assumption about length = order is correct.
set.seed(42)
fake <- runif(93000, 0, 500) %>% 
  magrittr::raise_to_power(3) %>% 
  as.integer() %>% 
  as.character()


# Step 1 - prep
library(dplyr); library(tidyr)
fake_2 <- fake %>%
  as_data_frame() %>%
  mutate(row = row_number()) %>%

  # Step 2 - widen by level and fill in all parent nodes
  mutate(level = str_length(value)) %>%
  spread(level, value) %>%
  fill(everything()) %>%

  # Step 3 - Get two highest non-NA nodes
  gather(level, code, -row) %>%
  arrange(row, level) %>%
  filter(!is.na(code)) %>%
  group_by(row) %>%
  top_n(2, wt = level) %>%

  # Step 4 - Spread once more to get pairs
  mutate(pos = row_number()) %>%
  ungroup() %>%
  select(-level) %>%
  spread(pos, code)

Вывод данных OP

# A tibble: 9 x 3
    row `1`   `2`  
  <int> <chr> <chr>
1     1 A00   NA   
2     2 A00   A000 
3     3 A00   A001 
4     4 A00   A009 
5     5 A01   A009 
6     6 A01   A010 
7     7 A010  A0100
8     8 A010  A0101
9     9 A010  A0101

Вывод на фальшивые данные 93k

> head(fake, 10)
 [1] "55174190" "50801321" "46771275" "6480673" 
 [5] "20447474" "879955"   "4365410"  "11434009"
 [9] "5002257"  "9200296" 

> head(fake_2, 10)
# A tibble: 10 x 3
     row `1`      `2`     
   <int> <chr>    <chr>   
 1     1 55174190 NA      
 2     2 50801321 NA      
 3     3 46771275 NA      
 4     4 6480673  46771275
 5     5 6480673  20447474
 6     6 6480673  20447474
 7     7 4365410  20447474
 8     8 4365410  11434009
 9     9 5002257  11434009
10    10 9200296  11434009