Skip to content

Commit

Permalink
Fix resas() #6
Browse files Browse the repository at this point in the history
  • Loading branch information
@UchidaMizuki
UchidaMizuki committed Dec 15, 2022
1 parent 591b5ca commit 83ab1a6
Show file tree
Hide file tree
Showing 2 changed files with 125 additions and 52 deletions.
117 changes: 75 additions & 42 deletions R/resas.R
View file
Expand Up @@ -106,78 +106,111 @@ resas_get <- function(setup) {
}

#' @export
collect.resas <- function(x, ...) {
collect.resas <- function(x,
to_snakecase = TRUE,
names_sep = "/", ...) {
setup <- attr(x, "setup")
setup$query <- resas_query(x)

collect_resas(setup)
collect_resas(setup,
args = list(to_snakecase = to_snakecase,
names_sep = names_sep))
}

collect_resas <- function(setup) {
collect_resas <- function(setup, args) {
setup |>
resas_get() |>
resas_rectangle()
resas_rectangle(args = args)
}

resas_rectangle <- function(x) {
if (is_named(x)) {
resas_rectangle <- function(x, args) {
if (is.data.frame(x)) {
x
} else if (is_named(x)) {
x <- x |>
purrr::modify(function(x) {
if (vec_is_list(x)) {
x <- resas_rectangle(x)
}
x
})

if (vec_is_list(x[[1L]])) {
x <- x |>
purrr::imap(function(x, nm) {
x |>
set_names(stringr::str_c(nm, names2(x),
sep = "/"))
})
vec_c(!!!unname(x))
resas_rectangle(x,
args = args)
}) |>
resas_flatten(args = args)

sizes <- list_sizes(x)
n <- vec_size(x)
loc_1 <- vec_as_location(sizes == 1L, n)
loc_n <- vec_as_location(sizes > 1L, n)

if (vec_size(loc_n) <= 1L) {
resas_cbind(x,
args = args)
} else {
sizes <- list_sizes(x)
n <- vec_size(x)
loc_1 <- vec_as_location(sizes == 1L, n)
loc_n <- vec_as_location(sizes > 1L, n)

if (vec_size(loc_n) <= 1L) {
vec_cbind(!!!x) |>
resas_unpack()
} else {
loc_n |>
purrr::map(function(loc_n) {
vec_cbind(!!!x[c(loc_1, loc_n)]) |>
resas_unpack()
})
}
loc_n |>
purrr::map(function(loc_n) {
resas_rectangle(x[c(loc_1, loc_n)],
args = args)
})
}
} else {
x <- purrr::modify(x, resas_rectangle)
} else if (vec_is_list(x)) {
x <- purrr::modify(x,
function(x) {
resas_rectangle(x,
args = args)
})
x_1 <- x[[1L]]

if (vec_is_list(x_1)) {
nms <- names(x_1)
to_snakecase <- resas_to_snakecase(args)
nms |>
set_names() |>
set_names(to_snakecase(nms)) |>
purrr::map(function(nm) {
x <- x |>
purrr::modify(function(x) {
x[[nm]]
})
vec_rbind(!!!x)
resas_rectangle(x,
args = args)
})
} else {
vec_rbind(!!!x)
}
} else {
x
}
}

resas_unpack <- function(x) {
resas_flatten <- function(x, args) {
to_snakecase <- resas_to_snakecase(args)
x <- x |>
purrr::imap(function(x, nm) {
if (vec_is_list(x)) {
x |>
set_names(stringr::str_c(to_snakecase(nm), names2(x),
sep = args$names_sep))
} else {
list(x) |>
set_names(nm)
}
})
vec_c(!!!unname(x))
}

resas_unpack <- function(x, args) {
cols <- vec_as_location(purrr::map_lgl(x, is.data.frame), ncol(x))
x |>
tidyr::unpack(cols,
names_sep = "/")
names_sep = args$names_sep)
}

resas_cbind <- function(x, args) {
to_snakecase <- resas_to_snakecase(args)
vec_cbind(!!!x) |>
resas_unpack(args = args) |>
dplyr::rename_with(to_snakecase)
}

resas_to_snakecase <- function(args) {
if (args$to_snakecase) {
str_to_snakecase
} else {
identity
}
}
60 changes: 50 additions & 10 deletions tests/testthat/test-resas.R
View file
@@ -1,6 +1,5 @@
test_that("resas-power_for_industry", {
skip_on_cran()

library(dplyr)

X_API_KEY <- keyring::key_get("resas-api")
Expand All @@ -16,12 +15,11 @@ test_that("resas-power_for_industry", {

power_for_industry <- collect(power_for_industry)

expect_s3_class(power_for_industry$data, "tbl_df")
expect_s3_class(power_for_industry, "tbl_df")
})

test_that("resas-population_change_rate", {
skip_on_cran()

library(dplyr)

X_API_KEY <- keyring::key_get("resas-api")
Expand All @@ -37,13 +35,10 @@ test_that("resas-population_change_rate", {

test_that("resas-partner_docomo_destination", {
skip_on_cran()

library(dplyr)

X_API_KEY <- keyring::key_get("resas-api")
partner_docomo_destination <- resas(X_API_KEY, "https://opendata.resas-portal.go.jp/docs/api/v1/partner/docomo/destination.html")

partner_docomo_destination <- partner_docomo_destination |>
partner_docomo_destination <- resas(X_API_KEY, "https://opendata.resas-portal.go.jp/docs/api/v1/partner/docomo/destination.html") |>
itemise(year = "2016",
month = "01",
period_of_day = "1",
Expand All @@ -53,9 +48,54 @@ test_that("resas-partner_docomo_destination", {
pref_code_destination = "13",
city_code_destination = "13101",
pref_code_residence = "13",
city_code_residence = "-")
city_code_residence = "-") |>
collect()

expect_s3_class(partner_docomo_destination, "tbl_df")
})

test_that("resas-population-society-for_age_class", {
skip_on_cran()
library(dplyr)

X_API_KEY <- keyring::key_get("resas-api")
population_society_for_age_class <- resas(X_API_KEY, "https://opendata.resas-portal.go.jp/docs/api/v1/population/society/forAgeClass.html") |>
itemise(pref_code = "01") |>
collect()

expect_s3_class(population_society_for_age_class$`data/positive_age_classes`, "tbl_df")
expect_s3_class(population_society_for_age_class$`data/negative_age_classes`, "tbl_df")
})

test_that("agriculture_crops_farmers_age_structure", {
skip_on_cran()
library(dplyr)

X_API_KEY <- keyring::key_get("resas-api")
agriculture_crops_farmers_age_structure <- resas(X_API_KEY, "https://opendata.resas-portal.go.jp/docs/api/v1/agriculture/crops/farmersAgeStructure.html") |>
itemise(city_code = "11362",
farmers_type = "1",
gender_type = "3",
matter = "3",
pref_code = "11") |>
collect()

partner_docomo_destination <- collect(partner_docomo_destination)
expect_s3_class(agriculture_crops_farmers_age_structure$`years/legend`, "tbl_df")
expect_s3_class(agriculture_crops_farmers_age_structure$`years/data`, "tbl_df")
})

test_that("agriculture_crops_farmers_average_age", {
skip_on_cran()
library(dplyr)

X_API_KEY <- keyring::key_get("resas-api")
agriculture_crops_farmers_average_age <- resas(X_API_KEY, "https://opendata.resas-portal.go.jp/docs/api/v1/agriculture/crops/farmersAverageAge.html") |>
itemise(city_code = "11362",
farmers_type = "1",
gender_type = "3",
matter = "3",
pref_code = "11") |>
collect()

expect_s3_class(partner_docomo_destination$prefs, "tbl_df")
expect_s3_class(agriculture_crops_farmers_average_age, "tbl_df")
})

0 comments on commit 83ab1a6

Please sign in to comment.