colourvision
Colour Vision Models

Package index
Search the colourvision package
Vignettes
Functions
42
Source code
4
Man pages
30
Home
/
CRAN
/
colourvision
/
tests/testthat/test.models.R

tests/testthat/test.models.R
In colourvision: Colour Vision Models 

context("models")

test_that("photor", {
  expect_equal(ncol(photor(350)), 2)
  expect_equal(nrow(photor(350, lambda = seq(300, 700, 1))), 401)
})

test_that("photor", {
  expect_equal(ncol(photor(350, beta.band=TRUE)), 2)
  expect_equal(nrow(photor(350, lambda = seq(300, 700, 1), beta.band=TRUE)), 401)
})


test_that("logistic", {
  expect_equal(ncol(logistic(x0=350,L=60,k=0.08)), 2)
  expect_equal(nrow(logistic(x0=350,L=60,k=0.08)), 401)
})

data("bee")
data("D65")
data("Rb")

midpoint<-seq(from = 300, to = 700, 50)
W<-seq(300, 700, 1)
R<-data.frame(W)
for (i in 1:length(midpoint)) {
  R[,i+1]<-logistic(x = seq(300, 700, 1), x0=midpoint[[i]], L = 50, k=0.04)[,2]
}
names(R)[2:ncol(R)]<-midpoint

#1.CTTKmodel dichromatic
test_that("CTTKmodel", {
  expect_equal(ncol(CTTKmodel(photo=2,
                              R=R,
                              I=D65,
                              Rb=Rb,
                              C=bee)), 6)
})


#1.CTTKmodeltrichromatic
test_that("CTTKmodel", {
  expect_equal(ncol(CTTKmodel(photo=c("tri"),
                                R=R,
                                I=D65,
                                Rb=Rb,
                                C=bee)), 9)
})

test_that("CTTKmodel", {
  expect_equal(nrow(CTTKmodel(photo=c("tri"),
                                R=R,
                                I=D65,
                                Rb=Rb,
                                C=bee)), 9)
})

#2.CTTKmodel tetrachromatic
test_that("CTTKmodel", {
  expect_equal(ncol(CTTKmodel(photo=c("tetra"),
                                R=R,
                                I=D65,
                                Rb=Rb,
                                C=photor(c(350,420,490,560)))), 12)
})

test_that("CTTKmodel", {
  expect_equal(nrow(CTTKmodel(photo=c("tetra"),
                              R=R,
                              I=D65,
                              Rb=Rb,
                              C=photor(c(350,420,490,560)))), 9)
})

test_that("CTTKmodel", {
  expect_equal(ncol(CTTKmodel(photo=6,
                              R=R,
                              I=D65,
                              Rb=Rb,
                              C=photor(c(350,380,420,490,520,560)))), 18)
})

#3. EMmodel trichromatic
test_that("EMmodel", {
  expect_equal(ncol(EMmodel(photo=2,
                            R=R,
                            I=D65,
                            Rb=Rb,
                            C=bee)), 6)
})


test_that("EMmodel", {
  expect_equal(ncol(EMmodel(photo=c("tri"),
                              R=R,
                              I=D65,
                              Rb=Rb,
                              C=bee)), 9)
})

test_that("EMmodel", {
  expect_equal(nrow(EMmodel(photo=c("tri"),
                              R=R,
                              I=D65,
                              Rb=Rb,
                              C=bee)), 9)
})

#4.EMmodel tetrachromatic
test_that("EMmodel", {
  expect_equal(ncol(EMmodel(photo=c("tetra"),
                              R=R,
                              I=D65,
                              Rb=Rb,
                              C=photor(c(350,420,490,560)))), 12)
})

test_that("EMmodel", {
  expect_equal(nrow(EMmodel(photo=c("tetra"),
                              R=R,
                              I=D65,
                              Rb=Rb,
                              C=photor(c(350,420,490,560)))), 9)
})


test_that("EMmodel", {
  expect_equal(ncol(EMmodel(photo=6,
                            R=R,
                            I=D65,
                            Rb=Rb,
                            C=photor(c(350,380,420,490,520,560)))), 18)
})


#5. RNLmodel, dichromatic, log=F, noise=T
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=2,
                            model="linear",
                            R1=R,
                            I=D65,
                            Rb=Rb,
                            C=photor(c(420,560)),
                            noise=TRUE,
                            e=c(0.1,0.05))), 13)
  expect_equal(nrow(RNLmodel(photo=2,
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=TRUE,
                             e=c(0.1,0.05))), 9)
})

