diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..8679743 --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,4 @@ +^.*\.Rproj$ +^\.Rproj\.user$ +^bea\.R\.Rproj$ +^data-raw$ diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5b6a065 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata diff --git a/DESCRIPTION b/DESCRIPTION index 5272ef4..1b85233 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,51 +1,45 @@ -Package: beaR -Title: R interface to the Bureau of Economic Analysis API -Version: 1.0.0 -Authors@R: c(person("Andrea", "Julca", role = c("aut", "cre"), - email = c("Andrea.Julca@gmail.com", "Andrea.Julca@bea.gov")), +Package: bea.R +Title: Bureau of Economic Analysis API +Version: 1.1.0 +Authors@R: c(person("Andrea", "Batch", role = c("aut", "cre"), + email = c("Andrea.Batch@bea.gov")), person("Jeff", "Chen", role = "ctb"), person("Walt", "Kampas", role = "ctb")) -Author: Andrea Julca [aut, cre], +Author: Andrea Batch [aut, cre], Jeff Chen [ctb], Walt Kampas [ctb] -Maintainer: Andrea Julca +Maintainer: Andrea Batch Depends: R (>= 3.2.1), data.table Imports: httr, DT, - shiny, - jsonlite, - googleVis, - shinydashboard, - ggplot2, - stringr, - chron, - gtable, - scales, - htmltools, - httpuv, - xtable, - stringi, - magrittr, - htmlwidgets, - Rcpp, - munsell, - colorspace, - plyr, - yaml -Description: The beaR package is an R interface for the Bureau of Economic - Analysis (BEA) API that serves two core purposes - - 1. To Extract/Transform/Load data [beaGet] from the BEA API as R-friendly - formats in the user's workspace [transformation done by default in beaGet - can be modified using optional params; see, too, bea2List, bea2Tab]. - 2. To enable the search of descriptive metadata [beaSearch]. + jsonlite +Description: Provides an R interface for the Bureau of Economic Analysis (BEA) + API (see for + more information) that serves two core purposes - + 1. To Extract/Transform/Load data [beaGet()] from the BEA API as R-friendly + formats in the user's work space [transformation done by default in beaGet() + can be modified using optional parameters; see, too, bea2List(), bea2Tab()]. + 2. To enable the search of descriptive meta data [beaSearch()]. Other features of the library exist mainly as intermediate methods or are in early stages of development. - Important Note - You must have an API Key to use this library. - Register for a key at http://www.bea.gov/API/signup/index.cfm . -URL: http://www.bea.gov/API/bea_web_service_api_user_guide.htm -License: file LICENSE + Important Note - You must have an API key to use this library. + Register for a key at . + As a note regarding the license: + Software code created by U.S. Government employees is not subject to + copyright in the United States (17 U.S.C. §105). The United States/ + Department of Commerce reserve all rights to seek and obtain copyright + protection in countries other than the United States for Software authored + in its entirety by the Department of Commerce. To this end, the Department + of Commerce hereby grants to Recipient a royalty-free, nonexclusive license + to freely use, copy, distribute, and create derivative works of the Software + outside of the United States. The CC0 1.0 Universal License should be taken + to apply to this work inside and outside of the United States. +URL: https://github.com/us-bea/bea.R +License: CC0 LazyData: no -RoxygenNote: 5.0.1 +Encoding: UTF-8 +Roxygen: list(markdown = TRUE) +RoxygenNote: 7.3.2 diff --git a/INDEX b/INDEX new file mode 100644 index 0000000..00d7081 --- /dev/null +++ b/INDEX @@ -0,0 +1,14 @@ +bea2List Convert BEA API httr response payload to list +bea2Tab Convert BEA API httr response or list payload + to data.table +beaGet Pass list of user specifications (including API + key) to return data from BEA API. +beaParamVals Gives list of values possible for a given + dataset's parameters +beaParams Gives list of parameters possible for a given + dataset +beaSearch Search a selection of indexed BEA data table + names, series labels, and series codes. +beaSets Returns a list of all datasets +beaUpdateMetadata Download BEA metadata into library/data folder + if needed diff --git a/LICENSE b/LICENSE index 99d7835..896a4e3 100644 --- a/LICENSE +++ b/LICENSE @@ -1,130 +1,135 @@ --------------------------------------------------------------------------- - +LICENSE Note +--------------------------------------------------------------------------- Software code created by U.S. Government employees is not subject to copyright in the United States (17 U.S.C. §105). The United States/ Department of Commerce reserve all rights to seek and obtain copyright protection in countries other than the United States for Software authored in its entirety by the Department of Commerce. To this end, the Department of Commerce hereby grants to Recipient a royalty-free, nonexclusive license -to use, copy, and create derivative works of the Software outside of the -United States. - +to freely use, copy, distribute, and create derivative works of the Software +outside of the United States. The CC0 1.0 Universal License should be taken +to apply to this work inside and outside of the United States. --------------------------------------------------------------------------- +Creative Commons Legal Code + CC0 1.0 Universal + CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE + LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN + ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS + INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES + REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS + PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM + THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED + HEREUNDER. Statement of Purpose The laws of most jurisdictions throughout the world automatically confer -exclusive Copyright and Related Rights (defined below) upon the creator and -subsequent owner(s) (each and all, an "owner") of an original work of +exclusive Copyright and Related Rights (defined below) upon the creator +and subsequent owner(s) (each and all, an "owner") of an original work of authorship and/or a database (each, a "Work"). -Certain owners wish to permanently relinquish those rights to a Work for the -purpose of contributing to a commons of creative, cultural and scientific -works ("Commons") that the public can reliably and without fear of later -claims of infringement build upon, modify, incorporate in other works, reuse -and redistribute as freely as possible in any form whatsoever and for any -purposes, including without limitation commercial purposes. These owners may -contribute to the Commons to promote the ideal of a free culture and the -further production of creative, cultural and scientific works, or to gain -reputation or greater distribution for their Work in part through the use and -efforts of others. - -For these and/or other purposes and motivations, and without any expectation -of additional consideration or compensation, the person associating CC0 with a -Work (the "Affirmer"), to the extent that he or she is an owner of Copyright -and Related Rights in the Work, voluntarily elects to apply CC0 to the Work -and publicly distribute the Work under its terms, with knowledge of his or her -Copyright and Related Rights in the Work and the meaning and intended legal -effect of CC0 on those rights. +Certain owners wish to permanently relinquish those rights to a Work for +the purpose of contributing to a commons of creative, cultural and +scientific works ("Commons") that the public can reliably and without fear +of later claims of infringement build upon, modify, incorporate in other +works, reuse and redistribute as freely as possible in any form whatsoever +and for any purposes, including without limitation commercial purposes. +These owners may contribute to the Commons to promote the ideal of a free +culture and the further production of creative, cultural and scientific +works, or to gain reputation or greater distribution for their Work in +part through the use and efforts of others. + +For these and/or other purposes and motivations, and without any +expectation of additional consideration or compensation, the person +associating CC0 with a Work (the "Affirmer"), to the extent that he or she +is an owner of Copyright and Related Rights in the Work, voluntarily +elects to apply CC0 to the Work and publicly distribute the Work under its +terms, with knowledge of his or her Copyright and Related Rights in the +Work and the meaning and intended legal effect of CC0 on those rights. 1. Copyright and Related Rights. A Work made available under CC0 may be protected by copyright and related or neighboring rights ("Copyright and -Related Rights"). Copyright and Related Rights include, but are not limited -to, the following: - - i. the right to reproduce, adapt, distribute, perform, display, communicate, - and translate a Work; - - ii. moral rights retained by the original author(s) and/or performer(s); - - iii. publicity and privacy rights pertaining to a person's image or likeness - depicted in a Work; - - iv. rights protecting against unfair competition in regards to a Work, - subject to the limitations in paragraph 4(a), below; - - v. rights protecting the extraction, dissemination, use and reuse of data in - a Work; - - vi. database rights (such as those arising under Directive 96/9/EC of the - European Parliament and of the Council of 11 March 1996 on the legal - protection of databases, and under any national implementation thereof, - including any amended or successor version of such directive); and - - vii. other similar, equivalent or corresponding rights throughout the world - based on applicable law or treaty, and any national implementations thereof. - -2. Waiver. To the greatest extent permitted by, but not in contravention of, -applicable law, Affirmer hereby overtly, fully, permanently, irrevocably and -unconditionally waives, abandons, and surrenders all of Affirmer's Copyright -and Related Rights and associated claims and causes of action, whether now -known or unknown (including existing as well as future claims and causes of -action), in the Work (i) in all territories worldwide, (ii) for the maximum -duration provided by applicable law or treaty (including future time -extensions), (iii) in any current or future medium and for any number of -copies, and (iv) for any purpose whatsoever, including without limitation -commercial, advertising or promotional purposes (the "Waiver"). Affirmer makes -the Waiver for the benefit of each member of the public at large and to the -detriment of Affirmer's heirs and successors, fully intending that such Waiver -shall not be subject to revocation, rescission, cancellation, termination, or -any other legal or equitable action to disrupt the quiet enjoyment of the Work -by the public as contemplated by Affirmer's express Statement of Purpose. - -3. Public License Fallback. Should any part of the Waiver for any reason be -judged legally invalid or ineffective under applicable law, then the Waiver -shall be preserved to the maximum extent permitted taking into account -Affirmer's express Statement of Purpose. In addition, to the extent the Waiver -is so judged Affirmer hereby grants to each affected person a royalty-free, -non transferable, non sublicensable, non exclusive, irrevocable and -unconditional license to exercise Affirmer's Copyright and Related Rights in -the Work (i) in all territories worldwide, (ii) for the maximum duration -provided by applicable law or treaty (including future time extensions), (iii) -in any current or future medium and for any number of copies, and (iv) for any -purpose whatsoever, including without limitation commercial, advertising or -promotional purposes (the "License"). The License shall be deemed effective as -of the date CC0 was applied by Affirmer to the Work. Should any part of the -License for any reason be judged legally invalid or ineffective under -applicable law, such partial invalidity or ineffectiveness shall not -invalidate the remainder of the License, and in such case Affirmer hereby -affirms that he or she will not (i) exercise any of his or her remaining -Copyright and Related Rights in the Work or (ii) assert any associated claims -and causes of action with respect to the Work, in either case contrary to -Affirmer's express Statement of Purpose. +Related Rights"). Copyright and Related Rights include, but are not +limited to, the following: + + i. the right to reproduce, adapt, distribute, perform, display, + communicate, and translate a Work; + ii. moral rights retained by the original author(s) and/or performer(s); +iii. publicity and privacy rights pertaining to a person's image or + likeness depicted in a Work; + iv. rights protecting against unfair competition in regards to a Work, + subject to the limitations in paragraph 4(a), below; + v. rights protecting the extraction, dissemination, use and reuse of data + in a Work; + vi. database rights (such as those arising under Directive 96/9/EC of the + European Parliament and of the Council of 11 March 1996 on the legal + protection of databases, and under any national implementation + thereof, including any amended or successor version of such + directive); and +vii. other similar, equivalent or corresponding rights throughout the + world based on applicable law or treaty, and any national + implementations thereof. + +2. Waiver. To the greatest extent permitted by, but not in contravention +of, applicable law, Affirmer hereby overtly, fully, permanently, +irrevocably and unconditionally waives, abandons, and surrenders all of +Affirmer's Copyright and Related Rights and associated claims and causes +of action, whether now known or unknown (including existing as well as +future claims and causes of action), in the Work (i) in all territories +worldwide, (ii) for the maximum duration provided by applicable law or +treaty (including future time extensions), (iii) in any current or future +medium and for any number of copies, and (iv) for any purpose whatsoever, +including without limitation commercial, advertising or promotional +purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each +member of the public at large and to the detriment of Affirmer's heirs and +successors, fully intending that such Waiver shall not be subject to +revocation, rescission, cancellation, termination, or any other legal or +equitable action to disrupt the quiet enjoyment of the Work by the public +as contemplated by Affirmer's express Statement of Purpose. + +3. Public License Fallback. Should any part of the Waiver for any reason +be judged legally invalid or ineffective under applicable law, then the +Waiver shall be preserved to the maximum extent permitted taking into +account Affirmer's express Statement of Purpose. In addition, to the +extent the Waiver is so judged Affirmer hereby grants to each affected +person a royalty-free, non transferable, non sublicensable, non exclusive, +irrevocable and unconditional license to exercise Affirmer's Copyright and +Related Rights in the Work (i) in all territories worldwide, (ii) for the +maximum duration provided by applicable law or treaty (including future +time extensions), (iii) in any current or future medium and for any number +of copies, and (iv) for any purpose whatsoever, including without +limitation commercial, advertising or promotional purposes (the +"License"). The License shall be deemed effective as of the date CC0 was +applied by Affirmer to the Work. Should any part of the License for any +reason be judged legally invalid or ineffective under applicable law, such +partial invalidity or ineffectiveness shall not invalidate the remainder +of the License, and in such case Affirmer hereby affirms that he or she +will not (i) exercise any of his or her remaining Copyright and Related +Rights in the Work or (ii) assert any associated claims and causes of +action with respect to the Work, in either case contrary to Affirmer's +express Statement of Purpose. 4. Limitations and Disclaimers. - a. No trademark or patent rights held by Affirmer are waived, abandoned, - surrendered, licensed or otherwise affected by this document. - - b. Affirmer offers the Work as-is and makes no representations or warranties - of any kind concerning the Work, express, implied, statutory or otherwise, - including without limitation warranties of title, merchantability, fitness - for a particular purpose, non infringement, or the absence of latent or - other defects, accuracy, or the present or absence of errors, whether or not - discoverable, all to the greatest extent permissible under applicable law. - - c. Affirmer disclaims responsibility for clearing rights of other persons - that may apply to the Work or any use thereof, including without limitation - any person's Copyright and Related Rights in the Work. Further, Affirmer - disclaims responsibility for obtaining any necessary consents, permissions - or other rights required for any use of the Work. - - d. Affirmer understands and acknowledges that Creative Commons is not a - party to this document and has no duty or obligation with respect to this - CC0 or use of the Work. - -For more information, please see - + a. No trademark or patent rights held by Affirmer are waived, abandoned, + surrendered, licensed or otherwise affected by this document. + b. Affirmer offers the Work as-is and makes no representations or + warranties of any kind concerning the Work, express, implied, + statutory or otherwise, including without limitation warranties of + title, merchantability, fitness for a particular purpose, non + infringement, or the absence of latent or other defects, accuracy, or + the present or absence of errors, whether or not discoverable, all to + the greatest extent permissible under applicable law. + c. Affirmer disclaims responsibility for clearing rights of other persons + that may apply to the Work or any use thereof, including without + limitation any person's Copyright and Related Rights in the Work. + Further, Affirmer disclaims responsibility for obtaining any necessary + consents, permissions or other rights required for any use of the + Work. + d. Affirmer understands and acknowledges that Creative Commons is not a + party to this document and has no duty or obligation with respect to + this CC0 or use of the Work. diff --git a/LICENSE.note b/LICENSE.note new file mode 100644 index 0000000..244ede8 --- /dev/null +++ b/LICENSE.note @@ -0,0 +1,14 @@ + +--------------------------------------------------------------------------- + +Software code created by U.S. Government employees is not subject to +copyright in the United States (17 U.S.C. §105). The United States/ +Department of Commerce reserve all rights to seek and obtain copyright +protection in countries other than the United States for Software authored +in its entirety by the Department of Commerce. To this end, the Department +of Commerce hereby grants to Recipient a royalty-free, nonexclusive license +to freely use, copy, distribute, and create derivative works of the Software +outside of the United States. The CC0 1.0 Universal License should be taken +to apply to this work inside and outside of the United States. + +--------------------------------------------------------------------------- \ No newline at end of file diff --git a/Meta/Rd.rds b/Meta/Rd.rds new file mode 100644 index 0000000..d4b2d77 Binary files /dev/null and b/Meta/Rd.rds differ diff --git a/Meta/features.rds b/Meta/features.rds new file mode 100644 index 0000000..bfaf9ac Binary files /dev/null and b/Meta/features.rds differ diff --git a/Meta/hsearch.rds b/Meta/hsearch.rds new file mode 100644 index 0000000..5c27b00 Binary files /dev/null and b/Meta/hsearch.rds differ diff --git a/Meta/links.rds b/Meta/links.rds new file mode 100644 index 0000000..5246004 Binary files /dev/null and b/Meta/links.rds differ diff --git a/Meta/nsInfo.rds b/Meta/nsInfo.rds new file mode 100644 index 0000000..8566bc5 Binary files /dev/null and b/Meta/nsInfo.rds differ diff --git a/Meta/package.rds b/Meta/package.rds new file mode 100644 index 0000000..46af56f Binary files /dev/null and b/Meta/package.rds differ diff --git a/NAMESPACE b/NAMESPACE index 43402cc..b97f731 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,13 +8,7 @@ export(beaParams) export(beaSearch) export(beaSets) export(beaUpdateMetadata) -export(beaViz) import(data.table) -import(ggplot2) -import(googleVis) import(httr) -import(shiny) -import(shinydashboard) -import(stringr) importFrom(DT,datatable) importFrom(jsonlite,fromJSON) diff --git a/R/bea.R b/R/bea.R new file mode 100644 index 0000000..588e700 --- /dev/null +++ b/R/bea.R @@ -0,0 +1,24 @@ +# File share/R/nspackloader.R +# Part of the R package, http://www.R-project.org +# +# Copyright (C) 1995-2012 The R Core Team +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# A copy of the GNU General Public License is available at +# http://www.r-project.org/Licenses/ + +#.onLoad <- function(libname, pkgname) { +# ns <- .getNamespace(pkgname) +# if (is.null(ns)) stop("cannot find namespace environment for ", pkgname, domain = NA) +# dbbase <- file.path(libname, pkgname, "R", pkgname) +# lazyLoad(dbbase, ns, filter = function(n) n != ".__NAMESPACE__.") +#} diff --git a/R/bea2List.r b/R/bea2List.r index 37eaff9..1bf06e1 100644 --- a/R/bea2List.r +++ b/R/bea2List.r @@ -1,17 +1,17 @@ #' Convert BEA API httr response payload to list -#' +#' #' @param beaPayload An object with httr class 'response' from call to BEA API #' @param isMeta Special parameter meant to interact with metadata functions (default: FALSE) #' @return An object of class 'list' of several dimensions. View list structure using 'str(yourList)'. #' @import httr #' @importFrom jsonlite fromJSON #' @export -#' @examples -#' userSpecList <- list('UserID' = 'yourKey' , +#' @examplesIf interactive() && Sys.getenv("BEA_API_KEY") != "" +#' userSpecList <- list('UserID' = Sys.getenv("BEA_API_KEY"), #' 'Method' = 'GetData', #' 'datasetname' = 'NIPA', #' 'Frequency' = 'A', -#' 'TableID' = '68', +#' 'TableName' = 'T20405', #' 'Year' = 'X') #' resp <- beaGet(userSpecList, asTable = FALSE) #' BL <- bea2List(resp) @@ -20,60 +20,74 @@ bea2List <- function(beaPayload, isMeta=FALSE) { requireNamespace('httr', quietly = TRUE) requireNamespace('jsonlite', quietly = TRUE) - if(class(beaPayload) != 'response'){ - warning('Submitted variable is not a valid httr response class object.') - return('Submitted variable is not a valid httr response class object.') + + if(!inherits(beaPayload, 'response') && !inherits(beaPayload, 'character')){ + stop('Submitted variable is not a valid JSON string or httr response class object.', call.=TRUE) } - - if(floor(beaPayload$status_code/100) != 2){ - stop( - paste0('Request failed. Returned HTTP status code: ', beaPayload$status_code), - call. = FALSE - ) + + if(inherits(beaPayload, 'response')){ + if(floor(beaPayload$status_code/100) != 2){ + stop( + paste0('Request failed. Returned HTTP status code: ', beaPayload$status_code), + call. = TRUE + ) + } + + #Never going to fix later: I gave up on parsing it identically and just re-pull data as JSON. + if(length(grep("resultformat=xml", beaPayload$url, ignore.case=TRUE))==1){ + beaJSON <- httr::GET( + gsub( + "resultformat=xml", + "ResultFormat=json", + beaPayload$url, + ignore.case=TRUE + ) + ) + + beaContent <- httr::content(beaJSON, as = 'text', encoding = 'UTF-8') + } + else { + beaContent <- httr::content(beaPayload, as = 'text', encoding = 'UTF-8') + } + } else { + beaContent <- beaPayload + } + + beaResponse <- jsonlite::fromJSON(beaContent) + if(!is.element('BEAAPI', names(beaResponse))){ + stop(paste0('The submitted request was not a valid BEA API response: ', beaContent), call.=TRUE) + } + #Handler for certain dataset responses having a different structure >:( + if(inherits(beaResponse$BEAAPI$Results, 'data.frame')){ + beaResponse$BEAAPI$Results <- as.list(beaResponse$BEAAPI$Results) + beaResponse$BEAAPI$Results$Dimensions <- as.data.frame(beaResponse$BEAAPI$Results$Dimensions) + beaResponse$BEAAPI$Results$Notes <- as.data.frame(beaResponse$BEAAPI$Results$Notes) + beaResponse$BEAAPI$Results$Data <- as.data.frame(beaResponse$BEAAPI$Results$Data) + } + + if('error' %in% tolower( + attributes( + beaResponse$BEAAPI$Results + )$names) + ){ + warning(beaResponse$BEAAPI$Results$Error$APIErrorDescription) + return(beaResponse$BEAAPI$Results) } - - -#Fix later: I gave up on parsing it identically and just re-pull data as JSON - if(length(grep("resultformat=xml", beaPayload$url, ignore.case=TRUE))==1){ - beaJSON <- httr::GET( - gsub( - "resultformat=xml", - "ResultFormat=json", - beaPayload$url, - ignore.case=TRUE - ) - ) - - beaContent <- httr::content(beaJSON, as = 'text') - } - else { - beaContent <- httr::content(beaPayload, as = 'text') - } - beaResponse <- jsonlite::fromJSON(beaContent) + if(isMeta){ + beaList <- beaResponse$BEAAPI$Results + attributes(beaList)$params <- beaResponse$BEAAPI$Request$RequestParam + } else { + beaList <- beaResponse$BEAAPI$Results$Data + attributes(beaList)$params <- beaResponse$BEAAPI$Request$RequestParam + attributes(beaList)$detail <- beaResponse$BEAAPI$Results[( + attributes(beaResponse$BEAAPI$Results)$names != 'Data' + )] + beaList$DataValue <- as.numeric( + gsub(',', '', beaList$DataValue, fixed = TRUE) + ) + } - if('error' %in% tolower( - attributes( - beaResponse$BEAAPI$Results - )$names) - ){ - warning(beaResponse$BEAAPI$Results$Error$APIErrorDescription) - return(beaResponse$BEAAPI$Results) - } - - if(isMeta){ - beaList <- beaResponse$BEAAPI$Results - attributes(beaList)$params <- beaResponse$BEAAPI$Request$RequestParam - } else { - beaList <- beaResponse$BEAAPI$Results$Data - attributes(beaList)$params <- beaResponse$BEAAPI$Request$RequestParam - attributes(beaList)$detail <- beaResponse$BEAAPI$Results[( - attributes(beaResponse$BEAAPI$Results)$names != 'Data' - )] - beaList$DataValue <- as.numeric( - gsub(',', '', beaList$DataValue, fixed = TRUE) - ) - } - #Use jsonlite fromJSON f(x) to convert to list - return(beaList) + #Use jsonlite fromJSON f(x) to convert to list + return(beaList) } diff --git a/R/bea2Tab.r b/R/bea2Tab.r index 971956d..cc0d164 100644 --- a/R/bea2Tab.r +++ b/R/bea2Tab.r @@ -1,48 +1,57 @@ -#' Convert BEA API httr response or list payload to data.table -#' +#' Convert BEA API httr response or list payload to data.table +#' #' @param beaPayload An object of class 'list' or httr 'response' returned from beaGet() call to BEA API #' @param asWide Return data.table in wide format (default: TRUE) #' @param iTableStyle If "asWide = TRUE", setting "iTableStyle = TRUE" will return data.table in same format as shown on BEA website, with dates and attributes as column headers and series as rows; otherwise, results have series codes as column headers (default: TRUE) -#' @description Convert BEA API httr response or list payload to data.table. Also, converts LONG data frame (default API format - see bea2List results) to WIDE data (with years as columns) by default +#' @description Convert BEA API httr response or list payload to data.table. Also, converts LONG data frame (default API format - see bea2List results) to WIDE data (with years as columns) by default #' @return An object of class 'data.table' containing data from beaGet(...) with custom attributes(BDT)$params. #' @import data.table #' @export -#' @examples -#' userSpecList <- list('UserID' = 'yourKey' , +#' @examplesIf interactive() && Sys.getenv("BEA_API_KEY") != "" +#' userSpecList <- list('UserID' = Sys.getenv("BEA_API_KEY"), #' 'Method' = 'GetData', #' 'datasetname' = 'NIPA', #' 'Frequency' = 'A', -#' 'TableID' = '68', +#' 'TableName' = 'T20405', #' 'Year' = 'X') #' resp <- beaGet(userSpecList) #' BDT <- bea2Tab(resp) bea2Tab <- function(beaPayload, asWide = TRUE, iTableStyle = TRUE) { requireNamespace('data.table', quietly = TRUE) - if('response' %in% class(beaPayload)){ - beaResponse <- beaR::bea2List(beaPayload) + if(inherits(beaPayload, 'response')){ + beaResponse <- bea.R::bea2List(beaPayload) } else { beaResponse <- beaPayload } - + if('error' %in% tolower( attributes(beaResponse)$names ) ){ + warning('API response error. Please print your response payload for details.') return(beaResponse$Error$APIErrorDescription) } DataValue <- NULL TimePeriod <- NULL + Year <- NULL LineNumber <- NULL beaResults <- data.table::as.data.table(beaResponse) attributes(beaResults)$is.wide <- FALSE - #Convert wide matrix to long + #Some datasets use "Year" while others use "TimePeriod"; you must remove both during reshape to wide + TimeIntersect <- intersect(attributes(beaResponse)$detail$Dimensions$Name, c('TimePeriod', 'Year')) + if(length(TimeIntersect) > 1){ + TimeColName <- 'TimePeriod' + } else { + TimeColName <- TimeIntersect + } + #Convert wide matrix to long #(less common as data comes as long, but needed for beaViz) - if('data.frame' %in% class(beaPayload)){ + if(inherits(beaPayload, 'data.frame')){ if( - attributes(beaPayload)$is.wide == TRUE && + attributes(beaPayload)$is.wide == TRUE && !asWide ) { @@ -50,8 +59,8 @@ bea2Tab <- function(beaPayload, asWide = TRUE, iTableStyle = TRUE) { id <- NULL dateColNames <- sort(attributes(beaTab)$names[ grepl( - 'DataValue_', - attributes(beaTab)$names, + 'DataValue_', + attributes(beaTab)$names, fixed = TRUE ) ]) @@ -61,50 +70,54 @@ bea2Tab <- function(beaPayload, asWide = TRUE, iTableStyle = TRUE) { '', dateColNames )) - + beaResults <- try(stats::reshape( - beaTab, - varying = dateColNames, - v.names = 'DataValue', - timevar = 'TimePeriod', - times = dateVector, - direction = 'long')[, + beaTab, + varying = dateColNames, + v.names = 'DataValue', + timevar = TimeColName, + times = dateVector, + direction = 'long')[, id:=NULL ] ) - + + if(length(TimeIntersect) > 1){ + suppressWarnings(beaResults[, Year := substr(TimePeriod, 1, 4)]) + } + attributes(beaResults)$is.wide <- FALSE } } #Convert long matrix to wide (if needed) if( - asWide && + asWide && !is.null(attributes(beaResponse)$detail) ){ beaTab <- beaResults - data.table::setkey(beaTab, key = TimePeriod) + eval(parse(text = paste0('data.table::setkey(beaTab, key = ', TimeColName, ')'))) noDV <- attributes(beaTab)$names != 'DataValue' - noTS <- attributes(beaTab)$names != 'TimePeriod' + noTS <- attributes(beaTab)$names != TimeIntersect noNotes <- attributes(beaTab)$names != 'NoteRef' #A weird fix to push NA values down to bottom for reshaping beaTab[, DataValue := ifelse(is.na(DataValue), 0, DataValue)] - + # beaResults <- try(stats::reshape( -# beaTab, -# timevar = 'TimePeriod', -# idvar = attributes(beaTab)$names[noDV & noTS & noNotes], +# beaTab, +# timevar = 'TimePeriod', +# idvar = attributes(beaTab)$names[noDV & noTS & noNotes], # direction = 'wide') # ) eval( parse( text=paste0( - 'beaResults <- data.table::dcast(data.table::melt(beaTab, measure = "DataValue"),', + 'beaResults <- data.table::dcast(data.table::melt(beaTab, measure = "DataValue"),', paste( - attributes(beaTab)$names[noDV & noTS & noNotes], + attributes(beaTab)$names[noDV & noTS & noNotes], collapse='+' ), - ' ~ variable + TimePeriod)' + ' ~ variable + ', TimeColName, ')' ) ) ) @@ -112,7 +125,7 @@ bea2Tab <- function(beaPayload, asWide = TRUE, iTableStyle = TRUE) { any( tolower( attributes(beaResponse)$params$ParameterValue - ) %in% + ) %in% c('nipa', 'niunderlyingdetail', 'fixedassets') ) ){ @@ -120,10 +133,10 @@ bea2Tab <- function(beaPayload, asWide = TRUE, iTableStyle = TRUE) { } attributes(beaResults)$is.wide <- TRUE if (!iTableStyle){ - beaTrans <- beaResults - + beaTrans <- beaResults + # beaStrMatrix <- t( - beaColHeaders <- + beaColHeaders <- eval( parse( # text = paste0('beaTrans[ , .(', paste( @@ -151,28 +164,28 @@ bea2Tab <- function(beaPayload, asWide = TRUE, iTableStyle = TRUE) { # headRows <- data.table(beaStrMatrix) # dataRows <- data.table(beaNumMatrix) - + # beaResults <- rbindlist(list(headRows, dataRows)) colnames(beaNumMatrix) <- beaColHeaders beaResults <- data.table(beaNumMatrix) - beaResults[, TimePeriod := gsub('DataValue_', + eval(parse(text = paste0("beaResults[, ", TimeColName, " := gsub('DataValue_', '', attributes(beaTrans)$names[ grepl('DataValue_', attributes(beaTrans)$names, fixed = T) - ], + ], fixed = TRUE - )] - data.table::setkey(beaResults, key = TimePeriod) + )]; + data.table::setkey(beaResults, key = ", TimeColName, ");"))) } } - + attributes(beaResults)$params <- attributes(beaResponse)$params attributes(beaResults)$detail <- attributes(beaResponse)$detail - + if(is.null(attributes(beaResults)$params)){ - warning('Request response data not found; returned values may not contain successful BEA API response.') + warning('Request parameter data not found; returned values may not contain successful BEA API response.') } - + return(beaResults) -} \ No newline at end of file +} diff --git a/R/beaGet.r b/R/beaGet.r index 8c54796..75c9522 100644 --- a/R/beaGet.r +++ b/R/beaGet.r @@ -1,7 +1,7 @@ #' Pass list of user specifications (including API key) to return data from BEA API. -#' +#' #' @param beaSpec A list of user specifications (required). In this example, 'GetData' specifies that we want data values (rather than metadata), 'NIPA' specifies the dataset, 'A' specifies that we want annual data, 'TableID' = '68' gets a specific table, and 'X' gets all years. See BEA API documentation or use metadata methods for complete lists of parameters. -#' @param asString Return result body as a string (default: FALSE) +#' @param asString Return result body as a string (default: FALSE) #' @param asList Return result body as a list (default: FALSE) #' @param asTable Return result body as a data.table (default: TRUE) #' @param asWide Return data.table in wide format (default: TRUE) @@ -9,96 +9,94 @@ #' @param isMeta Special parameter meant to interact with metadata functions (default: FALSE) #' @return By default, an object of class 'list' of several dimensions. View list structure using 'str(yourList)'. #' @import httr -#' @export -#' @examples -#' userSpecList <- list('UserID' = 'yourAPIKey' , +#' @export +#' @examplesIf interactive() && Sys.getenv("BEA_API_KEY") != "" +#' userSpecList <- list('UserID' = Sys.getenv("BEA_API_KEY"), #' 'Method' = 'GetData', #' 'datasetname' = 'NIPA', #' 'Frequency' = 'A', -#' 'TableID' = '68', -#' 'Year' = 'X') +#' 'TableName' = 'T20405', +#' 'Year' = 'X') #' BDT <- beaGet(userSpecList, asTable = TRUE) -beaGet <- function(beaSpec, asString=FALSE, asList=FALSE, asTable=TRUE, asWide=TRUE, isMeta=FALSE, iTableStyle=TRUE) { +beaGet <- function(beaSpec, asString=FALSE, asList=FALSE, asTable=TRUE, asWide=TRUE, isMeta=FALSE, iTableStyle=TRUE) { #, asTS=FALSE - if(class(beaSpec) != 'list'){ + if(!inherits(beaSpec, 'list')){ warning('Please specify API parameters as a list. For example: beaGet(list("UserID" = "YourKey", "Method" = "GetData", [your remaining parameters]))') - return(paste0('Invalid object class passed to beaGet([list of API parameters]): ', class(beaSpec), '. Should be of class "list"')) + stop(paste0('Invalid object class passed to beaGet([list of API parameters]): ', class(beaSpec), '. Should be of class "list"'), call.=TRUE) } - - - + + + requireNamespace('httr', quietly = TRUE) attributes(beaSpec)$names <- tolower(attributes(beaSpec)$names) - if(class(beaSpec$userid) != 'character'){ - warning(paste0('Invalid API key of class ', class(beaSpec$userid))) - return(paste0('Invalid API key of class ', class(beaSpec$userid))) + if(!inherits(beaSpec$userid, 'character')){ + stop(paste0('Invalid API key of class ', class(beaSpec$userid)), call.=TRUE) } beaSpec$userid <- gsub(' ', '', beaSpec$userid, fixed=T) - + if(nchar(beaSpec$userid) != 36){ - warning(paste0('Invalid API key: ', beaSpec$userid)) - return(paste0('Invalid API key: ', beaSpec$userid)) + stop(paste0('Invalid API key: ', beaSpec$userid), call.=TRUE) } #Parse user settings into API URL beaUrl <- utils::URLencode( paste0( - 'https://www.bea.gov/api/data?UserID=', - beaSpec$userid, - '&', + 'https://apps.bea.gov/api/data?UserID=', + beaSpec$userid, + '&', paste( paste( - attributes(beaSpec)$names[!grepl('userid', attributes(beaSpec)$names)], - beaSpec[!grepl('userid', attributes(beaSpec)$names)], + attributes(beaSpec)$names[!grepl('userid', attributes(beaSpec)$names)], + beaSpec[!grepl('userid', attributes(beaSpec)$names)], sep = '=' - ), + ), collapse = '&' - ), '&beaR=v1', + ), '&beaR=v2', collapse = NULL) ) - - #If the user just wants to return a list or table (default), use JSON - #Drop this later if we solve XML problem in section 1 + + #If the user just wants to return a list or table (default), use JSON + #Drop this later if we solve XML problem in section 1 if(asTable||asList) { #||asTS beaUrl <- gsub( - "resultformat=xml", - "ResultFormat=json", - beaUrl, + "resultformat=xml", + "ResultFormat=json", + beaUrl, ignore.case=TRUE ) } - #Use httr GET to make the API call + #Use httr GET to make the API call beaPayload <- httr::GET(beaUrl) -#Give user format they want - #if (asTS) { - # beaResults <- bea2TS(beaPayload) - # return(beaResults) - # } - # else { - if (asTable) { - userWide <- asWide - userTabStyle <- iTableStyle - beaResults <- beaR::bea2Tab(beaPayload, asWide = userWide, iTableStyle = userTabStyle) - return(beaResults) - } - else { - if(asList) { - metaMethod <- isMeta - beaResponse <- beaR::bea2List(beaPayload, isMeta = metaMethod) - return(beaResponse) - } +#Give user format they want + if(asList && asString){ + warning('You have specified that you would like the data as both a list and a string. Please pick only one per request. Defaulting to string; if you have opted for a JSON response (default), you may pass this string to bea.R::bea2List([the JSON string returned by this function]) to return a list without making another API request.') + } + if(asString) { + beaContent <- httr::content(beaPayload, as = 'text', encoding = 'UTF-8') + return(beaContent) + } else { - if(asString) { - beaContent <- httr::content(beaPayload, as = 'text') - return(beaContent) - } - else { return(beaPayload) } + if(asList) { + metaMethod <- isMeta + beaResponse <- bea.R::bea2List(beaPayload, isMeta = metaMethod) + return(beaResponse) + } + else { + if(asTable) { + userWide <- asWide + userTabStyle <- iTableStyle + beaResults <- bea.R::bea2Tab(beaPayload, asWide = userWide, iTableStyle = userTabStyle) + return(beaResults) + } + else { + return(beaPayload) + } } } #} diff --git a/R/beaParamVals.r b/R/beaParamVals.r index 7c286fc..50ded10 100644 --- a/R/beaParamVals.r +++ b/R/beaParamVals.r @@ -1,13 +1,13 @@ -#' Gives list of values possible for a given dataset's parameters -#' +#' Gives list of values possible for a given dataset's parameters +#' #' @param beaKey Your API key #' @param setName Name of BEA dataset (e.g., NIPA) -#' @param paramName Name of BEA dataset parameter (e.g., TableID) +#' @param paramName Name of BEA dataset parameter (e.g., TableName) #' @return A metadata object of class 'list' of several dimensions. View list structure using 'str(yourList)'. #' @keywords metadata #' @export -#' @examples -#' beaParamVals('yourAPIkey', 'RegionalData', 'keycode') +#' @examplesIf interactive() && Sys.getenv("BEA_API_KEY") != "" +#' beaParamVals(Sys.getenv("BEA_API_KEY"), 'NIPA', 'TableName') beaParamVals <- function(beaKey, setName, paramName) { beaMetaSpecs <- list( @@ -17,7 +17,7 @@ beaParamVals <- function(beaKey, setName, paramName) { 'ParameterName'=paramName, 'ResultFormat' = 'json' ) - beaResponse <- beaR::beaGet(beaMetaSpecs, asList = TRUE, asTable = FALSE, isMeta = TRUE) + beaResponse <- bea.R::beaGet(beaMetaSpecs, asList = TRUE, asTable = FALSE, isMeta = TRUE) return(beaResponse) -} \ No newline at end of file +} diff --git a/R/beaParams.r b/R/beaParams.r index f178177..f8ae3b2 100644 --- a/R/beaParams.r +++ b/R/beaParams.r @@ -1,12 +1,12 @@ -#' Gives list of parameters possible for a given dataset -#' +#' Gives list of parameters possible for a given dataset +#' #' @param beaKey Your API key #' @param setName Name of BEA dataset (e.g., 'NIPA') #' @keywords metadata #' @return A metadata object of class 'list' of several dimensions. View list structure using 'str(yourList)'. #' @export -#' @examples -#' beaParams('yourAPIkey', 'RegionalData') +#' @examplesIf interactive() && Sys.getenv("BEA_API_KEY") != "" +#' beaParams(Sys.getenv("BEA_API_KEY"), 'NIPA') beaParams <- function(beaKey, setName) { beaMetaSpecs <- list( @@ -16,7 +16,7 @@ beaParams <- function(beaKey, setName) { 'ResultFormat' = 'json' ) - beaResponse <- beaR::beaGet(beaMetaSpecs, asList = TRUE, asTable = FALSE, isMeta = TRUE) + beaResponse <- bea.R::beaGet(beaMetaSpecs, asList = TRUE, asTable = FALSE, isMeta = TRUE) return(beaResponse) } diff --git a/R/beaSearch.r b/R/beaSearch.r index af5c095..1ab3b68 100644 --- a/R/beaSearch.r +++ b/R/beaSearch.r @@ -1,21 +1,22 @@ #' Search a selection of indexed BEA data table names, series labels, and series codes. -#' +#' #' @param searchTerm A word or phrase of class 'character' to be found in BEA datasets #' @param beaKey Character string representation of user API key. Necessary for first time use and updates; recommended for anything beyond one-off searches from the console. #' @param asHtml Option to return results as DT markup, viewable in browser. Allows search WITHIN YOUR ALREADY-FILTERED RESULTS ONLY. Requires package 'DT' to be installed. #' @keywords search -#' @description Searches indexed dataset table name, label, and series codes. CAUTION: Currently only works with NATIONAL datasets (NIPA, NIUnderlyingDetail), temporarily excluding FixedAssets, and REGIONAL datasets (RegionalData, RegionalProduct, RegionalIncome) +#' @description Searches indexed dataset table name, label, and series codes. CAUTION: Currently only searches within NATIONAL datasets (NIPA, NIUnderlyingDetail, FixedAssets). #' @return An object of class 'data.table' with information about all indexed sets in which the search term was found. -#' @import data.table +#' @import data.table #' @importFrom DT datatable #' @export -#' @examples -#' beaSearch('gross domestic product', asHtml = TRUE) +#' @examplesIf interactive() && Sys.getenv("BEA_API_KEY") != "" +#' beaSearch('gross domestic product', beaKey = Sys.getenv("BEA_API_KEY"), asHtml = TRUE) - beaSearch <- function(searchTerm, beaKey = NULL, asHtml = FALSE){ -# beaSearch <- function(searchTerm, searchFilter = list(), justParents = FALSE, justChildren = FALSE){ - if (is.null(beaKey)){warning('Searching without specifying beaKey, e.g., - beaSearch("tobacco", beaKey = "[your 36-character API key]") + beaSearch <- function(searchTerm, beaKey = NULL, asHtml = FALSE){ + warning('Note: This function is currently only able to search NIPA, NIUnderlyingDetail, and FixedAssets data.') +# beaSearch <- function(searchTerm, searchFilter = list(), justParents = FALSE, justChildren = FALSE){ + if (is.null(beaKey)){warning('Searching without specifying beaKey, e.g., + beaSearch("tobacco", beaKey = "[your 36-character API key]") is not recommended, as the key is needed to update locally stored metadata.')} #beaSearch throws spurious NOTEs on check() without this due to data.table Depends 'LineDescription' <- NULL @@ -36,9 +37,9 @@ is not recommended, as the key is needed to update locally stored metadata.')} '.' <- NULL 'apiCall' <- NULL 'nipaIndex' <- NULL - 'fixaIndex' <- NULL 'niudIndex' <- NULL - 'rdatIndex' <- NULL + 'fixaIndex' <- NULL +# 'rdatIndex' <- NULL 'rprdIndex' <- NULL 'rincIndex' <- NULL 'JSONUpdateDate' <- NULL @@ -46,50 +47,51 @@ is not recommended, as the key is needed to update locally stored metadata.')} requireNamespace('data.table', quietly = TRUE) beaMetadataStore <- paste0(.libPaths()[1], '/beaR/data') - + beaMetaFiles <- list.files(path = beaMetadataStore, full.names = TRUE); beaMetaFilesTimes <- file.info(beaMetaFiles, extra_cols = TRUE) beaMetaFilesTimes$Dataset <- gsub( - paste0(beaMetadataStore, '/'), - '', - attributes(beaMetaFilesTimes)$row.names, + paste0(beaMetadataStore, '/'), + '', + attributes(beaMetaFilesTimes)$row.names, fixed=T ) - beaMetaMtime <- data.table::as.data.table(beaMetaFilesTimes)[, + beaMetaMtime <- data.table::as.data.table(beaMetaFilesTimes)[, .( - Dataset = gsub('.RData', '', Dataset, fixed=T), + Dataset = gsub('.RData', '', Dataset, fixed=T), mtime ) ] data.table::setkey(beaMetaMtime, key = Dataset) - - #Temporarily remove FixedAssets for V1 + + #Add FixedAssets in future, but regionaldata has been merged into regionalproduct and regionalincome on the API beaKnownMetaSets <- list( 'nipa', 'niunderlyingdetail', -# 'fixedassets', - 'regionaldata', - 'regionalproduct', - 'regionalincome' + 'fixedassets' +# 'regional' #Not yet implemented +# Deprecated +# 'regionaldata', +# 'regionalproduct', +# 'regionalincome' ) if ((length(beaMetaFiles) == 0) & is.null(beaKey)){ - warning(paste0('No API key provided and no local metadata storage detected in ', beaMetadataStore, '. - Please provide a valid key to use beaSearch.')) - return(paste0('No API key provided and no local metadata storage detected in ', beaMetadataStore, '. Please provide a valid key to use beaSearch.')) + stop(paste0('No API key provided and no local metadata storage detected in ', beaMetadataStore, '. + Please provide a valid key to use beaSearch.'), call.=TRUE) } #Check to see if this is the first time using the search function; if so, update all metadata currently handled. - if (length(beaMetaFiles) < 5){ + if (length(beaMetaFiles) < 3){ #Create directory and make single call to get all metadata if there are missing meta .RData files - message('Creating first-time local copy of metadata for all datasets - only done once.') - message('Datasets will be updated only if timestamps indicate metadata obsolete in future searches,') - message("and only obsolete metadata sets will be updated (it's faster this way).") + message('Creating first-time local copy of metadata for all datasets.') + message('Datasets will be updated only if timestamps indicate metadata obsolete in future searches.') + #message("and only obsolete metadata sets will be updated (it's faster this way).") message("") dir.create(beaMetadataStore, showWarnings = FALSE, recursive = TRUE) - + #call function to update metadata - remember to specify beaR namespace beaUpdateMetadata(beaKnownMetaSets, beaKey) - + } else { if (!is.null(beaKey)){ #Make a "GetParameterValues" call to get timestamps of latest metadata update @@ -101,31 +103,31 @@ is not recommended, as the key is needed to update locally stored metadata.')} 'ResultFormat' = 'json' ) #Get metadata response with timestamps we need to check for updates as list - beaMetaParams <- beaR::beaGet(beaMetaTimeSpec, asList = TRUE, asTable = FALSE, isMeta = TRUE) - + beaMetaParams <- bea.R::beaGet(beaMetaTimeSpec, asList = TRUE, asTable = FALSE, isMeta = TRUE) + beaMetaInfo <- data.table::as.data.table(beaMetaParams$ParamValue) - + data.table::setkey(beaMetaInfo, key = Dataset) - + tryCatch({ #If JSON has been updated, set check param = false - + timeCompare <- beaMetaMtime[beaMetaInfo][, .( - Dataset, - mtime, + Dataset, + mtime, APImtime = as.POSIXct( - JSONUpdateDate, + JSONUpdateDate, format = "%Y-%m-%dT%H:%M:%S" ) )][!is.na(APImtime)] outdatedLocalMeta <- timeCompare[ - (is.na(mtime) & !is.na(APImtime)) | + (is.na(mtime) & !is.na(APImtime)) | APImtime > mtime, Dataset ] - - beaMetaFirstToCache <- FALSE + + beaMetaFirstToCache <- FALSE if(length(timeCompare[is.na(APImtime) & Dataset %in% beaKnownMetaSets, Dataset]) > 0){ beaMetaFirstToCache <- TRUE } @@ -133,7 +135,7 @@ is not recommended, as the key is needed to update locally stored metadata.')} error = function(e){ beaMetaFirstToCache <- TRUE beaUpdateMetadata(beaKnownMetaSets, beaKey) - }, + }, finally = {''}) if(length(outdatedLocalMeta[!tolower(outdatedLocalMeta) %in% beaKnownMetaSets]) > 0){ @@ -154,206 +156,233 @@ is not recommended, as the key is needed to update locally stored metadata.')} beaMetaFiles <- list.files(path = beaMetadataStore, full.names = TRUE); -#Temporarily remove FixedAssets from V1 + missingNat <- FALSE; + missingReg <- FALSE; + +#Remove RegionalData, but add FixedAssets later + if( + length(grep('FixedAssets', beaMetaFiles, fixed = TRUE)) == 0 | + length(grep('NIPA', beaMetaFiles, fixed = TRUE)) == 0 | + length(grep('NIUnderlyingDetail', beaMetaFiles, fixed = TRUE)) == 0 + ){ + warning(paste0('National metadata is missing from ',beaMetadataStore,' and may be locked for updating on the BEA API; searching regional metadata only.')) + missingNat <- TRUE; + } + + if( -# length(grep('FixedAssets', beaMetaFiles, fixed = TRUE)) == 0 | - length(grep('NIPA', beaMetaFiles, fixed = TRUE)) == 0 | - length(grep('NIUnderlyingDetail', beaMetaFiles, fixed = TRUE)) == 0 | - length(grep('RegionalData', beaMetaFiles, fixed = TRUE)) == 0 | - length(grep('RegionalProduct', beaMetaFiles, fixed = TRUE)) == 0 | - length(grep('RegionalIncome', beaMetaFiles, fixed = TRUE)) == 0 + #Not yet implemented + length(grep('Regional', beaMetaFiles, fixed = TRUE)) == 0 + #Deprecated +# length(grep('RegionalData', beaMetaFiles, fixed = TRUE)) == 0 | +# length(grep('RegionalProduct', beaMetaFiles, fixed = TRUE)) == 0 | +# length(grep('RegionalIncome', beaMetaFiles, fixed = TRUE)) == 0 ){ - warning(paste0('Metadata is missing from ',beaMetadataStore,' and may be locked for updating on the BEA API; please try beaSearch again later.')) - return(paste0('Metadata is missing from ',beaMetadataStore,' and may be locked for updating on the BEA API; please try beaSearch again later.')) + #Suppress for now since it may always be missing. + #warning(paste0('Regional metadata is missing from ',beaMetadataStore,' and may be locked for updating on the BEA API; searching national metadata only.')) + missingReg <- TRUE; +# return(paste0('Metadata is missing from ',beaMetadataStore,' and may be locked for updating on the BEA API; please try beaSearch again later.')) + } + + if(missingNat && missingReg){ + stop(paste0('Metadata is missing from ',beaMetadataStore,' and may be locked for updating on the BEA API; please try beaSearch again later.'), call.=TRUE) } else { -#Temporarily remove FixedAssets from V1 +#Remove RegionalData permanently try({ -# load(paste0(beaMetadataStore, '/FixedAssets.RData')) - load(paste0(beaMetadataStore, '/NIPA.RData')) - load(paste0(beaMetadataStore, '/NIUnderlyingDetail.RData')) - load(paste0(beaMetadataStore, '/RegionalData.RData')) - load(paste0(beaMetadataStore, '/RegionalProduct.RData')) - load(paste0(beaMetadataStore, '/RegionalIncome.RData')) - - - #Temporarily remove FixedAssets from V1 -# nationalIndex <- rbindlist(list(nipaIndex, niudIndex, fixaIndex), use.names = TRUE, fill=F) - nationalIndex <- rbindlist(list(nipaIndex, niudIndex), use.names = TRUE, fill=F) - nationalIndex[, Account := 'National'] - data.table::setkey(nationalIndex, key = DatasetName, TableID, LineNumber) - - regionalIndex <- rbindlist(list(rdatIndex, rprdIndex, rincIndex), use.names = TRUE, fill=F) - try(regionalIndex[, Account := 'Regional']) - data.table::setkey(regionalIndex, key = DatasetName, Parameter, Key) - - - #Search national economic accounts for term - nPerfectMatch <- nationalIndex[ - grep( - tolower(searchTerm), - tolower( + if(!missingNat){ + load(paste0(beaMetadataStore, '/FixedAssets.RData')) + load(paste0(beaMetadataStore, '/NIPA.RData')) + load(paste0(beaMetadataStore, '/NIUnderlyingDetail.RData')) + #Remove RegionalData, add FixedAssets later (fixaIndex) + nationalIndex <- rbindlist(list(nipaIndex, niudIndex, fixaIndex), use.names = TRUE, fill=F) + nationalIndex[, Account := 'National'] + data.table::setkey(nationalIndex, key = DatasetName, TableID, LineNumber) + + #Search national economic accounts for term + nPerfectMatch <- nationalIndex[ + grep( + tolower(searchTerm), + tolower( + paste( + LineDescription, + TableName, + SeriesCode, + DatasetName + ) + ), fixed=TRUE + ) + ] + + # nPerfectMatch[ , + # Parameter := NA + # ] + # nPerfectMatch[ , + # Key := NA + # ] + + nPerfectMatch[, + apiCall := + paste0( + "beaGet(list('UserID' = '[your_key]', 'Method' = 'GetData', 'DatasetName' = '", + DatasetName, + "', 'TableName' = '", + TableID, + "', ...))" + ) + ] + + + nReasonableMatch <- nationalIndex[ + grep( + searchTerm, paste( - LineDescription, - TableName, - SeriesCode, + LineDescription, + TableName, + SeriesCode, DatasetName - ) - ), fixed=TRUE - ) - ] - - # nPerfectMatch[ , - # Parameter := NA - # ] - # nPerfectMatch[ , - # Key := NA - # ] - - nPerfectMatch[, - apiCall := - paste0( - "beaGet(list('UserID' = '[your_key]', 'Method' = 'GetData', 'DatasetName' = '", - DatasetName, - "', 'TableID' = '", - TableID, - "', ...))" + ), ignore.case=TRUE ) - ] - - - nReasonableMatch <- nationalIndex[ - grep( - searchTerm, - paste( - LineDescription, - TableName, - SeriesCode, - DatasetName - ), ignore.case=TRUE - ) - ] - - # nReasonableMatch[ , - # Parameter := NA - # ] - # nReasonableMatch[ , - # Key := NA - # ] - - nReasonableMatch[, - apiCall := - paste0( - "beaGet(list('UserID' = '[your_key]', 'Method' = 'GetData', 'DatasetName' = '", - DatasetName, - "', 'TableID' = '", - TableID, - "', ...))" + ] + + # nReasonableMatch[ , + # Parameter := NA + # ] + # nReasonableMatch[ , + # Key := NA + # ] + + nReasonableMatch[, + apiCall := + paste0( + "beaGet(list('UserID' = '[your_key]', 'Method' = 'GetData', 'DatasetName' = '", + DatasetName, + "', 'TableName' = '", + TableID, + "', ...))" + ) + ] + + #FixedAssets is different from NIPA and NIUnderlyingDetail; handler here + nPerfectMatch[tolower(DatasetName) == 'fixedassets', apiCall := gsub("', 'TableName' = '", "', 'TableID' = '", apiCall, fixed = T)] + nReasonableMatch[tolower(DatasetName) == 'fixedassets', apiCall := gsub("', 'TableName' = '", "', 'TableID' = '", apiCall, fixed = T)] + + + + } + + if(!missingReg){ + load(paste0(beaMetadataStore, '/RegionalProduct.RData')) + load(paste0(beaMetadataStore, '/RegionalIncome.RData')) + # load(paste0(beaMetadataStore, '/RegionalData.RData')) + + #Removed rdatIndex, which was used for RegionalData + regionalIndex <- rbindlist(list(rprdIndex, rincIndex), use.names = TRUE, fill=F) + try(regionalIndex[, Account := 'Regional']) + data.table::setkey(regionalIndex, key = DatasetName, Parameter, Key) + + + #Search regional accounts for the term + rPerfectMatch <- regionalIndex[ + grep( + tolower(searchTerm), + tolower( + paste( + Desc, + Key, + DatasetName + ) + ), fixed=TRUE ) - ] - - - #Search regional accounts for the term - rPerfectMatch <- regionalIndex[ - grep( - tolower(searchTerm), - tolower( + ] + + # rPerfectMatch[ , + # TableID := NA + # ] + # rPerfectMatch[ , + # LineNumber := NA + # ] + # rPerfectMatch[ , + # SeriesCode := NA + # ] + # rPerfectMatch[ , + # LineDescription := NA + # ] + # rPerfectMatch[ , + # tier := NA + # ] + # rPerfectMatch[ , + # rootTabLine := NA + # ] + + + rPerfectMatch[, + apiCall := + paste0( + "beaGet(list('UserID' = '[your_key]', 'Method' = 'GetData', 'DatasetName' = '", + DatasetName, + "', '", + Parameter, + "' = '", + Key, + "', ...))" + ) + ] + + + + rReasonableMatch <- regionalIndex[ + grep( + searchTerm, paste( - Desc, - Key, + Desc, + Key, DatasetName - ) - ), fixed=TRUE - ) - ] - - # rPerfectMatch[ , - # TableID := NA - # ] - # rPerfectMatch[ , - # LineNumber := NA - # ] - # rPerfectMatch[ , - # SeriesCode := NA - # ] - # rPerfectMatch[ , - # LineDescription := NA - # ] - # rPerfectMatch[ , - # tier := NA - # ] - # rPerfectMatch[ , - # rootTabLine := NA - # ] - - - rPerfectMatch[, - apiCall := - paste0( - "beaGet(list('UserID' = '[your_key]', 'Method' = 'GetData', 'DatasetName' = '", - DatasetName, - "', '", - Parameter, - "' = '", - Key, - "', ...))" - ) - ] - - - - rReasonableMatch <- regionalIndex[ - grep( - searchTerm, - paste( - Desc, - Key, - DatasetName - ), ignore.case=TRUE - ) - ] - - # rReasonableMatch[ , - # TableID := NA - # ] - # rReasonableMatch[ , - # LineNumber := NA - # ] - # rReasonableMatch[ , - # SeriesCode := NA - # ] - # rReasonableMatch[ , - # LineDescription := NA - # ] - # rReasonableMatch[ , - # tier := NA - # ] - # rReasonableMatch[ , - # rootTabLine := NA - # ] - - rReasonableMatch[, - apiCall := - paste0( - "beaGet(list('UserID' = '[your_key]', 'Method' = 'GetData', 'DatasetName' = '", - DatasetName, - "', '", - Parameter, - "' = '", - Key, - "', ...))" + ), ignore.case=TRUE ) - ] - - - if(requireNamespace('DT', quietly = TRUE) && asHtml == TRUE){ - requireNamespace('DT', quietly = TRUE) - searchMatch <- DT::datatable(unique( + ] + + # rReasonableMatch[ , + # TableID := NA + # ] + # rReasonableMatch[ , + # LineNumber := NA + # ] + # rReasonableMatch[ , + # SeriesCode := NA + # ] + # rReasonableMatch[ , + # LineDescription := NA + # ] + # rReasonableMatch[ , + # tier := NA + # ] + # rReasonableMatch[ , + # rootTabLine := NA + # ] + + rReasonableMatch[, + apiCall := + paste0( + "beaGet(list('UserID' = '[your_key]', 'Method' = 'GetData', 'DatasetName' = '", + DatasetName, + "', '", + Parameter, + "' = '", + Key, + "', ...))" + ) + ] + } + + #TODO: figure out how to sort list by var name s.t. it concatenates lazily instead of this if-then stuff + if(!(missingNat) && !(missingReg)){ + searchMatch <- unique( rbindlist( list( - # nPerfectMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription)], - # rPerfectMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription)], - # nReasonableMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription)], - # rReasonableMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription)] + # nPerfectMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription, rootTabLine)], + # rPerfectMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription, rootTabLine)], + # nReasonableMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription, rootTabLine)], + # rReasonableMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription, rootTabLine)] nPerfectMatch, rPerfectMatch, nReasonableMatch, @@ -362,22 +391,14 @@ is not recommended, as the key is needed to update locally stored metadata.')} use.names = TRUE, fill = TRUE ) - )) + ) } - else{ - if (asHtml == TRUE){ - message('Note: Returning as data.table. You must have package DT installed to return browser-viewable table.') - } + + if(missingNat && !(missingReg)){ searchMatch <- unique( rbindlist( list( - # nPerfectMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription, rootTabLine)], - # rPerfectMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription, rootTabLine)], - # nReasonableMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription, rootTabLine)], - # rReasonableMatch[, .(apiCall, datasetName, TableID, Description, paramType, Key, LineNumber, SeriesCode, LineDescription, rootTabLine)] - nPerfectMatch, rPerfectMatch, - nReasonableMatch, rReasonableMatch ), use.names = TRUE, @@ -385,8 +406,30 @@ is not recommended, as the key is needed to update locally stored metadata.')} ) ) } + + if(!(missingNat) && missingReg){ + searchMatch <- unique( + rbindlist( + list( + nPerfectMatch, + nReasonableMatch + ), + use.names = TRUE, + fill = TRUE + ) + ) + } + + if(requireNamespace('DT', quietly = TRUE) && asHtml == TRUE){ + requireNamespace('DT', quietly = TRUE) + searchMatch <- DT::datatable(searchMatch) + } + else{ + if (asHtml == TRUE){ + message('Note: Returning as data.table. You must have package DT installed to return browser-viewable table.') + } + } return(searchMatch) }) } } - \ No newline at end of file diff --git a/R/beaSets.r b/R/beaSets.r index 1d9f310..814d843 100644 --- a/R/beaSets.r +++ b/R/beaSets.r @@ -1,22 +1,22 @@ #' Returns a list of all datasets -#' +#' #' @param beaKey Your API key #' @keywords metadata #' @return A metadata object of class 'list' of several dimensions. View list structure using 'str(yourList)'. #' @export -#' @examples -#' beaSets('yourAPIkey') +#' @examplesIf interactive() && Sys.getenv("BEA_API_KEY") != "" +#' beaSets(Sys.getenv("BEA_API_KEY")) beaSets <- function(beaKey) { - #Set up spec for it + #Set up spec for it beaMetaSpecs <- list( 'method' = 'GetDataSetList', 'UserID' = beaKey , 'ResultFormat' = 'json' ) - #Set list using beaGet - beaResponse <- beaR::beaGet(beaMetaSpecs, asList = TRUE, asTable = FALSE, isMeta = TRUE) - + #Set list using beaGet + beaResponse <- bea.R::beaGet(beaMetaSpecs, asList = TRUE, asTable = FALSE, isMeta = TRUE) + return(beaResponse) -} \ No newline at end of file +} diff --git a/R/beaUpdateMetadata.r b/R/beaUpdateMetadata.r index 223ecfb..2a43876 100644 --- a/R/beaUpdateMetadata.r +++ b/R/beaUpdateMetadata.r @@ -1,5 +1,5 @@ #' Download BEA metadata into library/data folder if needed -#' +#' #' @param datasetList list of BEA datasets to update local metadata file for (e.g., list('NIPA', 'FixedAssets')) #' @param beaKey Your API key #' @keywords metadata search @@ -7,8 +7,8 @@ #' @import httr data.table #' @importFrom jsonlite fromJSON #' @export -#' @examples -#' beaUpdateMetadata(list('RegionalData', 'NIPA'), beaKey = 'yourAPIkey') +#' @examplesIf interactive() && Sys.getenv("BEA_API_KEY") != "" +#' beaUpdateMetadata(list('NIUnderlyingDetail', 'NIPA'), beaKey = Sys.getenv("BEA_API_KEY")) beaUpdateMetadata <- function(datasetList, beaKey){ @@ -33,13 +33,14 @@ beaUpdateMetadata <- function(datasetList, beaKey){ 'Parameter' <- NULL 'ParamValue' <- NULL - #datasetList <- list('nipa','niunderlyingdetail','fixedassets','regionaldata','regionalproduct','regionalincome') - + #datasetList <- list('nipa','niunderlyingdetail','fixedassets','regionalproduct','regionalincome') + #update as of 2017-07-12: 'regionaldata' dataset removed from API, merged into regionalproduct and regionalincome + requireNamespace('data.table', quietly = TRUE) requireNamespace('httr', quietly = TRUE) requireNamespace('jsonlite', quietly = TRUE) - beaMetadataStore <- paste0(.libPaths()[1], '/beaR/data') + beaMetadataStore <- paste0(.libPaths()[1], '/bea.R/data') beaMetaSpecs <- list( 'UserID' = beaKey , @@ -48,33 +49,31 @@ beaUpdateMetadata <- function(datasetList, beaKey){ 'dataset' = paste(datasetList, collapse = ','), 'ResultFormat' = 'json' ) - + #Get as httr response - beaResponse <- beaR::beaGet(beaMetaSpecs, asList = FALSE, asTable = FALSE, isMeta = TRUE) - + beaResponse <- bea.R::beaGet(beaMetaSpecs, asList = FALSE, asTable = FALSE, isMeta = TRUE) + #Check to ensure it is httr response - if(class(beaResponse) != 'response'){ - warning('API metadata not returned. Verify that you are using a valid API key, represented as a character string.') - return('API metadata not returned. Verify that you are using a valid API key, represented as a character string.') + if(!inherits(beaResponse, 'response')){ + stop('API metadata not returned. Verify that you are using a valid API key, represented as a character string.', call.=TRUE) } - + lapply(datasetList, function(outdat){ - try(file.remove(paste0(beaMetadataStore,'/', outdat, '.RData')), silent = TRUE) + try(suppressWarnings(file.remove(paste0(beaMetadataStore,'/', outdat, '.RData'))), silent = TRUE) }) - - + + #Get JSON String respStr <- httr::content(beaResponse, as = 'text') - + #Actually, we can get this same info faster using GetParamValsList or something #The line below should be suppressed if fixed - JSON was malformed due to missing commas #respStr <- gsub('}{', '},{', respStr, fixed = TRUE) metaList <-jsonlite::fromJSON(respStr) - metasetInfo <- as.data.table(metaList$BEAAPI$Datasets) + metasetInfo <- data.table::as.data.table(metaList$BEAAPI$Datasets) if(dim(metasetInfo)[1] == 0){ - warning('API metadata not returned. Verify that you are using a valid API key, represented as a character string.') - return('API metadata not returned. Verify that you are using a valid API key, represented as a character string.') + stop('API metadata not returned. Verify that you are using a valid API key, represented as a character string.', call.=TRUE) } #bind dataset metadata together @@ -82,177 +81,198 @@ beaUpdateMetadata <- function(datasetList, beaKey){ #And do it separately for each dataset if('nipa' %in% tolower(datasetList)){try({ nipaMDU <- metasetInfo[tolower(Datasetname) == 'nipa', MetaDataUpdated] - nipaTabs <- rbindlist(metasetInfo[tolower(Datasetname) == 'nipa', APITable]) + nipaTabs <- data.table::rbindlist(metasetInfo[tolower(Datasetname) == 'nipa', APITable]) nipaTabs[, DatasetName := 'NIPA'] - - nipaRows <- rbindlist(lapply(nipaTabs[, TableID], function(thisTab){ - tabPart <- nipaTabs[TableID == thisTab, as.data.table(Line[[1]])] - tabPart[, TableID := thisTab] + #TableIDN has become obsolete; we should no longer overwrite to rename + #setnames(nipaTabs, old = names(nipaTabs)[grepl('tableidn', tolower(names(nipaTabs)),fixed = T)], new = 'TableID') + #...however, there does appear to be an issue with capitalization + setnames(nipaTabs, old = names(nipaTabs)[tolower(names(nipaTabs)) == 'tableid'], new = 'TableID') + + #Backend issue: Sometimes, NIPA table 38 has a NULL table for the line descriptions. Handle and warn the user. + handler <- c() + + nipaRowList <- lapply(nipaTabs[, TableID], function(thisTab){ + tabPart <- nipaTabs[TableID == thisTab, data.table::as.data.table(Line[[1]])] + tryCatch({tabPart[, TableID := thisTab]}, error = function(e){handler <<- c(handler, paste0(e, ': NIPA Table ', thisTab))}) return(tabPart) - })) - + }) + + nipaRows <- data.table::rbindlist(nipaRowList, use.names = TRUE) + data.table::setkey(nipaTabs, key = TableID) data.table::setkey(nipaRows, key = TableID) - + nipaIndex <- nipaTabs[nipaRows][,.( - SeriesCode, - RowNumber, - LineDescription, - LineNumber, - ParentLineNumber, - Tier, - Path, + SeriesCode, + RowNumber, + LineDescription, + LineNumber, + ParentLineNumber, + Tier, + Path, TableID, DatasetName, - TableName, + TableName, ReleaseDate, NextReleaseDate, MetaDataUpdated = nipaMDU )] save(nipaIndex, file=paste0(beaMetadataStore, '/NIPA.RData')) })} - + if('niunderlyingdetail' %in% tolower(datasetList)){try({ niudMDU <- metasetInfo[tolower(Datasetname) == 'niunderlyingdetail', MetaDataUpdated] - niudTabs <- rbindlist(metasetInfo[tolower(Datasetname) == 'niunderlyingdetail', APITable]) + niudTabs <- data.table::rbindlist(metasetInfo[tolower(Datasetname) == 'niunderlyingdetail', APITable]) niudTabs[, DatasetName := 'NIUnderlyingDetail'] - - niudRows <- rbindlist(lapply(niudTabs[, TableID], function(thisTab){ - tabPart <- niudTabs[TableID == thisTab, as.data.table(Line[[1]])] + #TableIDN has become obsolete; we should no longer overwrite to rename + #setnames(niudTabs, old = names(niudTabs)[grepl('tableidn', tolower(names(niudTabs)),fixed = T)], new = 'TableID') + #...however, there does appear to be an issue with capitalization + setnames(niudTabs, old = names(niudTabs)[tolower(names(niudTabs)) == 'tableid'], new = 'TableID') + + niudRows <- data.table::rbindlist(lapply(niudTabs[, TableID], function(thisTab){ + tabPart <- niudTabs[TableID == thisTab, data.table::as.data.table(Line[[1]])] tabPart[, TableID := thisTab] return(tabPart) })) - + data.table::setkey(niudTabs, key = TableID) data.table::setkey(niudRows, key = TableID) - + niudIndex <- niudTabs[niudRows][,.( - SeriesCode, - RowNumber, - LineDescription, - LineNumber, - ParentLineNumber, - Tier, - Path, + SeriesCode, + RowNumber, + LineDescription, + LineNumber, + ParentLineNumber, + Tier, + Path, TableID, DatasetName, - TableName, + TableName, ReleaseDate, - NextReleaseDate, + NextReleaseDate, MetaDataUpdated = niudMDU )] - + save(niudIndex, file=paste0(beaMetadataStore, '/NIUnderlyingDetail.RData')) })} - - + + if('fixedassets' %in% tolower(datasetList)){try({ fixaMDU <- metasetInfo[tolower(Datasetname) == 'fixedassets', MetaDataUpdated] - fixaTabs <- rbindlist(metasetInfo[tolower(Datasetname) == 'fixedassets', APITable]) + fixaTabs <- data.table::rbindlist(metasetInfo[tolower(Datasetname) == 'fixedassets', APITable]) fixaTabs[, DatasetName := 'FixedAssets'] - - fixaRows <- rbindlist(lapply(fixaTabs[, TableID], function(thisTab){ - tabPart <- fixaTabs[TableID == thisTab, as.data.table(Line[[1]])] + #No TableIDN here + #setnames(fixaTabs, old = names(fixaTabs)[grepl('tableidn', tolower(names(fixaTabs)),fixed = T)], new = 'TableID') + #...however, there does appear to be an issue with capitalization + setnames(fixaTabs, old = names(fixaTabs)[tolower(names(fixaTabs)) == 'tableid'], new = 'TableID') + + fixaRows <- data.table::rbindlist(lapply(fixaTabs[, TableID], function(thisTab){ + tabPart <- fixaTabs[TableID == thisTab, data.table::as.data.table(Line[[1]])] tabPart[, TableID := thisTab] return(tabPart) })) - + data.table::setkey(fixaTabs, key = TableID) data.table::setkey(fixaRows, key = TableID) - + fixaIndex <- fixaTabs[fixaRows][,.( - SeriesCode, - RowNumber, - LineDescription, - LineNumber, - ParentLineNumber, - Tier, - Path, + SeriesCode, + RowNumber, + LineDescription, + LineNumber, + ParentLineNumber, + Tier, + Path, TableID, DatasetName, - TableName, + TableName, ReleaseDate, NextReleaseDate, MetaDataUpdated = fixaMDU )] - + save(fixaIndex, file=paste0(beaMetadataStore, '/FixedAssets.RData')) })} - #Regional data: Treated differently from National data + #Regional data: Treated differently from National data #Set "RegionalData" - if('regionaldata' %in% tolower(datasetList)){try({ - - rdatMDU <- metasetInfo[tolower(Datasetname) == 'regionaldata', MetaDataUpdated] - rdatParam <- metaList$BEAAPI$Datasets$Parameter[[grep('regionaldata', tolower(metaList$BEAAPI$Datasets$Datasetname), fixed=T)]] - #rbindlist(rdatParam[[1]])[ParamValue != 'NULL'] - rdatKeys <- as.data.table(rdatParam$Keycode$ParamValue[[1]]) - rdatKeys[, Parameter := 'Keycode'] - rdatFips <- as.data.table(rdatParam$GeoFIPS$ParamValue[[2]]) - rdatFips[, Parameter := 'GeoFIPS'] - - rdatIndex <- rbindlist(list(rdatKeys, rdatFips), use.names = TRUE) - rdatIndex[, DatasetName := 'RegionalData'] - rdatIndex[, MetaDataUpdated := rdatMDU] - - save(rdatIndex, file=paste0(beaMetadataStore, '/RegionalData.RData')) - })} - + if('regionaldata' %in% tolower(datasetList)){ + warning('The RegionalData dataset has been removed from the API; please use the Regional dataset instead. Searching remaining datasets.'); +# try({ +# +# rdatMDU <- metasetInfo[tolower(Datasetname) == 'regionaldata', MetaDataUpdated] +# rdatParam <- metaList$BEAAPI$Datasets$Parameter[[grep('regionaldata', tolower(metaList$BEAAPI$Datasets$Datasetname), fixed=T)]] +# #rbindlist(rdatParam[[1]])[ParamValue != 'NULL'] +# rdatKeys <- as.data.table(rdatParam$Keycode$ParamValue[[1]]) +# rdatKeys[, Parameter := 'Keycode'] +# rdatFips <- as.data.table(rdatParam$GeoFIPS$ParamValue[[2]]) +# rdatFips[, Parameter := 'GeoFIPS'] +# +# rdatIndex <- rbindlist(list(rdatKeys, rdatFips), use.names = TRUE) +# rdatIndex[, DatasetName := 'RegionalData'] +# rdatIndex[, MetaDataUpdated := rdatMDU] +# +# save(rdatIndex, file=paste0(beaMetadataStore, '/RegionalData.RData')) +# }, silent=TRUE) + } + #Dataset "RegionalProduct" - if('regionalproduct' %in% tolower(datasetList)){try({ - rprdMDU <- metasetInfo[tolower(Datasetname) == 'regionalproduct', MetaDataUpdated] - rprdParams <- metaList$BEAAPI$Datasets$Parameters[[grep('regionalproduct', tolower(metaList$BEAAPI$Datasets$Datasetname), fixed=T)]] - rprdParNms <- attributes(rprdParams)$names - - rprdPages <- rbindlist(rprdParams)[ParamValue != 'NULL', ParamValue] - - rprdIndex <- rbindlist(lapply(1:length(rprdPages), function(x){ - rprdDT <- as.data.table(rprdPages[[x]]) - rprdDT[, Parameter := rprdParNms[x]] - return(rprdDT) - })) + if('regionalproduct' %in% tolower(datasetList)){ + warning('The RegionalProduct dataset has been removed from the API; please use the Regional dataset instead. Searching remaining datasets.'); + #try({ + #rprdMDU <- metasetInfo[tolower(Datasetname) == 'regionalproduct', MetaDataUpdated] + #rprdParams <- metaList$BEAAPI$Datasets$Parameters[[grep('regionalproduct', tolower(metaList$BEAAPI$Datasets$Datasetname), fixed=T)]] + #rprdParNms <- attributes(rprdParams)$names + #rprdPages <- data.table::rbindlist(rprdParams)[ParamValue != 'NULL', ParamValue] + #rprdIndex <- data.table::rbindlist(lapply(1:length(rprdPages), function(x){ + # rprdDT <- data.table::as.data.table(rprdPages[[x]]) + # rprdDT[, Parameter := rprdParNms[x]] + # return(rprdDT) + #})) + + #rprdIndex[, DatasetName := 'RegionalProduct'] + #rprdIndex[, MetaDataUpdated := rprdMDU] + #save(rprdIndex, file=paste0(beaMetadataStore, '/RegionalProduct.RData')) + #}, silent = TRUE) + } - rprdIndex[, DatasetName := 'RegionalProduct'] - rprdIndex[, MetaDataUpdated := rprdMDU] - - save(rprdIndex, file=paste0(beaMetadataStore, '/RegionalProduct.RData')) - })} - #Dataset "RegionalIncome" - if('regionalincome' %in% tolower(datasetList)){try({ - rincMDU <- metasetInfo[tolower(Datasetname) == 'regionalincome', MetaDataUpdated] - rincParams <- metaList$BEAAPI$Datasets$Parameters[[grep('regionalincome', tolower(metaList$BEAAPI$Datasets$Datasetname), fixed=T)]] - rincParNms <- attributes(rincParams)$names - - rincPages <- rbindlist(rincParams)[ParamValue != 'NULL', ParamValue] - - rincIndex <- rbindlist(lapply(1:length(rincPages), function(x){ - rincDT <- as.data.table(rincPages[[x]]) - rincDT[, Parameter := rincParNms[x]] - return(rincDT) - })) - - rincIndex[, DatasetName := 'RegionalIncome'] - rincIndex[, MetaDataUpdated := rincMDU] - - save(rincIndex, file=paste0(beaMetadataStore, '/RegionalIncome.RData')) - })} - + if('regionalincome' %in% tolower(datasetList)){ + message('The RegionalIncome dataset has been removed from the API; please use the Regional dataset instead. Searching remaining datasets.'); + #try({ + #rincMDU <- metasetInfo[tolower(Datasetname) == 'regionalincome', MetaDataUpdated] + #rincParams <- metaList$BEAAPI$Datasets$Parameters[[grep('regionalincome', tolower(metaList$BEAAPI$Datasets$Datasetname), fixed=T)]] + #rincParNms <- attributes(rincParams)$names + #rincPages <- data.table::rbindlist(rincParams)[ParamValue != 'NULL', ParamValue] + #rincIndex <- data.table::rbindlist(lapply(1:length(rincPages), function(x){ + # rincDT <- data.table::as.data.table(rincPages[[x]]) + # rincDT[, Parameter := rincParNms[x]] + # return(rincDT) + #})) + + #rincIndex[, DatasetName := 'RegionalIncome'] + #rincIndex[, MetaDataUpdated := rincMDU] + + # save(rincIndex, file=paste0(beaMetadataStore, '/RegionalIncome.RData')) + # }, silent = TRUE) + } + # if(length(datasetList) > length(metasetInfo[, Datasetname])){ # staleList <- datasetList[ # !(tolower(datasetList) %in% tolower(metasetInfo[, Datasetname])) # ] # message('beaR attempted to update metadata for the following dataset(s) which could not be returned from the API: ') # message(paste( -# toupper(staleList), +# toupper(staleList), # collapse = ', ' # )) # message('Removing stale data from local storage...') ## return(staleList) # }# else {return(list())} - + } diff --git a/R/beaViz.r b/R/beaViz.r deleted file mode 100644 index e631c6c..0000000 --- a/R/beaViz.r +++ /dev/null @@ -1,1670 +0,0 @@ -#' Visualize BEA API response payload -#' -#' @param beaPayload An httr response from call to BEA API -#' @param beaKey Your 36-digit BEA API key -#' @description When entered into the R console, the function below starts an interactive dashboard. CAUTION: Currently only works with NATIONAL datasets (NIPA, NIUnderlyingDetail, FixedAs-sets). R Studio users must opt to "show in browser" for this method to be fully functional. -#' @import data.table googleVis shiny shinydashboard ggplot2 stringr -#' @export -#' @examples -#' userSpecList <- list('UserID' = 'yourKey' , -#' 'Method' = 'GetData', -#' 'datasetname' = 'NIPA', -#' 'Frequency' = 'A', -#' 'TableID' = '68', -#' 'Year' = 'X') -#' resp <- beaGet(userSpecList) -#' BDF <- beaViz(resp) - -beaViz <- function(beaPayload = NULL, beaKey = NULL) { - if(!requireNamespace('googleVis', quietly = TRUE)){ - stop( - 'Package googleVis needed to use beaViz.', - call. = FALSE - ) - } - - if(!requireNamespace('shinydashboard', quietly = TRUE)){ - stop( - 'Package shinydashboard needed to use beaViz.', - call. = FALSE - ) - } - - if(!requireNamespace('shiny', quietly = TRUE)){ - stop( - 'Package shiny needed to use beaViz.', - call. = FALSE - ) - } - - requireNamespace('data.table', quietly = TRUE) - requireNamespace('googleVis', quietly = TRUE) - requireNamespace('ggplot2', quietly = TRUE) - requireNamespace('shiny', quietly = TRUE) - requireNamespace('shinydashboard', quietly = TRUE) - - - #For some reason, ifelse() does not work on bea2Tab([data.table class of beaPayload]) - # and, for now, we must transform back to LONG format for beaViz. Change this later. - if(!is.null(attributes(beaPayload)$is.wide)){ - if(attributes(beaPayload)$is.wide){ - beaTab <- beaR::bea2Tab(beaPayload, asWide = FALSE) - } else { - beaTab <- beaPayload - } - } else { - - beaTab <- ifelse( - ( - 'response' %in% class(beaPayload) || - 'list' %in% class(beaPayload) - ), - beaR::bea2Tab(beaPayload, asWide = FALSE), - beaPayload - ) - } - - beaRespChk <- ifelse( - !is.null(attributes(beaTab)$params), - TRUE, - FALSE - ) - - if(beaRespChk) { -#so uglyyyyyy - 'LineNumber' <- NULL - '.' <- NULL - 'TimePeriod' <- NULL - 'DataValue' <- NULL - 'LineDescription' <- NULL - 'SeriesCode' <- NULL - 'TableID' <- NULL - 'DatasetName' <- NULL - 'i.LineDescription' <- NULL - 'i.LineNumber' <- NULL - 'TimePeriod' <- NULL - 'LineNumber' <- NULL - 'LineDescription' <- NULL - '.' <- NULL - 'node' <- NULL - 'root' <- NULL - 'DataValue' <- NULL - 'lnNo' <- NULL - 'size' <- NULL - 'lag1' <- NULL - 'lag2' <- NULL - 'hue' <- NULL - 'pctChgNew' <- NULL - 'pctChgOld' <- NULL - 'absz' <- NULL - 'Tier' <- NULL - 'Description' <- NULL - 'TableName' <- NULL - 'Account' <- NULL - 'ParentLineNumber' <- NULL - - message('') - message('Press "ESC" to exit the beaViz function.') - message('Note: If you are using RStudio, you will need to "Open in Browser" to view graphs/table.') - message('') - message('****You can safely ignore the following errors:****') - #beaTab <- beaR::bea2Tab(beaList) - - #Get info about the dataset and request - thisDatasetLoc <- grep( - 'DATASETNAME', - attributes(beaTab)$params$ParameterName - ) - - thisDataset <- attributes(beaTab)$params$ParameterValue[thisDatasetLoc] - - thisUserIDLoc <- grepl( - 'USERID', - attributes(beaTab)$params$ParameterName - ) - - - thisUserID <- attributes(beaTab)$params$ParameterValue[thisUserIDLoc] - - - beaFreqCheck <- ifelse( - nchar( - beaTab[1, TimePeriod] - ) > - nchar( - gsub('M', '', beaTab[1, TimePeriod]) - ), - 'M', - ifelse( - nchar( - beaTab[1, TimePeriod] - ) > - nchar( - gsub('Q', '', beaTab[1, TimePeriod]) - ), - 'Q', - 'A' - ) - ) - - if(beaFreqCheck == 'A'){ - - dateRange <- unique( - beaTab[,as.Date(TimePeriod, format = '%Y')] - ) - } else { - if (beaFreqCheck == 'Q') { - dateRange <- unique(beaTab[, as.Date( - paste0( - substr(TimePeriod, 1, 4), - substr(paste0( - '0', - 3 * as.numeric( - substr(TimePeriod, 6, 6) - )), - nchar(paste0( - '0', - 3 * as.numeric( - substr(TimePeriod, 6, 6) - )) - )-1, - nchar(paste0( - '0', - 3 * as.numeric( - substr(TimePeriod, 6, 6) - ))) - ), - '01' - ), - format = '%Y%m%d') - ]); - } else { - dateRange <- unique(beaTab[, as.Date(paste0( - gsub('M','', - stringr::str_extract( - pattern = '([:digit:]{4})(M)([:digit:]{2})', - TimePeriod - ), - fixed = TRUE - ), '01'), - format = '%Y%m%d' - ) - ]); - } - } - - beaBar <- beaTab[ - LineNumber==1, - .( - TimePeriod, - DataPoint = as.numeric(gsub(',', '', DataValue, fixed=TRUE)) - ) - ][order(rank(TimePeriod))] - - topName <- unique(beaTab[LineNumber==1, LineDescription]) - - attributes(beaBar)$names <- c('Time Period', topName) - - thisTabIDLoc <- grep( - 'TABLEID', - attributes(beaTab)$params$ParameterName - ) - - thisTabID <- attributes(beaTab)$params$ParameterValue[thisTabIDLoc] - - nationalIndex <- beaR::beaSearch(' ', beaKey = thisUserID)[Account == 'National'] - data.table::setkey(nationalIndex, key = DatasetName, TableID, LineNumber) - -#/IF NATIONAL - if(!(tolower(paste0(thisDataset, thisTabID)) %in% nationalIndex[, tolower(paste0(DatasetName, TableID))])){ - message('beaViz is not available for this dataset.') - } else { - #theseSeries <- unique(beaTab[,SeriesCode]) - hierTab <- unique( - nationalIndex[ - (TableID == thisTabID) & - (toupper(DatasetName) == toupper(thisDataset)), - TableName - ] - ) - - thisIndex <- unique( - nationalIndex[ - (TableID == thisTabID) & - (toupper(DatasetName) == toupper(thisDataset)), - ] - ) - thisIndex[LineNumber == 0, LineDescription := TableName] - data.table::setkey(thisIndex, key = LineNumber) - - thisRoots <- unique( - nationalIndex[ - (TableID == thisTabID) & -# (ParentLineNumber %in% beaTab[, LineNumber]) & - (toupper(DatasetName) == toupper(thisDataset)), - ] - ) - thisRoots[LineNumber == 0, LineDescription := TableName] - data.table::setkey(thisRoots, key = ParentLineNumber) - - hierTree <- thisIndex[thisRoots][, - .( - node = paste0( - i.LineDescription, - ' [Line ', - i.LineNumber, - ']' - ), - root = ifelse( - is.na(LineNumber), - NA, - paste0( - LineDescription, - ' [Line ', - LineNumber, - ']' - ) - ), - LineNumber = i.LineNumber - ) - ] - hierTree[root == node, root := NA] - data.table::setkey(hierTree, key=LineNumber) - - - #Get a list of possible datasets - beaAllSets <- beaR::beaSets(thisUserID)$Dataset - - #Create list of names for select box -# setList <- as.list( -# beaAllSets$DatasetDescription -# ) - setStarter <- grepl( - toupper(thisDataset), - toupper(beaAllSets$DatasetName) - ) - - setOptions <- as.list(c( - beaAllSets$DatasetDescription[setStarter], - beaAllSets$DatasetDescription[!setStarter]) - ) - - #We can now move on to create dashboard - ui <- shinydashboard::dashboardPage( - shinydashboard::dashboardHeader(title = 'beaViz'), - shinydashboard::dashboardSidebar( - shiny::uiOutput('dataset'), -# tags$head(tags$style("#treemap{height:45vh !important;}")), -# tags$head(tags$style("#treemap{width:45vw !important;}")), -# tags$head(tags$style("#topbar{width:45vw !important;}")), -# shiny::tags$head(shiny::HTML("") -# ), - shiny::uiOutput('apiInp1'), - shiny::uiOutput('apiInp2'), - shiny::uiOutput('apiInp3'), - shiny::uiOutput('apiInp4'), - shiny::uiOutput('apiInp5'), - shiny::uiOutput('apiInp6'), - shiny::uiOutput('apiInp7'), - shiny::uiOutput('apiInp8'), - shiny::uiOutput('apiInp9'), - shiny::uiOutput('seriesbox') - #Removed with treemap - #, - #shiny::uiOutput('slidebar'), - #shiny::tags$p("Time period:"), - #shiny::verbatimTextOutput("userPd") - - #Removed prior to removal of treemap - #, - #shiny::tags$p("Possible params:"), - #shiny::verbatimTextOutput("userSetParams"), - #shiny::tags$p("Dataset:"), - #shiny::verbatimTextOutput("userSet"), - #shiny::tags$p("Series:"), - #shiny::verbatimTextOutput("userSer") - ), - shinydashboard::dashboardBody( - # Boxes need to be put in a row (or column) - shiny::fluidRow( - #shinydashboard::box(shiny::htmlOutput("treemap"), height = 300), - shinydashboard::box(shiny::htmlOutput("topbar"), height = 300), - shinydashboard::box(shiny::verbatimTextOutput("dataDetail"), height = 300), - height = 300 - ), - shiny::fluidRow( - shinydashboard::box( - shiny::downloadButton('downloadData', 'Download'), - shiny::htmlOutput("vistab"), - width = 9 - ), - shinydashboard::box( - shiny::tags$p("beaGet() call:"), - shiny::verbatimTextOutput("apiCall"), - width = 3 - ) - ) - ) - ) - - server <- function(input, output, session) { - # shiny::fluidRow( - # box( - # title = "Date Control", - #Removed with treemap -# output$slidebar <- shiny::renderUI({shiny::sliderInput("timePd", -# label = shiny::h5("Select Period:"), -# min(dateRange), -# max(dateRange), -# max(dateRange), -# step = ifelse( -# ( nchar(max(beaTab[, TimePeriod])) > -# nchar(gsub('M', '', max(beaTab[, TimePeriod]), fixed = TRUE)) -# ), -# 30.5, ifelse( -# ( nchar(max(beaTab[, TimePeriod])) > -# nchar(gsub('Q', '', max(beaTab[, TimePeriod]), fixed = TRUE)) -# ), -# 91, 364.25 -# ) -# ) -# , -# timeFormat = ifelse( -# ( nchar(max(beaTab[, TimePeriod])) > -# nchar(gsub('M', '', max(beaTab[, TimePeriod]), fixed = TRUE)) -# ), -# '%Ym%m', ifelse( -# ( nchar(max(beaTab[, TimePeriod])) > -# nchar(gsub('Q', '', max(beaTab[, TimePeriod]), fixed = TRUE)) -# ), -# '%Ym%m', '%Y' -# ) -# ) -## ) -## ) -# ) -# }) - - - output$dataset <- shiny::renderUI({ - shiny::selectInput( - "userSetname", - label = shiny::h5("Select dataset:"), - choices = setOptions, - selected = 1) - }) - - output$userSet <- shiny::renderPrint({ - input$userSetname - }) - - userSelectedSet <- shiny::reactive({ - toupper( - beaAllSets$DatasetName[ - beaAllSets$DatasetDescription == input$userSetname - ] - ) - }) - - #output$userSetParams <- shiny::reactive({ - userSetParams <- shiny::reactive({ - - theseParams <- beaR::beaParams(thisUserID, userSelectedSet())$Parameter - - #return(str(theseParams)) - return(theseParams) - }) - - - output$apiInp1 <- shiny::renderUI({ - - selectedSet <- userSelectedSet() - theseParams <- userSetParams() - - thisParamDesc <- theseParams[[3]][1] - thisParamCode <- theseParams[[1]][1] - - allValCheck <- ifelse(is.character(theseParams$AllValue[1]), - ifelse( - nchar(theseParams$AllValue[1]) > 0, - TRUE, - FALSE - ), - FALSE - ) - - if(is.null(thisParamCode)){ - return() - } - - if(is.na(thisParamCode)){ - return() - } else { - - allParamSet <- beaR::beaParamVals(thisUserID, selectedSet, thisParamCode)$ParamValue - if(allValCheck){ - allParamDesc <- as.list( - c(theseParams$AllValue[1], allParamSet[[1]]) - ) - attributes(allParamDesc)$names <- c('All', allParamSet[[2]]) - - } else { - allParamDesc <- as.list( - allParamSet[[1]] - ) - attributes(allParamDesc)$names <- ifelse(nchar(substr(allParamSet[[2]], 1, 35) ) < nchar(allParamSet[[2]]), paste(substr(allParamSet[[2]], 1, 35), '...'), allParamSet[[2]]) - } - - inputGetter <- shiny::selectInput( - "apiParam1", - label = shiny::h5(paste0('Select ', tolower(thisParamDesc), ':')), - choices = allParamDesc - ) - - - thisInput <- switch(selectedSet, - "REGIONALDATA" = inputGetter, - "NIPA" = inputGetter, - "NIUNDERLYINGDETAIL" = inputGetter, - "MNE" = inputGetter, - "FIXEDASSETS" = inputGetter, - "ITA" = inputGetter, - "IIP" = inputGetter, - "GDPBYINDUSTRY" = inputGetter, - "REGIONALINCOME" = inputGetter, - "REGIONALPRODUCT" = inputGetter, - "INPUTOUTPUT" = inputGetter, - "UNDERLYINGGDPBYINDUSTRY" = inputGetter - ); - - return(thisInput); - } - }) - - output$apiInp2 <- shiny::renderUI({ - - selectedSet <- userSelectedSet() - theseParams <- userSetParams() - - thisParamDesc <- theseParams[[3]][2] - thisParamCode <- theseParams[[1]][2] - - allValCheck <- ifelse(is.character(theseParams$AllValue[2]), - ifelse( - nchar(theseParams$AllValue[2]) > 0, - TRUE, - FALSE - ), - FALSE - ) - - if(is.null(thisParamCode)){ - return() - } - - if(is.na(thisParamCode)){ - return() - } else { - - allParamSet <- beaR::beaParamVals(thisUserID, selectedSet, thisParamCode)$ParamValue - if(allValCheck){ - allParamDesc <- as.list( - c(theseParams$AllValue[1], allParamSet[[1]]) - ) - attributes(allParamDesc)$names <- c('All', allParamSet[[2]]) - - } else { - allParamDesc <- as.list( - allParamSet[[1]] - ) - attributes(allParamDesc)$names <- ifelse(nchar(substr(allParamSet[[2]], 1, 35) ) < nchar(allParamSet[[2]]), paste(substr(allParamSet[[2]], 1, 35), '...'), allParamSet[[2]]) - } - - - inputGetter <- shiny::selectInput( - "apiParam2", - label = shiny::h5(paste0('Select ', tolower(thisParamDesc), ':')), - choices = allParamDesc - ) - - - thisInput <- switch(selectedSet, - "REGIONALDATA" = inputGetter, - "NIPA" = inputGetter, - "NIUNDERLYINGDETAIL" = inputGetter, - "MNE" = inputGetter, - "FIXEDASSETS" = inputGetter, - "ITA" = inputGetter, - "IIP" = inputGetter, - "GDPBYINDUSTRY" = inputGetter, - "REGIONALINCOME" = inputGetter, - "REGIONALPRODUCT" = inputGetter, - "INPUTOUTPUT" = inputGetter, - "UNDERLYINGGDPBYINDUSTRY" = inputGetter - ); - - return(thisInput); - } - }) - - output$apiInp3 <- shiny::renderUI({ - - selectedSet <- userSelectedSet() - theseParams <- userSetParams() - - thisParamDesc <- theseParams[[3]][3] - thisParamCode <- theseParams[[1]][3] - - allValCheck <- ifelse(is.character(theseParams$AllValue[3]), - ifelse( - nchar(theseParams$AllValue[3]) > 0, - TRUE, - FALSE - ), - FALSE - ) - - if(is.null(thisParamCode)){ - return() - } - - if(is.na(thisParamCode)){ - return() - } else { - - allParamSet <- beaR::beaParamVals(thisUserID, selectedSet, thisParamCode)$ParamValue - if(allValCheck){ - allParamDesc <- as.list( - c(theseParams$AllValue[1], allParamSet[[1]]) - ) - attributes(allParamDesc)$names <- c('All', allParamSet[[2]]) - - } else { - allParamDesc <- as.list( - allParamSet[[1]] - ) - attributes(allParamDesc)$names <- ifelse(nchar(substr(allParamSet[[2]], 1, 35) ) < nchar(allParamSet[[2]]), paste(substr(allParamSet[[2]], 1, 35), '...'), allParamSet[[2]]) - } - - - inputGetter <- shiny::selectInput( - "apiParam3", - label = shiny::h5(paste0('Select ', tolower(thisParamDesc), ':')), - choices = allParamDesc - ) - - - thisInput <- switch(selectedSet, - "REGIONALDATA" = inputGetter, - "NIPA" = inputGetter, - "NIUNDERLYINGDETAIL" = inputGetter, - "MNE" = inputGetter, - "FIXEDASSETS" = inputGetter, - "ITA" = inputGetter, - "IIP" = inputGetter, - "GDPBYINDUSTRY" = inputGetter, - "REGIONALINCOME" = inputGetter, - "REGIONALPRODUCT" = inputGetter, - "INPUTOUTPUT" = inputGetter, - "UNDERLYINGGDPBYINDUSTRY" = inputGetter - ); - - return(thisInput); - } - }) - - output$apiInp4 <- shiny::renderUI({ - - selectedSet <- userSelectedSet() - theseParams <- userSetParams() - - thisParamDesc <- theseParams[[3]][4] - thisParamCode <- theseParams[[1]][4] - - allValCheck <- ifelse(is.character(theseParams$AllValue[4]), - ifelse( - nchar(theseParams$AllValue[4]) > 0, - TRUE, - FALSE - ), - FALSE - ) - - if(is.null(thisParamCode)){ - return() - } - - if(is.na(thisParamCode)){ - return() - } else { - - allParamSet <- beaR::beaParamVals(thisUserID, selectedSet, thisParamCode)$ParamValue - if(allValCheck){ - allParamDesc <- as.list( - c(theseParams$AllValue[1], allParamSet[[1]]) - ) - attributes(allParamDesc)$names <- c('All', allParamSet[[2]]) - - } else { - allParamDesc <- as.list( - allParamSet[[1]] - ) - attributes(allParamDesc)$names <- ifelse(nchar(substr(allParamSet[[2]], 1, 35) ) < nchar(allParamSet[[2]]), paste(substr(allParamSet[[2]], 1, 35), '...'), allParamSet[[2]]) - } - - - inputGetter <- shiny::selectInput( - "apiParam4", - label = shiny::h5(paste0('Select ', tolower(thisParamDesc), ':')), - choices = allParamDesc - ) - - - thisInput <- switch(selectedSet, - "REGIONALDATA" = inputGetter, - "NIPA" = inputGetter, - "NIUNDERLYINGDETAIL" = inputGetter, - "MNE" = inputGetter, - "FIXEDASSETS" = inputGetter, - "ITA" = inputGetter, - "IIP" = inputGetter, - "GDPBYINDUSTRY" = inputGetter, - "REGIONALINCOME" = inputGetter, - "REGIONALPRODUCT" = inputGetter, - "INPUTOUTPUT" = inputGetter, - "UNDERLYINGGDPBYINDUSTRY" = inputGetter - ); - - return(thisInput); - } - }) - - - output$apiInp5 <- shiny::renderUI({ - - selectedSet <- userSelectedSet() - theseParams <- userSetParams() - - thisParamDesc <- theseParams[[3]][5] - thisParamCode <- theseParams[[1]][5] - - allValCheck <- ifelse(is.character(theseParams$AllValue[5]), - ifelse( - nchar(theseParams$AllValue[5]) > 0, - TRUE, - FALSE - ), - FALSE - ) - - if(is.null(thisParamCode)){ - return() - } - - if(is.na(thisParamCode)){ - return() - } else { - - allParamSet <- beaR::beaParamVals(thisUserID, selectedSet, thisParamCode)$ParamValue - if(allValCheck){ - allParamDesc <- as.list( - c(theseParams$AllValue[1], allParamSet[[1]]) - ) - attributes(allParamDesc)$names <- c('All', allParamSet[[2]]) - - } else { - allParamDesc <- as.list( - allParamSet[[1]] - ) - attributes(allParamDesc)$names <- ifelse(nchar(substr(allParamSet[[2]], 1, 35) ) < nchar(allParamSet[[2]]), paste(substr(allParamSet[[2]], 1, 35), '...'), allParamSet[[2]]) - } - - - inputGetter <- shiny::selectInput( - "apiParam5", - label = shiny::h5(paste0('Select ', tolower(thisParamDesc), ':')), - choices = allParamDesc - ) - - - thisInput <- switch(selectedSet, - "REGIONALDATA" = inputGetter, - "NIPA" = inputGetter, - "NIUNDERLYINGDETAIL" = inputGetter, - "MNE" = inputGetter, - "FIXEDASSETS" = inputGetter, - "ITA" = inputGetter, - "IIP" = inputGetter, - "GDPBYINDUSTRY" = inputGetter, - "REGIONALINCOME" = inputGetter, - "REGIONALPRODUCT" = inputGetter, - "INPUTOUTPUT" = inputGetter, - "UNDERLYINGGDPBYINDUSTRY" = inputGetter - ); - - return(thisInput); - } - }) - - output$apiInp6 <- shiny::renderUI({ - - selectedSet <- userSelectedSet() - theseParams <- userSetParams() - - thisParamDesc <- theseParams[[3]][6] - thisParamCode <- theseParams[[1]][6] - allValCheck <- ifelse(is.character(theseParams$AllValue[6]), - ifelse( - nchar(theseParams$AllValue[6]) > 0, - TRUE, - FALSE - ), - FALSE - ) - - - if(is.null(thisParamCode)){ - return() - } - - if(is.na(thisParamCode)){ - return() - } else { - - allParamSet <- beaR::beaParamVals(thisUserID, selectedSet, thisParamCode)$ParamValue - if(allValCheck){ - allParamDesc <- as.list( - c(theseParams$AllValue[1], allParamSet[[1]]) - ) - attributes(allParamDesc)$names <- c('All', allParamSet[[2]]) - - } else { - allParamDesc <- as.list( - allParamSet[[1]] - ) - attributes(allParamDesc)$names <- ifelse(nchar(substr(allParamSet[[2]], 1, 35) ) < nchar(allParamSet[[2]]), paste(substr(allParamSet[[2]], 1, 35), '...'), allParamSet[[2]]) - } - - - inputGetter <- shiny::selectInput( - "apiParam6", - label = shiny::h5(paste0('Select ', tolower(thisParamDesc), ':')), - choices = allParamDesc - ) - - - thisInput <- switch(selectedSet, - "REGIONALDATA" = inputGetter, - "NIPA" = inputGetter, - "NIUNDERLYINGDETAIL" = inputGetter, - "MNE" = inputGetter, - "FIXEDASSETS" = inputGetter, - "ITA" = inputGetter, - "IIP" = inputGetter, - "GDPBYINDUSTRY" = inputGetter, - "REGIONALINCOME" = inputGetter, - "REGIONALPRODUCT" = inputGetter, - "INPUTOUTPUT" = inputGetter, - "UNDERLYINGGDPBYINDUSTRY" = inputGetter - ); - - return(thisInput); - } - }) - - output$apiInp7 <- shiny::renderUI({ - - selectedSet <- userSelectedSet() - theseParams <- userSetParams() - - thisParamDesc <- theseParams[[3]][7] - thisParamCode <- theseParams[[1]][7] - allValCheck <- ifelse(is.character(theseParams$AllValue[7]), - ifelse( - nchar(theseParams$AllValue[7]) > 0, - TRUE, - FALSE - ), - FALSE - ) - - if(is.null(thisParamCode)){ - return() - } - - if(is.na(thisParamCode)){ - return() - } else { - - allParamSet <- beaR::beaParamVals(thisUserID, selectedSet, thisParamCode)$ParamValue - if(allValCheck){ - allParamDesc <- as.list( - c(theseParams$AllValue[1], allParamSet[[1]]) - ) - attributes(allParamDesc)$names <- c('All', allParamSet[[2]]) - - } else { - allParamDesc <- as.list( - allParamSet[[1]] - ) - attributes(allParamDesc)$names <- ifelse(nchar(substr(allParamSet[[2]], 1, 35) ) < nchar(allParamSet[[2]]), paste(substr(allParamSet[[2]], 1, 35), '...'), allParamSet[[2]]) - } - - - inputGetter <- shiny::selectInput( - "apiParam7", - label = shiny::h5(paste0('Select ', tolower(thisParamDesc), ':')), - choices = allParamDesc - ) - - thisInput <- switch(selectedSet, - "REGIONALDATA" = inputGetter, - "NIPA" = inputGetter, - "NIUNDERLYINGDETAIL" = inputGetter, - "MNE" = inputGetter, - "FIXEDASSETS" = inputGetter, - "ITA" = inputGetter, - "IIP" = inputGetter, - "GDPBYINDUSTRY" = inputGetter, - "REGIONALINCOME" = inputGetter, - "REGIONALPRODUCT" = inputGetter, - "INPUTOUTPUT" = inputGetter, - "UNDERLYINGGDPBYINDUSTRY" = inputGetter - ); - - return(thisInput); - } - }) - - output$apiInp8 <- shiny::renderUI({ - - selectedSet <- userSelectedSet() - theseParams <- userSetParams() - - thisParamDesc <- theseParams[[3]][8] - thisParamCode <- theseParams[[1]][8] - allValCheck <- ifelse(is.character(theseParams$AllValue[8]), - ifelse( - nchar(theseParams$AllValue[8]) > 0, - TRUE, - FALSE - ), - FALSE - ) - - if(is.null(thisParamCode)){ - return() - } - - if(is.na(thisParamCode)){ - return() - } else { - - allParamSet <- beaR::beaParamVals(thisUserID, selectedSet, thisParamCode)$ParamValue - if(allValCheck){ - allParamDesc <- as.list( - c(theseParams$AllValue[1], allParamSet[[1]]) - ) - attributes(allParamDesc)$names <- c('All', allParamSet[[2]]) - - } else { - allParamDesc <- as.list( - allParamSet[[1]] - ) - attributes(allParamDesc)$names <- ifelse(nchar(substr(allParamSet[[2]], 1, 35) ) < nchar(allParamSet[[2]]), paste(substr(allParamSet[[2]], 1, 35), '...'), allParamSet[[2]]) - } - - - inputGetter <- shiny::selectInput( - "apiParam8", - label = shiny::h5(paste0('Select ', tolower(thisParamDesc), ':')), - choices = allParamDesc - ) - - thisInput <- switch(selectedSet, - "REGIONALDATA" = inputGetter, - "NIPA" = inputGetter, - "NIUNDERLYINGDETAIL" = inputGetter, - "MNE" = inputGetter, - "FIXEDASSETS" = inputGetter, - "ITA" = inputGetter, - "IIP" = inputGetter, - "GDPBYINDUSTRY" = inputGetter, - "REGIONALINCOME" = inputGetter, - "REGIONALPRODUCT" = inputGetter, - "INPUTOUTPUT" = inputGetter, - "UNDERLYINGGDPBYINDUSTRY" = inputGetter - ); - - return(thisInput); - } - }) - - output$apiInp9 <- shiny::renderUI({ - - selectedSet <- userSelectedSet() - theseParams <- userSetParams() - - thisParamDesc <- theseParams[[3]][9] - thisParamCode <- theseParams[[1]][9] - allValCheck <- ifelse(is.character(theseParams$AllValue[9]), - ifelse( - nchar(theseParams$AllValue[9]) > 0, - TRUE, - FALSE - ), - FALSE - ) - - - if(is.null(thisParamCode)){ - return() - } - - if(is.na(thisParamCode)){ - return() - } else { - - allParamSet <- beaR::beaParamVals(thisUserID, selectedSet, thisParamCode)$ParamValue - if(allValCheck){ - allParamDesc <- as.list( - c(theseParams$AllValue[1], allParamSet[[1]]) - ) - attributes(allParamDesc)$names <- c('All', allParamSet[[2]]) - - } else { - allParamDesc <- as.list( - allParamSet[[1]] - ) - attributes(allParamDesc)$names <- ifelse(nchar(substr(allParamSet[[2]], 1, 35) ) < nchar(allParamSet[[2]]), paste(substr(allParamSet[[2]], 1, 35), '...'), allParamSet[[2]]) - } - - - inputGetter <- shiny::selectInput( - "apiParam8", - label = shiny::h5(paste0('Select ', tolower(thisParamDesc), ':')), - choices = allParamDesc - ) - - thisInput <- switch(selectedSet, - "REGIONALDATA" = inputGetter, - "NIPA" = inputGetter, - "NIUNDERLYINGDETAIL" = inputGetter, - "MNE" = inputGetter, - "FIXEDASSETS" = inputGetter, - "ITA" = inputGetter, - "IIP" = inputGetter, - "GDPBYINDUSTRY" = inputGetter, - "REGIONALINCOME" = inputGetter, - "REGIONALPRODUCT" = inputGetter, - "INPUTOUTPUT" = inputGetter, - "UNDERLYINGGDPBYINDUSTRY" = inputGetter - ); - - return(thisInput); - } - }) - -#Removed with treemap -# output$userPd <- shiny::renderPrint({ -# userPeriod <- ifelse( -# nchar(max(beaTab[, TimePeriod])) > -# nchar(gsub('Q', '', max(beaTab[, TimePeriod]), fixed = TRUE)), -# paste0( -# format(input$timePd, '%Y'), 'Q', -# floor((as.numeric(format(input$timePd, '%m'))+2)/3) -# ), -# ifelse( -# ( nchar(max(beaTab[, TimePeriod])) > -# nchar(gsub('M', '', max(beaTab[, TimePeriod]), fixed = TRUE)) -# ), -# format(input$timePd, '%YM%m'), format(input$timePd, '%Y') -# ) -# ) -# return(userPeriod) -# }) - - output$seriesbox <- shiny::renderUI({ - #Create list of names for select box - lineOptions <- as.list( - unique( - beaTab[order(as.numeric(LineNumber)),LineDescription] - ) - ) -# #Assign names so that select box understands - may be bad? -# attributes(lineOptions)$names <- paste0( -# 'Choice ', -# seq(1, length(lineOptions))) - shiny::selectInput( - "userSeries", - label = shiny::h5("Select series:"), - choices = lineOptions, - selected = 1 - ) - }) - - output$userSer <- shiny::renderPrint({ - input$userSeries - }) - -####Treemap section suppressed - Misleading -## output$treemap <- googleVis::renderGvis({ -## #output$treemap <- shiny::renderPlot({ -## #Get latest datapoint for each series within context of user specs -## userPeriod <- ifelse( -## nchar(max(beaTab[, TimePeriod])) > -## nchar(gsub('Q', '', max(beaTab[, TimePeriod]), fixed = TRUE)), -## paste0( -## format(input$timePd, '%Y'), 'Q', -## floor((as.numeric(format(input$timePd, '%m'))+1)/3) -## ), -## ifelse( -## ( nchar(max(beaTab[, TimePeriod])) > -## nchar(gsub('M', '', max(beaTab[, TimePeriod]), fixed = TRUE)) -## ), -## format(input$timePd, '%YM%m'), format(input$timePd, '%Y') -## ) -## ) -## -## latestTime <- ifelse( -## nchar(userPeriod) < 4, -## max(beaTab[, TimePeriod]), -## userPeriod -## ) -## latestVals <- beaTab[TimePeriod == latestTime] -## data.table::setkey(latestVals, key='LineNumber') -## -## #Get previous period's datapoint -## latestTlag <- max(beaTab[TimePeriod < latestTime, TimePeriod]) -## latestVlag <- beaTab[TimePeriod == latestTlag] -## data.table::setkey(latestVlag, key='LineNumber') -## -## #Create treemap using latest levels for size, change in pct chg for color -## tmVal <- hierTree[latestVals][, -## .(node, -## root, -## size = as.numeric(gsub(',', '', DataValue, fixed = TRUE)), -## lnNo = LineNumber -## ) -## ] -## -## root0chk <- tmVal[grep(' [Line 0]', root, fixed=T), root] -## #Special handler for "line 0" -## if(length(root0chk) > 0){ -## -## root0topV <- data.table::as.data.table( -## list( -## 'lnNo' = '0', -## 'node' = unique(root0chk), -## 'root' = NA, -## 'size' = 1 -## ) -## ) -## root0topL1 <- data.table::as.data.table( -## list( -## 'lnNo' = '0', -## 'node' = unique(root0chk), -## 'root' = NA, -## 'size' = 1, -## 'lag1' = 1 -## ) -## ) -## root0topL2 <- data.table::as.data.table( -## list( -## 'lnNo' = '0', -## 'node' = unique(root0chk), -## 'root' = NA, -## 'size' = 1, -## 'lag1' = 1, -## 'lag2' = 1 -## ) -## ) -## -## -## -## tmVal <- data.table::rbindlist( -## list( -## tmVal, -## root0topV -## ), -## use.names = TRUE -## ) -## -## -## } -## -## data.table::setkey(tmVal, key = lnNo) -## -## if(length(unique(beaTab[,TimePeriod])) >= 3) { -## #Get period before previous datapoint -## secondTlag <- max(beaTab[TimePeriod < latestTlag, TimePeriod]) -## secondVlag <- beaTab[TimePeriod == secondTlag] -## data.table::setkey(secondVlag, key='LineNumber') -## -## tmLag1 <- tmVal[latestVlag][, -## .(lnNo, node, root, size, -## lag1 = as.numeric(gsub(',','', DataValue, fixed = TRUE)) -## ) -## ] -## -## tmLag2 <- tmLag1[secondVlag][, -## .(lnNo, node, root, size, lag1, -## lag2 = as.numeric(gsub(',','', DataValue, fixed = TRUE)) -## ) -## ] -## -## if(length(root0chk) > 0){ -## tmLag1 <- data.table::rbindlist( -## list( -## tmLag1, -## root0topL1 -## ), -## use.names = TRUE -## ) -## -## tmLag2 <- data.table::rbindlist( -## list( -## tmLag2, -## root0topL2 -## ), -## use.names = TRUE -## ) -## } -## -## data.table::setkey(tmLag1, key = lnNo) -## data.table::setkey(tmLag2, key = lnNo) -## -## -## tmDT <- tmLag2[ -## !is.na(lnNo) & -## ( -## !(node %in% tmLag2[ -## !(root %in% tmLag2[, node]), -## node -## ] -## ) | ( -## lnNo == 1 | lnNo == 0 -## ) -## ), -## .(lnNo, node, root, size, lag1, lag2, -## pctChgNew = (size / lag1) - 1, -## pctChgOld = (lag1 / lag2) - 1 -## ) -## ] -## } else { -## if(length(unique(beaTab[,TimePeriod])) == 2) { -## tmLag1 <- tmVal[latestVlag][, -## .(lnNo, node, root, size, -## lag1 = as.numeric(gsub(',','', DataValue, fixed = TRUE)) -## ) -## ] -## -## #Special handler for "line 0" -## if(length(root0chk) > 0){ -## tmLag1 <- data.table::rbindlist( -## list( -## tmLag1, -## root0topL1 -## ), -## use.names = TRUE -## ) -## } -## data.table::setkey(tmLag1, key = lnNo) -## -## tmDT <- tmLag1[ -## !is.na(lnNo) & -## ( -## !(node %in% tmLag1[ -## !(root %in% tmLag1[, node]), -## node -## ] -## ) | ( -## lnNo == 1 | lnNo == 0 -## ) -## ), -## .(lnNo, node, root, size, lag1, -## pctChgNew = size, -## pctChgOld = lag1 -## ) -## ] -## } else { -## tmDT <- tmVal[ -## !is.na(lnNo) & -## ( -## !(node %in% tmVal[ -## !(root %in% tmVal[, node]), -## node -## ] -## ) | ( -## lnNo == 1 | lnNo == 0 -## ) -## ), -## .(lnNo, node, root, size, -## pctChgNew = size, -## pctChgOld = 0 -## ) -## ] -## } -## } -## -## -## #Special hue when node is changed from row 1 in sidebar -## if(input$userSeries != unique(beaTab[LineNumber == 1, LineDescription]) -## ) { -## tmDT[!is.na(node), hue := -## ifelse( -## (node == paste0(input$userSeries, ' [Line ', lnNo, ']')) -## , -## 1, ifelse(!is.na(root) & -## substr( -## root, -## 1, -## regexpr(' [Line ', root, fixed=TRUE)-1 -## ) == input$userSeries, -## 0.1, -## -1 -## ) -## ) -## ] -## } else { -## tmDT[!is.na(node), hue := -## ifelse( -## (pctChgNew - pctChgOld) > 0, -## ifelse( -## pctChgNew > 0, -## ifelse( -## pctChgOld < 0, 3, 2 -## ), 1 -## ), -## ifelse( -## (pctChgNew - pctChgOld) > 0, -## ifelse( -## pctChgNew < 0, -## ifelse( -## pctChgOld > 0, -3, -2 -## ), -1 -## ), 0 -## ) -## ) -## ] -## } -## -## -## tmDT[, absz := abs(size)] -## #tmDT[root == ' [Line 0]', root := ''] -## -## #Convert treemap data.table to data.frame, eliminate empty nodes -## tmDF <- as.data.frame(tmDT[!is.na(node)]) -## -## maxTiers <- max( -## as.numeric( -## unique( -## thisIndex[ -## as.numeric(LineNumber) %in% -## as.numeric(beaTab[LineDescription == input$userSeries, LineNumber] -## ), -## Tier -## ]) -## ) -## ) -## session$clientData$output_treemap_width -## -## Tree <- googleVis::gvisTreeMap(tmDF, -## idvar = 'node', -## parentvar = 'root', -## sizevar = 'absz', -## colorvar = 'hue', -## options = list( -## title = paste0(hierTab, ' [relative levels]'), -### titleTextStyle = '{fontSize:9}', -### maxDepth = 1, -### maxPostDepth = maxTiers, -## maxDepth = ifelse(is.character(input$userSeries), -## ifelse(maxTiers > 1, maxTiers-1, 1), -## 1 -## ), -## minColor = ifelse(is.character(input$userSeries), -## ifelse( -## input$userSeries != unique(beaTab[LineNumber == 1, LineDescription]), -## '#ababab', '#990000' -## ), -## '#990000'), -## midColor = '#ffffcc', -## maxColor = ifelse(is.character(input$userSeries), -## ifelse( -## input$userSeries != unique(beaTab[LineNumber == 1, LineDescription]), -## '#0a5eff', '#339933' -## ), -## '#339933'), -## headerHeight = 15, -## fontColor = 'black', -## showScale = FALSE, -## highlightOnMouseOver = TRUE, -### width = 'floor(0.15 * screen.width);', -## width = '100%', -### width = 'gvisWidths', -## height = 275 -## ) -## ) -## return(Tree) -## }) - - output$topbar <- googleVis::renderGvis({ - session$clientData$output_topbar_width - - beaBar <- beaTab[ - LineDescription==input$userSeries, - .( - TimePeriod, - DataPoint = as.numeric(gsub(',', '', DataValue, fixed=TRUE)) - ) - ][order(rank(TimePeriod))] - - topName <- unique(beaTab[LineDescription == input$userSeries, LineDescription]) - - attributes(beaBar)$names <- c('Time Period', topName) - - Bar <- googleVis::gvisSteppedAreaChart( - beaBar, - xvar='Time Period', - yvar=topName, - options=list( - isStacked=TRUE, - height = 275, -# width = 'floor(0.15 * screen.width);', - width = '100%', -# width = 'gvisWidths', - legend = 'none', - title = topName, - vAxis = '{}' - ) - ) - return(Bar) - }) - - output$vistab <- googleVis::renderGvis({ - preTab <- try(as.data.frame( - beaR::bea2Tab(beaTab, asWide = TRUE)[ - order( - as.numeric( - LineNumber - ) - ) - ] - ), silent = TRUE) - - ptNames <- names(preTab) - - ptnClean <- gsub('DataValue_', '', ptNames, fixed = TRUE) - ptnClean <- gsub('CL_UNIT', 'Units', ptnClean, fixed = TRUE) - ptnClean <- gsub('UNIT_MULT', 'Multiplier', ptnClean, fixed = TRUE) - - names(preTab) <- ptnClean - - vTab <- googleVis::gvisTable( - preTab, - options=list( -# title = hierTab, - page='enable', - height='automatic', - width='automatic') - ) - return(vTab) - }) - - output$dataDetail <- shiny::renderText({ - beaTabDets <- attributes(beaPayload)$detail - beaTabList <- lapply( - attributes(beaTabDets)$names, - function(thisAtr){ - if(class(beaTabDets[[thisAtr]]) == 'character'){ - beaTabElem <- beaTabDets[[thisAtr]] - } else { - #Add exception for notes - if(thisAtr == 'Notes') { - beaTabElem <- paste(beaTabDets$Notes$NoteText, collapse = "\n") - } else{ - beaElemDets <- attributes(beaTabDets[[thisAtr]]) - beaTabElem <- paste(lapply(beaElemDets$names, function(thisElem){ - return(paste0(thisElem, ': ', beaTabDets[[thisAtr]][[thisElem]])) - }), collapse = "\n") - } - } - - if(thisAtr != 'Dimensions'){ - if(tolower(thisAtr) %in% c('statistic', 'utcproductiontime')){ - return(paste0(thisAtr, ": ", beaTabElem)) - } else { - return(paste0(thisAtr, ": \n", beaTabElem)) - } - } else { - return('') - } - - }) - detailStr <- paste(beaTabList, collapse = "\n") - return(detailStr) - }) - -# output$apiCall <- shiny::renderPrint({ - output$apiCall <- shiny::renderText({ - #' userSpecList <- list('UserID' = 'yourKey' , -#' 'Method' = 'GetData', -#' 'datasetname' = 'NIPA', -#' 'Frequency' = 'A', -#' 'TableID' = '68', -#' 'Year' = 'X') - - selectedSet <- userSelectedSet() - theseParams <- userSetParams() - - userDefPrms <- theseParams$ParameterName[ - !( - nchar(theseParams$AllValue) > 0 & - is.character(theseParams$AllValue) - ) - ] - - - allValsPrms <- theseParams$ParameterName[ - ( - nchar(theseParams$AllValue) > 0 & - is.character(theseParams$AllValue) - ) - ] - - allValsSetr <- theseParams$AllValue[ - ( - nchar(theseParams$AllValue) > 0 & - is.character(theseParams$AllValue) - ) - ] - - allValsPrms <- ifelse(is.null(allValsPrms), c(NA, NA), allValsPrms) - allValsSetr <- ifelse(is.null(allValsSetr), c(NA, NA), allValsSetr) - - paramDescs <- sapply(1:length(userDefPrms), function(x){ - apiInStr <- paste0('input$apiParam', x); - apiDesc <- apiInStr #eval(parse(apiInStr)); - return(apiDesc); - }) - - paramAttrs <- sapply(1:length(userDefPrms), function(x){ - apiInStr <- paste0('attributes(input$apiParam', x, ')'); - apiAttr <- apiInStr #eval(parse(apiInStr)); - return(apiAttr); - }) - - specStr <- paste0("beaData <- beaR::beaGet( \n list(\n 'UserID' = '", thisUserID, "', \n 'Method' = 'GetData', \n 'DatasetName' = '", selectedSet,"'", - ifelse( - !is.null(userDefPrms[1]), - ifelse(!is.na(userDefPrms[1]), - paste0(", \n '", userDefPrms[1], "' = '", input$apiParam1,"'"), - ""), "" - ), - ifelse( - !is.null(userDefPrms[2]), - ifelse( - !is.na(userDefPrms[2]), - paste0(", \n '", userDefPrms[2], "' = '", input$apiParam2,"'"), - ""), "" - ), - ifelse( - !is.null(userDefPrms[3]), - ifelse( - !is.na(userDefPrms[3]), - paste0(", \n '", userDefPrms[3], "' = '", input$apiParam3,"'"), - ""), "" - ), - ifelse( - !is.null(userDefPrms[4]), - ifelse( - !is.na(userDefPrms[4]), - paste0(", \n '", userDefPrms[4], "' = '", input$apiParam4,"'"), - ""), "" - ), - ifelse( - !is.null(userDefPrms[5]), - ifelse( - !is.na(userDefPrms[5]), - paste0(", \n '", userDefPrms[5], "' = '", input$apiParam5,"'"), - ""), "" - ), - ifelse( - !is.null(userDefPrms[6]), - ifelse( - !is.na(userDefPrms[6]), - paste0(", \n '", userDefPrms[6], "' = '", input$apiParam6,"'"), - ""), "" - ), - ifelse( - !is.null(userDefPrms[7]), - ifelse( - !is.na(userDefPrms[7]), - paste0(", \n '", userDefPrms[7], "' = '", input$apiParam7,"'"), - ""), "" - ), - ifelse( - !is.null(userDefPrms[8]), - ifelse( - !is.na(userDefPrms[8]), - paste0(", \n '", userDefPrms[8], "' = '", input$apiParam8,"'"), - ""), "" - ), - ifelse( - !is.null(userDefPrms[9]), - ifelse( - !is.na(userDefPrms[9]), - paste0(", \n '", userDefPrms[9], "' = '", input$apiParam9,"'"), - ""), "" - ), - ifelse( - !is.null(allValsPrms[1]), - ifelse( - !is.na(allValsPrms[1]), - paste0(", \n '", allValsPrms[1], "' = '", allValsSetr[1],"'"), - ""), "" - ), - ifelse( - !is.null(allValsPrms[2]), - ifelse( - !is.na(allValsPrms[2]), - paste0(", \n '", allValsPrms[2], "' = '", allValsSetr[2],"'"), - ""), "" - ), - ifelse( - !is.null(allValsPrms[3]), - ifelse( - !is.na(allValsPrms[3]), - paste0(", \n '", allValsPrms[3], "' = '", allValsSetr[3],"'"), - ""), "" - ), - ifelse( - !is.null(allValsPrms[4]), - ifelse( - !is.na(allValsPrms[4]), - paste0(", \n '", allValsPrms[4], "' = '", allValsSetr[4],"'"), - ""), "" - ), - ifelse( - !is.null(allValsPrms[5]), - ifelse( - !is.na(allValsPrms[5]), - paste0(", \n '", allValsPrms[5], "' = '", allValsSetr[5],"'"), - ""), "" - ), - ifelse( - !is.null(allValsPrms[6]), - ifelse( - !is.na(allValsPrms[6]), - paste0(", \n '", allValsPrms[6], "' = '", allValsSetr[6],"'"), - ""), "" - ), - ifelse( - !is.null(allValsPrms[7]), - ifelse( - !is.na(allValsPrms[7]), - paste0(", \n '", allValsPrms[7], "' = '", allValsSetr[7],"'"), - ""), "" - ), - "))" - ) - - #return(writeLines(specStr)) - return(specStr) - - }) - - output$downloadData <- downloadHandler( - filename = function() { paste( - userSelectedSet(), - input$apiParam1, - input$apiParam2, - input$apiParam3, - input$apiParam4, - input$apiParam5, - input$apiParam6, - input$apiParam7, - input$apiParam8, - input$apiParam9, - '.csv', sep='') }, - content = function(file) { - utils::write.csv(beaR::bea2Tab(beaTab, asWide = TRUE)[ - order( - as.numeric( - LineNumber - ) - ) - ], file - ) - } - ) - - } - - suppressWarnings(shiny::shinyApp(ui, server)) - - - #if(length(unique(hierTree[, nodeID])) > unique(tmFnl[,nodeID])){ - # warning('Some rows of this data table may be missing from treemap.') - #} - } - } else{ - warning("Error in API response. Returning error information.") - return(beaTab) - } -} diff --git a/R/zzz.R b/R/zzz.R new file mode 100644 index 0000000..a591f45 --- /dev/null +++ b/R/zzz.R @@ -0,0 +1,20 @@ +.onLoad <- function(libname, pkgname) { + # Optionally bypass startup code when R CMD check is running + if (nzchar(Sys.getenv("RCMDCHECK", ""))) return() + + if (system.file("help", package = pkgname) == "") return() + + ns <- .getNamespace(pkgname) + if (is.null(ns)) stop("cannot find namespace environment for ", pkgname, domain = NA) + + dbbase <- file.path(libname, pkgname, "R", pkgname) + lazyLoad(dbbase, ns, filter = function(n) n != ".__NAMESPACE__.") +} +.onAttach <- function(libname, pkgname) { + # startup message + if (interactive()) { + packageStartupMessage("Note 1: As of February 2018, beaGet() requires 'TableName' for NIPA and NIUnderlyingDetail data instead of 'TableID.' See https://github.us-bea/bea.R for details.") + packageStartupMessage("Note 2: The BEA API no longer releases regional data under the RegionalData, RegionalIncome, or RegionalProduct dataset names; please use 'DatasetName'='Regional' for regional data instead.") + invisible() + } +} diff --git a/README.md b/README.md index 7adaa0d..743abf4 100644 --- a/README.md +++ b/README.md @@ -1,134 +1,156 @@ -# Instructions - -Thank you for taking the time to test BEA's R library. The library is intended to make it easier to retrieve and work with BEA data. - -After you test the library, please send any feedback and, if possible, code that you have written to Developers@bea.gov (feedback and code can be provided together as an .Rmd file, or can be provided separately, in the formats of your preference). - -## To Install and Load the beaR Library - -**Please take the following steps:** - -1. Run the following line of code to install the 'httr' and 'devtools' packages: - ```r - install.packages(c('devtools', 'httr')) - ``` - -2. Load the packages listed in Step 1 using the 'library' function: - ```r - library(httr) - library(devtools) - ``` - -3. Install the beaR library from the BEA GitHub repo: - ```r - httr::set_config( config( ssl_verifypeer = 0L )) #zero L - devtools::install_github('us-bea/beaR') - ``` - - -4. Load beaR using the library function. - ```r - library(beaR) - ``` -You are now ready to use beaR! - -## To Get Started -You must first [register for an API key](http://www.bea.gov/API/signup/index.cfm) from BEA by providing your name and email address. The key will be emailed to you. - -Once you have received your BEA API key, save it to a variable to make it easier to use later: - -```r -beaKey <- 'YOUR 36-DIGIT API KEY' -``` - -## To Use beaSearch and beaGet - -Currently, the beaR library offers two main methods: beaSearch and beaGet. - -### beaSearch -This method allows you to search for BEA data by keyword. For example, to find all datasets in which the term "personal consumption" appears, use the following: - -```r -beaSearch('personal consumption', beaKey) -``` - -Please note that that beaSearch currently searches only national and regional data. - -You may also specify "asHtml = TRUE" to view in-browser: -```r -beaSearch('gross domestic', beaKey, asHtml = TRUE) -``` - -The contents of this function are automatically updated using a new metadata component of BEA's API; as such, we recommend that you use it with your API key, and the first use of this function requires that you use your key or it will be unable to extract the metadata. - -If you do not wish to automatically update the metadata (e.g., you have conducted a study using the search function), simply searching for the term without also passing your key to the function will do a search only using your locally stored version. - -However, *this approach is not advised.* If you would like to retain metadata for posterity, please copy it from the "beaR/data" area of your .libPaths() directory to local storage elsewhere on your machine; this will help prevent accidental overwrite, and will not interfere with the "freshness" of your searches. - -### beaGet - -Once you have identified the TableID number and other information, you can use beaGet to access the data. The following code, for example, returns the NIPA table with 2015 data for TableID no. 66. - -```r -beaSpecs <- list( - 'UserID' = beaKey , - 'Method' = 'GetData', - 'datasetname' = 'NIPA', - 'TableID' = '66', - 'Frequency' = 'Q', - 'Year' = 'X', - 'ResultFormat' = 'json' -); -beaPayload <- beaGet(beaSpecs); -``` - -To retrieve a limited selection of multiple years, list all the years you want to retrieve. For example, to retrieve data for 2011-2015, use "Year"="2011,2012,2013,2014,2015" - -The [API documentation](http://www.bea.gov/API/bea_web_service_api_user_guide.htm) includes information about the specific parameters required by beaGET. - -Setting asWide = FALSE gives results closest to the way they are actually returned by the API (every column is a variable, every row is an observation): -```r -beaLong <- beaGet(beaSpecs, asWide = FALSE) -``` - -To return in a format in which each column represents a series, set iTableStyle = FALSE. - -This returns columns named with a concatenation of the descriptive column values, whereas rows are populated with numeric DataValues for each TimePeriod, and has one column named "TimePeriod" filled with dates. -```r -beaStatTab <- beaGet(beaSpecs, iTableStyle = FALSE) -``` - -By default, asWide = TRUE and iTableStyle = TRUE, as this format is the most similar to our iTables; the "beaPayload" object in our first beaGet example at the beginning of this section is in the default format. - - -## To Use beaViz - -The beaR library also includes an experimental method to create a visual dashboard. This method is still under development. Currently, it is designed to work with the standard R Console interface—not with other interfaces such as R Studio. (However, if you want to experiment with beaViz in R Studio, click on "Open in Browser" at the top of pop-up box after you execute the beaViz method. - -The beaViz method allows you to pass a variable generated from beaGet to create a dashboard. To use the "beaPayload" example given above, enter the following command: - -```r -beaViz(beaPayload) -``` -Please note that beaViz is currently only available for use with the NIPA and NIUnderlyingDetail datasets and the associated metadata. -BEA is open to any thoughts you may have about visually representing BEA data. - - -# About beaR -beaR is a library for use with BEA’s API and the R programming language, version 3.2.1 or higher. - -This library serves two core purposes: - -1. To Extract/Transform/Load data [beaGet] from the BEA API as R-friendly formats in the user's workspace. Transformation done by default in beaGet is analogous to the format used in [BEA's iTables](http://www.bea.gov/itable/index.cfm), but this can be modified using beaGet's optional parameters. - -2. To enable the search of descriptive metadata [beaSearch]. - -Other features of the library exist mainly as intermediate methods or are in early stages of development. - - -# Disclaimer -The United States Department of Commerce (DOC) GitHub project code is provided on an ‘as is’ basis and the user assumes responsibility for its use. DOC has relinquished control of the information and no longer has responsibility to protect the integrity, confidentiality, or availability of the information. Any claims against the Department of Commerce stemming from the use of its GitHub project will be governed by all applicable Federal law. Any reference to specific commercial products, processes, or services by service mark, trademark, manufacturer, or otherwise, does not constitute or imply their endorsement, recommendation or favoring by the Department of Commerce. The Department of Commerce seal and logo, or the seal and logo of a DOC bureau, shall not be used in any manner to imply endorsement of any commercial product or activity by DOC or the United States Government. - -Use of this library will result in data being stored on users' local machines. Specifically, local copies of BEA API metadata will be stored and automatically updated in the .libPaths() "/beaR/data" directory in order to improve performance of beaSearch. - - +# Patch/issue notes + +*GetParameterValuesFiltered method for list of parameters:* If your request returns the error message "The dataset requested requires parameters that were missing from the request" and the `beaParamVals()` method returns a very large number of results, [see the help request here](https://github.com/us-bea/bea.R/pull/5) for an example of how to use `beaGet()` to return a filtered list of parameters. + +*Patch 1.0.5 Note:* The parameter used to make a beaGet() call for NIPA and NIUnderlyingDetail data sets have changed as of February 2018. "TableID" has been discontinued, and "TableName" has been added, with parameter values that differ from the obsolete TableID values. + +To find the new parameters to use with TableName, use any one of the following: + +```R + beaSearch('NIPA', '[your 36-digit BEA API key]') + beaParamVals('[your 36-digit BEA API key]', 'NIPA', 'TableName') + beaSearch('NIUnderlyingDetail', '[your 36-digit BEA API key]') + beaParamVals('[your 36-digit BEA API key]', 'NIUnderlyingDetail', 'TableName') +``` + +*Patch 1.0.2 Note:* The RegionalIncome and RegionalProduct data sets replaced RegionalData at the end of May 2017. The "RegionalData" dataset has been discontinued, and the package was patched (v1.0.2) to update the beaSearch function accordingly. + + +# Instructions + +Thank you for using BEA's R library. The library is intended to make it easier to retrieve and work with BEA data. + +After you test the library, please send any feedback and, if possible, code that you have written to Developers@bea.gov (feedback and code can be provided together as an .Rmd file, or can be provided separately, in the formats of your preference). +## To Install and Load the stable, published version of the bea.R Library (recommended) + +```R + install.packages('bea.R') + library(bea.R) +``` + +## To Install and Load the development version of the bea.R Library (not recommended) + +**Please take the following steps:** + +1. Run the following line of code to install the 'httr' and 'devtools' packages: +```r + install.packages(c('devtools', 'httr')) +``` + +2. Load the packages listed in Step 1 using the 'library' function: +```r + library(httr) + library(devtools) +``` + +3. Install the bea.R library from the BEA GitHub repo: +```r + httr::set_config( config( ssl_verifypeer = 0L )) #zero L + devtools::install_github('us-bea/bea.R') +``` + + +4. Load bea.R using the library function. +```r + library(bea.R) +``` +You are now ready to use bea.R! + +## To Get Started +You must first [register for an API key](http://www.bea.gov/API/signup/index.cfm) from BEA by providing your name and email address. The key will be emailed to you. + +Once you have received your BEA API key, save it to a variable to make it easier to use later: + +```r +beaKey <- 'YOUR 36-DIGIT API KEY' +``` + +## To Use beaSearch and beaGet + +Currently, the bea.R library offers two main methods: beaSearch and beaGet. + +### beaSearch +This method allows you to search for BEA data by keyword. For example, to find all datasets in which the term "personal consumption" appears, use the following: + +```r +beaSearch('personal consumption', beaKey) +``` + +Please note that that beaSearch currently searches only national and regional data. + +You may also specify "asHtml = TRUE" to view in-browser: +```r +beaSearch('gross domestic', beaKey, asHtml = TRUE) +``` + +The contents of this function are automatically updated using a new metadata component of BEA's API; as such, we recommend that you use it with your API key, and the first use of this function requires that you use your key or it will be unable to extract the metadata. + +If you do not wish to automatically update the metadata (e.g., you have conducted a study using the search function), simply searching for the term without also passing your key to the function will do a search only using your locally stored version. + +However, *this approach is not advised.* If you would like to retain metadata for posterity, please copy it from the "bea.R/data" area of your .libPaths() directory to local storage elsewhere on your machine; this will help prevent accidental overwrite, and will not interfere with the "freshness" of your searches. + +### beaGet + +Once you have identified the TableID number and other information, you can use beaGet to access the data. The following code, for example, returns the NIPA table with 2015 data for TableID no. 66. + +```r +beaSpecs <- list( + 'UserID' = beaKey , + 'Method' = 'GetData', + 'datasetname' = 'NIPA', + 'TableName' = 'T20305', + 'Frequency' = 'Q', + 'Year' = 'X', + 'ResultFormat' = 'json' +); +beaPayload <- beaGet(beaSpecs); +``` + +To retrieve a limited selection of multiple years, list all the years you want to retrieve. For example, to retrieve data for 2011-2015, use "Year"="2011,2012,2013,2014,2015" + +The [API documentation](http://www.bea.gov/API/bea_web_service_api_user_guide.htm) includes information about the specific parameters required by beaGET. + +Setting asWide = FALSE gives results closest to the way they are actually returned by the API (every column is a variable, every row is an observation): +```r +beaLong <- beaGet(beaSpecs, asWide = FALSE) +``` + +To return in a format in which each column represents a series, set iTableStyle = FALSE. + +This returns columns named with a concatenation of the descriptive column values, whereas rows are populated with numeric DataValues for each TimePeriod, and has one column named "TimePeriod" filled with dates. +```r +beaStatTab <- beaGet(beaSpecs, iTableStyle = FALSE) +``` + +By default, asWide = TRUE and iTableStyle = TRUE, as this format is the most similar to our iTables; the "beaPayload" object in our first beaGet example at the beginning of this section is in the default format. + + +## To Use beaViz + +The bea.R library also includes an experimental method to create a visual dashboard. This method is still under development. Currently, it is designed to work with the standard R Console interface—not with other interfaces such as R Studio. (However, if you want to experiment with beaViz in R Studio, click on "Open in Browser" at the top of pop-up box after you execute the beaViz method. + +The beaViz method allows you to pass a variable generated from beaGet to create a dashboard. To use the "beaPayload" example given above, enter the following command: + +```r +beaViz(beaPayload) +``` +Please note that beaViz is currently only available for use with the NIPA and NIUnderlyingDetail datasets and the associated metadata. +BEA is open to any thoughts you may have about visually representing BEA data. + + +# About bea.R +bea.R is a library for use with BEA’s API and the R programming language, version 3.2.1 or higher. + +This library serves two core purposes: + +1. To Extract/Transform/Load data [beaGet] from the BEA API as R-friendly formats in the user's workspace. Transformation done by default in beaGet is analogous to the format used in [BEA's iTables](https://www.bea.gov/itable), but this can be modified using beaGet's optional parameters. + +2. To enable the search of descriptive metadata [beaSearch]. + +Other features of the library exist mainly as intermediate methods or are in early stages of development. + + +# Disclaimer +The United States Department of Commerce (DOC) GitHub project code is provided on an ‘as is’ basis and the user assumes responsibility for its use. DOC has relinquished control of the information and no longer has responsibility to protect the integrity, confidentiality, or availability of the information. Any claims against the Department of Commerce stemming from the use of its GitHub project will be governed by all applicable Federal law. Any reference to specific commercial products, processes, or services by service mark, trademark, manufacturer, or otherwise, does not constitute or imply their endorsement, recommendation or favoring by the Department of Commerce. The Department of Commerce seal and logo, or the seal and logo of a DOC bureau, shall not be used in any manner to imply endorsement of any commercial product or activity by DOC or the United States Government. + +Use of this library will result in data being stored on users' local machines. Specifically, local copies of BEA API metadata will be stored and automatically updated in the .libPaths() "/bea.R/data" directory in order to improve performance of beaSearch. diff --git a/bea.R.Rproj b/bea.R.Rproj new file mode 100644 index 0000000..09ef544 --- /dev/null +++ b/bea.R.Rproj @@ -0,0 +1,23 @@ +Version: 1.0 +ProjectId: 773d3faa-07bc-4169-850c-485cb5b2c3c1 + +RestoreWorkspace: No +SaveWorkspace: No +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +AutoAppendNewline: Yes +StripTrailingWhitespace: Yes +LineEndingConversion: Posix + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source +PackageRoxygenize: rd,collate,namespace diff --git a/beaR_Manual.pdf b/beaR_Manual.pdf index 8951f3e..f7eb9e1 100644 Binary files a/beaR_Manual.pdf and b/beaR_Manual.pdf differ diff --git a/help/AnIndex b/help/AnIndex new file mode 100644 index 0000000..b7e8842 --- /dev/null +++ b/help/AnIndex @@ -0,0 +1,9 @@ +bea2List bea2List +bea2Tab bea2Tab +beaGet beaGet +beaParams beaParams +beaParamVals beaParamVals +beaSearch beaSearch +beaSets beaSets +beaUpdateMetadata beaUpdateMetadata +beaViz beaViz diff --git a/help/aliases.rds b/help/aliases.rds new file mode 100644 index 0000000..9fdbca7 Binary files /dev/null and b/help/aliases.rds differ diff --git a/help/bea.R.rdb b/help/bea.R.rdb new file mode 100644 index 0000000..8bbbda0 Binary files /dev/null and b/help/bea.R.rdb differ diff --git a/help/bea.R.rdx b/help/bea.R.rdx new file mode 100644 index 0000000..0f0f06c Binary files /dev/null and b/help/bea.R.rdx differ diff --git a/help/paths.rds b/help/paths.rds new file mode 100644 index 0000000..76d7794 Binary files /dev/null and b/help/paths.rds differ diff --git a/html/00Index.html b/html/00Index.html new file mode 100644 index 0000000..a0601fe --- /dev/null +++ b/html/00Index.html @@ -0,0 +1,42 @@ + + +R: Bureau of Economic Analysis API + + + +

Bureau of Economic Analysis API + +

+
+
+[Up] +[Top] +

Documentation for package ‘bea.R’ version 1.0.6

+ + + +

Help Pages

+ + + + + + + + + + + + + + + + + + + + + +
bea2ListConvert BEA API httr response payload to list
bea2TabConvert BEA API httr response or list payload to data.table
beaGetPass list of user specifications (including API key) to return data from BEA API.
beaParamsGives list of parameters possible for a given dataset
beaParamValsGives list of values possible for a given dataset's parameters
beaSearchSearch a selection of indexed BEA data table names, series labels, and series codes.
beaSetsReturns a list of all datasets
beaUpdateMetadataDownload BEA metadata into library/data folder if needed
beaVizVisualize BEA API response payload
+ diff --git a/html/R.css b/html/R.css new file mode 100644 index 0000000..ab8c9bd --- /dev/null +++ b/html/R.css @@ -0,0 +1,97 @@ +body { + background: white; + color: black; +} + +a:link { + background: white; + color: blue; +} + +a:visited { + background: white; + color: rgb(50%, 0%, 50%); +} + +h1 { + background: white; + color: rgb(55%, 55%, 55%); + font-family: monospace; + font-size: x-large; + text-align: center; +} + +h2 { + background: white; + color: rgb(40%, 40%, 40%); + font-family: monospace; + font-size: large; + text-align: center; +} + +h3 { + background: white; + color: rgb(40%, 40%, 40%); + font-family: monospace; + font-size: large; +} + +h4 { + background: white; + color: rgb(40%, 40%, 40%); + font-family: monospace; + font-style: italic; + font-size: large; +} + +h5 { + background: white; + color: rgb(40%, 40%, 40%); + font-family: monospace; +} + +h6 { + background: white; + color: rgb(40%, 40%, 40%); + font-family: monospace; + font-style: italic; +} + +img.toplogo { + width: 4em; + vertical-align: middle; +} + +img.arrow { + width: 30px; + height: 30px; + border: 0; +} + +span.acronym { + font-size: small; +} + +span.env { + font-family: monospace; +} + +span.file { + font-family: monospace; +} + +span.option{ + font-family: monospace; +} + +span.pkg { + font-weight: bold; +} + +span.samp{ + font-family: monospace; +} + +div.vignettes a:hover { + background: rgb(85%, 85%, 85%); +} diff --git a/man/bea2List.Rd b/man/bea2List.Rd index 5943efb..6b6bb64 100644 --- a/man/bea2List.Rd +++ b/man/bea2List.Rd @@ -1,30 +1,31 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/bea2List.r -\name{bea2List} -\alias{bea2List} -\title{Convert BEA API httr response payload to list} -\usage{ -bea2List(beaPayload, isMeta = FALSE) -} -\arguments{ -\item{beaPayload}{An object with httr class 'response' from call to BEA API} - -\item{isMeta}{Special parameter meant to interact with metadata functions (default: FALSE)} -} -\value{ -An object of class 'list' of several dimensions. View list structure using 'str(yourList)'. -} -\description{ -Convert BEA API httr response payload to list -} -\examples{ -userSpecList <- list('UserID' = 'yourKey' , - 'Method' = 'GetData', - 'datasetname' = 'NIPA', - 'Frequency' = 'A', - 'TableID' = '68', - 'Year' = 'X') -resp <- beaGet(userSpecList, asTable = FALSE) -BL <- bea2List(resp) -} - +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bea2List.r +\name{bea2List} +\alias{bea2List} +\title{Convert BEA API httr response payload to list} +\usage{ +bea2List(beaPayload, isMeta = FALSE) +} +\arguments{ +\item{beaPayload}{An object with httr class 'response' from call to BEA API} + +\item{isMeta}{Special parameter meant to interact with metadata functions (default: FALSE)} +} +\value{ +An object of class 'list' of several dimensions. View list structure using 'str(yourList)'. +} +\description{ +Convert BEA API httr response payload to list +} +\examples{ +\dontshow{if (interactive() && Sys.getenv("BEA_API_KEY") != "") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +userSpecList <- list('UserID' = Sys.getenv("BEA_API_KEY"), + 'Method' = 'GetData', + 'datasetname' = 'NIPA', + 'Frequency' = 'A', + 'TableName' = 'T20405', + 'Year' = 'X') +resp <- beaGet(userSpecList, asTable = FALSE) +BL <- bea2List(resp) +\dontshow{\}) # examplesIf} +} diff --git a/man/bea2Tab.Rd b/man/bea2Tab.Rd index 2a48385..5d7ec87 100644 --- a/man/bea2Tab.Rd +++ b/man/bea2Tab.Rd @@ -1,32 +1,33 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/bea2Tab.r -\name{bea2Tab} -\alias{bea2Tab} -\title{Convert BEA API httr response or list payload to data.table} -\usage{ -bea2Tab(beaPayload, asWide = TRUE, iTableStyle = TRUE) -} -\arguments{ -\item{beaPayload}{An object of class 'list' or httr 'response' returned from beaGet() call to BEA API} - -\item{asWide}{Return data.table in wide format (default: TRUE)} - -\item{iTableStyle}{If "asWide = TRUE", setting "iTableStyle = TRUE" will return data.table in same format as shown on BEA website, with dates and attributes as column headers and series as rows; otherwise, results have series codes as column headers (default: TRUE)} -} -\value{ -An object of class 'data.table' containing data from beaGet(...) with custom attributes(BDT)$params. -} -\description{ -Convert BEA API httr response or list payload to data.table. Also, converts LONG data frame (default API format - see bea2List results) to WIDE data (with years as columns) by default -} -\examples{ -userSpecList <- list('UserID' = 'yourKey' , - 'Method' = 'GetData', - 'datasetname' = 'NIPA', - 'Frequency' = 'A', - 'TableID' = '68', - 'Year' = 'X') -resp <- beaGet(userSpecList) -BDT <- bea2Tab(resp) -} - +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/bea2Tab.r +\name{bea2Tab} +\alias{bea2Tab} +\title{Convert BEA API httr response or list payload to data.table} +\usage{ +bea2Tab(beaPayload, asWide = TRUE, iTableStyle = TRUE) +} +\arguments{ +\item{beaPayload}{An object of class 'list' or httr 'response' returned from beaGet() call to BEA API} + +\item{asWide}{Return data.table in wide format (default: TRUE)} + +\item{iTableStyle}{If "asWide = TRUE", setting "iTableStyle = TRUE" will return data.table in same format as shown on BEA website, with dates and attributes as column headers and series as rows; otherwise, results have series codes as column headers (default: TRUE)} +} +\value{ +An object of class 'data.table' containing data from beaGet(...) with custom attributes(BDT)$params. +} +\description{ +Convert BEA API httr response or list payload to data.table. Also, converts LONG data frame (default API format - see bea2List results) to WIDE data (with years as columns) by default +} +\examples{ +\dontshow{if (interactive() && Sys.getenv("BEA_API_KEY") != "") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +userSpecList <- list('UserID' = Sys.getenv("BEA_API_KEY"), + 'Method' = 'GetData', + 'datasetname' = 'NIPA', + 'Frequency' = 'A', + 'TableName' = 'T20405', + 'Year' = 'X') +resp <- beaGet(userSpecList) +BDT <- bea2Tab(resp) +\dontshow{\}) # examplesIf} +} diff --git a/man/beaGet.Rd b/man/beaGet.Rd index c61b3c6..79ea7b1 100644 --- a/man/beaGet.Rd +++ b/man/beaGet.Rd @@ -1,40 +1,48 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/beaGet.r -\name{beaGet} -\alias{beaGet} -\title{Pass list of user specifications (including API key) to return data from BEA API.} -\usage{ -beaGet(beaSpec, asString = FALSE, asList = FALSE, asTable = TRUE, - asWide = TRUE, isMeta = FALSE, iTableStyle = TRUE) -} -\arguments{ -\item{beaSpec}{A list of user specifications (required). In this example, 'GetData' specifies that we want data values (rather than metadata), 'NIPA' specifies the dataset, 'A' specifies that we want annual data, 'TableID' = '68' gets a specific table, and 'X' gets all years. See BEA API documentation or use metadata methods for complete lists of parameters.} - -\item{asString}{Return result body as a string (default: FALSE)} - -\item{asList}{Return result body as a list (default: FALSE)} - -\item{asTable}{Return result body as a data.table (default: TRUE)} - -\item{asWide}{Return data.table in wide format (default: TRUE)} - -\item{isMeta}{Special parameter meant to interact with metadata functions (default: FALSE)} - -\item{iTableStyle}{If "asWide = TRUE", setting "iTableStyle = TRUE" will return data.table in same format as shown on BEA website, with dates and attributes as column headers and series as rows; otherwise, results have series codes as column headers (default: TRUE)} -} -\value{ -By default, an object of class 'list' of several dimensions. View list structure using 'str(yourList)'. -} -\description{ -Pass list of user specifications (including API key) to return data from BEA API. -} -\examples{ -userSpecList <- list('UserID' = 'yourAPIKey' , - 'Method' = 'GetData', - 'datasetname' = 'NIPA', - 'Frequency' = 'A', - 'TableID' = '68', - 'Year' = 'X') -BDT <- beaGet(userSpecList, asTable = TRUE) -} - +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/beaGet.r +\name{beaGet} +\alias{beaGet} +\title{Pass list of user specifications (including API key) to return data from BEA API.} +\usage{ +beaGet( + beaSpec, + asString = FALSE, + asList = FALSE, + asTable = TRUE, + asWide = TRUE, + isMeta = FALSE, + iTableStyle = TRUE +) +} +\arguments{ +\item{beaSpec}{A list of user specifications (required). In this example, 'GetData' specifies that we want data values (rather than metadata), 'NIPA' specifies the dataset, 'A' specifies that we want annual data, 'TableID' = '68' gets a specific table, and 'X' gets all years. See BEA API documentation or use metadata methods for complete lists of parameters.} + +\item{asString}{Return result body as a string (default: FALSE)} + +\item{asList}{Return result body as a list (default: FALSE)} + +\item{asTable}{Return result body as a data.table (default: TRUE)} + +\item{asWide}{Return data.table in wide format (default: TRUE)} + +\item{isMeta}{Special parameter meant to interact with metadata functions (default: FALSE)} + +\item{iTableStyle}{If "asWide = TRUE", setting "iTableStyle = TRUE" will return data.table in same format as shown on BEA website, with dates and attributes as column headers and series as rows; otherwise, results have series codes as column headers (default: TRUE)} +} +\value{ +By default, an object of class 'list' of several dimensions. View list structure using 'str(yourList)'. +} +\description{ +Pass list of user specifications (including API key) to return data from BEA API. +} +\examples{ +\dontshow{if (interactive() && Sys.getenv("BEA_API_KEY") != "") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +userSpecList <- list('UserID' = Sys.getenv("BEA_API_KEY"), + 'Method' = 'GetData', + 'datasetname' = 'NIPA', + 'Frequency' = 'A', + 'TableName' = 'T20405', + 'Year' = 'X') +BDT <- beaGet(userSpecList, asTable = TRUE) +\dontshow{\}) # examplesIf} +} diff --git a/man/beaParamVals.Rd b/man/beaParamVals.Rd index 8e375d2..b1d2100 100644 --- a/man/beaParamVals.Rd +++ b/man/beaParamVals.Rd @@ -1,26 +1,27 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/beaParamVals.r -\name{beaParamVals} -\alias{beaParamVals} -\title{Gives list of values possible for a given dataset's parameters} -\usage{ -beaParamVals(beaKey, setName, paramName) -} -\arguments{ -\item{beaKey}{Your API key} - -\item{setName}{Name of BEA dataset (e.g., NIPA)} - -\item{paramName}{Name of BEA dataset parameter (e.g., TableID)} -} -\value{ -A metadata object of class 'list' of several dimensions. View list structure using 'str(yourList)'. -} -\description{ -Gives list of values possible for a given dataset's parameters -} -\examples{ -beaParamVals('yourAPIkey', 'RegionalData', 'keycode') -} -\keyword{metadata} - +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/beaParamVals.r +\name{beaParamVals} +\alias{beaParamVals} +\title{Gives list of values possible for a given dataset's parameters} +\usage{ +beaParamVals(beaKey, setName, paramName) +} +\arguments{ +\item{beaKey}{Your API key} + +\item{setName}{Name of BEA dataset (e.g., NIPA)} + +\item{paramName}{Name of BEA dataset parameter (e.g., TableName)} +} +\value{ +A metadata object of class 'list' of several dimensions. View list structure using 'str(yourList)'. +} +\description{ +Gives list of values possible for a given dataset's parameters +} +\examples{ +\dontshow{if (interactive() && Sys.getenv("BEA_API_KEY") != "") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +beaParamVals(Sys.getenv("BEA_API_KEY"), 'NIPA', 'TableName') +\dontshow{\}) # examplesIf} +} +\keyword{metadata} diff --git a/man/beaParams.Rd b/man/beaParams.Rd index 936029d..58f275e 100644 --- a/man/beaParams.Rd +++ b/man/beaParams.Rd @@ -1,24 +1,25 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/beaParams.r -\name{beaParams} -\alias{beaParams} -\title{Gives list of parameters possible for a given dataset} -\usage{ -beaParams(beaKey, setName) -} -\arguments{ -\item{beaKey}{Your API key} - -\item{setName}{Name of BEA dataset (e.g., 'NIPA')} -} -\value{ -A metadata object of class 'list' of several dimensions. View list structure using 'str(yourList)'. -} -\description{ -Gives list of parameters possible for a given dataset -} -\examples{ -beaParams('yourAPIkey', 'RegionalData') -} -\keyword{metadata} - +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/beaParams.r +\name{beaParams} +\alias{beaParams} +\title{Gives list of parameters possible for a given dataset} +\usage{ +beaParams(beaKey, setName) +} +\arguments{ +\item{beaKey}{Your API key} + +\item{setName}{Name of BEA dataset (e.g., 'NIPA')} +} +\value{ +A metadata object of class 'list' of several dimensions. View list structure using 'str(yourList)'. +} +\description{ +Gives list of parameters possible for a given dataset +} +\examples{ +\dontshow{if (interactive() && Sys.getenv("BEA_API_KEY") != "") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +beaParams(Sys.getenv("BEA_API_KEY"), 'NIPA') +\dontshow{\}) # examplesIf} +} +\keyword{metadata} diff --git a/man/beaSearch.Rd b/man/beaSearch.Rd index 78eb7c7..4c99537 100644 --- a/man/beaSearch.Rd +++ b/man/beaSearch.Rd @@ -1,26 +1,27 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/beaSearch.r -\name{beaSearch} -\alias{beaSearch} -\title{Search a selection of indexed BEA data table names, series labels, and series codes.} -\usage{ -beaSearch(searchTerm, beaKey = NULL, asHtml = FALSE) -} -\arguments{ -\item{searchTerm}{A word or phrase of class 'character' to be found in BEA datasets} - -\item{beaKey}{Character string representation of user API key. Necessary for first time use and updates; recommended for anything beyond one-off searches from the console.} - -\item{asHtml}{Option to return results as DT markup, viewable in browser. Allows search WITHIN YOUR ALREADY-FILTERED RESULTS ONLY. Requires package 'DT' to be installed.} -} -\value{ -An object of class 'data.table' with information about all indexed sets in which the search term was found. -} -\description{ -Searches indexed dataset table name, label, and series codes. CAUTION: Currently only works with NATIONAL datasets (NIPA, NIUnderlyingDetail), temporarily excluding FixedAssets, and REGIONAL datasets (RegionalData, RegionalProduct, RegionalIncome) -} -\examples{ -beaSearch('gross domestic product', asHtml = TRUE) -} -\keyword{search} - +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/beaSearch.r +\name{beaSearch} +\alias{beaSearch} +\title{Search a selection of indexed BEA data table names, series labels, and series codes.} +\usage{ +beaSearch(searchTerm, beaKey = NULL, asHtml = FALSE) +} +\arguments{ +\item{searchTerm}{A word or phrase of class 'character' to be found in BEA datasets} + +\item{beaKey}{Character string representation of user API key. Necessary for first time use and updates; recommended for anything beyond one-off searches from the console.} + +\item{asHtml}{Option to return results as DT markup, viewable in browser. Allows search WITHIN YOUR ALREADY-FILTERED RESULTS ONLY. Requires package 'DT' to be installed.} +} +\value{ +An object of class 'data.table' with information about all indexed sets in which the search term was found. +} +\description{ +Searches indexed dataset table name, label, and series codes. CAUTION: Currently only searches within NATIONAL datasets (NIPA, NIUnderlyingDetail, FixedAssets). +} +\examples{ +\dontshow{if (interactive() && Sys.getenv("BEA_API_KEY") != "") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +beaSearch('gross domestic product', beaKey = Sys.getenv("BEA_API_KEY"), asHtml = TRUE) +\dontshow{\}) # examplesIf} +} +\keyword{search} diff --git a/man/beaSets.Rd b/man/beaSets.Rd index cff8710..102628d 100644 --- a/man/beaSets.Rd +++ b/man/beaSets.Rd @@ -1,22 +1,23 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/beaSets.r -\name{beaSets} -\alias{beaSets} -\title{Returns a list of all datasets} -\usage{ -beaSets(beaKey) -} -\arguments{ -\item{beaKey}{Your API key} -} -\value{ -A metadata object of class 'list' of several dimensions. View list structure using 'str(yourList)'. -} -\description{ -Returns a list of all datasets -} -\examples{ -beaSets('yourAPIkey') -} -\keyword{metadata} - +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/beaSets.r +\name{beaSets} +\alias{beaSets} +\title{Returns a list of all datasets} +\usage{ +beaSets(beaKey) +} +\arguments{ +\item{beaKey}{Your API key} +} +\value{ +A metadata object of class 'list' of several dimensions. View list structure using 'str(yourList)'. +} +\description{ +Returns a list of all datasets +} +\examples{ +\dontshow{if (interactive() && Sys.getenv("BEA_API_KEY") != "") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +beaSets(Sys.getenv("BEA_API_KEY")) +\dontshow{\}) # examplesIf} +} +\keyword{metadata} diff --git a/man/beaUpdateMetadata.Rd b/man/beaUpdateMetadata.Rd index d7e2163..c50a8eb 100644 --- a/man/beaUpdateMetadata.Rd +++ b/man/beaUpdateMetadata.Rd @@ -1,25 +1,26 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/beaUpdateMetadata.r -\name{beaUpdateMetadata} -\alias{beaUpdateMetadata} -\title{Download BEA metadata into library/data folder if needed} -\usage{ -beaUpdateMetadata(datasetList, beaKey) -} -\arguments{ -\item{datasetList}{list of BEA datasets to update local metadata file for (e.g., list('NIPA', 'FixedAssets'))} - -\item{beaKey}{Your API key} -} -\value{ -Nothing. This updates local .RData files to be used in beaSearch. -} -\description{ -Download BEA metadata into library/data folder if needed -} -\examples{ -beaUpdateMetadata(list('RegionalData', 'NIPA'), beaKey = 'yourAPIkey') -} -\keyword{metadata} -\keyword{search} - +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/beaUpdateMetadata.r +\name{beaUpdateMetadata} +\alias{beaUpdateMetadata} +\title{Download BEA metadata into library/data folder if needed} +\usage{ +beaUpdateMetadata(datasetList, beaKey) +} +\arguments{ +\item{datasetList}{list of BEA datasets to update local metadata file for (e.g., list('NIPA', 'FixedAssets'))} + +\item{beaKey}{Your API key} +} +\value{ +Nothing. This updates local .RData files to be used in beaSearch. +} +\description{ +Download BEA metadata into library/data folder if needed +} +\examples{ +\dontshow{if (interactive() && Sys.getenv("BEA_API_KEY") != "") (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +beaUpdateMetadata(list('NIUnderlyingDetail', 'NIPA'), beaKey = Sys.getenv("BEA_API_KEY")) +\dontshow{\}) # examplesIf} +} +\keyword{metadata} +\keyword{search} diff --git a/man/beaViz.Rd b/man/beaViz.Rd deleted file mode 100644 index e481066..0000000 --- a/man/beaViz.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/beaViz.r -\name{beaViz} -\alias{beaViz} -\title{Visualize BEA API response payload} -\usage{ -beaViz(beaPayload = NULL, beaKey = NULL) -} -\arguments{ -\item{beaPayload}{An httr response from call to BEA API} - -\item{beaKey}{Your 36-digit BEA API key} -} -\description{ -When entered into the R console, the function below starts an interactive dashboard. CAUTION: Currently only works with NATIONAL datasets (NIPA, NIUnderlyingDetail, FixedAs-sets). R Studio users must opt to "show in browser" for this method to be fully functional. -} -\examples{ -userSpecList <- list('UserID' = 'yourKey' , - 'Method' = 'GetData', - 'datasetname' = 'NIPA', - 'Frequency' = 'A', - 'TableID' = '68', - 'Year' = 'X') -resp <- beaGet(userSpecList) -BDF <- beaViz(resp) -userSpecList <- list('UserID' = 'yourKey' , - 'Method' = 'GetData', - 'datasetname' = 'NIPA', - 'Frequency' = 'A', - 'TableID' = '68', - 'Year' = 'X') -} -