add ar_characterize_targets function

samuelae · Dec 10, 2023 · 72c0618 · 72c0618
1 parent 57f3e54
commit 72c0618
Show file tree

Hide file tree

Showing 4 changed files with 78 additions and 36 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -23,7 +23,7 @@ BugReports: https://github.com/samuelae/associatoR/issues
 Maintainer: Samuel Aeschbach <samuel.aeschbach@gmail.com>
 License: GPL-3
 Depends: R (>= 3.1.0),
-Imports: dplyr (>= 0.5.0), dtplyr, tidyselect, magrittr, tibble, stringr, chk, cli, rlang, readr
+Imports: dplyr (>= 0.5.0), dtplyr, tidyselect, magrittr, tibble, stringr, chk, cli, rlang, readr, readxl, tidyr
 Suggests: testthat
 LinkingTo: Rcpp
 Encoding: UTF-8

diff --git a/R/target.R b/R/target.R
@@ -130,7 +130,7 @@ ar_count_targets <- function(associations, ...) {
 #' Append target characteristic to the \code{targets} table in the \code{associatoR} object
 #'
 #' @param associations an \code{associatoR} object containing association data as generated by \link[associatoR]{ar_import}.
-#' @param characteristic a \code{character} string or vector specifying which word characteristics to add to \code{targets}. Must be one or multiple of \code{c("valence", "frequency", "pos", "concreteness")}.
+#' @param characteristic a \code{character} string or vector specifying which word characteristics to add to \code{targets}. Must be one or multiple of \code{c("valence", "arousal", "dominance", "concreteness", "frequency")}. Data on valence, arousal, and dominance are retrieved from Warriner et al. (2013), concreteness and frequency data are retrieved from Brysbaert et al. (2014).
 #'
 #' @return Returns an \code{associatoR} object containing a list of tibbles, with \code{targets} gaining additional columns including the target characteristics:
 #' \describe{
@@ -141,58 +141,86 @@ ar_count_targets <- function(associations, ...) {
 #' }
 #'
 #' @references
-#'   Warriner, A.B., Kuperman, V. & Brysbaert, M. Norms of valence, arousal, and dominance for 13,915 English lemmas. Behav Res 45, 1191–1207 (2013). https://doi.org/10.3758/s13428-012-0314-x
-#'   Brysbaert, M., Warriner, A.B. & Kuperman, V. Concreteness ratings for 40 thousand generally known English word lemmas. Behav Res 46, 904–911 (2014). https://doi.org/10.3758/s13428-013-0403-5
+#' \itemize{
+#'   \item{Warriner, A.B., Kuperman, V. & Brysbaert, M. Norms of valence, arousal, and dominance for 13,915 English lemmas. Behav Res 45, 1191–1207 (2013). https://doi.org/10.3758/s13428-012-0314-x}
+#'   \item{Brysbaert, M., Warriner, A.B. & Kuperman, V. Concreteness ratings for 40 thousand generally known English word lemmas. Behav Res 46, 904–911 (2014). https://doi.org/10.3758/s13428-013-0403-5}
+#' }
+#'
+#'
+#'
 #'
 #' @examples
+#' ar_import(fa_data,
+#'           participant = "participantID", participant_vars = c("age", "gender"),
+#'           cue = "cue", response = "response",
+#'           response_vars = c("created_at", "pos")) %>%
+#'   ar_normalize() %>%
+#'   ar_set_targets("cues") %>%
+#'   ar_characterize_targets()
 #'
 #' @export
 ar_characterize_targets <- function(associations,
                                     characteristic = c("valence",
-                                                       "arrousal",
+                                                       "arousal",
                                                        "dominance",
                                                        "concreteness",
                                                        "frequency")) {
 
+  # checks
+  chk::chk_s3_class(associations, "associatoR")
+  chk::chk_subset(characteristic, c("valence",
+                                    "arousal",
+                                    "dominance",
+                                    "concreteness",
+                                    "frequency"))
+
   # retrieve valence, arousal, dominance ---
   # form Warriner, A.B., Kuperman, V. & Brysbaert, M. Norms of valence, arousal, and dominance for 13,915 English lemmas. Behav Res 45, 1191–1207 (2013). https://doi.org/10.3758/s13428-012-0314-x
 
-  # download from publisher
-  temp <- tempfile()
-  download.file("https://static-content.springer.com/esm/art%3A10.3758%2Fs13428-012-0314-x/MediaObjects/13428_2012_314_MOESM1_ESM.zip", temp)
-  warriner <- readr::read_csv(temp)
-  unlink(temp)
-
-  warriner <- warriner %>%
-    dplyr::select(word = Word,
-                  valence = V.Mean.Sum,
-                  arousal = A.Mean.Sum,
-                  dominance = D.Mean.Sum)
+  if("valence" %in% characteristic | "arousal" %in% characteristic | "dominance" %in% characteristic) {
 
+    # download from publisher
+    temp <- tempfile()
+    download.file("https://static-content.springer.com/esm/art%3A10.3758%2Fs13428-012-0314-x/MediaObjects/13428_2012_314_MOESM1_ESM.zip", temp)
+    warriner <- readr::read_csv(temp, show_col_types = FALSE)
+    unlink(temp)
 
-  # retrieve concreteness, frequency ----
-  # from Brysbaert, M., Warriner, A.B. & Kuperman, V. Concreteness ratings for 40 thousand generally known English word lemmas. Behav Res 46, 904–911 (2014). https://doi.org/10.3758/s13428-013-0403-5
+    warriner <- warriner %>%
+      dplyr::select(word = Word,
+                    valence = V.Mean.Sum,
+                    arousal = A.Mean.Sum,
+                    dominance = D.Mean.Sum) %>%
+      dplyr::select(word, any_of(characteristic))
 
-  # download from publisher
-  temp <- tempfile()
-  download.file("https://static-content.springer.com/esm/art%3A10.3758%2Fs13428-013-0403-5/MediaObjects/13428_2013_403_MOESM1_ESM.xlsx", temp)
-  brysbaert <- readxl::read_excel(temp)
-  unlink(temp)
-
-  brysbaert <- brysbaert %>%
-    dplyr::select(word = Word,
-                  concreteness = Conc.M,
-                  frequency = SUBTLEX)
+    # add selected characteristics to targets
+    associations$targets <- associations$targets %>%
+      dplyr::left_join(warriner, by = c("target" = "word"))
+  }
 
-  # add characteristics to targets ----
-  associations$targets <- associations$targets %>%
-    dplyr::left_join(warriner, by = c("target" = "word")) %>%
-    dplyr::left_join(brysbaert, by = c("target" = "word"))
+  if("concreteness" %in% characteristic | "frequency" %in% characteristic) {
 
+    # retrieve concreteness, frequency ----
+    # from Brysbaert, M., Warriner, A.B. & Kuperman, V. Concreteness ratings for 40 thousand generally known English word lemmas. Behav Res 46, 904–911 (2014). https://doi.org/10.3758/s13428-013-0403-5
 
+    # download from publisher
+    temp <- tempfile()
+    download.file("https://static-content.springer.com/esm/art%3A10.3758%2Fs13428-013-0403-5/MediaObjects/13428_2013_403_MOESM1_ESM.xlsx", temp)
+    brysbaert <- readxl::read_excel(temp)
+    unlink(temp)
 
+    brysbaert <- brysbaert %>%
+      dplyr::select(word = Word,
+                    concreteness = Conc.M,
+                    frequency = SUBTLEX) %>%
+      dplyr::select(word, any_of(characteristic))
 
+    # add characteristics to targets ----
+    associations$targets <- associations$targets %>%
+      dplyr::left_join(brysbaert, by = c("target" = "word"))
 
+  }
 
+  # out
+  associations
 
 }
diff --git a/man/ar_characterize_targets.Rd b/man/ar_characterize_targets.Rd
diff --git a/man/ar_count_targets.Rd b/man/ar_count_targets.Rd