#6. RNLmodel, dichromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=2,
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=F,
                             v=0.1, n=c(1,2))), 13)
  expect_equal(nrow(RNLmodel(photo=2,
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=F,
                             v=0.1, n=c(1,2))), 9)
})


#7. RNLmodel, dichromatic, log=T, noise=T
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=2,
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=TRUE,
                             e=c(0.1,0.05))), 13)
  expect_equal(nrow(RNLmodel(photo=2,
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=TRUE,
                             e=c(0.1,0.05))), 9)
})

#8. RNLmodel, dichromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=2,
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=F,
                             v=0.1, n=c(1,2))), 13)
  expect_equal(nrow(RNLmodel(photo=2,
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=F,
                             v=0.1, n=c(1,2))), 9)
})


#9. RNLmodel, trichromatic, log=F, noise=T
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=c("tri"),
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05))), 20)
  expect_equal(nrow(RNLmodel(photo=c("tri"),
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05))), 9)
})

#10. RNLmodel, trichromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=c("tri"),
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2))), 20)
  expect_equal(nrow(RNLmodel(photo=c("tri"),
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=F,
                             v=0.1, n=c(1,1,5,2))), 9)
})


#11. RNLmodel, trichromatic, log=T, noise=T
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=c("tri"),
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05))), 20)
  expect_equal(nrow(RNLmodel(photo=c("tri"),
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05))), 9)
})

#12. RNLmodel, trichromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=c("tri"),
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2))), 20)
  expect_equal(nrow(RNLmodel(photo=c("tri"),
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2))), 9)
})


#13. RNLmodel, tetrachromatic, log=F, noise=T
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=c("tetra"),
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05,0.04))), 27)
  expect_equal(nrow(RNLmodel(photo=c("tetra"),
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05,0.04))), 9)
})

#14. RNLmodel, tetrachromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=c("tetra"),
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2,2))), 27)
  expect_equal(nrow(RNLmodel(photo=c("tetra"),
                             model="linear",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=F,
                             v=0.1, n=c(1,1,5,2,2))), 9)
})


#15. RNLmodel, tetrachromatic, log=T, noise=T
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=c("tetra"),
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05,0.04))), 27)
  expect_equal(nrow(RNLmodel(photo=c("tetra"),
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05,0.04))), 9)
})

#16. RNLmodel, tetrachromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=c("tetra"),
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2,2))), 27)
  expect_equal(nrow(RNLmodel(photo=c("tetra"),
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2,2))), 9)
})

test_that("RNLmodel", {
  expect_equal(ncol(RNLmodel(photo=5,
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560,600)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2,2,2))), 34)
  expect_equal(nrow(RNLmodel(photo=5,
                             model="log",
                             R1=R,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560,600)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2,2,2))), 9)
})


test_that("RNLthres", {
  expect_equal(ncol(RNLthres(photo=5,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560,600)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2,2,2))), 3)
  expect_equal(nrow(RNLthres(photo=5,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560,600)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2,2,2))), 401)
})


#deltaS=0
#deltaS=0
#deltaS=0
#1.CTTKmodel trichromatic
test_that("CTTKmodel", {
  expect_equal(CTTKmodel(photo=c("tri"),
                              R=Rb,
                              I=D65,
                              Rb=Rb,
                              C=bee)$deltaS, 0)
})

#2.CTTKmodel tetrachromatic
test_that("CTTKmodel", {
  expect_equal(CTTKmodel(photo=c("tetra"),
                              R=Rb,
                              I=D65,
                              Rb=Rb,
                              C=photor(c(350,420,490,560)))$deltaS, 0)
})

#3. EMmodel trichromatic
EMRb<-data.frame(300:700, rep(7,401))
test_that("EMmodel", {
  expect_equal(round(EMmodel(photo=c("tri"),
                            R=cbind(EMRb[,1],EMRb[,2]+10),
                            I=D65,
                            Rb=EMRb,
                            C=bee)$deltaS, 2), 0)
})


#4.EMmodel tetrachromatic
test_that("EMmodel", {
  expect_equal(round(EMmodel(photo=c("tetra"),
                       R=cbind(EMRb[,1],EMRb[,2]+10),
                       I=D65,
                       Rb=EMRb,
                       C=photor(c(350,420,490,560)))$deltaS, 2), 0)
})


#5. RNLmodel, dichromatic, log=F, noise=T
test_that("RNLmodel", {
  expect_equal(RNLmodel(photo=2,
                             model="linear",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=TRUE,
                             e=c(0.1,0.05))$deltaS, 0)
})

