R Как разбить столбец строк на несколько столбцов, используя код формата / строку? - PullRequest
2 голосов
/ 19 апреля 2019

Я работаю с данными переписи (CTPP), и поле GEOID представляет собой длинную строку, которая содержит много географической информации.Формат этой строки изменяется для различных таблиц переписи, но они обеспечивают поиск кода.Вот пример GEOID и формат «код».(Части, которые я уже могу разобрать, были удалены. Это часть GEOID, которую я не могу разобрать.)

geoid <- "0202000000126"
format <- "ssccczzzzzzzz"

Это означает, что первые два символа ("02") обозначают состояние (Аляска), следующие три ("020") - это округ, а остальные символы - зона.

У меня есть таблица этих пар геоид / формат, и формат может быть различным для каждой строки.

  • s: штат
  • c: округ
  • p: место
  • z: зона
  • (другие не используются вэтот простой пример)
df <- data.frame(
  geoid = c(
    "0224230",
    "0202000000126"
  ),
  format = c(
    "ssppppp",
    "ssccczzzzzzzz"
  )
)
# A tibble: 2 x 2
  geoid         format       
  <chr>         <chr>        
1 0224230       ssppppp      
2 0202000000126 ssccczzzzzzzz

Что я хотел бы сделать, это разбить столбец geoid на столбцы для каждой географии следующим образом:

# A tibble: 2 x 6
  geoid         format        s     p     c     z       
  <chr>         <chr>         <chr> <chr> <chr> <chr>   
1 0224230       ssppppp       02    24230 NA    NA      
2 0202000000126 ssccczzzzzzzz 02    NA    020   00000126

Я посмотрел на несколько подходов.extract() из stringr выглядело многообещающе.Я также почти уверен, что мне понадобится пользовательская функция, которую я сопоставлю (?) / Map с моим фреймом данных.

Ответы [ 3 ]

2 голосов
/ 21 апреля 2019

A base альтернатива:

geo_codes <- c("s", "c", "p", "z")

# get starting position and lengths of consecutive characters in 'format'
g <- gregexpr("(.)\\1+", df$format)

# use the result above to extract corresponding substrings from 'geoid' 
geo <- regmatches(df$geoid, g)

# select first element in each run of 'format' and split
# used to name substrings from above
fmt <- strsplit(gsub("(.)\\1+", "\\1", df$format), "")

# for each element in 'geo' and 'fmt',
# 1. create a named vector
# 2. index the vector with 'geo_codes' 
# 3. set names of the full length vector
t(mapply(function(geo, fmt){
  setNames(setNames(geo, fmt)[geo_codes], geo_codes)},
  geo, fmt))
#      s    c     p       z         
# [1,] "02" NA    "24230" NA        
# [2,] "02" "020" NA      "00000126"

Другая альтернатива,

geo <- strsplit(df$geoid, "")
fmt <- strsplit(df$format, "")

t(mapply(function(geo, fmt) unlist(lapply(split(geo, factor(fmt, levels = geo_codes)), function(x){
  if(length(x)) paste(x, collapse = "") else NA})), geo, fmt))

Моя первая альтернатива примерно в 2 раза быстрее, чем вторая, с оценкой 2e5 строк.

0 голосов
/ 24 апреля 2019

A Tidyverse Решение:

library(tidyverse)

create_new_code <- function(id, format, char) {
    format %>% 
        str_locate_all(paste0(char, "*", char)) %>% 
        unlist() %>% 
        {substr(id, .[1], .[2])}
}

create_new_codes <- function(id, format) {
    c("s", "p", "c", "z") %>% 
        set_names() %>% 
        map(create_new_code, id = id, format = format)
}

bind_cols(df, 
          with(df, map2_df(geoid, format, create_new_codes)))

#          geoid        format  s     p    c        z
#1       0224230       ssppppp 02 24230 <NA>     <NA>
#2 0202000000126 ssccczzzzzzzz 02  <NA>  020 00000126
0 голосов
/ 19 апреля 2019

Как это часто бывает, написание вопроса и минимального примера помогло мне упростить проблему и найти решение. Я уверен, что есть более причудливое решение, но это то, что я придумал, и легко (иш) разобраться.

Хотя форматы различаются, количество уникальных символов ограничено. В игрушечном примере в этой задаче только s, c, p, z. Итак, вот что я сделал:

Сначала я создал функцию, которая принимает одну строку формата, одну строку геоида и один символ / код субгео. Функция определяет, какие позиции символов в format соответствуют subgeo, а затем возвращает эти позиции из geoid.

extract_sub_geo <- function(format, geoid, subgeo) {
  geoid_v <- unlist(strsplit(geoid, ""))
  format_v <- unlist(strsplit(format, ""))
  positions <- which(format_v == subgeo)
  result <- paste(geoid_v[positions], collapse = "")
  return(result)
}

extract_sub_geo("ssccczzzzzzzz", "0202000000126", "s")
[1] "02"

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

geo_codes <- c("s", "c", "p", "z")

for (code in geo_codes) {
  df <- df %>%
    mutate(
      !!code := pmap_chr(list(format, remainder, !!(code)), extract_sub_geo)
    )
}
# A tibble: 2 x 6
  geoid         format        s     c     p     z       
  <chr>         <chr>         <chr> <chr> <chr> <chr>   
1 0224230       ssppppp       02    ""    02000 ""      
2 0202000000126 ssccczzzzzzzz 02    020   ""    00000126

Возможно, чище сделать цикл в базе R вместо dplyr.

...