У меня есть данные в таком формате:

X    Raw data
1     %100,02231,      ,001,013, -00007,000,999 &IC  ,001,013 >vs     ,0652 ?2    ,2    ,00007 .vss    ,0655 ?2    ,2    ,00007 .mdb    ,0700 ?2    ,2    ,00007 .arn    ,0704 ?1    ,1
2     %100,02231,      ,001,023, -00008,000,999 &IC  ,001,023 >vs     ,0652 ?3    ,3    ,00008 .vss    ,0655 ?2    ,2    ,00008 .mdb    ,0700 ?2    ,2    ,00008 .arn    ,0704 ?1    ,1    ,00008 +gs     ,0713,0714 ?2    ,2    ,00008 .bzl    ,0719 ?2    ,2    ,00008 .krg    ,0724 ?1    ,1

И т.п.

Я хочу преобразовать эти необработанные данные в красивую форму таблицы. Я знаю, как разделять определенные вещи, используя отдельную функцию tidyr, например:

DFx <- separate(DF, Raw.data, into="Starting station", sep=">", extra="warn", fill = "right")

>, например, указывает начальную станцию. & укажет тип поезда. В приведенном выше примере он отделяет начальную станцию ​​от остальных. Я ищу лучший способ поместить этот большой набор данных (отобранный только часть строк) в красивую таблицу. Я не боюсь ручного труда, а просто ищу любые указатели, которые могут направить меня в правильном направлении. Спасибо.

Файл timetbls.dat, который я использую, можно загрузить с: здесь

Документ о формате данных (к сожалению, на голландском языке, но, возможно, это может помочь некоторым, потому что вы все еще можете видеть структуру данных), см. Страницы 9 / 28-11 / 28: здесь

0
Kevin 14 Окт 2018 в 19:01

1 ответ

Лучший ответ

Bedankt voor de documentatie!

Давайте сначала уберем этот большой фрагмент кода (прокрутите его, чтобы увидеть комментарии и примечания к формату списка):