#6. RNLmodel, dichromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(RNLmodel(photo=2,
                             model="linear",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=F,
                             v=0.1, n=c(1,2))$deltaS, 0)
})


#7. RNLmodel, dichromatic, log=T, noise=T
test_that("RNLmodel", {
  expect_equal(RNLmodel(photo=2,
                             model="log",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=TRUE,
                             e=c(0.1,0.05))$deltaS, 0)
})

#8. RNLmodel, dichromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(RNLmodel(photo=2,
                             model="log",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(420,560)),
                             noise=F,
                             v=0.1, n=c(1,2))$deltaS, 0)
})


#9. RNLmodel, trichromatic, log=F, noise=T
test_that("RNLmodel", {
  expect_equal(RNLmodel(photo=c("tri"),
                             model="linear",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05))$deltaS, 0)
})

#10. RNLmodel, trichromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(RNLmodel(photo=c("tri"),
                             model="linear",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2))$deltaS, 0)
})


#11. RNLmodel, trichromatic, log=T, noise=T
test_that("RNLmodel", {
  expect_equal(RNLmodel(photo=c("tri"),
                             model="log",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05))$deltaS, 0)
})

#12. RNLmodel, trichromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(RNLmodel(photo=c("tri"),
                             model="log",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,560)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2))$deltaS, 0)
})


#13. RNLmodel, tetrachromatic, log=F, noise=T
test_that("RNLmodel", {
  expect_equal(RNLmodel(photo=c("tetra"),
                             model="linear",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05,0.04))$deltaS, 0)
})

#14. RNLmodel, tetrachromatic, log=F, noise=F
test_that("RNLmodel", {
  expect_equal(RNLmodel(photo=c("tetra"),
                             model="linear",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2,2))$deltaS, 0)
})


#15. RNLmodel, tetrachromatic, log=T, noise=T
test_that("RNLmodel, tetrachromatic, log=T, noise=T", {
  expect_equal(RNLmodel(photo=c("tetra"),
                             model="log",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=TRUE,
                             e=c(0.1,0.07,0.05,0.04))$deltaS, 0)
})

#16. RNLmodel, tetrachromatic, log=F, noise=F
test_that("RNLmodel, tetrachromatic, log=F, noise=F", {
  expect_equal(RNLmodel(photo=c("tetra"),
                             model="log",
                             R1=Rb,
                             I=D65,
                             Rb=Rb,
                             C=photor(c(350,420,490,560)),
                             noise=F,
                             v=0.1, n=c(1,1.5,2,2))$deltaS, 0)
})


###compare with AVICOL
r500<-logistic(x0=500,L=50,k=0.04)
test_that("CTTKmodel, trichromatic, AVICOL", {
  model<-CTTKmodel(photo="tri",
                  R=r500,
                  I=D65,
                  Rb=Rb,
                  C=bee)
  expect_equal(round(model$E1, 3), 0.301)
  expect_equal(round(model$E2, 3), 0.597)
  expect_equal(round(model$E3, 3), 0.786)
})

test_that("CTTKmodel, tetrachromatic, AVICOL", {
  model<-CTTKmodel(photo="tetra",
                   R=r500,
                   I=D65,
                   Rb=Rb,
                   C=photor(c(350,420,490,560)))
  expect_equal(round(model$E1, 3), 0.112)
  expect_equal(round(model$E2, 3), 0.520)
  expect_equal(round(model$E3, 3), 0.755)
  expect_equal(round(model$E4, 3), 0.795)
})

test_that("RNLmodel, dichromatic, AVICOL", {
  model<-RNLmodel(photo="di",
                model="log",
                R1=r500,
                I=D65,
                Rb=Rb,
                C=photor(c(420,560)),
                noise=F,
                v=0.05,
                n=c(1,1.77))
  expect_equal(round(model$e1, 3), 0.050)
  expect_equal(round(model$e2, 3), 0.038)
  expect_equal(abs(round(model$E1_R1, 3)-round(log(10^0.034),3))<=0.002, TRUE)
  expect_equal(abs(round(model$E2_R1, 3)-round(log(10^0.588),3))<=0.002, TRUE)
  expect_equal(abs(round(model$deltaS, 3)-round(log(10^8.853),3))<=0.002, TRUE)
})

