Nothing
R/sysdata.R
In finbif: Interface for the 'Finnish Biodiversity Information Facility' API
Defines functions
complete_list_type
record_reliability
record_quality
collection_quality
quality_issues
restriction_level
restriction_reason
sex
life_stage
superrecord_basis
record_basis
sources
finnish_occurrence_status
bird_assoc_area
municipality
primary_habitat
informal_groups
red_list_status
regulatory_status
replace_missing_names
get_areas
get_code
set_translations
get_enumeration
get_sysdata
sysdata
#' @noRd
sysdata <- function(obj) {
switch(
obj[["which"]],
supported_langs = c(English = "en", Finnish = "fi", Swedish = "sv"),
var_names = var_names_df,
has_value = has_value_df,
cite_file_vars = cite_file_vars_df,
lite_download_file_vars = lite_download_file_vars_df,
filter_names = filter_names_df,
regulatory_status = regulatory_status(obj),
red_list_status = red_list_status(obj),
threatened_status = get_sysdata(
list(which = "MX.threatenedStatusEnum", cache = obj[["cache"]])
),
informal_groups = informal_groups(obj),
informal_groups_reported = informal_groups(obj),
primary_habitat = primary_habitat(obj),
primary_secondary_habitat = primary_habitat(obj),
taxon_rank = get_sysdata(
list(which = "MX.taxonRankEnum", cache = obj[["cache"]])
),
orig_taxon_rank = get_sysdata(
list(which = "MX.taxonRankEnum", cache = obj[["cache"]])
),
country = get_areas(
list(which = "ML.country", cache = obj[["cache"]])
),
region = get_areas(
list(which = "ML.province", cache = obj[["cache"]])
),
bio_province = get_areas(
list(which = "ML.biogeographicalProvince", cache = obj[["cache"]])
),
municipality = municipality(obj),
bird_assoc_area = bird_assoc_area(obj),
finnish_occurrence_status = finnish_occurrence_status(obj),
finnish_occurrence_status_neg = finnish_occurrence_status(obj),
source = sources(obj),
record_basis = record_basis(obj),
superrecord_basis = superrecord_basis(),
life_stage = life_stage(obj),
sex = sex(obj),
restriction_reason = restriction_reason(obj),
restriction_level = restriction_level(obj),
quality_issues = quality_issues(),
collection_quality = collection_quality(obj),
record_quality = record_quality(obj),
record_reliability = record_reliability(),
complete_list_type = complete_list_type(),
location_tag = get_sysdata(
list(which = "MNP.tagEnum", cache = obj[["cache"]])
),
atlas_code = get_sysdata(
list(which = "MY.atlasCodeEnum", cache = obj[["cache"]])
),
atlas_class = get_sysdata(
list(which = "MY.atlasClassEnum", cache = obj[["cache"]])
),
abundance_unit = get_sysdata(
list(which = "MY.abundanceUnitEnum", cache = obj[["cache"]])
)
)
}
#' @noRd
get_sysdata <- function(obj) {
request <- list(
path = paste0("metadata/ranges/", obj[["which"]]),
query = list(lang = "multi"),
cache = obj[["cache"]]
)
sd_response <- api_get(request)
supported_langs <- sysdata(list(which = "supported_langs"))
n_langs <- length(supported_langs)
sd_response_content <- sd_response[["content"]]
sd_df <- structure(
vector("list", n_langs),
row.names = vapply(sd_response_content, getElement, "", "id"),
names = paste0("name_", supported_langs)
)
for (i in seq_len(n_langs)) {
el_i <- c("value", supported_langs[[i]])
sd_i <- vapply(sd_response_content, get_el_recurse, "", el_i, "character")
sd_df[[i]] <- sub("^.* [\u2013|-] ", "", sd_i)
}
structure(set_translations(sd_df), class = "data.frame")
}
#' @noRd
get_enumeration <- function(obj) {
request <- list(
path = "warehouse/enumeration-labels",
cache = obj[["cache"]]
)
en_response <- api_get(request)
en_response_results <- en_response[[c("content", "results")]]
enumerations <- vapply(en_response_results, getElement, "", "enumeration")
ids <- vapply(en_response_results, getElement, "", "property")
enumerations <- structure(enumerations, names = ids)
get_function <- obj[["fun"]]
sd_en_df <- get_function(obj)
id <- enumerations[row.names(sd_en_df)]
non_missing_enums <- !is.na(id)
sd_en_df <- structure(sd_en_df, row.names = id)
sd_en_df <- sd_en_df[non_missing_enums, ]
id <- id[non_missing_enums]
enumeration <- list(code = tolower(id))
enumeration <- structure(enumeration, class = "data.frame", row.names = id)
sd_en_df <- cbind(enumeration, sd_en_df)
set_translations(sd_en_df)
}
#' @noRd
set_translations <- function(x) {
x[] <- lapply(x, structure, class = "translation")
x
}
#' @noRd
get_code <- function(obj) {
prefix <- obj[["prefix"]]
ht <- get_sysdata(
list(which = paste0(prefix, obj[["suffix"]]), cache = obj[["cache"]])
)
ht_row_names <- row.names(ht)
ht_code <- sub(prefix, "", ht_row_names)
ht_code <- structure(ht_code, class = "translation")
ht_code <- list(code = ht_code)
ht_code <- structure(ht_code, class = "data.frame", row.names = ht_row_names)
cbind(ht_code, ht)
}
#' @noRd
get_areas <- function(obj) {
request <- list(
path = "areas",
query = list(areaType = obj[["which"]], lang = "multi", pageSize = 1000L),
cache = obj[["cache"]]
)
sd_response <- api_get(request)
sd_response_results <- sd_response[[c("content", "results")]]
supported_langs <- sysdata(list(which = "supported_langs"))
col_names <- paste0("name_", supported_langs)
n_cols <- length(col_names)
sd_df <- structure(
vector("list", n_cols),
row.names = vapply(sd_response_results, getElement, "", "id"),
names = col_names
)
for (i in seq_along(supported_langs)) {
el_i <- c("name", supported_langs[[i]])
sd_i <- vapply(sd_response_results, get_el_recurse, "", el_i, "character")
sd_df[[i]] <- sub("^.* [\u2013|-] ", "", sd_i)
}
c_els <- paste0("countryCodeISO", "alpha2")
ccode <- vapply(sd_response_results, get_el_recurse, "", c_els, "character")
if (!all_na(ccode)) {
sd_df[["code"]] <- ccode
}
p_els <- c("provinceCodeAlpha", "fi")
pcode <- vapply(sd_response_results, get_el_recurse, "", p_els, "character")
if (!all_na(pcode)) {
sd_df[["code"]] <- pcode
}
sd_df <- replace_missing_names(sd_df)
structure(set_translations(sd_df), class = "data.frame")
}
#' @noRd
replace_missing_names <- function(df) {
supported_langs <- sysdata(list(which = "supported_langs"))
col_names <- paste0("name_", supported_langs)
for (i in col_names) {
col <- df[[i]]
for (j in setdiff(col_names, i)) {
missing <- is.na(col)
other_col <- df[[j]]
col[missing] <- other_col[missing]
}
df[[i]] <- col
}
df
}
#' @noRd
regulatory_status <- function(obj) {
code <- c(
MX.finlex160_1997_appendix4 = "FNLX160_97_4",
MX.finlex160_1997_appendix4_specialInterest = "FNLX160_97_4_SI",
MX.finlex160_1997_appendix2a = "FNLX160_97_2A",
MX.finlex160_1997_appendix2b = "FNLX160_97_2B",
MX.finlex160_1997_appendix3a = "FNLX160_97_3A",
MX.finlex160_1997_appendix3b = "FNLX160_97_3B",
MX.finlex160_1997_appendix3c = "FNLX160_97_3C",
MX.habitatsDirectiveAnnexII = "HABDIR2",
MX.habitatsDirectiveAnnexIV = "HABDIR4",
MX.habitatsDirectiveAnnexV = "HABDIR5",
MX.primaryInterestInEU = "PI_EU",
MX.habitatsDirectiveAnnexIIExceptionGranted = "HABDIR2E",
MX.habitatsDirectiveAnnexIVExceptionGranted = "HABDIR4E",
MX.habitatsDirectiveAnnexVExceptionGranted = "HABDIR5E",
MX.birdsDirectiveStatusAppendix1 = "BDS1",
MX.birdsDirectiveStatusAppendix2A = "BDS2A",
MX.birdsDirectiveStatusAppendix2B = "BDS2B",
MX.birdsDirectiveStatusAppendix3A = "BDS3A",
MX.birdsDirectiveStatusAppendix3B = "BDS3B",
MX.finnishEnvironmentInstitute2010protectionPrioritySpecies = "FEI_PPS",
MX.finnishEnvironmentInstitute2020conservationProjectSpecies = "FEI_CPS",
MX.finnishEnvironmentInstitute2020conservationProjectAapamireSpecies =
"FEI_CPAS",
MX.gameBird = "GMEB",
MX.gameMammal = "GMEM",
MX.unprotectedSpecies = "UNP_SP",
MX.nationallySignificantInvasiveSpecies = "NS_INVSV",
MX.euInvasiveSpeciesList = "EU_INVSV",
MX.otherPlantPest = "OPP_INVSV",
MX.qualityPlantPest = "QLPP_INVSV",
MX.quarantinePlantPest = "QPP_INVSV",
MX.nationalInvasiveSpeciesStrategy = "NSS_INVSV",
MX.otherInvasiveSpeciesList = "OTH_INVSV",
MX.controllingRisksOfInvasiveAlienSpecies = "CRAS_INVSV",
MX.finnishEnvironmentInstitute20072010forestSpecies = "FEI_FS",
MX.finnishEnvironmentInstitute20192021forestSpecies = "FEI_FS2",
MX.cropWildRelative = "CWR",
MX.birdsDirectiveStatusMigratoryBirds = "BDSMB",
MX.cites_appendixI = "CITES1",
MX.cites_appendixII = "CITES2",
MX.cites_appendixIII = "CITES3",
MX.euRegulation_cites_appendixA = "EU_CITESA",
MX.euRegulation_cites_appendixB = "EU_CITESB",
MX.finlex160_1997_appendix4_2021 = "FNLX160_97_4_2021",
MX.finlex160_1997_appendix4_specialInterest_2021 = "FNLX160_97_4_SI_2021",
MX.finlex160_1997_largeBirdsOfPrey = "FNLX160_97_LBP",
MX.finlex160_1997_appendix1 = "FNLX160_97_1",
MX.finnishEnvironmentInstitute2020protectionPrioritySpecies = "FEI2020PPS",
MX.finnishEnvironmentInstitute2020conservationProjectVascularSpecies =
"FEI2020CPVPS",
MX.habitatsDirectiveAnnexII_FinlandNaturaSpecies = "HABDIR2FN",
MX.euRegulation_cites_appendixD = "EU_CITESD"
)
reg_status <- get_sysdata(
list(which = "MX.adminStatusEnum", cache = obj[["cache"]])
)
id <- row.names(reg_status)
code <- code[id]
code_na <- is.na(code)
missing_codes <- id[code_na]
missing_codes <- sub("^.*\\.", "", missing_codes)
missing_codes <- abbreviate(missing_codes, 20L)
code[code_na] <- toupper(missing_codes)
code <- make.unique(code)
code <- structure(code, class = "translation")
code <- list(code = code)
code <- structure(code, class = "data.frame", row.names = id)
cbind(code, reg_status)
}
#' @noRd
red_list_status <- function(obj) {
red_list <- list(
prefix = "MX.iucn", suffix = "Statuses", cache = obj[["cache"]]
)
get_code(red_list)
}
#' @noRd
informal_groups <- function(obj) {
request <- list(
path = "informal-taxon-groups",
query = list(lang = "multi", pageSize = 1000L),
cache = obj[["cache"]]
)
sd_response <- api_get(request)
sd_response_content <- sd_response[[c("content", "results")]]
supported_langs <- sysdata(list(which = "supported_langs"))
n_langs <- length(supported_langs)
sd_df <- structure(
vector("list", n_langs),
row.names = vapply(sd_response_content, getElement, "", "id"),
names = paste0("name_", supported_langs)
)
for (i in seq_len(n_langs)) {
el_i <- c("name", supported_langs[[i]])
sd_i <- vapply(sd_response_content, get_el_recurse, "", el_i, "character")
sd_df[[i]] <- sub("^.* [\u2013|-] ", "", sd_i)
}
structure(set_translations(sd_df), class = "data.frame")
}
#' @noRd
primary_habitat <- function(obj) {
habitat_types <- list(
prefix = "MKV.habitat", suffix = "Enum", cache = obj[["cache"]]
)
specific_types <- list(
prefix = "MKV.habitatSpecificType", suffix = "Enum", cache = obj[["cache"]]
)
list(
habitat_types = get_code(habitat_types),
specific_habitat_types = get_code(specific_types)
)
}
#' @noRd
municipality <- function(obj) {
regions <- c(
ML.351 = "Ahvenanmaa",
ML.352 = "Uusimaa",
ML.353 = "Ahvenanmaa",
ML.354 = "Ahvenanmaa",
ML.355 = "Ahvenanmaa",
ML.356 = "Ahvenanmaa",
ML.357 = "Ahvenanmaa",
ML.358 = "Ahvenanmaa",
ML.359 = "Ahvenanmaa",
ML.360 = "Ahvenanmaa",
ML.361 = "Ahvenanmaa",
ML.362 = "Uusimaa",
ML.363 = "Uusimaa",
ML.364 = "Uusimaa",
ML.365 = "Uusimaa",
ML.366 = "Uusimaa",
ML.367 = "Uusimaa",
ML.368 = "Ahvenanmaa",
ML.369 = "Ahvenanmaa",
ML.370 = "Uusimaa",
ML.371 = "Uusimaa",
ML.372 = "Uusimaa",
ML.373 = "Varsinais-Suomi",
ML.374 = "Ahvenanmaa",
ML.375 = "Uusimaa",
ML.376 = "Kanta-H\u00e4me",
ML.377 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.378 = "Kanta-H\u00e4me",
ML.379 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.380 = "Kanta-H\u00e4me",
ML.381 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.382 = "Uusimaa",
ML.383 = "Uusimaa",
ML.384 = "Uusimaa",
ML.385 = "Uusimaa",
ML.386 = "Varsinais-Suomi",
ML.387 = "Varsinais-Suomi",
ML.388 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.389 = "Uusimaa",
ML.390 = "Uusimaa",
ML.391 = "Varsinais-Suomi",
ML.392 = "Uusimaa",
ML.393 = "Varsinais-Suomi",
ML.394 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.396 = "Kymenlaakso",
ML.397 = "Uusimaa",
ML.398 = "Uusimaa",
ML.399 = "Satakunta",
ML.400 = "Satakunta",
ML.401 = "Varsinais-Suomi",
ML.402 = "Varsinais-Suomi",
ML.403 = "Uusimaa",
ML.404 = "Kymenlaakso",
ML.405 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.406 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.407 = "Keski-Suomi",
ML.408 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.409 = "Satakunta",
ML.410 = "Uusimaa",
ML.411 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.412 = "Kymenlaakso",
ML.413 = "Etel\u00e4-Savo",
ML.414 = "Pohjois-Karjala",
ML.415 = "Pirkanmaa",
ML.416 = "Kymenlaakso",
ML.417 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.418 = "Etel\u00e4-Savo",
ML.419 = "Keski-Suomi",
ML.420 = "Etel\u00e4-Savo",
ML.421 = "Etel\u00e4-Savo",
ML.422 = "Etel\u00e4-Karjala",
ML.423 = "Etel\u00e4-Savo",
ML.424 = "Etel\u00e4-Savo",
ML.425 = "Etel\u00e4-Savo",
ML.426 = "Etel\u00e4-Karjala",
ML.427 = "Etel\u00e4-Savo",
ML.428 = "Etel\u00e4-Karjala",
ML.429 = "Satakunta",
ML.430 = "Pirkanmaa",
ML.431 = "Etel\u00e4-Karjala",
ML.432 = "Satakunta",
ML.433 = "Keski-Suomi",
ML.434 = "Keski-Suomi",
ML.435 = "Satakunta",
ML.436 = "Pohjanmaa",
ML.437 = "Kanta-H\u00e4me",
ML.438 = "Kanta-H\u00e4me",
ML.439 = "Pirkanmaa",
ML.440 = "Pirkanmaa",
ML.442 = "Pohjois-Savo",
ML.443 = "Etel\u00e4-Karjala",
ML.444 = "Pohjois-Karjala",
ML.445 = "Pohjois-Karjala",
ML.446 = "Etel\u00e4-Savo",
ML.447 = "Etel\u00e4-Pohjanmaa",
ML.449 = "Pohjois-Savo",
ML.450 = "Etel\u00e4-Savo",
ML.451 = "Etel\u00e4-Karjala",
ML.452 = "Pohjois-Karjala",
ML.453 = "Pohjois-Savo",
ML.454 = "Pohjois-Savo",
ML.455 = "Satakunta",
ML.456 = "Varsinais-Suomi",
ML.457 = "Varsinais-Suomi",
ML.458 = "Varsinais-Suomi",
ML.459 = "Satakunta",
ML.460 = "Varsinais-Suomi",
ML.461 = "Varsinais-Suomi",
ML.462 = "Varsinais-Suomi",
ML.464 = "Satakunta",
ML.465 = "Satakunta",
ML.466 = "Satakunta",
ML.467 = "Satakunta",
ML.468 = "Varsinais-Suomi",
ML.469 = "Varsinais-Suomi",
ML.470 = "Kanta-H\u00e4me",
ML.471 = "Etel\u00e4-Karjala",
ML.472 = "Varsinais-Suomi",
ML.473 = "Varsinais-Suomi",
ML.474 = "Etel\u00e4-Karjala",
ML.475 = "Varsinais-Suomi",
ML.476 = "Kymenlaakso",
ML.477 = "Etel\u00e4-Karjala",
ML.478 = "Varsinais-Suomi",
ML.479 = "Pohjanmaa",
ML.480 = "Pohjanmaa",
ML.481 = "Varsinais-Suomi",
ML.482 = "Keski-Pohjanmaa",
ML.483 = "Pirkanmaa",
ML.484 = "Etel\u00e4-Pohjanmaa",
ML.485 = "Etel\u00e4-Pohjanmaa",
ML.486 = "Varsinais-Suomi",
ML.487 = "Etel\u00e4-Savo",
ML.488 = "Etel\u00e4-Savo",
ML.489 = "Pohjois-Karjala",
ML.490 = "Pohjanmaa",
ML.491 = "Pohjanmaa",
ML.492 = "Pohjanmaa",
ML.493 = "Pohjanmaa",
ML.494 = "Keski-Pohjanmaa",
ML.495 = "Pohjois-Savo",
ML.496 = "Varsinais-Suomi",
ML.497 = "Pirkanmaa",
ML.498 = "Etel\u00e4-Pohjanmaa",
ML.499 = "Pohjanmaa",
ML.500 = "Etel\u00e4-Pohjanmaa",
ML.501 = "Etel\u00e4-Pohjanmaa",
ML.502 = "Keski-Suomi",
ML.503 = "Etel\u00e4-Pohjanmaa",
ML.504 = "Keski-Suomi",
ML.505 = "Keski-Suomi",
ML.506 = "Etel\u00e4-Pohjanmaa",
ML.507 = "Keski-Suomi",
ML.508 = "Keski-Pohjanmaa",
ML.509 = "Kanta-H\u00e4me",
ML.510 = "Satakunta",
ML.512 = "Etel\u00e4-Pohjanmaa",
ML.513 = "Pirkanmaa",
ML.514 = "Pirkanmaa",
ML.515 = "Keski-Suomi",
ML.516 = "Keski-Suomi",
ML.517 = "Pohjois-Pohjanmaa",
ML.518 = "Keski-Suomi",
ML.519 = "Pohjanmaa",
ML.520 = "Pohjois-Pohjanmaa",
ML.521 = "Pirkanmaa",
ML.522 = "Etel\u00e4-Pohjanmaa",
ML.523 = "Pohjanmaa",
ML.524 = "Pohjanmaa",
ML.525 = "Pirkanmaa",
ML.526 = "Keski-Pohjanmaa",
ML.527 = "Keski-Suomi",
ML.528 = "Pirkanmaa",
ML.529 = "Pirkanmaa",
ML.530 = "Keski-Suomi",
ML.531 = "Keski-Suomi",
ML.532 = "Keski-Suomi",
ML.533 = "Varsinais-Suomi",
ML.534 = "Keski-Suomi",
ML.536 = "Keski-Suomi",
ML.537 = "Kanta-H\u00e4me",
ML.538 = "Keski-Suomi",
ML.539 = "Keski-Suomi",
ML.541 = "Pirkanmaa",
ML.542 = "Etel\u00e4-Pohjanmaa",
ML.543 = "Etel\u00e4-Pohjanmaa",
ML.544 = "Kanta-H\u00e4me",
ML.545 = "Etel\u00e4-Pohjanmaa",
ML.546 = "Keski-Suomi",
ML.547 = "Varsinais-Suomi",
ML.548 = "Pohjois-Savo",
ML.549 = "Keski-Suomi",
ML.550 = "Keski-Suomi",
ML.551 = "Etel\u00e4-Pohjanmaa",
ML.552 = "Pirkanmaa",
ML.553 = "Pohjois-Savo",
ML.554 = "Pirkanmaa",
ML.555 = "Pirkanmaa",
ML.556 = "Etel\u00e4-Pohjanmaa",
ML.557 = "Etel\u00e4-Pohjanmaa",
ML.558 = "Pohjois-Savo",
ML.559 = "Etel\u00e4-Pohjanmaa",
ML.560 = "Keski-Pohjanmaa",
ML.561 = "Pirkanmaa",
ML.562 = "Pirkanmaa",
ML.563 = "Satakunta",
ML.564 = "Keski-Pohjanmaa",
ML.565 = "Keski-Pohjanmaa",
ML.566 = "Keski-Pohjanmaa",
ML.567 = "Pohjois-Savo",
ML.568 = "Kainuu",
ML.569 = "Pohjois-Savo",
ML.570 = "Pohjois-Savo",
ML.572 = "Pohjois-Pohjanmaa",
ML.573 = "Pohjois-Savo",
ML.574 = "Pohjois-Savo",
ML.575 = "Pohjois-Savo",
ML.576 = "Pohjois-Savo",
ML.577 = "Pirkanmaa",
ML.578 = "Pohjois-Karjala",
ML.579 = "Pirkanmaa",
ML.580 = "Pohjois-Karjala",
ML.582 = "Pohjois-Karjala",
ML.584 = "Pohjois-Karjala",
ML.585 = "Pohjois-Savo",
ML.586 = "Pohjois-Pohjanmaa",
ML.587 = "Pohjois-Pohjanmaa",
ML.588 = "Pohjois-Pohjanmaa",
ML.589 = "Kanta-H\u00e4me",
ML.590 = "Pohjois-Karjala",
ML.591 = "Pohjois-Pohjanmaa",
ML.592 = "Kainuu",
ML.593 = "Pohjois-Pohjanmaa",
ML.594 = "Pohjois-Pohjanmaa",
ML.595 = "Pohjois-Pohjanmaa",
ML.596 = "Kainuu",
ML.597 = "Pohjois-Pohjanmaa",
ML.598 = "Pohjois-Pohjanmaa",
ML.599 = "Pohjois-Savo",
ML.600 = "Lappi",
ML.601 = "Pohjois-Pohjanmaa",
ML.602 = "Pohjois-Pohjanmaa",
ML.603 = "Lappi",
ML.604 = "Pohjois-Pohjanmaa",
ML.605 = "Kainuu",
ML.606 = "Pohjois-Pohjanmaa",
ML.607 = "Kainuu",
ML.608 = "Pohjois-Pohjanmaa",
ML.609 = "Kainuu",
ML.610 = "Pohjois-Pohjanmaa",
ML.611 = "Pohjois-Pohjanmaa",
ML.612 = "Pohjois-Karjala",
ML.613 = "Kainuu",
ML.614 = "Kainuu",
ML.615 = "Lappi",
ML.616 = "Pohjois-Pohjanmaa",
ML.617 = "Lappi",
ML.618 = "Lappi",
ML.619 = "Lappi",
ML.620 = "Lappi",
ML.621 = "Lappi",
ML.622 = "Lappi",
ML.623 = "Lappi",
ML.624 = "Lappi",
ML.625 = "Lappi",
ML.626 = "Lappi",
ML.627 = "Lappi",
ML.628 = "Lappi",
ML.629 = "Lappi",
ML.630 = "Lappi",
ML.631 = "Lappi",
ML.632 = "Lappi",
ML.633 = "Lappi",
ML.634 = "Lappi",
ML.635 = "Kanta-H\u00e4me",
ML.636 = "Pohjois-Karjala",
ML.637 = "Pohjois-Karjala",
ML.638 = "Pohjois-Pohjanmaa",
ML.639 = "Pohjois-Pohjanmaa",
ML.640 = "Pohjois-Pohjanmaa",
ML.641 = "Satakunta",
ML.642 = "Pohjois-Pohjanmaa",
ML.643 = "Uusimaa",
ML.644 = "Pohjois-Pohjanmaa",
ML.645 = "Pohjois-Pohjanmaa",
ML.647 = "Varsinais-Suomi",
ML.648 = "Uusimaa",
ML.649 = "Satakunta",
ML.650 = "Pohjois-Pohjanmaa",
ML.651 = "Ahvenanmaa",
ML.652 = "Pohjanmaa",
ML.653 = "Etel\u00e4-Pohjanmaa",
ML.654 = "Pohjanmaa",
ML.655 = "Pohjois-Savo",
ML.656 = "Ahvenanmaa",
ML.657 = "Pohjois-Pohjanmaa",
ML.658 = "Pohjois-Pohjanmaa",
ML.659 = "Pohjois-Savo",
ML.660 = "Uusimaa",
ML.661 = "Kymenlaakso",
ML.662 = "Ahvenanmaa",
ML.663 = "Pirkanmaa",
ML.664 = "Varsinais-Suomi",
ML.665 = "Varsinais-Suomi",
ML.666 = "Pirkanmaa",
ML.667 = "Uusimaa",
ML.668 = "Pirkanmaa",
ML.669 = "Pohjois-Pohjanmaa",
ML.670 = "Pohjanmaa"
)
municipalities <- get_areas(
list(which = "ML.municipality", cache = obj[["cache"]])
)
id <- row.names(municipalities)
regions <- structure(regions[id], class = "translation", names = NULL)
regions <- list(region = regions)
regions <- structure(regions, class = "data.frame", row.names = id)
cbind(municipalities, regions)
}
#' @noRd
bird_assoc_area <- function(obj) {
codes <- c(
ML.1088 = "AFF",
ML.1095 = "EKLY",
ML.1101 = "Oriolus",
ML.1091 = "Tringa",
ML.1110 = "KLY",
ML.1097 = "KHLY",
ML.1111 = "Xenus",
ML.1092 = "Apus",
ML.1108 = "KPLY",
ML.1104 = "KSLY",
ML.1113 = "Kuusamo",
ML.1094 = "KyLY",
ML.1112 = "LLY",
ML.1114 = "Hakki",
ML.1096 = "LHLH",
ML.1107 = "MLY",
ML.1098 = "PHLY",
ML.1099 = "PiLY",
ML.1103 = "PKLY",
ML.1109 = "PPLY",
ML.1102 = "Kuikka",
ML.1090 = "PLY",
ML.1093 = "PSLY",
ML.1116 = "RSLH",
ML.1127 = "SUA",
ML.1105 = "SSLTY",
ML.1106 = "SpLY",
ML.1089 = "TLY",
ML.1267 = "OA"
)
bird_assoc <- get_areas(
list(which = "ML.birdAssociationArea", cache = obj[["cache"]])
)
id <- row.names(bird_assoc)
codes <- unname(codes[id])
codes <- structure(codes, class = "translation", names = NULL)
codes <- list(code = codes)
codes <- structure(codes, class = "data.frame", row.names = id)
cbind(bird_assoc, codes)
}
#' @noRd
finnish_occurrence_status <- function(obj) {
codes <- c(
MX.doesNotOccur = "none",
MX.typeOfOccurrenceOccurs = "occurs",
MX.typeOfOccurrenceStablePopulation = "stable",
MX.typeOfOccurrenceCommon = "common",
MX.typeOfOccurrenceRare = "rare",
MX.typeOfOccurrenceVeryRare = "very_rare",
MX.typeOfOccurrenceVagrant = "vagrant_regular",
MX.typeOfOccurrenceRareVagrant = "vagrant_irregular",
MX.typeOfOccurrenceMigrant = "migrant",
MX.typeOfOccurrenceImport = "import",
MX.typeOfOccurrenceAnthropogenic = "introduced",
MX.typeOfOccurrenceNotEstablished = "unestablished",
MX.typeOfOccurrenceExtirpated = "extinct",
MX.typeOfOccurrenceOldRecords = "historic",
MX.typeOfOccurrenceUncertain = "uncertain",
MX.typeOfOccurrenceMaxReplanted = "reintroduced",
MX.typeOfOccurrenceNotEvaluated = "unevaluated",
MX.typeOfOccurrenceSpontaneousOldResident = "SOR",
MX.typeOfOccurrenceSpontaneousOldFormerlyResidentPossiblyExtinct = "SORPE",
MX.typeOfOccurrenceSpontaneousOldFormerlyResidentExtinct = "SORE",
MX.typeOfOccurrenceSpontaneousNewResident = "SNR",
MX.typeOfOccurrenceSpontaneousNewEphemeral = "SNE",
MX.typeOfOccurrenceSpontaneousNewEphemeralOnlyOld = "SNEH",
MX.typeOfOccurrenceAlienOldResident = "AOR",
MX.typeOfOccurrenceAlienOldFormerlyResidentPossiblyExtinct = "AORPE",
MX.typeOfOccurrenceAlienOldExtinct = "AORE",
MX.typeOfOccurrenceAlienNewResident = "ANR",
MX.typeOfOccurrenceAlienNewEphemeral = "ANE",
MX.typeOfOccurrenceAlienNewEphemeralOnlyold = "ANEH",
MX.typeOfOccurrenceCompletelyCultivatedOrigin = "cultivation_escape_all",
MX.typeOfOccurrenceNotableDegreeCultivatedOrigin = "cultivation_escape",
MX.typeOfOccurrenceMaxShortDistanceEscape = "cultivation_escape_short",
MX.typeOfOccurrenceSmallDegreeCultivatedOrigin = "cultivation_escape_some",
MX.typeOfOccurrenceOnlyCultivated = "cultivation_only",
MX.typeOfOccurrenceMaxRelict = "cultivation_relict",
MX.typeOfOccurrenceMaxSoilImmigrant = "soil_immigrant",
MX.typeOfOccurrenceOccursBasedOnOccurrences = "records_only",
MX.typeOfOccurrenceRegularBreeder = "regular_breeder",
MX.typeOfOccurrenceIrregularBreeder = "irregular_breeder",
MX.typeOfOccurrencePassageMigrant = "passage_migrant",
MX.typeOfOccurrenceBirdLifeCategoryA = "BLA",
MX.typeOfOccurrenceBirdLifeCategoryB = "BLB",
MX.typeOfOccurrenceBirdLifeCategoryC = "BLC",
MX.typeOfOccurrenceBirdLifeCategoryD = "BLD",
MX.typeOfOccurrenceBirdLifeCategoryE = "BLE"
)
finnish_occurrence <- get_sysdata(
list(which = "MX.typeOfOccurrenceEnum", cache = obj[["cache"]])
)
id <- row.names(finnish_occurrence)
codes <- unname(codes[id])
codes <- structure(codes, class = "translation", names = NULL)
codes <- list(code = codes)
codes <- structure(codes, class = "data.frame", row.names = id)
cbind(finnish_occurrence, codes)
}
#' @noRd
sources <- function(obj) {
request <- list(
path = "sources",
query = list(lang = "multi", pageSize = 1000L),
cache = obj[["cache"]]
)
sd_response <- api_get(request)
sd_response_results <- sd_response[[c("content", "results")]]
row_names <- vapply(sd_response_results, getElement, "", "id")
types <- c("name", "description")
supported_langs <- sysdata(list(which = "supported_langs"))
n_langs <- length(supported_langs)
col_names <- rep(types, each = n_langs)
col_names <- paste(col_names, supported_langs, sep = "_")
n_cols <- length(col_names)
sd_df <- vector("list", n_cols)
sd_df <- structure(sd_df, row.names = row_names, names = col_names)
sd_df[["code"]] <- row_names
sq <- seq_along(supported_langs)
for (type in types) {
for (i in sq) {
lang_i <- supported_langs[[i]]
el_i <- c(type, lang_i)
sd_i <- vapply(sd_response_results, get_el_recurse, "", el_i, "character")
col <- paste(type, lang_i, sep = "_")
sd_df[[col]] <- sub("^.* \u2013 ", "", sd_i)
}
}
structure(set_translations(sd_df), class = "data.frame")
}
#' @noRd
record_basis <- function(obj) {
record_bases <- list(
which = "MY.recordBases", cache = obj[["cache"]], fun = get_sysdata
)
get_enumeration(record_bases)
}
#' @noRd
superrecord_basis <- function() {
r <- c(
"HUMAN_OBSERVATION_UNSPECIFIED",
"MACHINE_OBSERVATION_UNSPECIFIED",
"PRESERVED_SPECIMEN"
)
bases <- list(
code = tolower(r),
name_en = c(
"Human Observation",
"Machine Observation",
"Specimen"
),
name_fi = c(
"Havaittu",
"Laitteen tekem\u00e4 havainto",
"N\u00e4yte"
),
name_sv = c(
"Observation",
"Maskinobservation",
"Prov"
)
)
bases <- structure(bases, row.names = r, class = "data.frame")
set_translations(bases)
}
#' @noRd
life_stage <- function(obj) {
animal_life_stages <- list(
which = "MY.lifeStages", cache = obj[["cache"]], fun = get_sysdata
)
animal_life_stages <- get_enumeration(animal_life_stages)
plant_life_stages <- list(
which = "MY.plantLifeStageEnum", cache = obj[["cache"]], fun = get_sysdata
)
plant_life_stages <- get_enumeration(plant_life_stages)
life_stages <- rbind(animal_life_stages, plant_life_stages)
set_translations(life_stages)
}
#' @noRd
sex <- function(obj) {
sexes <- list(
prefix = "MY.sex", suffix = "es", cache = obj[["cache"]], fun = get_code
)
get_enumeration(sexes)
}
#' @noRd
restriction_reason <- function(obj) {
reasons <- list(
which = "MZ.secureReason", cache = obj[["cache"]], fun = get_sysdata
)
get_enumeration(reasons)
}
#' @noRd
restriction_level <- function(obj) {
levels <- list(
which = "MX.secureLevels", cache = obj[["cache"]], fun = get_sysdata
)
get_enumeration(levels)
}
#' @noRd
quality_issues <- function() {
r <- c("ONLY_ISSUES", "NO_ISSUES", "BOTH")
quality <- list(
code = c("with_issues", "without_issues", "both"),
name_en = c(
"With issues",
"Without issues",
"Both"
),
name_fi = c(
"Vain virheelliset",
"Vain virheett\u00f6m\u00e4t",
"Virheelliset ja virheett\u00f6m\u00e4t"
),
name_sv = c(
"Endast med problem",
"Inga problem",
"Med problem och inga problem"
)
)
quality <- structure(quality, row.names = r, class = "data.frame")
set_translations(quality)
}
#' @noRd
collection_quality <- function(obj) {
quality <- list(
which = "MY.collectionQualityEnum",
cache = obj[["cache"]],
fun = get_sysdata
)
get_enumeration(quality)
}
#' @noRd
record_quality <- function(obj) {
quality <- list(
which = "MZ.recordQualityEnum", cache = obj[["cache"]], fun = get_sysdata
)
get_enumeration(quality)
}
#' @noRd
record_reliability <- function() {
r <- c("RELIABLE", "UNDEFINED", "UNRELIABLE")
reliability <- list(
code = c("reliable", "unassessed", "unreliable"),
name_en = c("Reliable", "Unassessed", "Unreliable"),
name_fi = c("Luotettava", "Neutraali", "Ep\u00e4luotettava"),
name_sv = c("P\u00e5litlig", "Neutral", "Op\u00e5litliga")
)
reliability <- structure(reliability, row.names = r, class = "data.frame")
set_translations(reliability)
}
#' @noRd
complete_list_type <- function() {
r <- c(
"MY.completeListTypeCompleteWithBreedingStatus",
"MY.completeListTypeComplete",
"MY.completeListTypeIncomplete",
"MY.completeListTypeCompleteWithBreedingStatus,MY.completeListTypeComplete"
)
list_type <- list(
code = c(
"all_species_and_all_breeding",
"all_species_and_partial_breeding",
"incomplete",
"all_species"
),
name_en = c(
"All species and all breeding codes",
"All species and some breeding codes",
"Incomplete",
"All species"
),
name_fi = c(
paste0(
"T\u00e4ydellinen lajilista sis\u00e4lt\u00e4en",
" pesim\u00e4varmuusindeksit kaikille havainnoille"
),
paste0(
"T\u00e4ydellinen lajiluettelo sis\u00e4lt\u00e4en",
" joidenkin havaintojen lis\u00e4\u00e4ntymisvarmuusindeksit"
),
"Ep\u00e4t\u00e4ydellinen lajilista",
"T\u00e4ydellinen lajilista"
),
name_sv = c(
paste0(
"Komplett artlista inklusive h\u00e4ckningss\u00e4kerhetsindex",
" f\u00f6r alla observationer"
),
paste0(
"Komplett artlista inklusive h\u00e4ckningss\u00e4kerhetsindex",
" f\u00f6r vissa observationer"
),
"Komplett artlista",
"Okomplett artlista"
)
)
list_type <- structure(list_type, row.names = r, class = "data.frame")
set_translations(list_type)
}
Try the finbif package in your browser
Any scripts or data that you put into this service are public.
finbif documentation built on April 12, 2025, 2:22 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions complete_list_type record_reliability record_quality collection_quality quality_issues restriction_level restriction_reason sex life_stage superrecord_basis record_basis sources finnish_occurrence_status bird_assoc_area municipality primary_habitat informal_groups red_list_status regulatory_status replace_missing_names get_areas get_code set_translations get_enumeration get_sysdata sysdata
#' @noRd
sysdata <- function(obj) {
switch(
obj[["which"]],
supported_langs = c(English = "en", Finnish = "fi", Swedish = "sv"),
var_names = var_names_df,
has_value = has_value_df,
cite_file_vars = cite_file_vars_df,
lite_download_file_vars = lite_download_file_vars_df,
filter_names = filter_names_df,
regulatory_status = regulatory_status(obj),
red_list_status = red_list_status(obj),
threatened_status = get_sysdata(
list(which = "MX.threatenedStatusEnum", cache = obj[["cache"]])
),
informal_groups = informal_groups(obj),
informal_groups_reported = informal_groups(obj),
primary_habitat = primary_habitat(obj),
primary_secondary_habitat = primary_habitat(obj),
taxon_rank = get_sysdata(
list(which = "MX.taxonRankEnum", cache = obj[["cache"]])
),
orig_taxon_rank = get_sysdata(
list(which = "MX.taxonRankEnum", cache = obj[["cache"]])
),
country = get_areas(
list(which = "ML.country", cache = obj[["cache"]])
),
region = get_areas(
list(which = "ML.province", cache = obj[["cache"]])
),
bio_province = get_areas(
list(which = "ML.biogeographicalProvince", cache = obj[["cache"]])
),
municipality = municipality(obj),
bird_assoc_area = bird_assoc_area(obj),
finnish_occurrence_status = finnish_occurrence_status(obj),
finnish_occurrence_status_neg = finnish_occurrence_status(obj),
source = sources(obj),
record_basis = record_basis(obj),
superrecord_basis = superrecord_basis(),
life_stage = life_stage(obj),
sex = sex(obj),
restriction_reason = restriction_reason(obj),
restriction_level = restriction_level(obj),
quality_issues = quality_issues(),
collection_quality = collection_quality(obj),
record_quality = record_quality(obj),
record_reliability = record_reliability(),
complete_list_type = complete_list_type(),
location_tag = get_sysdata(
list(which = "MNP.tagEnum", cache = obj[["cache"]])
),
atlas_code = get_sysdata(
list(which = "MY.atlasCodeEnum", cache = obj[["cache"]])
),
atlas_class = get_sysdata(
list(which = "MY.atlasClassEnum", cache = obj[["cache"]])
),
abundance_unit = get_sysdata(
list(which = "MY.abundanceUnitEnum", cache = obj[["cache"]])
)
)
}
#' @noRd
get_sysdata <- function(obj) {
request <- list(
path = paste0("metadata/ranges/", obj[["which"]]),
query = list(lang = "multi"),
cache = obj[["cache"]]
)
sd_response <- api_get(request)
supported_langs <- sysdata(list(which = "supported_langs"))
n_langs <- length(supported_langs)
sd_response_content <- sd_response[["content"]]
sd_df <- structure(
vector("list", n_langs),
row.names = vapply(sd_response_content, getElement, "", "id"),
names = paste0("name_", supported_langs)
)
for (i in seq_len(n_langs)) {
el_i <- c("value", supported_langs[[i]])
sd_i <- vapply(sd_response_content, get_el_recurse, "", el_i, "character")
sd_df[[i]] <- sub("^.* [\u2013|-] ", "", sd_i)
}
structure(set_translations(sd_df), class = "data.frame")
}
#' @noRd
get_enumeration <- function(obj) {
request <- list(
path = "warehouse/enumeration-labels",
cache = obj[["cache"]]
)
en_response <- api_get(request)
en_response_results <- en_response[[c("content", "results")]]
enumerations <- vapply(en_response_results, getElement, "", "enumeration")
ids <- vapply(en_response_results, getElement, "", "property")
enumerations <- structure(enumerations, names = ids)
get_function <- obj[["fun"]]
sd_en_df <- get_function(obj)
id <- enumerations[row.names(sd_en_df)]
non_missing_enums <- !is.na(id)
sd_en_df <- structure(sd_en_df, row.names = id)
sd_en_df <- sd_en_df[non_missing_enums, ]
id <- id[non_missing_enums]
enumeration <- list(code = tolower(id))
enumeration <- structure(enumeration, class = "data.frame", row.names = id)
sd_en_df <- cbind(enumeration, sd_en_df)
set_translations(sd_en_df)
}
#' @noRd
set_translations <- function(x) {
x[] <- lapply(x, structure, class = "translation")
x
}
#' @noRd
get_code <- function(obj) {
prefix <- obj[["prefix"]]
ht <- get_sysdata(
list(which = paste0(prefix, obj[["suffix"]]), cache = obj[["cache"]])
)
ht_row_names <- row.names(ht)
ht_code <- sub(prefix, "", ht_row_names)
ht_code <- structure(ht_code, class = "translation")
ht_code <- list(code = ht_code)
ht_code <- structure(ht_code, class = "data.frame", row.names = ht_row_names)
cbind(ht_code, ht)
}
#' @noRd
get_areas <- function(obj) {
request <- list(
path = "areas",
query = list(areaType = obj[["which"]], lang = "multi", pageSize = 1000L),
cache = obj[["cache"]]
)
sd_response <- api_get(request)
sd_response_results <- sd_response[[c("content", "results")]]
supported_langs <- sysdata(list(which = "supported_langs"))
col_names <- paste0("name_", supported_langs)
n_cols <- length(col_names)
sd_df <- structure(
vector("list", n_cols),
row.names = vapply(sd_response_results, getElement, "", "id"),
names = col_names
)
for (i in seq_along(supported_langs)) {
el_i <- c("name", supported_langs[[i]])
sd_i <- vapply(sd_response_results, get_el_recurse, "", el_i, "character")
sd_df[[i]] <- sub("^.* [\u2013|-] ", "", sd_i)
}
c_els <- paste0("countryCodeISO", "alpha2")
ccode <- vapply(sd_response_results, get_el_recurse, "", c_els, "character")
if (!all_na(ccode)) {
sd_df[["code"]] <- ccode
}
p_els <- c("provinceCodeAlpha", "fi")
pcode <- vapply(sd_response_results, get_el_recurse, "", p_els, "character")
if (!all_na(pcode)) {
sd_df[["code"]] <- pcode
}
sd_df <- replace_missing_names(sd_df)
structure(set_translations(sd_df), class = "data.frame")
}
#' @noRd
replace_missing_names <- function(df) {
supported_langs <- sysdata(list(which = "supported_langs"))
col_names <- paste0("name_", supported_langs)
for (i in col_names) {
col <- df[[i]]
for (j in setdiff(col_names, i)) {
missing <- is.na(col)
other_col <- df[[j]]
col[missing] <- other_col[missing]
}
df[[i]] <- col
}
df
}
#' @noRd
regulatory_status <- function(obj) {
code <- c(
MX.finlex160_1997_appendix4 = "FNLX160_97_4",
MX.finlex160_1997_appendix4_specialInterest = "FNLX160_97_4_SI",
MX.finlex160_1997_appendix2a = "FNLX160_97_2A",
MX.finlex160_1997_appendix2b = "FNLX160_97_2B",
MX.finlex160_1997_appendix3a = "FNLX160_97_3A",
MX.finlex160_1997_appendix3b = "FNLX160_97_3B",
MX.finlex160_1997_appendix3c = "FNLX160_97_3C",
MX.habitatsDirectiveAnnexII = "HABDIR2",
MX.habitatsDirectiveAnnexIV = "HABDIR4",
MX.habitatsDirectiveAnnexV = "HABDIR5",
MX.primaryInterestInEU = "PI_EU",
MX.habitatsDirectiveAnnexIIExceptionGranted = "HABDIR2E",
MX.habitatsDirectiveAnnexIVExceptionGranted = "HABDIR4E",
MX.habitatsDirectiveAnnexVExceptionGranted = "HABDIR5E",
MX.birdsDirectiveStatusAppendix1 = "BDS1",
MX.birdsDirectiveStatusAppendix2A = "BDS2A",
MX.birdsDirectiveStatusAppendix2B = "BDS2B",
MX.birdsDirectiveStatusAppendix3A = "BDS3A",
MX.birdsDirectiveStatusAppendix3B = "BDS3B",
MX.finnishEnvironmentInstitute2010protectionPrioritySpecies = "FEI_PPS",
MX.finnishEnvironmentInstitute2020conservationProjectSpecies = "FEI_CPS",
MX.finnishEnvironmentInstitute2020conservationProjectAapamireSpecies =
"FEI_CPAS",
MX.gameBird = "GMEB",
MX.gameMammal = "GMEM",
MX.unprotectedSpecies = "UNP_SP",
MX.nationallySignificantInvasiveSpecies = "NS_INVSV",
MX.euInvasiveSpeciesList = "EU_INVSV",
MX.otherPlantPest = "OPP_INVSV",
MX.qualityPlantPest = "QLPP_INVSV",
MX.quarantinePlantPest = "QPP_INVSV",
MX.nationalInvasiveSpeciesStrategy = "NSS_INVSV",
MX.otherInvasiveSpeciesList = "OTH_INVSV",
MX.controllingRisksOfInvasiveAlienSpecies = "CRAS_INVSV",
MX.finnishEnvironmentInstitute20072010forestSpecies = "FEI_FS",
MX.finnishEnvironmentInstitute20192021forestSpecies = "FEI_FS2",
MX.cropWildRelative = "CWR",
MX.birdsDirectiveStatusMigratoryBirds = "BDSMB",
MX.cites_appendixI = "CITES1",
MX.cites_appendixII = "CITES2",
MX.cites_appendixIII = "CITES3",
MX.euRegulation_cites_appendixA = "EU_CITESA",
MX.euRegulation_cites_appendixB = "EU_CITESB",
MX.finlex160_1997_appendix4_2021 = "FNLX160_97_4_2021",
MX.finlex160_1997_appendix4_specialInterest_2021 = "FNLX160_97_4_SI_2021",
MX.finlex160_1997_largeBirdsOfPrey = "FNLX160_97_LBP",
MX.finlex160_1997_appendix1 = "FNLX160_97_1",
MX.finnishEnvironmentInstitute2020protectionPrioritySpecies = "FEI2020PPS",
MX.finnishEnvironmentInstitute2020conservationProjectVascularSpecies =
"FEI2020CPVPS",
MX.habitatsDirectiveAnnexII_FinlandNaturaSpecies = "HABDIR2FN",
MX.euRegulation_cites_appendixD = "EU_CITESD"
)
reg_status <- get_sysdata(
list(which = "MX.adminStatusEnum", cache = obj[["cache"]])
)
id <- row.names(reg_status)
code <- code[id]
code_na <- is.na(code)
missing_codes <- id[code_na]
missing_codes <- sub("^.*\\.", "", missing_codes)
missing_codes <- abbreviate(missing_codes, 20L)
code[code_na] <- toupper(missing_codes)
code <- make.unique(code)
code <- structure(code, class = "translation")
code <- list(code = code)
code <- structure(code, class = "data.frame", row.names = id)
cbind(code, reg_status)
}
#' @noRd
red_list_status <- function(obj) {
red_list <- list(
prefix = "MX.iucn", suffix = "Statuses", cache = obj[["cache"]]
)
get_code(red_list)
}
#' @noRd
informal_groups <- function(obj) {
request <- list(
path = "informal-taxon-groups",
query = list(lang = "multi", pageSize = 1000L),
cache = obj[["cache"]]
)
sd_response <- api_get(request)
sd_response_content <- sd_response[[c("content", "results")]]
supported_langs <- sysdata(list(which = "supported_langs"))
n_langs <- length(supported_langs)
sd_df <- structure(
vector("list", n_langs),
row.names = vapply(sd_response_content, getElement, "", "id"),
names = paste0("name_", supported_langs)
)
for (i in seq_len(n_langs)) {
el_i <- c("name", supported_langs[[i]])
sd_i <- vapply(sd_response_content, get_el_recurse, "", el_i, "character")
sd_df[[i]] <- sub("^.* [\u2013|-] ", "", sd_i)
}
structure(set_translations(sd_df), class = "data.frame")
}
#' @noRd
primary_habitat <- function(obj) {
habitat_types <- list(
prefix = "MKV.habitat", suffix = "Enum", cache = obj[["cache"]]
)
specific_types <- list(
prefix = "MKV.habitatSpecificType", suffix = "Enum", cache = obj[["cache"]]
)
list(
habitat_types = get_code(habitat_types),
specific_habitat_types = get_code(specific_types)
)
}
#' @noRd
municipality <- function(obj) {
regions <- c(
ML.351 = "Ahvenanmaa",
ML.352 = "Uusimaa",
ML.353 = "Ahvenanmaa",
ML.354 = "Ahvenanmaa",
ML.355 = "Ahvenanmaa",
ML.356 = "Ahvenanmaa",
ML.357 = "Ahvenanmaa",
ML.358 = "Ahvenanmaa",
ML.359 = "Ahvenanmaa",
ML.360 = "Ahvenanmaa",
ML.361 = "Ahvenanmaa",
ML.362 = "Uusimaa",
ML.363 = "Uusimaa",
ML.364 = "Uusimaa",
ML.365 = "Uusimaa",
ML.366 = "Uusimaa",
ML.367 = "Uusimaa",
ML.368 = "Ahvenanmaa",
ML.369 = "Ahvenanmaa",
ML.370 = "Uusimaa",
ML.371 = "Uusimaa",
ML.372 = "Uusimaa",
ML.373 = "Varsinais-Suomi",
ML.374 = "Ahvenanmaa",
ML.375 = "Uusimaa",
ML.376 = "Kanta-H\u00e4me",
ML.377 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.378 = "Kanta-H\u00e4me",
ML.379 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.380 = "Kanta-H\u00e4me",
ML.381 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.382 = "Uusimaa",
ML.383 = "Uusimaa",
ML.384 = "Uusimaa",
ML.385 = "Uusimaa",
ML.386 = "Varsinais-Suomi",
ML.387 = "Varsinais-Suomi",
ML.388 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.389 = "Uusimaa",
ML.390 = "Uusimaa",
ML.391 = "Varsinais-Suomi",
ML.392 = "Uusimaa",
ML.393 = "Varsinais-Suomi",
ML.394 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.396 = "Kymenlaakso",
ML.397 = "Uusimaa",
ML.398 = "Uusimaa",
ML.399 = "Satakunta",
ML.400 = "Satakunta",
ML.401 = "Varsinais-Suomi",
ML.402 = "Varsinais-Suomi",
ML.403 = "Uusimaa",
ML.404 = "Kymenlaakso",
ML.405 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.406 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.407 = "Keski-Suomi",
ML.408 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.409 = "Satakunta",
ML.410 = "Uusimaa",
ML.411 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.412 = "Kymenlaakso",
ML.413 = "Etel\u00e4-Savo",
ML.414 = "Pohjois-Karjala",
ML.415 = "Pirkanmaa",
ML.416 = "Kymenlaakso",
ML.417 = "P\u00e4ij\u00e4t-H\u00e4me",
ML.418 = "Etel\u00e4-Savo",
ML.419 = "Keski-Suomi",
ML.420 = "Etel\u00e4-Savo",
ML.421 = "Etel\u00e4-Savo",
ML.422 = "Etel\u00e4-Karjala",
ML.423 = "Etel\u00e4-Savo",
ML.424 = "Etel\u00e4-Savo",
ML.425 = "Etel\u00e4-Savo",
ML.426 = "Etel\u00e4-Karjala",
ML.427 = "Etel\u00e4-Savo",
ML.428 = "Etel\u00e4-Karjala",
ML.429 = "Satakunta",
ML.430 = "Pirkanmaa",
ML.431 = "Etel\u00e4-Karjala",
ML.432 = "Satakunta",
ML.433 = "Keski-Suomi",
ML.434 = "Keski-Suomi",
ML.435 = "Satakunta",
ML.436 = "Pohjanmaa",
ML.437 = "Kanta-H\u00e4me",
ML.438 = "Kanta-H\u00e4me",
ML.439 = "Pirkanmaa",
ML.440 = "Pirkanmaa",
ML.442 = "Pohjois-Savo",
ML.443 = "Etel\u00e4-Karjala",
ML.444 = "Pohjois-Karjala",
ML.445 = "Pohjois-Karjala",
ML.446 = "Etel\u00e4-Savo",
ML.447 = "Etel\u00e4-Pohjanmaa",
ML.449 = "Pohjois-Savo",
ML.450 = "Etel\u00e4-Savo",
ML.451 = "Etel\u00e4-Karjala",
ML.452 = "Pohjois-Karjala",
ML.453 = "Pohjois-Savo",
ML.454 = "Pohjois-Savo",
ML.455 = "Satakunta",
ML.456 = "Varsinais-Suomi",
ML.457 = "Varsinais-Suomi",
ML.458 = "Varsinais-Suomi",
ML.459 = "Satakunta",
ML.460 = "Varsinais-Suomi",
ML.461 = "Varsinais-Suomi",
ML.462 = "Varsinais-Suomi",
ML.464 = "Satakunta",
ML.465 = "Satakunta",
ML.466 = "Satakunta",
ML.467 = "Satakunta",
ML.468 = "Varsinais-Suomi",
ML.469 = "Varsinais-Suomi",
ML.470 = "Kanta-H\u00e4me",
ML.471 = "Etel\u00e4-Karjala",
ML.472 = "Varsinais-Suomi",
ML.473 = "Varsinais-Suomi",
ML.474 = "Etel\u00e4-Karjala",
ML.475 = "Varsinais-Suomi",
ML.476 = "Kymenlaakso",
ML.477 = "Etel\u00e4-Karjala",
ML.478 = "Varsinais-Suomi",
ML.479 = "Pohjanmaa",
ML.480 = "Pohjanmaa",
ML.481 = "Varsinais-Suomi",
ML.482 = "Keski-Pohjanmaa",
ML.483 = "Pirkanmaa",
ML.484 = "Etel\u00e4-Pohjanmaa",
ML.485 = "Etel\u00e4-Pohjanmaa",
ML.486 = "Varsinais-Suomi",
ML.487 = "Etel\u00e4-Savo",
ML.488 = "Etel\u00e4-Savo",
ML.489 = "Pohjois-Karjala",
ML.490 = "Pohjanmaa",
ML.491 = "Pohjanmaa",
ML.492 = "Pohjanmaa",
ML.493 = "Pohjanmaa",
ML.494 = "Keski-Pohjanmaa",
ML.495 = "Pohjois-Savo",
ML.496 = "Varsinais-Suomi",
ML.497 = "Pirkanmaa",
ML.498 = "Etel\u00e4-Pohjanmaa",
ML.499 = "Pohjanmaa",
ML.500 = "Etel\u00e4-Pohjanmaa",
ML.501 = "Etel\u00e4-Pohjanmaa",
ML.502 = "Keski-Suomi",
ML.503 = "Etel\u00e4-Pohjanmaa",
ML.504 = "Keski-Suomi",
ML.505 = "Keski-Suomi",
ML.506 = "Etel\u00e4-Pohjanmaa",
ML.507 = "Keski-Suomi",
ML.508 = "Keski-Pohjanmaa",
ML.509 = "Kanta-H\u00e4me",
ML.510 = "Satakunta",
ML.512 = "Etel\u00e4-Pohjanmaa",
ML.513 = "Pirkanmaa",
ML.514 = "Pirkanmaa",
ML.515 = "Keski-Suomi",
ML.516 = "Keski-Suomi",
ML.517 = "Pohjois-Pohjanmaa",
ML.518 = "Keski-Suomi",
ML.519 = "Pohjanmaa",
ML.520 = "Pohjois-Pohjanmaa",
ML.521 = "Pirkanmaa",
ML.522 = "Etel\u00e4-Pohjanmaa",
ML.523 = "Pohjanmaa",
ML.524 = "Pohjanmaa",
ML.525 = "Pirkanmaa",
ML.526 = "Keski-Pohjanmaa",
ML.527 = "Keski-Suomi",
ML.528 = "Pirkanmaa",
ML.529 = "Pirkanmaa",
ML.530 = "Keski-Suomi",
ML.531 = "Keski-Suomi",
ML.532 = "Keski-Suomi",
ML.533 = "Varsinais-Suomi",
ML.534 = "Keski-Suomi",
ML.536 = "Keski-Suomi",
ML.537 = "Kanta-H\u00e4me",
ML.538 = "Keski-Suomi",
ML.539 = "Keski-Suomi",
ML.541 = "Pirkanmaa",
ML.542 = "Etel\u00e4-Pohjanmaa",
ML.543 = "Etel\u00e4-Pohjanmaa",
ML.544 = "Kanta-H\u00e4me",
ML.545 = "Etel\u00e4-Pohjanmaa",
ML.546 = "Keski-Suomi",
ML.547 = "Varsinais-Suomi",
ML.548 = "Pohjois-Savo",
ML.549 = "Keski-Suomi",
ML.550 = "Keski-Suomi",
ML.551 = "Etel\u00e4-Pohjanmaa",
ML.552 = "Pirkanmaa",
ML.553 = "Pohjois-Savo",
ML.554 = "Pirkanmaa",
ML.555 = "Pirkanmaa",
ML.556 = "Etel\u00e4-Pohjanmaa",
ML.557 = "Etel\u00e4-Pohjanmaa",
ML.558 = "Pohjois-Savo",
ML.559 = "Etel\u00e4-Pohjanmaa",
ML.560 = "Keski-Pohjanmaa",
ML.561 = "Pirkanmaa",
ML.562 = "Pirkanmaa",
ML.563 = "Satakunta",
ML.564 = "Keski-Pohjanmaa",
ML.565 = "Keski-Pohjanmaa",
ML.566 = "Keski-Pohjanmaa",
ML.567 = "Pohjois-Savo",
ML.568 = "Kainuu",
ML.569 = "Pohjois-Savo",
ML.570 = "Pohjois-Savo",
ML.572 = "Pohjois-Pohjanmaa",
ML.573 = "Pohjois-Savo",
ML.574 = "Pohjois-Savo",
ML.575 = "Pohjois-Savo",
ML.576 = "Pohjois-Savo",
ML.577 = "Pirkanmaa",
ML.578 = "Pohjois-Karjala",
ML.579 = "Pirkanmaa",
ML.580 = "Pohjois-Karjala",
ML.582 = "Pohjois-Karjala",
ML.584 = "Pohjois-Karjala",
ML.585 = "Pohjois-Savo",
ML.586 = "Pohjois-Pohjanmaa",
ML.587 = "Pohjois-Pohjanmaa",
ML.588 = "Pohjois-Pohjanmaa",
ML.589 = "Kanta-H\u00e4me",
ML.590 = "Pohjois-Karjala",
ML.591 = "Pohjois-Pohjanmaa",
ML.592 = "Kainuu",
ML.593 = "Pohjois-Pohjanmaa",
ML.594 = "Pohjois-Pohjanmaa",
ML.595 = "Pohjois-Pohjanmaa",
ML.596 = "Kainuu",
ML.597 = "Pohjois-Pohjanmaa",
ML.598 = "Pohjois-Pohjanmaa",
ML.599 = "Pohjois-Savo",
ML.600 = "Lappi",
ML.601 = "Pohjois-Pohjanmaa",
ML.602 = "Pohjois-Pohjanmaa",
ML.603 = "Lappi",
ML.604 = "Pohjois-Pohjanmaa",
ML.605 = "Kainuu",
ML.606 = "Pohjois-Pohjanmaa",
ML.607 = "Kainuu",
ML.608 = "Pohjois-Pohjanmaa",
ML.609 = "Kainuu",
ML.610 = "Pohjois-Pohjanmaa",
ML.611 = "Pohjois-Pohjanmaa",
ML.612 = "Pohjois-Karjala",
ML.613 = "Kainuu",
ML.614 = "Kainuu",
ML.615 = "Lappi",
ML.616 = "Pohjois-Pohjanmaa",
ML.617 = "Lappi",
ML.618 = "Lappi",
ML.619 = "Lappi",
ML.620 = "Lappi",
ML.621 = "Lappi",
ML.622 = "Lappi",
ML.623 = "Lappi",
ML.624 = "Lappi",
ML.625 = "Lappi",
ML.626 = "Lappi",
ML.627 = "Lappi",
ML.628 = "Lappi",
ML.629 = "Lappi",
ML.630 = "Lappi",
ML.631 = "Lappi",
ML.632 = "Lappi",
ML.633 = "Lappi",
ML.634 = "Lappi",
ML.635 = "Kanta-H\u00e4me",
ML.636 = "Pohjois-Karjala",
ML.637 = "Pohjois-Karjala",
ML.638 = "Pohjois-Pohjanmaa",
ML.639 = "Pohjois-Pohjanmaa",
ML.640 = "Pohjois-Pohjanmaa",
ML.641 = "Satakunta",
ML.642 = "Pohjois-Pohjanmaa",
ML.643 = "Uusimaa",
ML.644 = "Pohjois-Pohjanmaa",
ML.645 = "Pohjois-Pohjanmaa",
ML.647 = "Varsinais-Suomi",
ML.648 = "Uusimaa",
ML.649 = "Satakunta",
ML.650 = "Pohjois-Pohjanmaa",
ML.651 = "Ahvenanmaa",
ML.652 = "Pohjanmaa",
ML.653 = "Etel\u00e4-Pohjanmaa",
ML.654 = "Pohjanmaa",
ML.655 = "Pohjois-Savo",
ML.656 = "Ahvenanmaa",
ML.657 = "Pohjois-Pohjanmaa",
ML.658 = "Pohjois-Pohjanmaa",
ML.659 = "Pohjois-Savo",
ML.660 = "Uusimaa",
ML.661 = "Kymenlaakso",
ML.662 = "Ahvenanmaa",
ML.663 = "Pirkanmaa",
ML.664 = "Varsinais-Suomi",
ML.665 = "Varsinais-Suomi",
ML.666 = "Pirkanmaa",
ML.667 = "Uusimaa",
ML.668 = "Pirkanmaa",
ML.669 = "Pohjois-Pohjanmaa",
ML.670 = "Pohjanmaa"
)
municipalities <- get_areas(
list(which = "ML.municipality", cache = obj[["cache"]])
)
id <- row.names(municipalities)
regions <- structure(regions[id], class = "translation", names = NULL)
regions <- list(region = regions)
regions <- structure(regions, class = "data.frame", row.names = id)
cbind(municipalities, regions)
}
#' @noRd
bird_assoc_area <- function(obj) {
codes <- c(
ML.1088 = "AFF",
ML.1095 = "EKLY",
ML.1101 = "Oriolus",
ML.1091 = "Tringa",
ML.1110 = "KLY",
ML.1097 = "KHLY",
ML.1111 = "Xenus",
ML.1092 = "Apus",
ML.1108 = "KPLY",
ML.1104 = "KSLY",
ML.1113 = "Kuusamo",
ML.1094 = "KyLY",
ML.1112 = "LLY",
ML.1114 = "Hakki",
ML.1096 = "LHLH",
ML.1107 = "MLY",
ML.1098 = "PHLY",
ML.1099 = "PiLY",
ML.1103 = "PKLY",
ML.1109 = "PPLY",
ML.1102 = "Kuikka",
ML.1090 = "PLY",
ML.1093 = "PSLY",
ML.1116 = "RSLH",
ML.1127 = "SUA",
ML.1105 = "SSLTY",
ML.1106 = "SpLY",
ML.1089 = "TLY",
ML.1267 = "OA"
)
bird_assoc <- get_areas(
list(which = "ML.birdAssociationArea", cache = obj[["cache"]])
)
id <- row.names(bird_assoc)
codes <- unname(codes[id])
codes <- structure(codes, class = "translation", names = NULL)
codes <- list(code = codes)
codes <- structure(codes, class = "data.frame", row.names = id)
cbind(bird_assoc, codes)
}
#' @noRd
finnish_occurrence_status <- function(obj) {
codes <- c(
MX.doesNotOccur = "none",
MX.typeOfOccurrenceOccurs = "occurs",
MX.typeOfOccurrenceStablePopulation = "stable",
MX.typeOfOccurrenceCommon = "common",
MX.typeOfOccurrenceRare = "rare",
MX.typeOfOccurrenceVeryRare = "very_rare",
MX.typeOfOccurrenceVagrant = "vagrant_regular",
MX.typeOfOccurrenceRareVagrant = "vagrant_irregular",
MX.typeOfOccurrenceMigrant = "migrant",
MX.typeOfOccurrenceImport = "import",
MX.typeOfOccurrenceAnthropogenic = "introduced",
MX.typeOfOccurrenceNotEstablished = "unestablished",
MX.typeOfOccurrenceExtirpated = "extinct",
MX.typeOfOccurrenceOldRecords = "historic",
MX.typeOfOccurrenceUncertain = "uncertain",
MX.typeOfOccurrenceMaxReplanted = "reintroduced",
MX.typeOfOccurrenceNotEvaluated = "unevaluated",
MX.typeOfOccurrenceSpontaneousOldResident = "SOR",
MX.typeOfOccurrenceSpontaneousOldFormerlyResidentPossiblyExtinct = "SORPE",
MX.typeOfOccurrenceSpontaneousOldFormerlyResidentExtinct = "SORE",
MX.typeOfOccurrenceSpontaneousNewResident = "SNR",
MX.typeOfOccurrenceSpontaneousNewEphemeral = "SNE",
MX.typeOfOccurrenceSpontaneousNewEphemeralOnlyOld = "SNEH",
MX.typeOfOccurrenceAlienOldResident = "AOR",
MX.typeOfOccurrenceAlienOldFormerlyResidentPossiblyExtinct = "AORPE",
MX.typeOfOccurrenceAlienOldExtinct = "AORE",
MX.typeOfOccurrenceAlienNewResident = "ANR",
MX.typeOfOccurrenceAlienNewEphemeral = "ANE",
MX.typeOfOccurrenceAlienNewEphemeralOnlyold = "ANEH",
MX.typeOfOccurrenceCompletelyCultivatedOrigin = "cultivation_escape_all",
MX.typeOfOccurrenceNotableDegreeCultivatedOrigin = "cultivation_escape",
MX.typeOfOccurrenceMaxShortDistanceEscape = "cultivation_escape_short",
MX.typeOfOccurrenceSmallDegreeCultivatedOrigin = "cultivation_escape_some",
MX.typeOfOccurrenceOnlyCultivated = "cultivation_only",
MX.typeOfOccurrenceMaxRelict = "cultivation_relict",
MX.typeOfOccurrenceMaxSoilImmigrant = "soil_immigrant",
MX.typeOfOccurrenceOccursBasedOnOccurrences = "records_only",
MX.typeOfOccurrenceRegularBreeder = "regular_breeder",
MX.typeOfOccurrenceIrregularBreeder = "irregular_breeder",
MX.typeOfOccurrencePassageMigrant = "passage_migrant",
MX.typeOfOccurrenceBirdLifeCategoryA = "BLA",
MX.typeOfOccurrenceBirdLifeCategoryB = "BLB",
MX.typeOfOccurrenceBirdLifeCategoryC = "BLC",
MX.typeOfOccurrenceBirdLifeCategoryD = "BLD",
MX.typeOfOccurrenceBirdLifeCategoryE = "BLE"
)
finnish_occurrence <- get_sysdata(
list(which = "MX.typeOfOccurrenceEnum", cache = obj[["cache"]])
)
id <- row.names(finnish_occurrence)
codes <- unname(codes[id])
codes <- structure(codes, class = "translation", names = NULL)
codes <- list(code = codes)
codes <- structure(codes, class = "data.frame", row.names = id)
cbind(finnish_occurrence, codes)
}
#' @noRd
sources <- function(obj) {
request <- list(
path = "sources",
query = list(lang = "multi", pageSize = 1000L),
cache = obj[["cache"]]
)
sd_response <- api_get(request)
sd_response_results <- sd_response[[c("content", "results")]]
row_names <- vapply(sd_response_results, getElement, "", "id")
types <- c("name", "description")
supported_langs <- sysdata(list(which = "supported_langs"))
n_langs <- length(supported_langs)
col_names <- rep(types, each = n_langs)
col_names <- paste(col_names, supported_langs, sep = "_")
n_cols <- length(col_names)
sd_df <- vector("list", n_cols)
sd_df <- structure(sd_df, row.names = row_names, names = col_names)
sd_df[["code"]] <- row_names
sq <- seq_along(supported_langs)
for (type in types) {
for (i in sq) {
lang_i <- supported_langs[[i]]
el_i <- c(type, lang_i)
sd_i <- vapply(sd_response_results, get_el_recurse, "", el_i, "character")
col <- paste(type, lang_i, sep = "_")
sd_df[[col]] <- sub("^.* \u2013 ", "", sd_i)
}
}
structure(set_translations(sd_df), class = "data.frame")
}
#' @noRd
record_basis <- function(obj) {
record_bases <- list(
which = "MY.recordBases", cache = obj[["cache"]], fun = get_sysdata
)
get_enumeration(record_bases)
}
#' @noRd
superrecord_basis <- function() {
r <- c(
"HUMAN_OBSERVATION_UNSPECIFIED",
"MACHINE_OBSERVATION_UNSPECIFIED",
"PRESERVED_SPECIMEN"
)
bases <- list(
code = tolower(r),
name_en = c(
"Human Observation",
"Machine Observation",
"Specimen"
),
name_fi = c(
"Havaittu",
"Laitteen tekem\u00e4 havainto",
"N\u00e4yte"
),
name_sv = c(
"Observation",
"Maskinobservation",
"Prov"
)
)
bases <- structure(bases, row.names = r, class = "data.frame")
set_translations(bases)
}
#' @noRd
life_stage <- function(obj) {
animal_life_stages <- list(
which = "MY.lifeStages", cache = obj[["cache"]], fun = get_sysdata
)
animal_life_stages <- get_enumeration(animal_life_stages)
plant_life_stages <- list(
which = "MY.plantLifeStageEnum", cache = obj[["cache"]], fun = get_sysdata
)
plant_life_stages <- get_enumeration(plant_life_stages)
life_stages <- rbind(animal_life_stages, plant_life_stages)
set_translations(life_stages)
}
#' @noRd
sex <- function(obj) {
sexes <- list(
prefix = "MY.sex", suffix = "es", cache = obj[["cache"]], fun = get_code
)
get_enumeration(sexes)
}
#' @noRd
restriction_reason <- function(obj) {
reasons <- list(
which = "MZ.secureReason", cache = obj[["cache"]], fun = get_sysdata
)
get_enumeration(reasons)
}
#' @noRd
restriction_level <- function(obj) {
levels <- list(
which = "MX.secureLevels", cache = obj[["cache"]], fun = get_sysdata
)
get_enumeration(levels)
}
#' @noRd
quality_issues <- function() {
r <- c("ONLY_ISSUES", "NO_ISSUES", "BOTH")
quality <- list(
code = c("with_issues", "without_issues", "both"),
name_en = c(
"With issues",
"Without issues",
"Both"
),
name_fi = c(
"Vain virheelliset",
"Vain virheett\u00f6m\u00e4t",
"Virheelliset ja virheett\u00f6m\u00e4t"
),
name_sv = c(
"Endast med problem",
"Inga problem",
"Med problem och inga problem"
)
)
quality <- structure(quality, row.names = r, class = "data.frame")
set_translations(quality)
}
#' @noRd
collection_quality <- function(obj) {
quality <- list(
which = "MY.collectionQualityEnum",
cache = obj[["cache"]],
fun = get_sysdata
)
get_enumeration(quality)
}
#' @noRd
record_quality <- function(obj) {
quality <- list(
which = "MZ.recordQualityEnum", cache = obj[["cache"]], fun = get_sysdata
)
get_enumeration(quality)
}
#' @noRd
record_reliability <- function() {
r <- c("RELIABLE", "UNDEFINED", "UNRELIABLE")
reliability <- list(
code = c("reliable", "unassessed", "unreliable"),
name_en = c("Reliable", "Unassessed", "Unreliable"),
name_fi = c("Luotettava", "Neutraali", "Ep\u00e4luotettava"),
name_sv = c("P\u00e5litlig", "Neutral", "Op\u00e5litliga")
)
reliability <- structure(reliability, row.names = r, class = "data.frame")
set_translations(reliability)
}
#' @noRd
complete_list_type <- function() {
r <- c(
"MY.completeListTypeCompleteWithBreedingStatus",
"MY.completeListTypeComplete",
"MY.completeListTypeIncomplete",
"MY.completeListTypeCompleteWithBreedingStatus,MY.completeListTypeComplete"
)
list_type <- list(
code = c(
"all_species_and_all_breeding",
"all_species_and_partial_breeding",
"incomplete",
"all_species"
),
name_en = c(
"All species and all breeding codes",
"All species and some breeding codes",
"Incomplete",
"All species"
),
name_fi = c(
paste0(
"T\u00e4ydellinen lajilista sis\u00e4lt\u00e4en",
" pesim\u00e4varmuusindeksit kaikille havainnoille"
),
paste0(
"T\u00e4ydellinen lajiluettelo sis\u00e4lt\u00e4en",
" joidenkin havaintojen lis\u00e4\u00e4ntymisvarmuusindeksit"
),
"Ep\u00e4t\u00e4ydellinen lajilista",
"T\u00e4ydellinen lajilista"
),
name_sv = c(
paste0(
"Komplett artlista inklusive h\u00e4ckningss\u00e4kerhetsindex",
" f\u00f6r alla observationer"
),
paste0(
"Komplett artlista inklusive h\u00e4ckningss\u00e4kerhetsindex",
" f\u00f6r vissa observationer"
),
"Komplett artlista",
"Okomplett artlista"
)
)
list_type <- structure(list_type, row.names = r, class = "data.frame")
set_translations(list_type)
}
Try the finbif package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.