Skip to content

Commit

Permalink
added triangle inequality
Browse files Browse the repository at this point in the history
  • Loading branch information
@mtennekes
mtennekes committed Oct 1, 2024
1 parent 30930b7 commit f34619c
Show file tree
Hide file tree
Showing 4 changed files with 68 additions and 44 deletions.
44 changes: 33 additions & 11 deletions R/check_pals.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -42,18 +42,25 @@ check_div_pal = function(p) {
min(dm[1:nh1_scaled, nh2b_scaled:n2])
})

min_step_size = local({
dm = get_dist_matrix(p, cvd = cvd)
step_sizes = mapply(function(i,j) dm[i,j], 1:(n-1), 2:n)
min(step_sizes)
})
c(inter_wing_dist = round(inter_wing_dist * 100), min_step = round(min_step_size * 100))
dm = get_dist_matrix(p, cvd = cvd)
step_sizes = diag(dm[1:(n-1), 2:n])

step2_sizes = diag(dm[1:(n-2), 3:n])

# should be positive
step12a = step2_sizes - step_sizes[1:(n-2)]
step12b = step2_sizes - step_sizes[2:(n-1)]

min_step_size = min(step_sizes)
tri_ineq = min(step12a, step12b)

c(inter_wing_dist = round(inter_wing_dist * 100), min_step = round(min_step_size * 100), tri_ineq = round(tri_ineq * 100))
}))
inter_wing_dist = min(scores[,1])
min_step = min(scores[,2])
tri_ineq = min(scores[,3])


sc = as(c(inter_wing_dist = inter_wing_dist, min_step = min_step), "integer")
sc = as(c(inter_wing_dist = inter_wing_dist, min_step = min_step, tri_ineq = tri_ineq), "integer")
prop = hcl_prop(p)
rgb = rgb_prop(p)