test_that("RNLmodel, dichromatic, AVICOL alternative", {
  model<-RNLmodel(photo="di",
                  model="log",
                  R1=r500,
                  I=D65,
                  Rb=Rb,
                  C=photor(c(420,560)),
                  noise=F,
                  v=0.05,
                  n=c(1,1.77),
                  coord="alternative")
  expect_equal(round(model$e1, 3), 0.050)
  expect_equal(round(model$e2, 3), 0.038)
  expect_equal(abs(round(model$E1_R1, 3)-round(log(10^0.034),3))<=0.002, TRUE)
  expect_equal(abs(round(model$E2_R1, 3)-round(log(10^0.588),3))<=0.002, TRUE)
  expect_equal(abs(round(model$deltaS, 3)-round(log(10^8.853),3))<=0.002, TRUE)
})

test_that("RNLmodel, trichromatic, AVICOL", {
  model<-RNLmodel(photo="tri",
                  model="log",
                  R1=r500,
                  I=D65,
                  Rb=Rb,
                  C=bee,
                  noise=F,
                  v=0.05,
                  n=c(1,5,10))
  expect_equal(abs(round(model$E1_R1, 3)-round(log(10^-0.366),3))<=0.002, TRUE)
  expect_equal(abs(round(model$E2_R1, 3)-round(log(10^0.171),3))<=0.002, TRUE)
  expect_equal(abs(round(model$E3_R1, 3)-round(log(10^0.564),3))<=0.002, TRUE)
  expect_equal(round(model$e1, 3), 0.050)
  expect_equal(round(model$e2, 3), 0.022)
  expect_equal(round(model$e3, 3), 0.016)
  expect_equal(abs(round(model$deltaS, 3)-round(log(10^21.094),3))<=0.002, TRUE)
})

test_that("RNLmodel, trichromatic, AVICOL, alternative", {
  model<-RNLmodel(photo="tri",
                  model="log",
                  R1=r500,
                  I=D65,
                  Rb=Rb,
                  C=bee,
                  noise=F,
                  v=0.05,
                  n=c(1,5,10),
                  coord="alternative")
  expect_equal(abs(round(model$E1_R1, 3)-round(log(10^-0.366),3))<=0.002, TRUE)
  expect_equal(abs(round(model$E2_R1, 3)-round(log(10^0.171),3))<=0.002, TRUE)
  expect_equal(abs(round(model$E3_R1, 3)-round(log(10^0.564),3))<=0.002, TRUE)
  expect_equal(round(model$e1, 3), 0.050)
  expect_equal(round(model$e2, 3), 0.022)
  expect_equal(round(model$e3, 3), 0.016)
  expect_equal(abs(round(model$deltaS, 3)-round(log(10^21.094),3))<=0.002, TRUE)
})

test_that("RNLmodel, tetrachromatic, AVICOL, alternative", {
    model<-RNLmodel(photo="tetra",
                   model="log",
                   R1=r500,
                   I=D65,
                   Rb=Rb,
                   C=photor(c(350,420,490,560)),
                   noise=F,
                   v=0.05,
                   n=c(1, 1.9, 2.2, 2.1))
    expect_equal(abs(round(model$E1_R1, 3)-round(log(10^-0.900),3))<=0.002, TRUE)
    expect_equal(abs(round(model$E2_R1, 3)-round(log(10^0.034),3))<=0.002, TRUE)
    expect_equal(abs(round(model$E3_R1, 3)-round(log(10^0.488),3))<=0.002, TRUE)
    expect_equal(abs(round(model$E4_R1, 3)-round(log(10^0.588),3))<=0.002, TRUE)
    expect_equal(round(model$e1, 3), 0.050)
    expect_equal(round(model$e2, 3), 0.036)
    expect_equal(round(model$e3, 3), 0.034)
    expect_equal(round(model$e4, 3), 0.035)
    expect_equal(abs(round(model$deltaS, 3)-round(log(10^26.530),3))<=0.002, TRUE)
})

test_that("RNLmodel, tetrachromatic, AVICOL", {
  model<-RNLmodel(photo="tetra",
                  model="log",
                  R1=r500,
                  I=D65,
                  Rb=Rb,
                  C=photor(c(350,420,490,560)),
                  noise=F,
                  v=0.05,
                  n=c(1, 1.9, 2.2, 2.1),
                  coord="alternative")
  expect_equal(abs(round(model$E1_R1, 3)-round(log(10^-0.900),3))<=0.002, TRUE)
  expect_equal(abs(round(model$E2_R1, 3)-round(log(10^0.034),3))<=0.002, TRUE)
  expect_equal(abs(round(model$E3_R1, 3)-round(log(10^0.488),3))<=0.002, TRUE)
  expect_equal(abs(round(model$E4_R1, 3)-round(log(10^0.588),3))<=0.002, TRUE)
  expect_equal(round(model$e1, 3), 0.050)
  expect_equal(round(model$e2, 3), 0.036)
  expect_equal(round(model$e3, 3), 0.034)
  expect_equal(round(model$e4, 3), 0.035)
  expect_equal(abs(round(model$deltaS, 3)-round(log(10^26.530),3))<=0.002, TRUE)
})


