data-raw/gen-cvd-mats.R

# Generate CVD conversion matrices from Machado 2010

cvd_severity_dat <- rep(0:10, times = 3, each = 3)

cvd_type_dat <- gl(3, 33, labels = c("protan", "deutan", "tritan"))

cvd_mats <- rbind(
  # Protanomaly
  diag(3),

  c(0.856, 0.182, -0.038),
  c(0.029, 0.955, 0.016),
  c(-0.003, -0.002, 1.004),

  c(0.735, 0.335, -0.070),
  c(0.052, 0.919, 0.029),
  c(-0.005, -0.004, 1.009),

  c(0.630, 0.466, -0.096),
  c(0.069, 0.890, 0.041),
  c(-0.006, -0.008, 1.014),

  c(0.539, 0.579, -0.118),
  c(0.083, 0.866, 0.051),
  c(-0.007, -0.012, 1.019),

  c(0.458, 0.680, -0.138),
  c(0.093, 0.846, 0.061),
  c(-0.007, -0.017, 1.024),

  c(0.385, 0.769, -0.154),
  c(0.101, 0.830, 0.070),
  c(-0.007, -0.022, 1.030),

  c(0.320, 0.850, -0.169),
  c(0.106, 0.816, 0.078),
  c(-0.007, -0.028, 1.035),

  c(0.259, 0.923, -0.182),
  c(0.110, 0.804, 0.085),
  c(-0.006, -0.034, 1.041),

  c(0.204, 0.990, -0.194),
  c(0.113, 0.795, 0.092),
  c(-0.005, -0.041, 1.046),

  c(0.152, 1.053, -0.205),
  c(0.115, 0.786, 0.099),
  c(-0.004, -0.048, 1.052),

  # Deuteranomaly
  diag(3),

  c(0.866, 0.178, -0.044),
  c(0.050, 0.939, 0.011),
  c(-0.003, 0.007, 0.996),

  c(0.761, 0.319, -0.080),
  c(0.091, 0.889, 0.020),
  c(-0.006, 0.013, 0.993),

  c(0.675, 0.434,-0.109),
  c(0.125, 0.848, 0.027),
  c(-0.008, 0.019, 0.989),

  c(0.606, 0.529,-0.134),
  c(0.155, 0.812, 0.032),
  c(-0.009, 0.023, 0.986),

  c(0.547, 0.608,-0.155),
  c(0.182, 0.782, 0.037),
  c(-0.010, 0.027, 0.983),

  c(0.499, 0.675,-0.174),
  c(0.205, 0.755, 0.040),
  c(-0.011, 0.031, 0.980),

  c(0.458, 0.732,-0.190),
  c(0.226, 0.731, 0.043),
  c(-0.012, 0.034, 0.977),

  c(0.423, 0.781,-0.204),
  c(0.246, 0.710, 0.045),
  c(-0.012, 0.037, 0.974),

  c(0.393, 0.824,-0.217),
  c(0.264, 0.690, 0.046),
  c(-0.012, 0.040, 0.972),

  c(0.367, 0.861,-0.228),
  c(0.280, 0.673, 0.047),
  c(-0.012, 0.043, 0.969),

  # Tritanomaly
  diag(3),

  c(0.927, 0.093,-0.019),
  c(0.021, 0.965, 0.014),
  c(0.008, 0.055, 0.937),

  c(0.896, 0.133,-0.029),
  c(0.030, 0.945, 0.025),
  c(0.013, 0.105, 0.882),

  c(0.906, 0.128,-0.034),
  c(0.027, 0.941, 0.032),
  c(0.013, 0.148, 0.838),

  c(0.948, 0.089,-0.038),
  c(0.014, 0.947, 0.039),
  c(0.011, 0.194, 0.795),

  c(1.017, 0.027,-0.044),
  c(-0.006, 0.958, 0.048),
  c(0.006, 0.249, 0.745),

  c(1.105,-0.047,-0.058),
  c(-0.032, 0.972, 0.061),
  c(0.001, 0.318, 0.681),

  c(1.193,-0.110,-0.083),
  c(-0.058, 0.979, 0.079),
  c(-0.002, 0.403, 0.599),

  c(1.258,-0.140,-0.118),
  c(-0.078, 0.975, 0.103),
  c(-0.003, 0.501, 0.502),

  c(1.279,-0.125,-0.154),
  c(-0.085, 0.958, 0.127),
  c(-0.001, 0.601, 0.400),

  c(1.256,-0.077,-0.179),
  c(-0.078, 0.931, 0.148),
  c(0.005, 0.691, 0.304)
)

devtools::use_data(
  cvd_type_dat,
  cvd_severity_dat,
  cvd_mats,
  internal = TRUE,
  compress = "gzip",
  overwrite = TRUE
)
jolars/qualpalr documentation built on Sept. 23, 2023, 5:11 p.m.