Skip to content
Permalink

Comparing changes

This is a direct comparison between two commits made in this repository or its related repositories. View the default comparison for this range or learn more about diff comparisons.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also . Learn more about diff comparisons here.
base repository: rmaia/pavo
Failed to load repositories. Confirm that selected base ref is valid, then try again.
Loading
base: f4775d2645dcaa0d48a0702cf97fd85b2f6d3356
Choose a base ref
..
head repository: rmaia/pavo
Failed to load repositories. Confirm that selected head ref is valid, then try again.
Loading
compare: 95a2b8fc16012943eee9e16a172bf9ecb0e5667f
Choose a head ref
Showing with 13 additions and 10 deletions.
  1. +1 −0 .travis.yml
  2. +6 −6 R/jndrot.R
  3. +6 −4 R/nspace.R
1 change: 1 addition & 0 deletions .travis.yml
View file
Original file line number Diff line number Diff line change
@@ -15,6 +15,7 @@ addons:
packages:
- libmagick++-dev
- libglu1-mesa-dev
- pngquant
before_script:
- Rscript -e 'remotes::install_cran(c("covr", "spelling"))'
after_success:
12 changes: 6 additions & 6 deletions R/jndrot.R
View file
Original file line number Diff line number Diff line change
@@ -80,7 +80,7 @@ jndrot <- function(jnd2xyzres, center = c("mean", "achro"), ref1 = "l", ref2 = "
aa <- vectornorm(coords[grep(paste0("jnd2xyzrrf.", ref1), rownames(coords)), ] -
cent)
bb <- vectornorm(axis1)
daabb <- sum(aa * bb)
daabb <- drop(crossprod(aa, bb))
ncaabb <- vectormag(vectorcross(aa, bb))
GG <- rbind(
c(daabb, -ncaabb, 0),
@@ -96,7 +96,7 @@ jndrot <- function(jnd2xyzres, center = c("mean", "achro"), ref1 = "l", ref2 = "
RR <- FF %*% GG %*% solve(FF)

res <- sweep(coords, 2, cent, "-")
res <- t(apply(res, 1, function(x) RR %*% x))
res <- tcrossprod(res, RR)
# res <- sweep(res, 2, coords['jnd2xyzrrf.achro',], '+')

res <- res[, -dim(res)[2]]
@@ -120,7 +120,7 @@ jndrot <- function(jnd2xyzres, center = c("mean", "achro"), ref1 = "l", ref2 = "
aa <- vectornorm(coords[grep(paste0("jnd2xyzrrf.", ref1), rownames(coords)), ] -
cent)
bb <- vectornorm(axis1)
daabb <- sum(aa * bb)
daabb <- drop(crossprod(aa, bb))
ncaabb <- vectormag(vectorcross(aa, bb))
GG <- rbind(
c(daabb, -ncaabb, 0),
@@ -136,7 +136,7 @@ jndrot <- function(jnd2xyzres, center = c("mean", "achro"), ref1 = "l", ref2 = "
RR <- FF %*% GG %*% solve(FF)

res <- sweep(coords, 2, cent, "-")
res <- t(apply(res, 1, function(x) RR %*% x))
res <- tcrossprod(res, RR)
# res <- sweep(res, 2, coords['jnd2xyzrrf.achro',], '+')
} else {
res <- coords
@@ -154,7 +154,7 @@ jndrot <- function(jnd2xyzres, center = c("mean", "achro"), ref1 = "l", ref2 = "
aa <- vectornorm(res[grep(paste0("jnd2xyzrrf.", ref2), rownames(res)), ] -
cent)
bb <- vectornorm(axis2)
daabb <- sum(aa * bb)
daabb <- drop(crossprod(aa, bb))
ncaabb <- vectormag(vectorcross(aa, bb))
GG <- rbind(
c(daabb, -ncaabb, 0),
@@ -170,7 +170,7 @@ jndrot <- function(jnd2xyzres, center = c("mean", "achro"), ref1 = "l", ref2 = "
RR <- FF %*% GG %*% solve(FF)

res <- sweep(res, 2, cent, "-")
res <- t(apply(res, 1, function(x) RR %*% x))
res <- tcrossprod(res, RR)
# res <- sweep(res, 2, coords['jnd2xyzrrf.achro',], '+')
}

10 changes: 6 additions & 4 deletions R/nspace.R
View file
Original file line number Diff line number Diff line change
@@ -20,18 +20,20 @@
nspace <- function(vismodeldata) {

qcatches <- vismodeldata[, colnames(vismodeldata) != "lum"]
lum <- vismodeldata[, colnames(vismodeldata) == "lum"]
ncones <-ncol(qcatches)
message("Detected ", ncones, " cones.")

# Get relative qcatches
qcatches <- scale(qcatches, center = FALSE, scale = colSums(qcatches))
qcatches <- qcatches / rowSums(qcatches)

coords <- bary2cart(simplex(ncones), as.matrix(qcatches))

r.vec <- sqrt(rowSums(apply(coords, 2, function(x) x^2)))

return(data.frame(qcatches, coords, r.vec))
return(data.frame(qcatches, coords, r.vec, lum))
}

simplex <- function(n) {
qr.Q(qr(matrix(1,nrow=n)),complete=T)[,-1]
}
qr.Q(qr(matrix(1, nrow = n)), complete = TRUE)[,-1]
}