tests/testthat/test-wellformedness.R

In musicMCT: Analyze the Structure of Musical Scales

test_that("iswellformed works", {
  expect_true(iswellformed(c(0, 2, 4, 6)))
  expect_false(iswellformed(c(0, 4, 6)))

  expect_true(iswellformed(c(0, 1, 3, 5, 6, 8, 10)))
  expect_false(iswellformed(c(0, 1, 3, 4, 6, 8, 10)))

  qcm_fifth <- meantone_fifth()
  qcm_dia <- sort(((0:6)*qcm_fifth)%%12)
  expect_true(iswellformed(qcm_dia))
  expect_false(iswellformed(qcm_dia, rounder=14))

  expect_true(iswellformed(c(0, 2, 4, 7, 9, 12, 14), edo=17))

  expect_false(iswellformed(3))
  expect_true(iswellformed(3, allow_de=TRUE))
  expect_false(iswellformed(c(0, 4, 8)))
  expect_true(iswellformed(c(0, 4, 8), allow_de=TRUE))
  expect_false(iswellformed(c(0, 1, 6, 7)))
  expect_true(iswellformed(c(0, 1, 6, 7), allow_de=TRUE))

  expect_true(iswellformed(NULL, c(1, 1, 2, 1, 2)))
  expect_false(iswellformed(c(0, 2, 3, 7, 8), c(1, 1, 2, 1, 2)))
  expect_false(iswellformed(NULL, c(2, 1, 3, 1, 3)))  
})

test_that("isgwf detects 12edo PWF scales correctly", {
  expect_true(isgwf(c(0, 2, 4, 7, 9)))
  expect_true(isgwf(c(0, 2, 3, 7, 8)))
  expect_false(isgwf(c(0, 2, 4, 7, 10)))
  expect_true(isgwf(c(0, 1, 2, 5, 6, 8, 9)))
})

test_that("isgwf handles irrational values correctly", {
  just_dia <- 12 * log2(c(1, 9/8, 5/4, 4/3, 3/2, 5/3, 15/8))
  just_dia_inv <- charm(just_dia)
  expect_true(isgwf(just_dia))
  expect_true(isgwf(just_dia_inv))
  expect_false(isgwf(just_dia, rounder=14))
})

test_that("isgwf allow_de parameter behaves", {
  expect_false(isgwf(c(0, 2, 4, 5, 7, 9)))
  expect_true(isgwf(c(0, 2, 4, 5, 7, 9), allow_de=TRUE))
})

test_that("isgwf correctly detects n-wise WF for n > 2", {
  expect_true(isgwf(c(0, 4, 6, 10, 13, 14, 18), edo=21))
  expect_true(isgwf(c(0, 1, 4, 9, 11), edo=15))
  expect_false(isgwf(c(0, 23, 33, 42, 48, 60, 62), edo=63))
})

test_that("isgwf stepword parameter behaves", {
  expect_true(isgwf(NULL, c(2, 2, 1, 2, 2, 2, 1)))
  expect_true(isgwf(NULL, c(3, 2, 1, 3, 2, 3, 1)))
  expect_true(isgwf(NULL, c(1, 1, 3, 1, 2, 1, 3)))
  expect_false(isgwf(NULL, c(1, 1, 1, 3, 3, 1, 2)))
  expect_true(isgwf(NULL, c(1, 3, 5, 2, 4)))

  expect_false(isgwf(NULL, c(2, 2, 1, 2, 2, 3)))
  expect_true(isgwf(NULL, c(2, 2, 1, 2, 2, 3), allow_de=TRUE))

  expect_false(isgwf(NULL, c(1, NA, 3)))
})

test_that("clampitt_q works", {
  jd <- clampitt_q(j(dia))
  jd$vls <- t(jd$vls)
  expect_equal(jd$set[1, 2] - jd$set[1, 1], j(4))
  expect_equal(jd$vls[4, 1], j(3)-j(m3)+j(synt))
  expect_equal(jd$vls[2, 2], -1 * j(synt))

  expect_equal(t(clampitt_q(j(1, 2, 3, 5, 6))$vls)[1, 2], -1 * j(m2))

  expect_equal(clampitt_q(c(0, 2, 4, 5, 7, 9, 11), index=2),
               list(sets=c(6, 7, 9, 11, 0, 2, 4),
                    vls=t(c(0, 0, 0, 1, 0, 0, 0))))

  hept <- clampitt_q(c(0, 1, 3, 4, 6, 7, 9))
  t_mat <- matrix(c(0, 0, 0, 0, 0, 0, 1, -2, 0, 0, 0, 0, 0, 0), ncol=2)
  hept_ham <- clampitt_q(c(0, 1, 3, 4, 6, 7, 9), method="hamming")
  h_mat <- matrix(c(0, 0, 0, -2,
                    0, 0, 0, 0,
                    0, 0, -5, 0,
                    0, 0, 0, 0,
                    0, 4, 0, 0,
                    0, 0, 0, 0,
                    1, 0, 0, 0),
                  byrow=TRUE,
                  nrow=7)
  expect_equal(t(hept$vls), t_mat)
  expect_equal(t(hept_ham$vls), h_mat)

  pent15 <- clampitt_q(c(0, 1, 4, 9, 11), edo=15, method="hamming")
  expect_equal(t(pent15$vls), matrix(c(5, 0, 0, 0, 0), ncol=1))

  pent15_t <- clampitt_q(c(0, 1, 4, 9, 11), edo=15)
  expect_equal(unlist(lapply(pent15_t, length)), c(sets=0, vls=0))

  majb9 <- clampitt_q(c(0, 1, 4, 7))
  expect_equal(majb9$sets, matrix(c(1, 4, 7, 8), ncol=1))
  expect_equal(t(majb9$vls), matrix(c(-4, 0, 0, 0), ncol=1))

  empty_result <- list(sets=matrix(nrow=4, ncol=0),
                       vls=matrix(nrow=0, ncol=4))
  expect_equal(clampitt_q(c(0, 1, 3, 4)), empty_result)

  maj7 <- c(0, 4, 5)
  maj7_sets <- matrix(c(11, 0, 4,
                        0,  1, 5,
                        4,  5, 9), nrow=3, byrow=TRUE)
  maj7_vls <- matrix(c(0, 0, -3,
                       0, -3, 0,
                       6, 0, 0), nrow=3, byrow=TRUE)
  expect_equal(clampitt_q(maj7), list(sets=maj7_sets, vls=t(maj7_vls)))

  utremi <- lapply(clampitt_q(c(0, 2, 4)), dim)
  expect_equal(utremi, list(sets=c(3, 2), vls=c(2, 3)))

  expect_equal(dim(clampitt_q(sc(6,44))$vls), c(2,6))
  expect_equal(clampitt_q(c(0,6,9,12))$sets, matrix(c(6,6,9,0)))
  expect_equal(clampitt_q(c(0,1,3,4,7,8,11))$vls, t(c(0,1,0,0,0,0,0)))
  expect_equal(dim(clampitt_q(c(0,2,3,5,7,10,12), edo=14)$sets), c(7,2))
  
})