Nothing
#' List of cities currently included in bikedata
#'
#' @return A \code{data.frame} of cities, abbreviations, and names of bike
#' systems currently able to be accessed.
#'
#' @export
#'
#' @examples
#' bike_cities ()
bike_cities <- function ()
{
dat <- bike_demographic_data ()
dat$demographic_data <- NULL
return (dat)
}
#' Convert city names to two-letter prefixes
#'
#' @param city Name of one or more cities or corresponding bicycle hire systems
#'
#' @return A two letter prefix matching (bo, ch, dc, la, lo, mn, ny, ph)
#'
#' @noRd
convert_city_names <- function (city)
{
city <- gsub (' ', '', city)
if (any (nchar (city) >= 4))
{
if (substring (tolower (city), 1, 4) == 'sant')
city <- 'lo'
else if (substring (tolower (city), 1, 4) == 'sanf')
city <- 'sf'
}
city <- substring (gsub ('[[:punct:]]', '', tolower (city)), 1, 3)
indx_lo <- which (city %in% c ('lon', 'los'))
indx <- which (!seq (city) %in% indx_lo)
if (length (indx_lo) > 0)
{
city_lo <- city [indx_lo]
city <- city [indx]
city_lo [city_lo == 'lon'] <- 'lo'
city_lo [city_lo == 'los'] <- 'la'
}
city <- substring (city, 1, 2)
city_names <- c ('ny', 'ne', 'ci', # nyc citibike
'bo', 'hu', # boston hubway
'ch', 'di', # chicago divvy bike
'wa', 'dc', 'ca', # washington dc capital bike share
'la', 'me', # LA metro
'lo', 'sa', # london santander
'ph', 'in', # philly indego
'mn', 'mi', # minneapolis/st.paul nice ride
'fo', 'go', 'sf', # ford gobike san fran
'mo', 'bi', # montreal bixi
'gu') # guadalajara mibici
city_code <- c ('ny', 'ny', 'ny', 'bo', 'bo', 'ch', 'ch',
'dc', 'dc', 'dc', 'la', 'la', 'lo', 'lo', 'ph', 'ph',
'mn', 'mn', 'sf', 'sf', 'sf', 'mo', 'mo', 'gu')
city_code <- city_code [pmatch (city, city_names)]
if (length (indx_lo) > 0)
{
city <- rep (NA, min (1, length (city)))
city [indx_lo] <- city_lo
city [indx] <- city_code
} else
city <- city_code
if (any (is.na (city)))
stop ("city not recognised")
return (city)
}
#' check city arg
#'
#' @param bikedb Name of database holding bike trip data
#' @param city Name of city as passed to functions such as \code{bike_tripmat},
#' \code{bike_stations}, or \code{bike_distmat}
#' @return Standardised version of \code{city} parameter
#' @noRd
check_city_arg <- function (bikedb, city)
{
db_cities <- bike_cities_in_db (bikedb)
if (missing (city))
{
if (length (db_cities) > 1)
{
stop ('bikedb contains multiple cities; please specify one.',
'cities in current database are [',
paste (db_cities, collapse = ' '), ']')
} else
city <- db_cities [1]
} else if (!missing (city))
{
city <- convert_city_names (city)
if (is.na (city))
stop ('city not recognised')
if (!city %in% bike_cities_in_db (bikedb))
stop ('city ', city, ' not represented in database')
}
return (city)
}
#' Perform checks for name, existance, and structure of bikedb
#'
#' @param bikedb A string containing the path to the SQLite3 database.
#' If no directory specified, it is presumed to be in \code{tempdir()}.
#'
#' @return Potentially modified string containing full path
#'
#' @noRd
check_db_arg <- function (bikedb)
{
if (exists (bikedb, envir = parent.frame ()))
bikedb <- get (bikedb, envir = parent.frame ())
bikedb <- expand_home (bikedb)
# Note that dirname (bikedb) == '.' can not be used because that prevents
# bikedb = "./bikedb", so grepl must be used instead.
if (!grepl ('/', bikedb) | !grepl ('*//*', bikedb))
bikedb <- file.path (tempdir (), bikedb)
if (!file.exists (bikedb))
stop ('file ', basename (bikedb), ' does not exist')
db <- DBI::dbConnect(RSQLite::SQLite(), bikedb, create = FALSE)
qry <- 'SELECT name FROM sqlite_master WHERE type = "table"'
tbls <- DBI::dbGetQuery(db, qry) [, 1]
DBI::dbDisconnect(db)
if (!identical (tbls, c ('trips', 'stations', 'datafiles')))
stop ('bikedb does not appear to be a bikedata database')
return (bikedb)
}
# expand unix-style tidle for home directory
expand_home <- function (x)
{
if (grepl ("~", x))
x <- gsub ("~", Sys.getenv ("HOME"), x)
return (x)
}
# check whether data_dir exists and add option to create if not
# no code coverage coz it's interactive
check_data_dir <- function (x) # nocov start
{
split_path <- function (x)
{
if (dirname(x)==x)
x
else
c (basename (x), split_path (dirname (x)))
}
if (!file.exists (x))
{
message ("directory ", x, " does not exist")
inp <- readline ("Should it be created (y/n)? ") %>%
tolower ()
if (substring (inp, 1, 1) == "y")
{
xsp <- rev (split_path (x)) [-1]
for (i in seq_along (xsp))
{
fp <- do.call (file.path, as.list (xsp [1:i]))
if (!file.exists (fp))
dir.create (fp)
}
} else
{
stop ("Okay, stopping now")
}
}
invisible (x)
} # nocov end
# header files are parsed using sysdata.rda, which is written on load to the
# following file, subsequently read directly within the C++ routines
header_file_name <- function ()
{
file.path (tempdir (), "field_names.csv")
}
data_has_stations <- function (city)
{
cities <- bike_demographic_data ()$city
ret <- rep (FALSE, length (cities))
cities_with_station_data <- c ("ny", "la", "ph", "sf")
ret [cities %in% cities_with_station_data] <- TRUE
return (ret [which (cities == city)])
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.