# Reference: Section 5 of IFF Standaard
parse_iff_timetable <- function(path) {

  suppressPackageStartupMessages({
    require("stringi", quietly = TRUE, warn.conflicts = FALSE)
    require("tidyverse", quietly = TRUE, warn.conflicts = FALSE)
  })

  lines <- stri_read_lines(path.expand(path)) # read in all the lines

  starts <- which(grepl("^#", lines)) # find all the records
  ends <- c(starts[-1], length(lines))

  pb <- progress_estimated(length(starts)) # this took 3m on my system so progress bars might be handy

  map2(starts, ends, ~{

    pb$tick()$print()

    rec_num <- ""
    rec <- list(service = list(), stop = list())
    index <- 0

    for (l in lines[.x:.y]) { # iterate over the record

      if (stri_sub(l, 1, 1) == "#") { # (ritnummer)

        stri_sub(l, 1, 1) <- ""
        rec_num <-  l

      } else if (stri_sub(l, 1, 1) == "%") { # (vervoerder)

        stri_sub(l, 1, 1) <- ""
        tmp <- stri_trim_both(stri_split_fixed(l, ",")[[1]])
        set_names(
          tmp, c("company_number", "service_number", "variant", "first_stop",
                 "last_stop", "service_name")
        ) -> tmp

        rec$service <- append(rec$service, list(as.list(tmp)))

      } else if (stri_sub(l, 1, 1) == "-") { # (voetnoot)

        stri_sub(l, 1, 1) <- ""
        tmp <- stri_trim_both(stri_split_fixed(l, ",")[[1]])
        tmp <- set_names(tmp, c("footnote", "first_stop", "last_stop"))
        tmp <- as.list(tmp)

        rec$validity <- tmp

      } else if (stri_sub(l, 1, 1) == "&") { # (vervoerssort)

        stri_sub(l, 1, 1) <- ""
        tmp <- stri_trim_both(stri_split_fixed(l, ",")[[1]])
        tmp <- set_names(tmp, c("mode", "first_stop", "last_stop"))
        tmp <- as.list(tmp)

        rec$transport <- tmp

      } else if (stri_sub(l, 1, 1) == "*") { # (attribuut)

        stri_sub(l, 1, 1) <- ""
        tmp <- stri_trim_both(stri_split_fixed(l, ",")[[1]])
        tmp <- set_names(tmp, c("code", "first_stop", "last_stop", "unknown"))
        tmp <- as.list(tmp)

        rec$attribute <- tmp

      } else if (stri_sub(l, 1, 1) == ">") { # (begin van de rit)

        index <- index + 1

        stri_sub(l, 1, 1) <- ""
        tmp <- stri_trim_both(stri_split_fixed(l, ",")[[1]])
        tmp <- set_names(tmp, c("station_short", "departure_time"))
        tmp <- as.list(tmp)
        tmp$index <- index
        tmp$arrival_time <- NA_character_

        rec$stop <- list(tmp)

      } else if (stri_sub(l, 1, 1) == ".") { # (korte stop)

        index <- index + 1

        stri_sub(l, 1, 1) <- ""
        tmp <- stri_trim_both(stri_split_fixed(l, ",")[[1]])
        tmp <- set_names(tmp, c("station_short", "departure_time"))
        tmp <- as.list(tmp)
        tmp$index <- index
        tmp$arrival_time <- tmp$departure_time

        rec$stop <- append(rec$stop, list(tmp))

      } else if (stri_sub(l, 1, 1) == ";") { # (passeer station)

        index <- index + 1

        stri_sub(l, 1, 1) <- ""
        tmp <- stri_trim_both(stri_split_fixed(l, ",")[[1]])
        tmp <- set_names(tmp, c("station_short"))
        tmp <- as.list(tmp)
        tmp$index <- index
        tmp$arrival_time <- NA_character_
        tmp$departure_time <- NA_character_

        rec$stop <- append(rec$stop, list(tmp))

      } else if (stri_sub(l, 1, 1) == "+") { # (a/v stop)

        index <- index + 1

        stri_sub(l, 1, 1) <- ""
        tmp <- stri_trim_both(stri_split_fixed(l, ",")[[1]])
        tmp <- set_names(tmp, c("station_short", "arrival_time", "departure_time"))
        tmp <- as.list(tmp)
        tmp$index <- index

        rec$stop <- append(rec$stop, list(tmp))

      } else if (stri_sub(l, 1, 1) == "?") { # (spoor)

        stri_sub(l, 1, 1) <- ""
        tmp <- stri_trim_both(stri_split_fixed(l, ",")[[1]])
        tmp <- set_names(tmp, c("arrival_platform", "departure_platform", "footnote"))
        tmp <- as.list(tmp)
        tmp$index <- index

        if (stri_sub(tmp$arrival_platform, 1,1) != stri_sub(tmp$departure_platform, 1,1)) {
          message(
            sprintf(
              "\nNOTE: Difference in arrival/departure platforms: %s/%s (Record: #%s)",
              tmp$arrival_platform, tmp$departure_platform, rec_num
            )
          )
        }

        rec$platform <- tmp

      } else if (stri_sub(l, 1, 1) == "<") { # (eind van de rit)

        index <- index + 1

        stri_sub(l, 1, 1) <- ""
        tmp <- stri_trim_both(stri_split_fixed(l, ",")[[1]])
        tmp <- set_names(tmp, c("station_short", "arrival_time"))
        tmp <- as.list(tmp)
        tmp$index <- index
        tmp$departure_time <- NA_character_

        rec$stop <- append(rec$stop, list(tmp))

      }

    }

    rec

  })

}

Я использую stringi в ^^, поскольку высока вероятность того, что этот стандарт будет использоваться во многих регионах, и stringi должен позаботиться о нормализации кодирования за нас.

Если я запустил это в 13-мегабайтном файле dat:

ns_tbl <- parse_iff_timetable("~/data/ns-latest/timetbls.dat")

Это занимает ~ 3 м (быстрые посимвольные операции не является одной из сильных сторон R), и есть одно предупреждение о том, что одна запись имеет разные платформы прибытия / отправления. Rcpp-версия этого, вероятно, будет намного быстрее. Поскольку порядок на самом деле не имеет значения, пакеты furrr или pbapply также могут сократить время до <1 мин с помощью лишь незначительного изменения кода.

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

