tests/testthat/test_slpSUSTAIN.R

In ajwills72/catlearn: Formal Psychological Models of Categorization and Learning

## Check slpSUSTAIN against short supervised and unsupervised experiments.
context("slpSUSTAIN")
load('../data/test_slpSUSTAIN.RData')
out <- slpSUSTAIN(st, tr, ties = "first")

test_that("slpSUSTAIN reproduces a short Shepard et al. (1961) Type I simulation.",
{
    expect_equal(out$p[,1], corr)
})

out  <- slpSUSTAIN(init.state, bigtr, ties = "first")

test_that("slpSUSTAIN reproduces a short Medin et al. (1987) Exp. 1 simulation.",
{
    expect_equal(out$cluster[1,], cor.medin)
})

out <- slpSUSTAIN(st, tr, ties = "random", xtdo = TRUE)


test_that("slpSUSTAIN ties and xtdo works as expected.",
{
    expect_equal(out, out_random_xtdo)
})

## Generating code for Shepard et al 1961
#library(catlearn)
#tr <- nosof94train(cond = 1, blocks = 1, absval = 0, blkstyle = "eights",
#                   missing = 'pad', subjs = 1, seed = 7624)

#params = c(9.01245, 1.252233, 16.924073, 0.092327)

#st <- list(r = params[1], beta = params[2], d = params[3], eta = params[4],
#           tau = 0.0, lambda = c(1, 1, 1), dims = c(2, 2, 2), cluster = NA,
#           w = NA, colskip = 4)
#rm(params)
#out <- slpSUSTAIN(st, tr)$probs
#corr <- out[,1]
#rm(out)
#save.image("../data/test_slpSUSTAIN.RData")

## Generating code for Medin et al. (1987)

##params = c(9.998779, 6.396300, 1.977312, 0.096564, 0.5)

##init.state <- list(r = params[1], beta = params[2], d = params[3],
##                   eta = params[4], tau = params[5],
##                  lambda = c(1, 1, 1, 1), dims = c(2, 2, 2, 2),
##                   cluster = NA, w = NA, colskip = 3,
##                   maxcat = 2)

##bigtr <- medin87train(subjs = 1, blocks = 1)
##out  <- slpSUSTAIN(init.state, bigtr)
##cor.medin  <- out$cluster[1,]
##save(corr, cor.medin,st,tr,init.state,bigtr,file='tests/data/test_slpSUSTAIN.RData')