opiApp/algorithmTest.R at main · imarinfr/opiApp · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
library(OPI)
library(deldir)
source("modules/utils.r")
source("modules/serverUtils.r")
load("config/appParams.rda")
load("config/grids.rda")
# setup test
machine <- "PhoneHMD"
eye <- "R"
perimetry <- "luminance"
algorithm <- "MOCS"
grid <- "FOS3"
size <- appParams$size
lum <- appParams$lum
dbstep <- 1
estSD <- appParams$estSD
nreps <- 3
range <- 6

statement <- paste("opiInit", machine)
do.call(what = opiInitialize, args = parseMessage(statement, appParams)$pars)
# set background
if(machine == "PhoneHMD") {
  statement <- paste("opiSetBackground", "B", "B", "cross")
} else {
  statement <- paste("opiSetBackground")
}
do.call(what = opiSetBackground, args = parseMessage(statement, appParams)$pars)


statement <- paste("opiTestInit", eye, perimetry, algorithm, grid,
                   size, lum, dbstep, estSD, nreps, range)
pars <- parseMessage(statement, appParams)$pars
if(pars$grid == "fovea") {
  locs <- data.frame(x = 0, y = 0, w = 1, est = 30)
} else
  locs <- grids[[pars$grid]]$locs
if(chooseOPI()[.OpiEnv$chooser] == "PhoneHMD" & pars$perimetry == "luminance") {
  maxlum <- tail(appParams$lut, 1) - appParams$lut[which.min(abs(appParams$lut - appParams$bglum))]
  locs$est <- round(cdTodb(dbTocd(locs$est), maxlum), 1)
}
setup <- testSetup(chooseOPI()[.OpiEnv$chooser], appParams, pars, locs)
states <- setup$states
settings <- setup$settings

pars <- parseMessage(statement, appParams)$pars
if(grid == "fovea") {
  locs <- data.frame(x = 0, y = 0, w = 1, est = 30)
} else {
  locs <- grids[[pars$grid]]$locs
}

if(chooseOPI()[.OpiEnv$chooser] == "PhoneHMD" & pars$perimetry == "luminance") {
  maxlum <- tail(appParams$lut, 1) - appParams$lut[which.min(abs(appParams$lut - appParams$bglum))]
  locs$est <- round(cdTodb(dbTocd(locs$est), maxlum), 1)
}
setup <- testSetup(machine, appParams, pars, locs)
states <- setup$states
settings <- setup$settings

print("domain:")
print(states[[1]]$domain)
while(!all(sapply(states, function(s) settings$stopf(s)))) {
  rs <- testStep(states, settings)
  states <- rs$states
  settings <- rs$settings
  print("last presented:")
  print(round(sapply(states, function(s) ifelse(is.null(tail(s$stimuli, 1)), NA, tail(s$stimuli, 1))), 1))
  print("estimate:")
  print(round(sapply(states, function(s) settings$finalf(s)), 1))
}

opiClose()