Expand Down Expand Up @@ -153,17 +160,32 @@ check_seq_pal = function(p) {

scores = t(sapply(cvds, function(cvd) {
m = get_dist_matrix(p, cvd = cvd)
step_sizes = mapply(function(i,j) m[i,j], 1:(n-1), 2:n)
step_sizes = diag(m[1:(n-1), 2:n])# mapply(function(i,j) m[i,j], 1:(n-1), 2:n)
min_step_size = min(step_sizes)
max_step_size = max(step_sizes)
#mean_step_size = mean(step_sizes)
#step_indicator = max(abs(step_sizes - mean_step_size)) / mean_step_size
min_dist = min(m, na.rm = TRUE)

c(min_step = round(min_step_size * 100), max_step = round(max_step_size * 100), min_dist = round(min_dist * 100))
if (n > 2) {
step2_sizes = diag(m[1:(n-2), 3:n])

# should be positive
step12a = step2_sizes - step_sizes[1:(n-2)]
step12b = step2_sizes - step_sizes[2:(n-1)]

tri_ineq = min(step12a, step12b)
} else {
tri_ineq = 100
}




c(min_step = round(min_step_size * 100), max_step = round(max_step_size * 100), min_dist = round(min_dist * 100), tri_ineq = round(tri_ineq * 100))
}))

sc = as(c(min_step = min(scores[,1]), max_step = min(scores[,2]), min_dist = min(scores[,3])), "integer")
sc = as(c(min_step = min(scores[,1]), max_step = min(scores[,2]), min_dist = min(scores[,3]), tri_ineq = min(scores[,4])), "integer")
prop = hcl_prop(p)
rgb = rgb_prop(p)

Expand Down
44 changes: 23 additions & 21 deletions R/onLoad.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -131,30 +131,30 @@ do_cellspec = function(lst) {
with(.C4A,{
defaults = c(cat = "tol.muted", seq = "hcl.blues2", div = "hcl.purple_green", bivs = "c4a.bu_br_bivs", bivc = "met_monet", bivd = "c4a.pu_gn_bivd", bivg = "c4a.br_bivg")

score_x100 = c("min_dist", "min_step", "max_step", "inter_wing_dist", "CRmin", "CRwt", "CRbk", "Blues")
score_x100 = c("min_dist", "min_step", "max_step", "inter_wing_dist", "tri_ineq", "CRmin", "CRwt", "CRbk", "Blues")

#color-blind-friendly thresholds
CBF_th = list(cat = c(min_dist = 10),
seq = c(min_dist = 5),
cyc = c(min_dist = 5),
div = c(inter_wing_dist = 10, min_step = 5),
bivs = c(inter_wing_dist = 7, min_step = 3),
seq = c(min_dist = 5, tri_ineq = 2),
cyc = c(min_dist = 5, tri_ineq = 2),
div = c(inter_wing_dist = 10, min_step = 5, tri_ineq = 2),
bivs = c(inter_wing_dist = 7, min_step = 3, tri_ineq = 1),
bivc = c(min_dist = 10),
bivd = c(inter_wing_dist = 7, min_step = 3),
bivg = c(inter_wing_dist = 7, min_step = 3))
bivd = c(inter_wing_dist = 7, min_step = 3, tri_ineq = 1),
bivg = c(inter_wing_dist = 7, min_step = 3, tri_ineq = 1))

#color-blind-very-friendly thresholds
CBVF_th = list(cat = c(min_dist = 15))

# unfriendly (rolling eyes)
CBU_th = list(cat = c(min_dist = 2),
seq = c(min_dist = 1),
cyc = c(min_dist = 1),
div = c(inter_wing_dist = 4, min_step = 1),
bivs = c(inter_wing_dist = 3, min_step = 1),
seq = c(min_dist = 1, tri_ineq = 0),
cyc = c(min_dist = 1, tri_ineq = 0),
div = c(inter_wing_dist = 4, min_step = 1, tri_ineq = 0),
bivs = c(inter_wing_dist = 3, min_step = 1, tri_ineq = 0),
bivc = c(min_dist = 2),
bivd = c(inter_wing_dist = 3, min_step = 1),
bivg = c(inter_wing_dist = 3, min_step = 1))
bivd = c(inter_wing_dist = 3, min_step = 1, tri_ineq = 0),
bivg = c(inter_wing_dist = 3, min_step = 1, tri_ineq = 0))

Cgray = 10 # maximum chroma value to be considered as gray (used for Hwidth and c4a_add_series)

Expand Down Expand Up @@ -189,7 +189,8 @@ do_cellspec = function(lst) {
"nameability",
"min_step",
"max_step",
"inter_wing_dist")
"inter_wing_dist",
"tri_ineq")

types = c("Categorical" = "cat",
"Sequential" = "seq",
Expand Down Expand Up @@ -222,13 +223,13 @@ do_cellspec = function(lst) {
mdef = c(cat = 1, seq = 1, cyc = 1, div = 1, bivc = 3, bivs = NA, bivd = 3, bivg = 3) # NA meaning same as ndef

CB_ranges = list(cat = list(min_dist = c(0, 20)),
seq = list(min_dist = c(0, 20)),
cyc = list(min_dist = c(0, 20)),
div = list(inter_wing_dist = c(0, 20), min_step = c(0, 20)),
bivs = list(inter_wing_dist = c(0, 20), min_step = c(0, 20)),
seq = list(min_dist = c(0, 20), tri_ineq = c(-50, 50)),
cyc = list(min_dist = c(0, 20), tri_ineq = c(-50, 50)),
div = list(inter_wing_dist = c(0, 20), min_step = c(0, 20), tri_ineq = c(-50, 50)),
bivs = list(inter_wing_dist = c(0, 20), min_step = c(0, 20), tri_ineq = c(-50, 50)),
bivc = list(min_dist = c(0, 20)),
bivd = list(inter_wing_dist = c(0, 20), min_step = c(0, 20)),
bivg = list(inter_wing_dist = c(0, 20), min_step = c(0, 20)))
bivd = list(inter_wing_dist = c(0, 20), min_step = c(0, 20), tri_ineq = c(-50, 50)),
bivg = list(inter_wing_dist = c(0, 20), min_step = c(0, 20), tri_ineq = c(-50, 50)))

Ohter_ranges = list(C = c(0, 180, 5),
L = c(0, 100, 5),
Expand All @@ -245,7 +246,7 @@ do_cellspec = function(lst) {
# for table (with derived variables)
hcl2 = c("Cmax", "H", "HL", "HR", "Lmid", "Hwidth", "Hspread", "HwidthL", "HwidthR", "Lrange", "Crange", "fairness", "CRmin", "CRwt", "CRbk")

sortRev = c("cbfriendly", "harmonyRank", "fairness", "Cmax", "min_dist", "nameability", "Lmid", "Hwidth", "Hspread", "HwidthL", "HwidthR", "nmax", "CRwt", "CRbk", "Blues")
sortRev = c("cbfriendly", "harmonyRank", "fairness", "Cmax", "min_dist", "tri_ineq", "nameability", "Lmid", "Hwidth", "Hspread", "HwidthL", "HwidthR", "nmax", "CRwt", "CRbk", "Blues")

# naming_fun = "naming_dist_centroid"
# naming_colors = c(Green = "#859F68",
Expand Down Expand Up @@ -275,6 +276,7 @@ do_cellspec = function(lst) {
min_step = "Minimum step",
max_step = "Maximum step",
inter_wing_dist = "Inter-wing-distance",
tri_ineq = "Triangle inequality",
Crel = "Chroma (rel) max",
Cmax = "Chroma max",
H = "Hue middle",
Expand Down
24 changes: 12 additions & 12 deletions R/show_attach_scores.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -104,29 +104,29 @@ get_friendlyness = function(zn) {
ifelse(min_dist <= .C4A$CBU_th$cat["min_dist"], -1, 0))),


ifelse(type == "seq", (min_dist / 1000) + ifelse(min_dist >= .C4A$CBF_th$seq["min_dist"], 1,
ifelse(min_dist <= .C4A$CBU_th$seq["min_dist"], -1, 0)),
ifelse(type == "seq", (min_dist / 1000) + ifelse(min_dist >= .C4A$CBF_th$seq["min_dist"] & tri_ineq >= .C4A$CBF_th$seq["tri_ineq"], 1,
ifelse(min_dist < .C4A$CBU_th$seq["min_dist"] | tri_ineq < .C4A$CBU_th$seq["tri_ineq"], -1, 0)),

ifelse(type == "cyc", (min_dist / 1000) + ifelse(min_dist >= .C4A$CBF_th$cyc["min_dist"], 1,
ifelse(min_dist <= .C4A$CBU_th$cyc["min_dist"], -1, 0)),
ifelse(type == "cyc", (min_dist / 1000) + ifelse(min_dist >= .C4A$CBF_th$cyc["min_dist"] & tri_ineq >= .C4A$CBF_th$cyc["tri_ineq"], 1,
ifelse(min_dist <= .C4A$CBU_th$cyc["min_dist"] | tri_ineq < .C4A$CBU_th$cyc["tri_ineq"], -1, 0)),

ifelse(type == "div", (inter_wing_dist / 1000) + (min_step / 1e6) + ifelse(inter_wing_dist >= .C4A$CBF_th$div["inter_wing_dist"] & min_step >= .C4A$CBF_th$div["min_step"], 1,
ifelse(inter_wing_dist <= .C4A$CBU_th$div["inter_wing_dist"] | min_step <= .C4A$CBU_th$div["min_step"], -1, 0)),
ifelse(type == "div", (inter_wing_dist / 1000) + (min_step / 1e6) + ifelse(inter_wing_dist >= .C4A$CBF_th$div["inter_wing_dist"] & min_step >= .C4A$CBF_th$div["min_step"] & tri_ineq >= .C4A$CBF_th$div["tri_ineq"], 1,
ifelse(inter_wing_dist < .C4A$CBU_th$div["inter_wing_dist"] | min_step < .C4A$CBU_th$div["min_step"] | tri_ineq < .C4A$CBU_th$div["tri_ineq"], -1, 0)),


ifelse(type == "bivs", (inter_wing_dist / 1000) + (min_step / 1e6) + ifelse(inter_wing_dist >= .C4A$CBF_th$bivs["inter_wing_dist"] & min_step >= .C4A$CBF_th$bivs["min_step"], 1,
ifelse(inter_wing_dist <= .C4A$CBU_th$bivs["inter_wing_dist"] | min_step <= .C4A$CBU_th$bivs["min_step"], -1, 0)),
ifelse(type == "bivs", (inter_wing_dist / 1000) + (min_step / 1e6) + ifelse(inter_wing_dist >= .C4A$CBF_th$bivs["inter_wing_dist"] & min_step >= .C4A$CBF_th$bivs["min_step"] & tri_ineq >= .C4A$CBF_th$bivs["tri_ineq"], 1,
ifelse(inter_wing_dist < .C4A$CBU_th$bivs["inter_wing_dist"] | min_step < .C4A$CBU_th$bivs["min_step"] | tri_ineq < .C4A$CBU_th$bivs["tri_ineq"], -1, 0)),


ifelse(type == "bivc", (min_dist / 1000) + ifelse(min_dist >= .C4A$CBF_th$cat["min_dist"], 1,
ifelse(min_dist <= .C4A$CBU_th$cat["min_dist"], -1, 0)),


ifelse(type == "bivd", (inter_wing_dist / 1000) + (min_step / 1e6) + ifelse(inter_wing_dist >= .C4A$CBF_th$bivd["inter_wing_dist"] & min_step >= .C4A$CBF_th$bivd["min_step"], 1,
ifelse(inter_wing_dist <= .C4A$CBU_th$bivd["inter_wing_dist"] | min_step <= .C4A$CBU_th$bivd["min_step"], -1, 0)),
ifelse(type == "bivd", (inter_wing_dist / 1000) + (min_step / 1e6) + ifelse(inter_wing_dist >= .C4A$CBF_th$bivd["inter_wing_dist"] & min_step >= .C4A$CBF_th$bivd["min_step"] & tri_ineq >= .C4A$CBF_th$bivd["tri_ineq"], 1,
ifelse(inter_wing_dist < .C4A$CBU_th$bivd["inter_wing_dist"] | min_step < .C4A$CBU_th$bivd["min_step"] | tri_ineq < .C4A$CBU_th$bivd["tri_ineq"], -1, 0)),


ifelse(type == "bivg", (inter_wing_dist / 1000) + (min_step / 1e6) + ifelse(inter_wing_dist >= .C4A$CBF_th$bivg["inter_wing_dist"] & min_step >= .C4A$CBF_th$bivg["min_step"], 1,
ifelse(inter_wing_dist <= .C4A$CBU_th$bivg["inter_wing_dist"] | min_step <= .C4A$CBU_th$bivg["min_step"], -1, 0)), 0))))))))
ifelse(type == "bivg", (inter_wing_dist / 1000) + (min_step / 1e6) + ifelse(inter_wing_dist >= .C4A$CBF_th$bivg["inter_wing_dist"] & min_step >= .C4A$CBF_th$bivg["min_step"] & tri_ineq >= .C4A$CBF_th$bivg["tri_ineq"], 1,
ifelse(inter_wing_dist < .C4A$CBU_th$bivg["inter_wing_dist"] | min_step < .C4A$CBU_th$bivg["min_step"] | tri_ineq < .C4A$CBU_th$bivs["tri_ineq"], -1, 0)), 0))))))))
})
}
Binary file modified R/sysdata.rda
View file
Binary file not shown.

0 comments on commit f34619c

Please sign in to comment.