#' getGoffs - Download historic sale results data from the Goffs and Goffs DBS
#' websites.
#'
#' \code{getGoffs} downloads historic sale results data from the Goffs and Goffs
#' DBS websites in xls format.
#'
#' \code{getGoffs} downloads historic sale data from the Goffs
#' \url{http://goffs.com} and Goffs DBS \url{http://goffsdbs.com} websites,
#' based on the supplied URL. Data is downloaded as an xls file from the
#' websites. Various options may be specified such as a \code{filename} and
#' output format. Valid output formats are \code{csv}, \code{Rds} and
#' \code{sqlite}. Only an \code{Rds} file is generated by default. Valid URLs
#' for Goffs and Goffs DBS sales have been tested as far back as 2009. The demo
#' directory contains a complete set of URLs and function calls to generate
#' results data for all sales back to 2009.
#'
#' @param url A string containing the universal resource locator for a Goffs or
#' Goffs DBS xls file of historic bloodstock sale data. Required, no default
#' set.
#' @param catalogue A string containing the universal resource locator for a
#' sale catalogue, usually containing pedigree information in PDF format.
#' Optional, no default set.
#' @param auctioneer A string containing the name of the company conducting the
#' auction sale. Required, no default set.
#' @param country A string containing the abbreviated country code for the
#' location of the sale. e.g. IRE. Required, no default set.
#' @param currency A string containing the abbreviated currency code for the
#' currency of sale bids and payments. e.g. EUR. Required, no default set.
#' @param date A string containing the date of the sale. Multi-day sales should
#' only have the first day's date entered. The date should be entered in the
#' format yyyy-mm-dd. Required, no default set.
#' @param csv A Boolean defining the data output format, in this case a CSV
#' file. Required. Defaults to FALSE. May be changed to TRUE. Multiple output
#' formats are possible.
#' @param rds A Boolean defining the data output format, in this case an Rds
#' file. Required. Defaults to TRUE. May be changed to FALSE. Multiple output
#' formats are possible.
#' @param sqlite A Boolean defining the data output format, in this case an
#' SQLite file. Required. Defaults to FALSE. May be changed to TRUE. Multiple
#' output formats are possible. Requires the RSQLite library to be installed,
#' which is only optional for pinhooker package installation. Prior to
#' attempting SQLite output, please ensure the RSQLite package is installed.
#' @param filename A string containing the output file name, without file
#' extension. Required. Defaults to 'bloodstockSalesData'. Files are output to
#' the current working directory.
#'
#' @return If all parameters are valid, data will be downloaded from the Goffs
#' or Goffs DBS website, normalised and output, as the specified file fomats,
#' in the current working directory directory.
#'
#' @examples
#' getGoffs(url =
#' "http://goffs.com/sales-results/sales/february-sale-2015/excel/", catalogue
#' = "http://goffs.com/files/9014/2107/7132/Full_catalogue.pdf", csv = FALSE,
#' rds = TRUE, sqlite = FALSE, auctioneer = "Goffs", country = "IRE", currency
#' = "EUR", date = "2015-02-11", filename = "goffsSaleData")
#'
#' @export
getGoffs <-
function(url, catalogue = "", auctioneer, country, currency, date, csv = FALSE, rds = TRUE, sqlite = FALSE, filename = "bloodstockSalesData") {
# Read in XLS file and remove any additional columns
saleData <-
gdata::read.xls(
url, sheet = 1, method = "csv", colClasses = "character", blank.lines.skip = TRUE, encoding = "latin1"
)
saleData <- saleData[,-grep("X", colnames(saleData))]
# Change column name of Year to Foaled
saleData <- plyr::rename(saleData,c("Year" = "Foaled"))
# Create empty dataframe with correct column names. Not all XLS files initially contain all column names.
allCols <-
data.frame(
Lot = integer(), Name = character(), Foaled = character(), Sex = character(), Type = character(), Colour = character(), Sire = character(), Dam = character(), Consignor = character(), Stabling = character(), Purchaser = character(), coveringSire = character(), Catalogue = character(), Price = integer(), stringsAsFactors =
FALSE
)
# Check if Covering.sire column exists in XLS data and rename it
if ("Covering.sire" %in% colnames(saleData))
{
saleData <- plyr::rename(saleData,c("Covering.sire" = "coveringSire"))
}
# If Year contains less than 4 digits, expand to full year
saleData$Foaled <-
lapply(saleData$Foaled, function(x)
if (nchar(x) == 1) {
paste("200",x, sep = "")
} else if (nchar(x) == 2 & x < 50) {
paste("20",x, sep = "")
} else if (nchar(x) == 2 & x > 50) {
paste("19",x, sep = "")
} else {
x
})
saleData$Foaled <- unlist(saleData$Foaled)
# Bind empty dataframe with XLS data
saleData <- plyr::rbind.fill(allCols, saleData)
# Create new columns with data input from function options
saleData$Auctioneer <- auctioneer
saleData$Country <- country
saleData$Currency <- currency
saleData$saleDate <- date
saleData$Catalogue <- catalogue
# Reset column data types
saleData$Price <- as.integer(saleData$Price)
saleData$saleDate <- as.Date(saleData$saleDate, "%Y-%m-%d")
# Check to see if sale name ends with year, if so then remove year and capitalise
saleYear <- sub("^(\\d{4}).*$", "\\1", date)
saleName <- sub(".*?sales/(.*?)/excel.*", "\\1", url)
saleNameEnd <- sub(".*(?=.{4}$)", "", saleName, perl = T)
if (saleNameEnd == saleYear) {
saleName <- gsub(".{5}$", "", saleName)
}
saleName <- gsub("-", " ", saleName)
# Normalise pricing display for Not Sold, Vendor etc
saleData$Purchaser <- gsub("\\(", " \\(", saleData$Purchaser)
saleData$Purchaser <- gsub(",", "", saleData$Purchaser)
simpleCap <- function(x) {
s <- strsplit(x, " ")[[1]]
paste(toupper(substring(s, 1, 1)), substring(s, 2),
sep = "", collapse = " ")
}
saleName <- simpleCap(saleName)
saleData$Sale <- saleName
# Check to see if CSV file exists. Then write CSV.
if (isTRUE(csv)) {
if (!isTRUE(file.exists(paste(filename,".csv", sep = "")))) {
write.csv(
saleData, paste(filename,".csv", sep = ""), row.names = FALSE, na =
""
)
} else {
saleDataSaved <-
read.csv(
paste(filename,".csv", sep = ""), sep = ",", stringsAsFactors =
FALSE, as.is = TRUE
)
saleData$saleDate <- as.character(saleData$saleDate)
saleDataFinal <- rbind(saleDataSaved, saleData)
write.csv(
saleDataFinal, paste(filename,".csv", sep = ""), row.names = FALSE, na =
""
)
}
}
# Check to see if RDS file exists. Then write RDS.
if (isTRUE(rds)) {
if (!isTRUE(file.exists(paste(filename,".rds", sep = "")))) {
saleData[is.na(saleData)] <- ""
saveRDS(saleData, paste(filename,".rds", sep = ""))
} else {
saleDataSaved <- readRDS(paste(filename,".rds", sep = ""))
saleData[is.na(saleData)] <- ""
saleDataFinal <- rbind(saleDataSaved, saleData)
saveRDS(saleDataFinal, paste(filename,".rds", sep = ""))
}
}
# Check to see if SQLite file exists. Then write SQLite file.
if (isTRUE(sqlite)) {
if (!requireNamespace("RSQLite", quietly = TRUE)) {
stop(
"The package RSQlite is required to generate the SQLite data file. Please install it and run the script again.",
call. = FALSE
)
}
if (!isTRUE(file.exists(paste(filename,".sqlite", sep = "")))) {
saleData[is.na(saleData)] <- ""
saleData$saleDate <- as.character(saleData$saleDate)
con <-
dbConnect(SQLite(), paste(filename,".sqlite", sep = ""))
dbWriteTable(
con, name = filename, value = transform(saleData, saleDate), row.names =
FALSE, append = TRUE
)
dbDisconnect(con)
} else {
con <-
dbConnect(SQLite(), paste(filename,".sqlite", sep = ""))
sql1 <- paste("SELECT * FROM ",filename, sep = "")
saleDataSaved <- dbGetQuery(con, sql1)
saleData[is.na(saleData)] <- ""
saleData$saleDate <- as.character(saleData$saleDate)
saleDataFinal <- rbind(saleDataSaved, saleData)
dbWriteTable(
con, name = filename, value = transform(saleDataFinal, saleDate), row.names =
FALSE, overwrite = TRUE
)
dbDisconnect(con)
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.