Skip to content

Commit

Permalink
Merge pull request #60 from matthiasgomolka/#55
Browse files Browse the repository at this point in the history
[#55] Update testsuite
  • Loading branch information
matthiasgomolka authored Apr 17, 2024
2 parents ccbc87f + 7245d62 commit 1f5a7dd
Show file tree
Hide file tree
Showing 17 changed files with 291 additions and 160 deletions.
3 changes: 3 additions & 0 deletions .lintr
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
linters: linters_with_defaults(
line_length_linter(99)
)
3 changes: 2 additions & 1 deletion R/call_api.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,8 @@ call_api <- function(url, api_key, cache_dir, ...) {
if (is.null(cache_dir)) {
warning("'cache_dir' not set. Defaulting to 'tempdir()'. Thus, API results will ", "only be cached during this session. To learn why and how to cache ",
"results over the end of this session, see `?sfa_set_cache_dir`.\n\n", "[This warning appears only once per session.]",
call. = FALSE)
call. = FALSE
)
sfa_set_cache_dir(tempdir(), create = TRUE)
cache_dir <- getOption("sfa_cache_dir")
}
Expand Down
206 changes: 103 additions & 103 deletions R/check_inputs.R
Original file line number Diff line number Diff line change
@@ -1,191 +1,191 @@
#' @noRd
msg_sfplus_required <- function(var, verb = "Omitting") {
stop(verb, " '", var, "' is reserved for SimFin+ users.", call. = FALSE)
stop(verb, " '", var, "' is reserved for SimFin+ users.", call. = FALSE)
}

#' @importFrom checkmate assert_string
#' @noRd
check_api_key <- function(api_key) {
checkmate::assert_string(api_key)#, pattern = "^[a-zA-Z0-9]+(-[a-zA-Z0-9]+)*$")
checkmate::assert_string(api_key) # , pattern = "^[a-zA-Z0-9]+(-[a-zA-Z0-9]+)*$")
}

#' @importFrom checkmate assert_directory
#' @noRd
check_cache_dir <- function(cache_dir) {
if (!is.null(cache_dir)) {
checkmate::assert_directory(cache_dir, access = "rw")
}
if (!is.null(cache_dir)) {
checkmate::assert_directory(cache_dir, access = "rw")
}
}

#' @importFrom checkmate assert_logical
#' @noRd
check_sfplus <- function(sfplus) {
checkmate::assert_logical(sfplus, any.missing = FALSE, len = 1L)
checkmate::assert_logical(sfplus, any.missing = FALSE, len = 1L)
}

#' @importFrom checkmate assert_character
#' @noRd
check_ticker <- function(ticker) {
checkmate::assert_character(
ticker,
pattern = "^[A-Za-z0-9_\\.\\:\\-]+$",
any.missing = FALSE,
null.ok = TRUE
)
checkmate::assert_character(
ticker,
pattern = "^[A-Za-z0-9_\\.\\:\\-]+$",
any.missing = FALSE,
null.ok = TRUE
)
}

#' @importFrom checkmate assert_integerish
#' @noRd
check_id <- function(id) {
checkmate::assert_integerish(
id,
lower = 1L,
any.missing = FALSE,
null.ok = TRUE
)
checkmate::assert_integerish(
id,
lower = 1L,
any.missing = FALSE,
null.ok = TRUE
)
}

#' @importFrom checkmate assert_choice
#' @noRd
check_statement <- function(statement, sfplus) {
checkmate::assert_subset(
statement,
c("pl", "bs", "cf", "derived"),
empty.ok = FALSE,
fmatch = TRUE
)
# if (statement == "all" & isFALSE(sfplus)) {
# stop('statement = "all" is reserved for SimFin+ users.', call. = FALSE)
# }
checkmate::assert_subset(
statement,
c("pl", "bs", "cf", "derived"),
empty.ok = FALSE,
fmatch = TRUE
)
# if (statement == "all" & isFALSE(sfplus)) {
# stop('statement = "all" is reserved for SimFin+ users.', call. = FALSE)
# }
}

#' @importFrom checkmate assert_choice
#' @noRd
check_period <- function(period, sfplus, called_from_get_shares = FALSE) {
checkmate::assert_choice(
period,
c("q1", "q2", "q3", "q4", "fy", "h1", "h2", "9m", "6m", "quarters"),
null.ok = TRUE,
fmatch = TRUE
)
if (isFALSE(called_from_get_shares)) {
if (isFALSE(sfplus)) {
if (period %in% c("6m", "quarters")) {
stop(
'period = "', period, '" is reserved for SimFin+ users.',
call. = FALSE
)
}
checkmate::assert_choice(
period,
c("q1", "q2", "q3", "q4", "fy", "h1", "h2", "9m", "6m", "quarters"),
null.ok = TRUE,
fmatch = TRUE
)
if (isFALSE(called_from_get_shares)) {
if (isFALSE(sfplus)) {
if (period %in% c("6m", "quarters")) {
stop(
'period = "', period, '" is reserved for SimFin+ users.',
call. = FALSE
)
}
}
}
}
}

#' @noRd
check_period_get_shares <- function(...) {
check_period(...)
check_period(...)
}


#' @importFrom checkmate assert_integerish
#' @noRd
check_fyear <- function(fyear, sfplus) {
if (is.null(fyear) && isFALSE(sfplus)) {
msg_sfplus_required("fyear")
}
checkmate::assert_integerish(
fyear,
lower = 1900L,
upper = data.table::year(Sys.Date()),
null.ok = TRUE
)
if (is.null(fyear) && isFALSE(sfplus)) {
msg_sfplus_required("fyear")
}
checkmate::assert_integerish(
fyear,
lower = 1900L,
upper = data.table::year(Sys.Date()),
null.ok = TRUE
)
}

#' @noRd
check_fyear_get_shares <- function(..., type) {
if (type %in% c("wa-basic", "wa-diluted")) {
check_fyear(...)
}
if (type %in% c("wa-basic", "wa-diluted")) {
check_fyear(...)
}
}

#' @importFrom checkmate assert_date
#' @noRd
check_start <- function(start, sfplus) {
if (!is.null(start) && isFALSE(sfplus)) {
msg_sfplus_required("start", "Specifying")
}
checkmate::assert_date(
start,
lower = as.Date("1900-01-01"),
upper = Sys.Date(),
null.ok = TRUE
)
if (!is.null(start) && isFALSE(sfplus)) {
msg_sfplus_required("start", "Specifying")
}
checkmate::assert_date(
start,
lower = as.Date("1900-01-01"),
upper = Sys.Date(),
null.ok = TRUE
)
}

#' @importFrom checkmate assert_date
#' @noRd
check_end <- function(end, sfplus) {
if (!is.null(end) && isFALSE(sfplus)) {
msg_sfplus_required("end", "Specifying")
}
checkmate::assert_date(
end,
lower = as.Date("1900-01-01"),
upper = Sys.Date(),
null.ok = TRUE
)
if (!is.null(end) && isFALSE(sfplus)) {
msg_sfplus_required("end", "Specifying")
}
checkmate::assert_date(
end,
lower = as.Date("1900-01-01"),
upper = Sys.Date(),
null.ok = TRUE
)
}

#' @importFrom checkmate assert_logical
#' @noRd
check_ttm <- function(ttm) {
checkmate::assert_logical(ttm, any.missing = FALSE, len = 1L)
checkmate::assert_logical(ttm, any.missing = FALSE, len = 1L)
}

#' @importFrom checkmate assert_logical
#' @noRd
check_shares <- function(shares, sfplus) {
checkmate::assert_logical(shares, any.missing = FALSE, len = 1L)

if (isTRUE(shares) && isFALSE(sfplus)) {
stop(
"'shares = TRUE' is reserved to SimFin+ users. As a normal user, please ",
"use 'sfa_get_shares()' with 'type = \"wa-basic\"' or 'type = ",
"\"wa-diluted\".",
call. = FALSE
)
}
checkmate::assert_logical(shares, any.missing = FALSE, len = 1L)

if (isTRUE(shares) && isFALSE(sfplus)) {
stop(
"'shares = TRUE' is reserved to SimFin+ users. As a normal user, please ",
"use 'sfa_get_shares()' with 'type = \"wa-basic\"' or 'type = ",
"\"wa-diluted\".",
call. = FALSE
)
}
}

#' @importFrom checkmate assert_logical
#' @noRd
check_ratios <- function(ratios, sfplus) {
if (!is.null(ratios) && isFALSE(sfplus)) {
msg_sfplus_required("ratios", "Specifying")
}
checkmate::assert_logical(
ratios,
any.missing = FALSE,
len = 1L,
null.ok = TRUE
)
if (!is.null(ratios) && isFALSE(sfplus)) {
msg_sfplus_required("ratios", "Specifying")
}
checkmate::assert_logical(
ratios,
any.missing = FALSE,
len = 1L,
null.ok = TRUE
)
}

#' @importFrom checkmate assert_choice
#' @noRd
check_type <- function(type) {
checkmate::assert_choice(
type,
choices = c("common", "wa-basic", "wa-diluted"),
fmatch = TRUE
)
checkmate::assert_choice(
type,
choices = c("common", "wa-basic", "wa-diluted"),
fmatch = TRUE
)
}

#' @importFrom checkmate assert_choice
#' @noRd
check_ref_data <- function(ref_data) {
checkmate::assert_choice(
ref_data,
choices = c("industries", "markets"),
fmatch = TRUE
)
checkmate::assert_choice(
ref_data,
choices = c("industries", "markets"),
fmatch = TRUE
)
}
18 changes: 12 additions & 6 deletions R/sfa_load__shares_outstanding.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,12 +11,14 @@
#' @return [data.table] containing the common shares outstanding.
#'
#' @export
sfa_load_common_shares_outstanding <- function(id = NULL, ticker = NULL, start = NULL, end = NULL, api_key = getOption("sfa_api_key"),
sfa_load_common_shares_outstanding <- function(
id = NULL, ticker = NULL, start = NULL, end = NULL, api_key = getOption("sfa_api_key"),
cache_dir = getOption("sfa_cache_dir")) {
ticker <- gather_ticker(ticker, id, api_key, cache_dir)

response <- call_api(url = "/companies/common-shares-outstanding", api_key = api_key, cache_dir = cache_dir, ticker = paste(ticker,
collapse = ","), start = start, end = end)
collapse = ","
), start = start, end = end)

response_body <- httr2::resp_body_string(response) |>
RcppSimdJson::fparse(single_null = NA)
Expand Down Expand Up @@ -55,20 +57,24 @@ sfa_load_common_shares_outstanding <- function(id = NULL, ticker = NULL, start =
#' @return [data.table] containing the common shares outstanding.
#'
#' @export
sfa_load_weighted_shares_outstanding <- function(id = NULL, ticker = NULL, fyear = NULL, period = NULL, start = NULL, end = NULL,
sfa_load_weighted_shares_outstanding <- function(
id = NULL, ticker = NULL, fyear = NULL, period = NULL, start = NULL, end = NULL,
ttm = NULL, api_key = getOption("sfa_api_key"), cache_dir = getOption("sfa_cache_dir")) {
ticker <- gather_ticker(ticker, id, api_key, cache_dir)

response <- call_api(url = "/companies/weighted-shares-outstanding", api_key = api_key, cache_dir = cache_dir, ticker = paste(ticker,
collapse = ","), fyear = fyear, period = period, start = start, end = end, ttm = tolower(ttm))
collapse = ","
), fyear = fyear, period = period, start = start, end = end, ttm = tolower(ttm))

response_body <- httr2::resp_body_string(response) |>
RcppSimdJson::fparse(single_null = NA)

results_dt <- data.table::as.data.table(response_body)
if (ncol(results_dt) == 0L) {
return(data.table::data.table(id = integer(), Date = as.Date(character()), `Fiscal Year` = integer(), Period = character(),
`Basic Shares Outstanding` = numeric(), `Diluted Shares Outstanding` = numeric()))
return(data.table::data.table(
id = integer(), Date = as.Date(character()), `Fiscal Year` = integer(), Period = character(),
`Basic Shares Outstanding` = numeric(), `Diluted Shares Outstanding` = numeric()
))
}
setnames(results_dt, c("id", "Date", "Fiscal Year", "Period", "Basic Shares Outstanding", "Diluted Shares Outstanding"))

Expand Down
7 changes: 4 additions & 3 deletions R/sfa_load_companies.R
Original file line number Diff line number Diff line change
Expand Up @@ -23,15 +23,16 @@ sfa_load_companies <- function(api_key = getOption("sfa_api_key"), cache_dir = g
data.table::data.table() |>
data.table::setnames(response_body[["columns"]]) |>
utils::type.convert(as.is = TRUE)

} else {
response <- call_api(url = "/companies/list", api_key = api_key, cache_dir = cache_dir)
response_body <- httr2::resp_body_string(response) |>
RcppSimdJson::fparse()
companies <- data.table::data.table(response_body)
}
col_order <- c("id", "name", "ticker", "isin", "sectorCode", "sectorName", "industryName", "market", "endFy", "numEmployees",
"companyDescription")
col_order <- c(
"id", "name", "ticker", "isin", "sectorCode", "sectorName", "industryName", "market", "endFy", "numEmployees",
"companyDescription"
)
col_order <- intersect(col_order, names(companies))
data.table::setcolorder(companies, col_order)
data.table::setkeyv(companies, "id")
Expand Down
3 changes: 1 addition & 2 deletions R/sfa_load_shareprices.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,7 @@ sfa_load_shareprices <- function(
ratios = FALSE,
asreported = FALSE,
api_key = getOption("sfa_api_key"),
cache_dir = getOption("sfa_cache_dir")
) {
cache_dir = getOption("sfa_cache_dir")) {
# check_sfplus(sfplus)
check_id(id)
check_ticker(ticker)
Expand Down
Loading

0 comments on commit 1f5a7dd

Please sign in to comment.