test_that("RNLmodel, tetrachromatic, vismodel and tcs", {
  model<-EMmodel(photo="tetra",
                 R=r500,
                 I=D65,
                 Rb=Rb,
                 C=photor(c(350,420,490,560)))
  expect_equal(round(model$E1, 3), -4.284)
  expect_equal(round(model$E2, 3), 0.163)
  expect_equal(round(model$E3, 3), 2.322)
  expect_equal(round(model$E4, 3), 2.799)
  expect_equal(round(model$X1, 3), 1.615)
  expect_equal(round(model$X2, 3), 0.595)
  expect_equal(round(model$X3, 3), -4.534)
  expect_equal(round(model$deltaS, 3), 4.850)
})

#v1.1
test_that("CTTKmodel, tetrachromatic, AVICOL, new method", {
photo1<-4
C=photor(c(350,420,490,560))
P<-vector(length=photo1)
for (i in 1:length(P)) {
  P[[i]]<-Qr(I=D65, R=r500, Rb=Rb, C=C[,c(1,i+1)], interpolate=TRUE, nm=300:700)
}
E<-P/(P+1)
expect_equal(round(E[[1]], 3), 0.112)
expect_equal(round(E[[2]], 3), 0.520)
expect_equal(round(E[[3]], 3), 0.755)
expect_equal(round(E[[4]], 3), 0.795)

new<-colour_space(type="length", n=photo1, length=1, edge=NA, q=E)
new<-sqrt(sum(new$coordinates^2))
original<-CTTKmodel(photo="tetra",
          R=r500,
          I=D65,
          Rb=Rb,
          C=photor(c(350,420,490,560)))$deltaS
expect_equal(round(new, 3), round(original, 3))
})


test_that("EMmodel, tetrachromatic, new method", {
  photo1<-4
  C=photor(c(350,420,490,560))
  S<-vector(length=photo1)
  for (i in 1:photo1) {
    S[[i]]<-Qr(I=D65, R=r500, Rb=Rb, C=C[,c(1,1+i)], interpolate=TRUE, nm=300:700)
  }
  S.log<-log(S)
  E<-S.log/sum(S.log)
  new<-colour_space(type="length", n=photo1, length=0.75, edge=sqrt(3/2), q=E)
  new<-sqrt(sum(new$coordinates^2))
  original<-EMmodel(photo="tetra",
                      R=r500,
                      I=D65,
                      Rb=Rb,
                      C=photor(c(350,420,490,560)))$deltaS
  expect_equal(round(new, 3), round(original, 3))
})

#v2.0
test_that("GENmodel, EMmodel, tetra", {
  model1<-EMmodel(photo=4,
                 R=r500,
                 I=D65,
                 Rb=Rb,
                 C=photor(c(350,420,490,560)))
  model2<-GENmodel(photo=4,
                   type="length",
                   length=0.75,
                   unity=TRUE,
                   func=log,
                   R=r500,
                   I=D65,
                   Rb=Rb,
                   C=photor(c(350,420,490,560)))
  expect_equal(round(model1$deltaS, 3), round(model2$deltaS, 3))
})

test_that("GENmodel, CTTKmodel, tetra",{
  model1<-CTTKmodel(photo=4,
                  R=r500,
                  I=D65,
                  Rb=Rb,
                  C=photor(c(350,420,490,560)))
  model2<-GENmodel(photo=4,
                   type="length",
                   length=1,
                   unity=FALSE,
                   func=function(x){x/(x+1)},
                   R=r500,
                   I=D65,
                   Rb=Rb,
                   C=photor(c(350,420,490,560)))
  expect_equal(round(model1$deltaS, 3), round(model2$deltaS, 3))
})

test_that("GENmodel, CTTKmodel, tri", {
  model1<-CTTKmodel(photo=3,
                    R=r500,
                    I=D65,
                    Rb=Rb,
                    C=photor(c(350,420,490)))
  model2<-GENmodel(photo=3,
                   type="length",
                   length=1,
                   unity=FALSE,
                   func=function(x){x/(x+1)},
                   R=r500,
                   I=D65,
                   Rb=Rb,
                   C=photor(c(350,420,490)))
  expect_equal(round(model1$deltaS, 3), round(model2$deltaS, 3))
})