Пройдемся по одной записи (первой):

str(ns_tbl[1], 2)
## List of 1
##  $ :List of 5
##   ..$ service  :List of 2
##   ..$ stop     :List of 34
##   ..$ validity :List of 3
##   ..$ transport:List of 3
##   ..$ platform :List of 4

Элемент stop довольно большой, так что давайте сначала посмотрим на другие:

str(ns_tbl[[1]][-2], 3)
## List of 4
##  $ service  :List of 2
##   ..$ :List of 6
##   .. ..$ company_number: chr "100"
##   .. ..$ service_number: chr "11410"
##   .. ..$ variant       : chr ""
##   .. ..$ first_stop    : chr "001"
##   .. ..$ last_stop     : chr "002"
##   .. ..$ service_name  : chr "Nachtnettrein"
##   ..$ :List of 6
##   .. ..$ company_number: chr "100"
##   .. ..$ service_number: chr "01412"
##   .. ..$ variant       : chr ""
##   .. ..$ first_stop    : chr "002"
##   .. ..$ last_stop     : chr "008"
##   .. ..$ service_name  : chr "Nachtnettrein"
##  $ validity :List of 3
##   ..$ footnote  : chr "00002"
##   ..$ first_stop: chr "000"
##   ..$ last_stop : chr "999"
##  $ transport:List of 3
##   ..$ mode      : chr "IC"
##   ..$ first_stop: chr "001"
##   ..$ last_stop : chr "008"
##  $ platform :List of 4
##   ..$ arrival_platform  : chr "5"
##   ..$ departure_platform: chr "5"
##   ..$ footnote          : chr "00002"
##   ..$ index             : num 34

И мы можем посмотреть на первую остановку, вторую остановку (без прибытия / назначения, поэтому я предполагаю, что это не остановки), одну остановку с прибытием / отъездом и последнюю остановку:

str(ns_tbl[[1]]$stop[c(1, 2, 6, 34)], 2)
## List of 4
##  $ :List of 4
##   ..$ station_short : chr "rtd"
##   ..$ departure_time: chr "2532"
##   ..$ index         : num 1
##   ..$ arrival_time  : chr NA
##  $ :List of 4
##   ..$ station_short : chr "rtn"
##   ..$ index         : num 2
##   ..$ arrival_time  : chr NA
##   ..$ departure_time: chr NA
##  $ :List of 4
##   ..$ station_short : chr "gd"
##   ..$ arrival_time  : chr "2550"
##   ..$ departure_time: chr "2557"
##   ..$ index         : num 6
##  $ :List of 4
##   ..$ station_short : chr "ut"
##   ..$ arrival_time  : chr "2751"
##   ..$ index         : num 34
##   ..$ departure_time: chr NA

Я с радостью дополню это, добавив больше информации на основе комментариев.

Вы можете использовать стандартные идиомы R для превращения частей или всего этого во фрейм данных:

map_df(ns_tbl, ~{
  as.list(c(
    unlist(.x$validity),
    unlist(.x$transport),
    unlist(.x$platform)
  )) -> out
  out$service <- list(.x$service)
  out$stop <- list(.x$stop)
  out
}) %>% 
  glimpse()
## Observations: 40,901
## Variables: 9
## $ footnote           <chr> "00002", "00003", "00004", "00005", ...
## $ first_stop         <chr> "001", "001", "001", "001", "001", "...
## $ last_stop          <chr> "008", "008", "007", "007", "007", "...
## $ mode               <chr> "IC", "IC", "IC", "IC", "IC", "IC", ...
## $ arrival_platform   <chr> "5", "5", "5", "5", "5", "5", "5", "...
## $ departure_platform <chr> "5", "5", "5", "5", "5", "5", "5", "...
## $ index              <chr> "34", "34", "34", "34", "34", "34", ...
## $ service            <list> [[["100", "11410", "", "001", "002"...
## $ stop               <list> [[["rtd", "2532", 1, NA], ["rtn", 2...

Вам все еще нужно иметь дело с отключением битов с несколькими записями.

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

В идеале следует анализировать файлы метаданных меньшего размера и использовать расширенные версии различных сокращенных имен.

2
hrbrmstr 14 Окт 2018 в 18:40