Merge b03b7bc into 634a370

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dycon
 Title: Dyadic Models of Consonance
-Version: 0.1.0
+Version: 0.2.0
 Authors@R: person("Peter", "Harrison", email = "pmc.harrison@gmail.com", role = c("aut", "cre"))
 Description: Implements dyadic models of consonance, such as that of Hutchinson & Knopoff (1978).
 Depends: R (>= 3.4.0)
@@ -10,12 +10,16 @@ LazyData: true
 Imports: 
     assertthat,
     magrittr,
-    Rdpack
+    hrep,
+    dplyr,
+    tibble,
+    Rdpack,
+    purrr,
+    rlang,
+    ggplot2
 RoxygenNote: 6.1.1
 RdMacros: Rdpack
 Suggests: 
     testthat,
-    hrep,
-    tibble,
     covr
 Remotes: pmcharrison/hrep

NAMESPACE

@@ -7,8 +7,11 @@ S3method(roughness_seth,sparse_fr_spectrum)
 S3method(roughness_vass,default)
 S3method(roughness_vass,sparse_fr_spectrum)
 export(hutch_cbw)
+export(hutch_visualise)
+export(hutch_visualise_theme)
 export(hutch_y)
 export(roughness_hutch)
 export(roughness_seth)
 export(roughness_vass)
 importFrom(magrittr,"%>%")
+importFrom(rlang,".data")

NEWS.md

@@ -0,0 +1,4 @@
+# dycon 0.2.0
+
+- Added a `NEWS.md` file to track changes to the package.
+- Added visualisation function `hutch_visualise()`.

R/hutch.R

@@ -125,3 +125,99 @@ hutch_g <- function(y, cbw_cut_off = 1.2, a = 0.25, b = 2) {
   }
   res
 }
+
+hutch_visualise_data <- function(x, cbw_cut_off, a, b, min_freq, max_freq, ...) {
+  frequency <- c(min_freq, hrep::freq(x), max_freq)
+  amplitude <- c(0, hrep::amp(x), 0)
+  n <- length(frequency)
+  df <- expand.grid(j = seq_len(n), i = seq_len(n)) %>%
+    tibble::as_tibble() %>%
+    dplyr::mutate(
+      a_i_a_j = amplitude[.data$i] * amplitude[.data$j],
+      g_ij = hutch_g(
+        y = hutch_y(f1 = frequency[.data$i],
+                    f2 = frequency[.data$j]),
+        cbw_cut_off = cbw_cut_off,
+        a = a,
+        b = b
+      )) %>%
+    dplyr::group_by(.data$i) %>%
+    dplyr::summarise(dissonance = sum(.data$g_ij))
+  df2 <- tibble::tibble(i = seq_len(n), frequency, amplitude) %>%
+    dplyr::left_join(df, by = "i") %>%
+    dplyr::mutate(pitch = hrep::freq_to_midi(frequency))
+  df3 <- data.frame(pitch = numeric(n * 5),
+                    amplitude = numeric(n * 5),
+                    dissonance = numeric(n * 5))
+  for (i in seq_len(n)) {
+    I <- (i - 1L) * 5L
+    df3[I + 1:5, "pitch"] <- df2[i, "pitch"]
+    df3[I + 2:4, "dissonance"] <- df2[i, "dissonance"]
+    df3$amplitude[I + 3L] <- df2$amplitude[i]
+  }
+  df3
+}
+
+#' ggplot theme
+#'
+#' Defines a default theme for visualising computations
+#' for Hutchinson & Knopoff's (1978) model
+#' (see \code{\link{hutch_visualise}}).
+#' @export
+hutch_visualise_theme <- ggplot2::theme_classic() +
+  ggplot2::theme(
+    panel.spacing = ggplot2::unit(1.9, "lines"),
+    strip.background = ggplot2::element_blank(),
+    axis.text.x = ggplot2::element_text(colour = "black"),
+    axis.text.y = ggplot2::element_text(colour = "black"),
+    axis.ticks = ggplot2::element_line(colour = "black")
+  )
+
+#' Visualise
+#'
+#' Creates a plot visualising computations for Hutchinson & Knopoff's model.
+#'
+#' @param x Passed to \code{\link{roughness_hutch}}.
+#' @param cbw_cut_off Passed to \code{\link{roughness_hutch}}.
+#' @param a Passed to \code{\link{roughness_hutch}}.
+#' @param b Passed to \code{\link{roughness_hutch}}.
+#' @param label (Character scalar) x-axis label.
+#' @param amplitude_breaks Numeric vector of tick locations for the y-axis.
+#' @param colour_limits Defines the limits of the roughness scale.
+#' @param colour_low Colour to use for the lowest roughness.
+#' @param colour_high Colour to use for the highest roughness.
+#' @param theme \code{\link[ggplot2]{ggplot}} theme to use.
+#' @param ... Passed to \code{\link[hrep]{sparse_fr_spectrum}}.
+#' @export
+hutch_visualise <- function(x,
+                            cbw_cut_off = 1.2,
+                            a = 0.25,
+                            b = 2,
+                            label = "Roughness",
+                            amplitude_breaks = c(0, 1),
+                            colour_limits = c(0, 3),
+                            colour_low = "darkblue",
+                            colour_high = "red",
+                            theme = hutch_visualise_theme,
+                            ...) {
+  stopifnot(is.list(x), !is.null(names(x)), !anyDuplicated(names(x)))
+  x <- purrr::map(x, hrep::sparse_fr_spectrum, ...)
+  min_freq <- min(purrr::map_dbl(x, ~ min(hrep::freq(.))))
+  max_freq <- max(purrr::map_dbl(x, ~ max(hrep::freq(.))))
+  labels <- factor(names(x), levels = names(x))
+  purrr::map(x, hutch_visualise_data, cbw_cut_off, a, b, min_freq, max_freq, ...) %>%
+    purrr::map2(labels, ~ dplyr::mutate(.x, label = .y)) %>%
+    dplyr::bind_rows() %>%
+    ggplot2::ggplot(ggplot2::aes_string(x = "pitch",
+                                        y = "amplitude",
+                                        colour = "dissonance")) +
+    ggplot2::geom_line() +
+    ggplot2::scale_x_continuous("Pitch (MIDI)") +
+    ggplot2::scale_y_continuous("Amplitude", breaks = amplitude_breaks) +
+    ggplot2::scale_colour_gradient(label,
+                                   low = colour_low,
+                                   high = colour_high,
+                                   limits = colour_limits) +
+    ggplot2::facet_wrap(~ label, ncol = 1) +
+    theme
+}

R/imports.R

@@ -1,2 +1,5 @@
 #' @importFrom magrittr "%>%"
 NULL
+
+#' @importFrom rlang ".data"
+NULL