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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
## rm(list=ls())
## library("testthat")
## library("optimParallel", lib.loc = "../../../lib/")
source("testsetup.R")
context("test-issues")
control <- structure(list(maxit = 10,
factr = 2.22044604925031e-16),
.Names = c("maxit","factr"))
FN1 <- function(par, sleep){
Sys.sleep(sleep)
sum(par^2)
}
GR1 <- function(par, sleep){
Sys.sleep(sleep)
2*par
}
test_that("optimParallel",{
compareOptim(list(par=c(1,2,3), fn=FN1, gr=GR1, sleep=0,
control=control),
verbose=verbose)
})
FN2 <- function(par, sleep){
Sys.sleep(sleep)
par["a"]^2+par["b"]^2
}
GR2 <- function(par, sleep){
Sys.sleep(sleep)
2*c(par["a"],par["b"])
}
FN3 <- function(par, sleep){
Sys.sleep(sleep)
par["a"]^2
}
GR3 <- function(par, sleep){
Sys.sleep(sleep)
2*c(par["a"])
}
test_that("optimParallel - named arguments",{
compareOptim(list(par=c(a=1,b=2), fn=FN2, sleep=0,
control=control),
verbose=verbose)
compareOptim(list(par=c(a=1,b=2), fn=FN2, gr= GR2, sleep=0,
control=control),
verbose=verbose)
compareOptim(list(par=c(a=1), fn=FN3, sleep=0,
control=control),
verbose=verbose)
compareOptim(list(par=c(a=1), fn=FN3, gr= GR3, sleep=0,
control=control),
verbose=verbose)
})
test_that("optimParallel - use compiled code from other packages",{
compareOptim(list(par=c(a=1), fn=dnorm,
control=control),
verbose=verbose)
compareOptim(list(par=c(a=1), fn=dnorm, mean=1,
control=control),
verbose=verbose)
})
FN4 <- function(par, a, sleep=0){
Sys.sleep(sleep)
sum(10*par^2) + a
}
GR4 <- function(par, b, sleep=0){
Sys.sleep(sleep)
b*2*par
}
test_that("optimParallel - fn and gr can have different aguments",{
expect_equal(optimParallel(par=1, fn=FN4, gr=GR4,
a=1, b=10, sleep=0,
control=control)$par, 0)
})
test_that("optimParallel return correct sign of hessian if 'fnscale=-1'", {
set.seed(13)
x <- rnorm(1000, 5, 2)
negll <- function(par, x) { -sum(dnorm(x=x, mean=par[1], sd=par[2], log=TRUE)) }
posll <- function(par, x) { sum(dnorm(x=x, mean=par[1], sd=par[2], log=TRUE)) }
compareOptim(list(par=c(1,1), fn=negll, x=x,
control=control, hessian=TRUE),
verbose=verbose)
compareOptim(list(par=c(1,1), fn=posll, x=x,
control=c(control, fnscale=-1), hessian=TRUE),
verbose=verbose)
})
test_that("fn can have normal and ... aguments", {
fn <- function(par, data, ...) par^2
compareOptim(list(par=1, fn=fn, data=1:10,
control=control),
verbose=verbose)
})
|
