R/database.R

#' Write an object to a character string or recreate it from a character string.
#' @description Writes an ASCII text representation of an R object to a character string, or uses
#' one to recreate the object. If applying this function to a data.frame, it will do this on each
#' rows of given columns, and also transform columns between datetime and character.
#'
#' @param x An ojbect or a data.frame.
#' @param mutate If \code{TRUE}, apply the function on the given columns. If \code{FALSE}, apply the
#' function on the object.
#' @param vars,vars.time A list of columns generated by \code{\link[dplyr:vars]{vars()}}, a
#' character vector of column names, a numeric vector of column positions, or \code{NULL}.
#' \code{vars.time} is the columns names of datetime.
#' @param tz a character string that specifies which time zone to parse the date with. The string
#' must be a time zone that is recognized by the user's OS. If \code{NULL}, use the current time
#' zone.
#'
#' @return Transformed object.
#'
#' @examples
#' s <- flightscanner:::ListUnpack(LETTERS)
#' flightscanner:::ListPack(s)
#' d <- flightscanner:::ListUnpack(iris, mutate = TRUE, vars = "Species")
#' d <- flightscanner:::ListPack(d, mutate = TRUE, vars = "Species")
#' d$Species <- unlist(d$Species)
#' head(d)
ListUnpack <- function(x, mutate = FALSE, vars = NULL) {
  if (!mutate) {
    paste(utils::capture.output(dput(x)), collapse = "")
  } else if (is.data.frame(x)){
    y <- if (is.null(vars)) {
      mutate_if(x, is.list, ~ map_chr(., ListUnpack, mutate = FALSE))
    } else mutate_at(x, vars, ~ map_chr(., ListUnpack, mutate = FALSE))
    mutate_if(y, lubridate::is.POSIXt, as.character)
  } else stop("x should be a data.frame.")
}


#' @rdname ListUnpack
ListPack <- function(x, mutate = FALSE, vars = NULL, vars.time = vars(ends_with("Time")),
                     tz = "UTC") {
  if (!mutate) {
    eval(parse(text = x))
  } else if (is.data.frame(x)){
    mutate_at(mutate_at(x, vars, ~ map(., ListPack, mutate = FALSE)),
              vars.time, ~ lubridate::ymd_hms(., tz = tz))
  } else stop("x should be a data.frame.")
}


#' Insert rows into a table.
#' @description Insert rows into a table. If the table has key, it will ignore the duplicate rows
#' indexed by the key. It assumes that the table has been created beforehand.
#'
#' @param conn A \code{\link[RSQLite:SQLiteConnection-class]{SQLiteConnection}} object, as returned
#' by \code{\link[DBI:dbConnect]{dbConnect()}}.
#' @param name Name of the table.
#' @param value A data frame of values. The column names must be consistent with those in the target
#' table in the database.
#' @param ... Other arguments used by individual methods.
#'
#' @return Number of rows appended successfully.
#' @import DBI
#'
#' @examples
#' con <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
#' DBI::dbWriteTable(con, "iris", iris[0, ])
#' flightscanner:::dbAppendTableNew(con, "iris", iris)
#' df <- DBI::dbReadTable(con, "iris")
#' head(df)
#' dbDisconnect(con)
dbAppendTableNew <- function(conn, name, value, ...) {
  value <- ListUnpack(value, mutate = TRUE)
  sum(sapply(1:NROW(value), function(i) {
    x <- tryCatch(suppressWarnings(dbAppendTable(conn, name, value[i, , drop = FALSE], ...)),
                  error = function(e) {
                    if (grepl("^UNIQUE constraint failed", e$message)) 0L else stop(e)
                  })
    if (inherits(x, "error")) stop(x) else x
  }))
}


