Bedankt voor de documentmentatie!
Давайте сначала уберем этот большой кусочек кода (прокрутите его, чтобы найти некоторые комментарии и заметки в формате списка):
# 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 МБ:
ns_tbl <- parse_iff_timetable("~/data/ns-latest/timetbls.dat")
это занимает ~ 3 м (быстрые посимвольные операции не являются сильными сторонами R), и есть одна предупреждающая заметка об одной записи, имеющей разные платформы прибытия / отправления.Rcpp-версия этого, вероятно, будет намного быстрее.Поскольку порядок на самом деле не имеет значения, пакеты furrr или pbapply могут также сократить время до <1 м с небольшим изменением кода. </p>
Основная идиома - переход на строкупострочно для каждой «записи» и создайте структуру большого вложенного списка (это не «плоские» данные на любом отрезке воображения).
Давайте пройдемся по одной записи (первой):
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 на верхнем уровне - это просто метаданные для количества остановок, но я оставлю их лучше.на ваше усмотрение.
В идеале можно было бы проанализировать файлы метаданных меньшего размера и использовать расширенные версии различных сокращенных имен.