estmap/R/gtfs.R

#' GTFS - maanteeameti ühistranspordi andmed
#'
#' General Transit Feed Specification (GTFS). Source: \url{http://peatus.ee/gtfs/}. Ühistranspordiregistri avaandmed sisaldavad lihtsustatud struktuuri andmekoosseisuga väljavõtet Riiklikku Ühistranspordiregistrisse kantud andmetest, mis hõlmavad siseriiklikult käigus olevate ühistranspordiliinide kirjeldusi, sõidugraafikuid ja peatuste asukohtasid.  \url{https://www.mnt.ee/et/uhistransport/uhistranspordi-infosusteem} Funktsioon impordib gtfs andmestiku importimine andmebaasi.
#'
#' Ühistranspordiregistri avaandmete andmefailid:
#' - agency.txt
#' - calendar.txt
#' - calendar_dates.txt
#' - feed_info.txt
#' - routes.txt
#' - stop_times.txt
#' - stops.txt
#' - trips.txt
#' @importFrom magrittr %>%
#' @importFrom rlang .data
#' @param conf A list() of configuration variables. Default values \code{\link[ruut]{get_config}}.
#' @return No output.
#' @seealso [ruut::get_config()], [ruut::copy_shp_to_db()]
#' @keywords postgis, maps, ESRI Shpfile, OSM
#' @export
#' @examples
#' \dontrun{
#'
#' conf <- ruut::get_config()
#' gtfs(conf = conf)
#' }
gtfs <- function(conf = NULL) {
  ans <- utils::askYesNo("Do you want to import gtfs data into database?", default = F)
  if (!ans | is.na(ans)) {
    cat("\n------------------------\n")
    cat("Kaardikihte ei lisatud.")
    cat("\n------------------------\n")
    return()
  }
  if (ans) {
    # Temp directory
    tmp_dir <- sprintf("%s/tmp/%s", system.file(package = "estmap"), "gtfs")
    if (!dir.exists(tmp_dir)) {
      dir.create(tmp_dir)
    }
    cat("\n------------------------\n")
    cat(sprintf("Failide salvestamise kataloog: %s", tmp_dir))
    cat("\n------------------------\n")
    # Download link
    url <- "http://www.peatus.ee/gtfs/"
    # Estonia shapefile (ZIP archive)
    map_shapefile <- "gtfs.zip"
    # Download and save
    url_download <- sprintf("%s%s", url, map_shapefile)
    saveTo <- sprintf("%s/%s", tmp_dir, map_shapefile)
    if (!file.exists(saveTo)) {
      utils::download.file(
        url = url_download,
        destfile = saveTo, method = "curl", extra = "-L"
      )
    }
    # Unzip
    utils::unzip(saveTo, overwrite = T, exdir = tmp_dir)
    # List of files
    ls <- list.files(path = tmp_dir, pattern = ".txt")
    ls_long <- list.files(path = tmp_dir, pattern = ".txt", full.names = T)
    tbl_names <- tools::file_path_sans_ext(list.files(path = tmp_dir, pattern = "*.txt"))
    # Export to postgis
    if (is.null(conf)) {
      conf <- ruut::get_config()
      conf$schema <- "gtfs"
      conf$table <- ""
    }
    # Multi layer: paneme kõik csv failid üheks failiks.
    if (file.exists(saveTo)) {
      ## Export to postgis database.
      # New schema
      ruut::db_create_new_schema(conf = conf)
      # Postgresql string
      pg <- ruut::construct_ogr2ogr_PG_connect_str()
      # Connect to db
      conn <- ruut::db_connect()

      # ---------- Copy CSV!!! data to database ----------
      for (i in 1:length(tbl_names)) {
        # Tabeli nimi
        conf$table <- tbl_names[i]
        # ogr2ogr oskab csv faili lugeda juhul kui laiend on csv. Muudame.
        system(sprintf("mv %s %s/%s.csv", ls_long[i], tmp_dir, tbl_names[i]))
        # Laeme eraldi andmed shape muutujasse, et teede geomeetriat leida
        if (tbl_names[i] == "shapes") {
          shapes <- utils::read.csv(file = sprintf("%s/%s.csv", tmp_dir, tbl_names[i]))
          ## --------------- Points to SpatialLines -----------------
          cat("\n----------------\nMarsruutide geomeetria loomine\n")

          sl <- shapes %>%
            dplyr::arrange(.data$shape_id, .data$shape_pt_sequence) %>%
            sf::st_as_sf(coords = c("shape_pt_lon", "shape_pt_lat"), agr = "constant") %>%
            # dplyr::group_by(shape_id) %>%
            # dplyr::summarise() %>%
            sf::st_cast("POINT")
          sf::st_crs(sl) <- 4326
          sl <- sf::st_transform(sl, 3301)
          # # Test plot
          # sl %>%
          #   ggplot2::ggplot(ggplot2::aes(colour = shape_id)) +
          #   ggplot2::geom_sf()
          # plot(sl)
          # Write to database
          tabeli_suffix <- "_source"
          sf::st_write(
            obj = sl, dsn = conn, layer_options = c("OVERWRITE=yes"),
            layer = sprintf("%s%s", conf$table, tabeli_suffix)
          )
          # Change schema
          q <- sprintf("
          drop table if exists %s.%s%s cascade; \
          ALTER TABLE %s%s SET SCHEMA %s", conf$schema, conf$table, tabeli_suffix, conf$table, tabeli_suffix, conf$schema)
          cat("\n----------------\nMuudame schema.\n")
          cat(q)
          cat("\n\n")
          DBI::dbExecute(conn, q)
          # ----------- Point to path teisendus ------------
          # Algoritmi juhend!
          # qgis_algorithm_search_by_word(str = "pointstopath")
          algorithm <- "qgis:pointstopath"
          # ruut::qgis_show_help(algorithm = algorithm)
          # Run algorithm.
          output <- sprintf(
            'postgres://dbname=\'%s\' host=%s port=%s user=\'%s\' sslmode=%s password=\'%s\' table=\"%s\".\"%s\" (geom)',
            conf$dbname, conf$host, conf$port, conf$user, conf$sslmode, conf$password,
            conf$schema, conf$table
          )
          input <- sprintf(
            'postgres://dbname=\'%s\' host=%s port=%s user=\'%s\' sslmode=%s password=\'%s\' srid=3301 type=Point checkPrimaryKeyUnicity=\'1\' table=\"%s\".\"%s_source\" (geometry)',
            conf$dbname, conf$host, conf$port, conf$user, conf$sslmode, conf$password,
            conf$schema, conf$table
          )
          str <- sprintf("{ 'INPUT' : '%s', 'OUTPUT' : '%s' , 'CLOSE_PATH' : 0 , DATE_FORMAT : '', GROUP_FIELD : 'shape_id', ORDER_FIELD : 'shape_pt_sequence', OUTPUT_TEXT_DIR : '/tmp/' }", input, output)
          cmd <- ruut::construct_qgis_output_result_to_better_format(str = str, algorithm = algorithm)
          system(cmd)
        } else if (tbl_names[i] == "stops") {
          stops <- utils::read.csv(file = sprintf("%s/%s.csv", tmp_dir, tbl_names[i]))
          ## --------------- Points to SpatialPoints -----------------
          cat("\n----------------\nPeatuste geomeetria loomine\n")

          sl <- stops %>%
            # dplyr::arrange(.data$shape_id, .data$shape_pt_sequence) %>%
            sf::st_as_sf(coords = c("lest_y", "lest_x"), agr = "constant") %>%
            # dplyr::group_by(shape_id) %>%
            # dplyr::summarise() %>%
            sf::st_cast("POINT")
          sf::st_crs(sl) <- 3301
          # # Test plot
          # sl %>%
          #   ggplot2::ggplot() +
          #   ggplot2::geom_sf()
          # plot(sl)
          # Write to database
          tabeli_suffix <- ""
          sf::st_write(
            obj = sl, dsn = conn, layer_options = c("OVERWRITE=yes"),
            layer = sprintf("%s%s", conf$table, tabeli_suffix)
          )
          # Change schema
          q <- sprintf("
          drop table if exists %s.%s%s; \
          ALTER TABLE %s%s SET SCHEMA %s", conf$schema, conf$table, tabeli_suffix, conf$table, tabeli_suffix, conf$schema)
          cat("\n----------------\nMuudame schema.\n")
          cat(q)
          cat("\n\n")
          DBI::dbExecute(conn, q)
        }
        else {
          cmd <- sprintf(
            paste0(
              "ogr2ogr -f PostgreSQL ",
              "%s -lco SCHEMA=%s -lco OVERWRITE=yes -lco FID=%s -nln \"%s\" \"%s/%s.csv\""
            ), pg, conf$schema, "id", conf$table, tmp_dir, tbl_names[i]
          )
          cat(cmd)
          cat("\n\n")
          system(cmd)
        }
      }

      # Lisame andmebaasi seosed
      q <- sprintf("
      -- Kuna osad shape'id puuduvad lisame \u00FChe t\u00FChja \
      INSERT INTO %s.shapes (shape_id, \"begin\", \"end\") VALUES( 0, 1, 1); \
      UPDATE %s.trips SET shape_id='0' WHERE shape_id=''; \
      ALTER TABLE %s.stop_times ALTER COLUMN stop_id TYPE int4 USING stop_id::int4; \
      ALTER TABLE %s.trips ALTER COLUMN shape_id TYPE int4 USING shape_id::int4; \
      ALTER TABLE %s.agency ADD CONSTRAINT agency_un UNIQUE (agency_id); \
      ALTER TABLE %s.calendar ADD CONSTRAINT calendar_un UNIQUE (service_id); \
      ALTER TABLE %s.fare_attributes ADD CONSTRAINT fare_attributes_un UNIQUE (fare_id); \
      ALTER TABLE %s.routes ADD CONSTRAINT routes_un UNIQUE (route_id); \
      ALTER TABLE %s.shapes ADD CONSTRAINT shapes_un UNIQUE (shape_id); \
      ALTER TABLE %s.stops ADD CONSTRAINT stops_un UNIQUE (stop_id); \
      ALTER TABLE %s.trips ADD CONSTRAINT trips_un UNIQUE (trip_id); \
      ALTER TABLE %s.fare_rules ADD CONSTRAINT fare_rules_fk FOREIGN KEY (fare_id) REFERENCES %s.fare_attributes(fare_id); \
      ALTER TABLE %s.fare_attributes ADD CONSTRAINT fare_attributes_fk FOREIGN KEY (agency_id) REFERENCES %s.agency(agency_id); \
      ALTER TABLE %s.routes ADD CONSTRAINT routes_fk FOREIGN KEY (agency_id) REFERENCES %s.agency(agency_id); \
      ALTER TABLE %s.calendar_dates ADD CONSTRAINT calendar_dates_fk FOREIGN KEY (service_id) REFERENCES %s.calendar(service_id); \
      ALTER TABLE %s.fare_rules ADD CONSTRAINT fare_rules_route_fk FOREIGN KEY (route_id) REFERENCES %s.routes(route_id); \
      ALTER TABLE %s.stop_times ADD CONSTRAINT stop_times_stops_fk FOREIGN KEY (stop_id) REFERENCES %s.stops(stop_id); \
      ALTER TABLE %s.stop_times ADD CONSTRAINT stop_times_trips_fk FOREIGN KEY (trip_id) REFERENCES %s.trips(trip_id); \
      ALTER TABLE %s.trips ADD CONSTRAINT trips_shapes_fk FOREIGN KEY (shape_id) REFERENCES %s.shapes(shape_id); \
      ALTER TABLE %s.trips ADD CONSTRAINT trips_calendar_fk FOREIGN KEY (service_id) REFERENCES %s.calendar(service_id); \
      ALTER TABLE %s.trips ADD CONSTRAINT trips_routes_fk FOREIGN KEY (route_id) REFERENCES %s.routes(route_id);", conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema, conf$schema)
      cat(q)
      DBI::dbExecute(conn, q)

      # ogr2ogr help.
      # system("ogr2ogr --long-usage")
      # ogrinfo help.
      # system("ogrinfo --help-general")
      # pg <- ruut::construct_ogr2ogr_PG_connect_str()
      # system(sprintf("ogrinfo %s xgtfs.trips ", pg))
      # system(sprintf("ogrinfo %s xgtfs.trips ", pg))
    }
    # Delete unnecessary files.
    system(sprintf("rm -rf %s/*.csv", tmp_dir))
  }
}