diff --git a/R/ids.feature.R b/R/ids.feature.R index ce5ac97..d81672e 100644 --- a/R/ids.feature.R +++ b/R/ids.feature.R @@ -3,15 +3,13 @@ #' This function downloads data from The Intercontinental Dictionary Series (\url{https://ids.clld.org/}). You need the internet connection. #' #' @param features A vector with parameters from conepts (\url{https://ids.clld.org/parameters})) -#' @param languages A vector with language names from the database.If features not selected, downloads full dictionaries for chosen languages. -#' @param choose_var Logical. If TRUE looks for all of the variants of each language. By default is TRUE. #' @param na.rm Logical. If TRUE function removes all languages not available in the glottolog database available in lingtypology. By default is TRUE. #' @author Mikhail Leonov #' @export #' @importFrom utils read.csv -ids.feature <-function(features = c(),languages = c(),choose_var = TRUE,na.rm = TRUE) { +ids.feature <-function(features = c(), na.rm = TRUE) { message(paste0("Don't forget to cite a source (modify in case of using individual chapters): Key, Mary Ritchie & Comrie, Bernard (eds.) 2015. @@ -29,11 +27,6 @@ Leipzig: Max Planck Institute for Evolutionary Anthropology. if (length(not_features)==length(features) && length(features)!=0){ warning('None of the parameters are in the IDS database.') } - not_languages<-c() - languages_found<-unlist(sapply(languages, lang_check,lang_csv = lang_csv,choose_var=choose_var,not_languages=not_languages)) - if (length(not_languages)==length(languages) && length(languages)!=0){ - warning('None of the languages are in the IDS database.') - } if (length(not_features)!=0){ warning(paste( @@ -43,30 +36,14 @@ Leipzig: Max Planck Institute for Evolutionary Anthropology. )) } - if (length(not_languages)!=0){ - warning(paste( - "There are no languages", - paste0("'", not_languages, "'", collapse = ", "), - "in IDS database." - )) - } e_features<-as.character(id_list[id_list$concepticon_gloss %in% features,]$concepticon_gloss) - e_languages<-languages_found - feat_sourse<- TRUE if (length(e_features) == 0){ - if (length(e_languages)==0) - stop('None of the parameters and/or languages are in the ids database.') - else - feat_sourse<-FALSE - + stop('None of the parameters are in the ids database.') } - if(feat_sourse){ - final_df_list<-lapply(as.vector(e_features),add_param,langs= langs,feat_sourse =feat_sourse,id_list=id_list,lang_csv=lang_csv,conc_csv = conc_csv,e_languages=e_languages) - }else{ - final_df_list<-lapply(as.vector(languages_found),add_param,langs= langs,feat_sourse =feat_sourse,id_list=id_list,lang_csv=lang_csv,conc_csv=conc_csv - ,e_languages=e_languages) - } + + final_df_list<-lapply(as.vector(e_features),add_param,langs= langs,id_list=id_list,lang_csv=lang_csv,conc_csv = conc_csv) + final_df<-do.call(rbind, final_df_list) if (na.rm){ diff --git a/R/ids.utils.R b/R/ids.utils.R index 3899967..5dce134 100644 --- a/R/ids.utils.R +++ b/R/ids.utils.R @@ -1,38 +1,18 @@ #' Util fuctions for ids function #' +#' @noRd #' @author Mikhail Leonov #' @importFrom utils read.csv -#' @NoRd -lang_check <- function(lang_name, - lang_csv, - choose_var, - not_languages) { - cand <- c() - if (lang_name %in% lang_csv$Name) { - cand <- c(lang_name) - } - if (choose_var) { - add_cand <- c(grep(paste0('^', lang_name, ' '), - lang_csv$Name)) - cand <- c(cand, lang_csv[unique(add_cand), ]$Name) - } - if (length(cand) == 0) - not_languages<<-c(not_languages,lang_name) - # assign(not_languages, c(not_languages, lang_name), envir = .GlobalEnv) - cand -} +#' add_param <- function(x, langs, - feat_sourse, id_list, lang_csv, - conc_csv, - e_languages) { - if (feat_sourse) { - id <- as.character(id_list[id_list$concepticon_gloss == x, ]$id) - parameters <- + conc_csv) { + id <- as.character(id_list[id_list$concepticon_gloss == x, ]$id) + parameters <- read.csv( paste0( 'https://ids.clld.org/values.csv?parameter=', @@ -41,33 +21,7 @@ add_param <- ), encoding = 'UTF-8' ) - parameters['feature'] <- c(rep(x, nrow(parameters))) - } - else{ - lang <- as.character(lang_csv[lang_csv$Name == x, ]$ID) - parameters <- - read.csv( - paste0( - 'https://ids.clld.org/values.csv?contribution=', - lang, - '&sEcho=1&iSortingCols=1&iSortCol_0=0&sSortDir_0=asc' - ), - encoding = 'UTF-8' - ) - parameters['f_id'] <- - unlist(lapply(parameters$id, function(x) { - paste0(strsplit(x, '-')[[1]][1], '-', strsplit(x, '-')[[1]][2]) - })) - parameters <- - merge( - parameters, - id_list, - by.x = "f_id", - by.y = 'id', - all.x = TRUE - ) - colnames(parameters)[15] <- 'feature' - } + parameters['feature'] <- c(rep(x, nrow(parameters))) parameters['lang_id'] <- unlist(lapply(parameters$id, function(x) { strsplit(x, '-')[[1]][3] @@ -96,8 +50,5 @@ add_param <- 'language_name', 'glottocode', 'conc_chapter') - if (feat_sourse && length(e_languages) != 0) { - parameters <- parameters[parameters$language_name %in% e_languages, ] - } parameters } diff --git a/man/ids.feature.Rd b/man/ids.feature.Rd index 3cc0db4..2c3b005 100644 --- a/man/ids.feature.Rd +++ b/man/ids.feature.Rd @@ -4,16 +4,12 @@ \alias{ids.feature} \title{Download data from The Intercontinental Dictionary Series} \usage{ -ids.feature(features = c(), languages = c(), choose_var = TRUE, na.rm = TRUE) +ids.feature(features = c(), na.rm = TRUE) } \arguments{ -\item{features}{A vector with parameters from Conepts (\url{https://vanuatuvoices.clld.org/parameters}))} +\item{features}{A vector with parameters from conepts (\url{https://ids.clld.org/parameters}))} -\item{languages}{A vector with language names from the database.If features not selected, downloads full dictionaries for chosen languages.} - -\item{choose_var}{Logical. If TRUE looks for all of the variants of each language. By default is TRUE.} - -\item{na.rm}{Logical. If TRUE function removes all languages not available in lingtypology database. By default is TRUE.} +\item{na.rm}{Logical. If TRUE function removes all languages not available in the glottolog database available in lingtypology. By default is TRUE.} } \description{ This function downloads data from The Intercontinental Dictionary Series (\url{https://ids.clld.org/}). You need the internet connection. diff --git a/tests/testthat/test-ids-feature.R b/tests/testthat/test-ids-feature.R index bb301cb..33d7995 100644 --- a/tests/testthat/test-ids-feature.R +++ b/tests/testthat/test-ids-feature.R @@ -4,29 +4,13 @@ context("Tests for ids.feature function") test_that("ids.feature", { skip_on_cran() expect_error(ids.feature(), - "None of the parameters and/or languages are in the ids database.") -}) -test_that("ids.feature", { - skip_on_cran() - expect_error( - ids.feature( - languages = c('aa', 'bb'), - features = c('aa', 'bb') - ), - "None of the parameters and/or languages are in the ids database." - ) -}) -test_that("ids.feature", { - skip_on_cran() - expect_error( - ids.feature(languages = c('aa', 'bb')), - "None of the parameters and/or languages are in the ids database." - ) + "None of the parameters are in the ids database.") }) + test_that("ids.feature", { skip_on_cran() expect_error( ids.feature(features = c('aa', 'bb')), - "None of the parameters and/or languages are in the ids database." + "None of the parameters are in the ids database." ) })