#' Connect to a SQLite database and create tables.
#' @description Connect to a SQLite database file. And check it the following tables exists: price,
#' itinerary, leg, segment, carrier, agent, and place. If not, create them.
#'
#' @param conn A \code{\link[RSQLite:SQLiteDriver-class]{SQLiteDriver}} or
#' \code{\link[RSQLite:SQLiteConnection-class]{SQLiteConnection}}.
#' @param dbname The path to the database file. Don't use two exceptions:
#' \itemize{
#'   \item{
#'   \code{""} will create a temporary on-disk database. The file will be deleted when the
#'   connection is closed.
#'   }
#'   \item{
#'   \code{":memory:"} or \code{"file::memory:"} will create a temporary in-memory database.
#'   }
#' }
#'
#' @return An object of class \code{\link[RSQLite:SQLiteConnection-class]{SQLiteConnection}}. If
#' can't connect to SQLite driver, return 1.
#'
#' @import DBI
#' @export
#'
#' @examples
#' con <- dbCreateDB(dbname = ":memory:")
#' dbDisconnect(con)
dbCreateDB <- function(conn = RSQLite::SQLite(), dbname = "flight.db") {
  if (inherits(conn, "SQLiteConnection")) {
    con <- conn
  } else if (inherits(conn, "SQLiteDriver") && dbCanConnect(conn)) {
    con <- dbConnect(conn, dbname = dbname)
  } else stop("conn should be a SQLiteConnection or SQLiteDriver.")
  
  if (!dbExistsTable(con, "price")) {
    dbCreateTable(con, SQL("price"), c(SearchTime = "TEXT NOT NULL",
                                       OutboundLegId = "TEXT NOT NULL",
                                       InboundLegId = "TEXT NOT NULL",
                                       PricingOptions = "BLOB"))
  }
  
  if (!dbExistsTable(con, "itinerary")) {
    fields <- c(OutboundLegId = "TEXT NOT NULL",
                InboundLegId = "TEXT NOT NULL")
    columns <- paste(paste(dbQuoteIdentifier(con, names(fields)), fields), collapse = ",\n  ")
    query <- paste0("CREATE TABLE itinerary (\n  ", columns,
                    ",\n  PRIMARY KEY (`OutboundLegId`, `InboundLegId`)\n)")
    dbExecute(con, query)
  }
  
  if (!dbExistsTable(con, "leg")) {
    dbCreateTable(con, SQL("leg"), c(Id = "TEXT PRIMARY KEY NOT NULL",
                                     SegmentIds = "BLOB NOT NULL",
                                     OriginId = "INTEGER NOT NULL",
                                     DestinationId = "INTEGER NOT NULL",
                                     DepartureTime = "TEXT NOT NULL",
                                     ArrivalTime = "TEXT NOT NULL",
                                     Duration = "INTEGER NOT NULL",
                                     No.Stops = "INTEGER NOT NULL",
                                     Stops = "BLOB"))
  }
  
  if (!dbExistsTable(con, "segment")) {
    dbCreateTable(con, SQL("segment"), c(Id = "TEXT PRIMARY KEY NOT NULL",
                                         OriginId = "INTEGER NOT NULL",
                                         DestinationId = "INTEGER NOT NULL",
                                         DepartureTime = "TEXT NOT NULL",
                                         ArrivalTime = "TEXT NOT NULL",
                                         Duration = "INTEGER NOT NULL",
                                         CarrierId = "INTEGER NOT NULL",
                                         OperatingCarrierId = "INTEGER NOT NULL",
                                         FlightNumber = "TEXT NOT NULL"))
  }
  
  if (!dbExistsTable(con, "carrier")) {
    dbCreateTable(con, SQL("carrier"), c(Id = "INTEGER PRIMARY KEY NOT NULL",
                                         Code = "TEXT NOT NULL",
                                         Name = "TEXT NOT NULL",
                                         ImageURL = "TEXT"))
  }
  
  if (!dbExistsTable(con, "agent")) {
    dbCreateTable(con, SQL("agent"), c(Id = "INTEGER PRIMARY KEY NOT NULL",
                                       Name = "TEXT NOT NULL",
                                       Type = "TEXT NOT NULL",
                                       ImageURL = "TEXT"))
  }
  
  if (!dbExistsTable(con, "place")) {
    dbCreateTable(con, SQL("place"), c(Id = "INTEGER PRIMARY KEY NOT NULL",
                                       ParentId = "INTEGER",
                                       Code = "TEXT",
                                       Type = "TEXT NOT NULL",
                                       Name = "TEXT NOT NULL"))
  }
  
  con
}


#' Save data to SQLite database.
#' @description Save data to the corresponding tables in the SQLite database. Tables includes:
#' price, itinerary, leg, segment, carrier, agent, and place.
#'
#' @param x An object of data to be saved.
#' @param conn A \code{\link[RSQLite:SQLiteConnection-class]{SQLiteConnection}} object, as returned
#' by \code{\link[DBI:dbConnect]{dbConnect()}}.
#' @param ... Further arguments passed to methods.
#'
#' @export
#'
#' @examples
#' \dontrun{
#' # Get data from API
#' apiSetKey("YOUR_API_KEY")
#' resp <- apiCreateSession(origin = "SFO", destination = "LHR", startDate = "2019-07-01")
#' resp <- apiPollSession(resp)
#' data <- flightGet(resp)
#'
#' # Connect to SQLite database
#' con <- dbCreateDB(dbname = ":memory:")
#' dbSaveData(resp, con)  # from response
#' dbSaveData(data, con)  # from list
#' dbDisconnect(con)
#' }
dbSaveData <- function(x, conn, ...) UseMethod("dbSaveData")


#' @describeIn dbSaveData Save a list of data.frames in databse.
#' @export
dbSaveData.list <- function(x, conn, ...) {
  dbAppendTableNew(conn, "price", x$price)
  dbAppendTableNew(conn, "itinerary", x$itineraries)
  dbAppendTableNew(conn, "leg", x$legs)
  dbAppendTableNew(conn, "segment", x$segments)
  dbAppendTableNew(conn, "carrier", x$carriers)
  dbAppendTableNew(conn, "agent", x$agents)
  dbAppendTableNew(conn, "place", x$places)
  invisible()
}


#' @describeIn dbSaveData Save data from the request response in databse. 
#' @export
dbSaveData.response <- function(x, conn, ...) {
  dbSaveData.list(flightGet(x), conn = conn, ...)
}


#' Disconnect (close) a connection.
#' @description See \code{DBI::\link[DBI]{dbDisconnect}} for details.
#'
#' @name dbDisconnect
#' @export
#' @importFrom DBI dbDisconnect
NULL


#' List remote tables.
#' @description See \code{DBI::\link[DBI]{dbListTables}} for details.
#'
#' @name dbListTables
#' @export
#' @importFrom DBI dbListTables
NULL
MinZhang95/flightscanner documentation built on July 1, 2019, 9:36 p.m.