R<-data.frame(W)
for (i in 1:length(midpoint)) {
  R[,i+1]<-logistic(x = seq(300, 700, 1), x0=midpoint[[i]], L = 50, k=0.04)[,2]
}
names(R)[2:ncol(R)]<-midpoint

test_that("RNL THRES AND RADARPLOT", {
  model<-RNLthres(Rb=Rb,I=D65,C=photor(c(400,550)),e=c(0.05,0.01))
  expect_error(radarplot(model, item="E"))
})

test_that("deltaS", {
  
  model<-RNLmodel(model="log",R1=R,Rb=Rb,I=D65,C=photor(c(400,550)),noise=TRUE,e=c(0.05,0.01))
  expect_equal(deltaS(model)[1,2], sqrt((model[1,"X1_R1"]-model[2,"X1_R1"])^2))

  model<-RNLmodel(model="log",R1=R,Rb=Rb,I=D65,C=photor(c(400,500,550)),noise=TRUE,e=c(0.05,0.07,0.01))
  expect_equal(deltaS(model)[5,7],
               sqrt((model[5,"X1_R1"]-model[7,"X1_R1"])^2+
                      (model[5,"X2_R1"]-model[7,"X2_R1"])^2))
                      
  model<-RNLmodel(model="log",R1=R,Rb=Rb,I=D65,C=photor(c(350,400,500,550)),noise=TRUE,e=c(0.05,0.07,0.01,0.03))
  expect_equal(deltaS(model)[5,7],
               sqrt((model[5,"X1_R1"]-model[7,"X1_R1"])^2+
                      (model[5,"X2_R1"]-model[7,"X2_R1"])^2+
                        (model[5,"X3_R1"]-model[7,"X3_R1"])^2))
  
  model<-RNLmodel(model="log",R1=R,Rb=Rb,I=D65,C=photor(c(350,400,450,500,550)),noise=TRUE,e=c(0.05,0.07,0.07,0.01,0.03))
  expect_equal(deltaS(model)[1,2],
  sqrt((model[1,"X1_R1"]-model[2,"X1_R1"])^2+
       (model[1,"X2_R1"]-model[2,"X2_R1"])^2+
       (model[1,"X3_R1"]-model[2,"X3_R1"])^2+
       (model[1,"X4_R1"]-model[2,"X4_R1"])^2))

  model<-CTTKmodel(R=R,Rb=Rb,I=D65,C=photor(c(350,400,450,500,550)))
  expect_equal(deltaS(model)[1,2],
               sqrt((model[1,"X1"]-model[2,"X1"])^2+
                      (model[1,"X2"]-model[2,"X2"])^2+
                      (model[1,"X3"]-model[2,"X3"])^2+
                      (model[1,"X4"]-model[2,"X4"])^2))
  
  model<-EMmodel(R=R,Rb=Rb,I=D65,C=photor(c(350,400,450,500,550)))
  expect_equal(deltaS(model)[1,2],
               sqrt((model[1,"X1"]-model[2,"X1"])^2+
                      (model[1,"X2"]-model[2,"X2"])^2+
                      (model[1,"X3"]-model[2,"X3"])^2+
                      (model[1,"X4"]-model[2,"X4"])^2))
  
  model<-EMmodel(type="edge", R=R,Rb=Rb,I=D65,C=photor(c(350,400,450,500,550)))
  expect_equal(deltaS(model)[1,2],
               sqrt((model[1,"X1"]-model[2,"X1"])^2+
                      (model[1,"X2"]-model[2,"X2"])^2+
                      (model[1,"X3"]-model[2,"X3"])^2+
                      (model[1,"X4"]-model[2,"X4"])^2))
  
})

Try the colourvision package in your browser

Any scripts or data that you put into this service are public.

colourvision documentation built on Aug. 2, 2021, 1:06 a.m.

R Package Documentation

rdrr.io home R language documentation Run R code online

Browse R Packages

CRAN packages Bioconductor packages R-Forge packages GitHub packages

We want your feedback!

Note that we can't provide technical support on individual packages. You should contact the package authors for that.
GitHub issue tracker
ian@mutexlabs.com
Personal blog

 
Embedding an R snippet on your website

Add the following code to your website.

For more information on customizing the embed code, read Embedding Snippets.

Close