Nothing
starting.values <- function(MODEL){
if(MODEL == "BM_null"){
p_matrix <- c(
0.00001,
0.0001,
0.001,
0.01,
0.02,
0.04,
0.06,
0.08,
0.1,
0.2,
0.3,
0.4,
0.5,
0.6,
0.7,
0.8,
0.9,
1.0,
2.0,
5.0,
10.0,
100.0,
1000,
10000
)
p_starting <- matrix(p_matrix, length(p_matrix), 1, byrow=TRUE)
result_matrix <- matrix(NA, nrow(p_starting), 3)
result_matrix[,1] <- p_starting
}
if(MODEL == "BM_linear"){
p_matrix <- c(
0.01, 0.01,
0.01, 0.1,
0.01, 0.5,
0.01,-0.01,
0.01, -0.1,
0.01, -0.5,
0.1, 0.01,
0.1, 0.1,
0.1, 0.5,
0.1,-0.01,
0.1, -0.1,
0.1, -0.5,
0.5, 0.01,
0.5, 0.1,
0.5, 0.5,
0.5,-0.01,
0.5, -0.1,
0.5, -0.5,
1.0, 0.01,
1.0, 0.1,
1.0, 0.5,
1.0,-0.01,
1.0, -0.1,
1.0, -0.5,
10.0, 0.01,
10.0, 0.1,
10.0, 0.5,
10.0,-0.01,
10.0, -0.1,
10.0, -0.5,
100.0, 0.01,
100.0, 0.1,
100.0, 0.5,
100.0,-0.01,
100.0, -0.1,
100.0, -0.5,
1.0, 1,
1.0, 5,
1.0, 10,
1.0,-1,
1.0, -5,
1.0, -10,
10.0, 1,
10.0, 5,
10.0, 10,
10.0,-1,
10.0, -5,
10.0, -10,
100.0, 1,
100.0, 5,
100.0, 10,
100.0,-1,
100.0, -5,
100.0, -10
)
p_starting <- matrix(p_matrix, length(p_matrix)/2, 2, byrow=TRUE)
result_matrix <- matrix(NA, nrow(p_starting), 3)
result_matrix[,1:2] <- p_starting
}
if(MODEL == "BM_linear_2"){
A <- c(0.01, 0.1, 0.5, 1, 10, 100)
B <- c(-10, -5, -1, -0.5, -0.1, -0.01, 0, 0.01, 0.1, 0.5, 1, 5, 10)
C <- c(-10, -5, -1, -0.5, -0.1, -0.01, 0, 0.01, 0.1, 0.5, 1, 5, 10)
NROW <- length(A) * length(B) * length(C)
result_matrix <- matrix(NA, nrow = NROW, 4)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
for(p in 1:length(B)){
BB <- B[p]
for(z in 1:length(C)){
CC <- C[z]
result_matrix[count,c(1:3)] <- c(AA, BB, CC)
count = count + 1
}
}
}
}
if(MODEL == "BM_linear_3"){
A <- c(0.01, 0.1, 0.5, 1, 10)
B <- c(-5, -1, -0.5, -0.1, -0.01, 0, 0.01, 0.1, 0.5, 1, 5)
C <- c(-5, -1, -0.5, -0.1, -0.01, 0, 0.01, 0.1, 0.5, 1, 5)
D <- c(-1, -0.5, -0.1, -0.001, 0, 0.001, 0.1, 0.5, 1)
NROW <- length(A) * length(B) * length(C) * length(D)
result_matrix <- matrix(NA, nrow = NROW, 5)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
for(p in 1:length(B)){
BB <- B[p]
for(z in 1:length(C)){
CC <- C[z]
for(r in 1:length(D)){
DD <- D[r]
result_matrix[count,c(1:4)] <- c(AA, BB, CC, DD)
count = count + 1
}
}
}
}
}
###
if(MODEL == "OU_null"){
p_matrix <- c(
100, 0.001,
100, 0.01,
100, 0.1,
100, 1,
100, 10,
10, 0.001,
10, 0.01,
10, 0.1,
10, 1,
1, 0.001,
1, 0.01,
1, 0.1,
1, 1,
0.5, 0.001,
0.5, 0.01,
0.5, 0.1,
0.5, 1,
0.1, 0.001,
0.1, 0.01,
0.1, 0.1,
0.1, 1,
0.01, 0.001,
0.01, 0.01,
0.01, 0.1,
0.01, 1
)
p_starting <- matrix(p_matrix, length(p_matrix)/2, 2, byrow=TRUE)
result_matrix <- matrix(NA, nrow(p_starting), 3)
result_matrix[,1:2] <- p_starting
}
if(MODEL == "OU_linear_beta"){
A <- c(0.01, 0.1, 0.5, 1, 10,100)
B <- c(0.001, -0.001, 0.01, -0.01, 0.1, -0.1, -1, 1, 10, -10, 100, -100)
C <- c(0.001, 0.01, 0.1, 0.5,1,5,10, 20)
NROW <- length(A) * length(B) * length(C)
result_matrix <- matrix(NA, nrow = NROW, 4)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
for(p in 1:length(B)){
BB <- B[p]
for(z in 1:length(C)){
CC <- C[z]
result_matrix[count,c(1:3)] <- c(AA, BB, CC)
count = count + 1
}
}
}
}
if(MODEL == "OU_linear_beta_2"){
A <- c(0.01, 0.1, 0.5, 1, 10)
B <- c(0.001, -0.001, 0.01, -0.01, 0.1, -0.1, -1, 1)
C <- c(0.001, -0.001, 0.01, -0.01, 0.1, -0.1, -1, 1)
D <- c(0.001, 0.01, 0.1, 0.5,1,5,10)
NROW <- length(A) * length(B) * length(C) * length(D)
result_matrix <- matrix(NA, nrow = NROW, 5)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
for(p in 1:length(B)){
BB <- B[p]
for(z in 1:length(C)){
CC <- C[z]
for(r in 1:length(D)){
DD <- D[r]
result_matrix[count,c(1:4)] <- c(AA, BB, CC, DD)
count = count + 1
}
}
}
}
}
if(MODEL == "OU_linear_beta_3"){
A <- c(0.01, 0.1, 1, 10)
B <- c(0.01, -0.01, 0.1, -0.1, -1, 1)
C <- c(0.01, -0.01, 0.1, -0.1, -1, 1)
D <- c(0.001, -0.001, 0.01, -0.01, 0.1, -0.1)
E <- c(0.001, 0.01, 0.1, 0.5,1,5,10)
NROW <- length(A) * length(B) * length(C) * length(D) * length(E)
result_matrix <- matrix(NA, nrow = NROW, 6)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
for(p in 1:length(B)){
BB <- B[p]
for(z in 1:length(C)){
CC <- C[z]
for(r in 1:length(D)){
DD <- D[r]
for(h in 1:length(E)){
EE <- E[h]
result_matrix[count,c(1:5)] <- c(AA, BB, CC, DD, EE)
count = count + 1
}
}
}
}
}
}
if(MODEL == "OU_linear"){
p_matrix <- c(
10, 0.01, 0.01, 0.01,
10, 0.01, 0.1, 0.01,
10, 0.01, 0.5, 0.01,
10, 0.01, 1, 0.01,
10, 0.01, 5, 0.01,
10, 0.01, 10, 0.01,
10, 0.1, 0.01, 0.01,
10, 0.1, 0.1, 0.01,
10, 0.1, 0.5, 0.01,
10, 0.1, 1, 0.01,
10, 0.1, 5, 0.01,
10, 0.1, 10, 0.01,
10, 0.01, 0.01, 0.1,
10, 0.01, 0.1, 0.1,
10, 0.01, 0.5, 0.1,
10, 0.01, 1, 0.1,
10, 0.01, 5, 0.1,
10, 0.01, 10, 0.1,
10, 0.001, 0.01, 0.001,
10, 0.001, 0.1, 0.001,
10, 0.001, 0.5, 0.001,
10, 0.001, 1, 0.001,
10, 0.001, 5, 0.001,
10, 0.001, 10, 0.001,
10, -0.01, 0.01, 0.01,
10, -0.01, 0.1, 0.01,
10, -0.01, 0.5, 0.01,
10, -0.01, 1, 0.01,
10, -0.01, 5, 0.01,
10, -0.01, 10, 0.01,
10, -0.1, 0.01, 0.01,
10, -0.1, 0.1, 0.01,
10, -0.1, 0.5, 0.01,
10, -0.1, 1, 0.01,
10, -0.1, 5, 0.01,
10, -0.1, 10, 0.01,
10, -0.01, 0.01, 0.1,
10, -0.01, 0.1, 0.1,
10, -0.01, 0.5, 0.1,
10, -0.01, 1, 0.1,
10, -0.01, 5, 0.1,
10, -0.01, 10, 0.1,
10, -0.001, 0.01, 0.001,
10, -0.001, 0.1, 0.001,
10, -0.001, 0.5, 0.001,
10, -0.001, 1, 0.001,
10, -0.001, 5, 0.001,
10, -0.001, 10, 0.001,
10, 0.01, 0.01, -0.01,
10, 0.01, 0.1, -0.01,
10, 0.01, 0.5, -0.01,
10, 0.01, 1, -0.01,
10, 0.01, 5, -0.01,
10, 0.01, 10, -0.01,
10, 0.1, 0.01, -0.01,
10, 0.1, 0.1, -0.01,
10, 0.1, 0.5, -0.01,
10, 0.1, 1, -0.01,
10, 0.1, 5, -0.01,
10, 0.1, 10, -0.01,
10, 0.01, 0.01, -0.1,
10, 0.01, 0.1, -0.1,
10, 0.01, 0.5, -0.1,
10, 0.01, 1, -0.1,
10, 0.01, 5, -0.1,
10, 0.01, 10, -0.1,
10, 0.001, 0.01, -0.001,
10, 0.001, 0.1, -0.001,
10, 0.001, 0.5, -0.001,
10, 0.001, 1, -0.001,
10, 0.001, 5, -0.001,
10, 0.001, 10, -0.001,
10, -0.01, 0.01, -0.01,
10, -0.01, 0.1, -0.01,
10, -0.01, 0.5, -0.01,
10, -0.01, 1, -0.01,
10, -0.01, 5, -0.01,
10, -0.01, 10, -0.01,
10, -0.1, 0.01, -0.01,
10, -0.1, 0.1, -0.01,
10, -0.1, 0.5, -0.01,
10, -0.1, 1, -0.01,
10, -0.1, 5, -0.01,
10, -0.1, 10, -0.01,
10, -0.01, 0.01, -0.1,
10, -0.01, 0.1, -0.1,
10, -0.01, 0.5, -0.1,
10, -0.01, 1, -0.1,
10, -0.01, 5, -0.1,
10, -0.01, 10, -0.1,
10, -0.001, 0.01, -0.001,
10, -0.001, 0.1, -0.001,
10, -0.001, 0.5, -0.001,
10, -0.001, 1, -0.001,
10, -0.001, 5, -0.001,
10, -0.001, 10, -0.001,
10, 0.01, 0.01, 0.01,
1, 0.01, 0.1, 0.01,
1, 0.01, 0.5, 0.01,
1, 0.01, 1, 0.01,
1, 0.01, 5, 0.01,
1, 0.01, 10, 0.01,
1, 0.1, 0.01, 0.01,
1, 0.1, 0.1, 0.01,
1, 0.1, 0.5, 0.01,
1, 0.1, 1, 0.01,
1, 0.1, 5, 0.01,
1, 0.1, 10, 0.01,
1, 0.01, 0.01, 0.1,
1, 0.01, 0.1, 0.1,
1, 0.01, 0.5, 0.1,
1, 0.01, 1, 0.1,
1, 0.01, 5, 0.1,
1, 0.01, 10, 0.1,
1, 0.001, 0.01, 0.001,
1, 0.001, 0.1, 0.001,
1, 0.001, 0.5, 0.001,
1, 0.001, 1, 0.001,
1, 0.001, 5, 0.001,
1, 0.001, 10, 0.001,
1, -0.01, 0.01, 0.01,
1, -0.01, 0.1, 0.01,
1, -0.01, 0.5, 0.01,
1, -0.01, 1, 0.01,
1, -0.01, 5, 0.01,
1, -0.01, 10, 0.01,
1, -0.1, 0.01, 0.01,
1, -0.1, 0.1, 0.01,
1, -0.1, 0.5, 0.01,
1, -0.1, 1, 0.01,
1, -0.1, 5, 0.01,
1, -0.1, 10, 0.01,
1, -0.01, 0.01, 0.1,
1, -0.01, 0.1, 0.1,
1, -0.01, 0.5, 0.1,
1, -0.01, 1, 0.1,
1, -0.01, 5, 0.1,
1, -0.01, 10, 0.1,
1, -0.001, 0.01, 0.001,
1, -0.001, 0.1, 0.001,
1, -0.001, 0.5, 0.001,
1, -0.001, 1, 0.001,
1, -0.001, 5, 0.001,
1, -0.001, 10, 0.001,
1, 0.01, 0.01, -0.01,
1, 0.01, 0.1, -0.01,
1, 0.01, 0.5, -0.01,
1, 0.01, 1, -0.01,
1, 0.01, 5, -0.01,
1, 0.01, 10, -0.01,
1, 0.1, 0.01, -0.01,
1, 0.1, 0.1, -0.01,
1, 0.1, 0.5, -0.01,
1, 0.1, 1, -0.01,
1, 0.1, 5, -0.01,
1, 0.1, 10, -0.01,
1, 0.01, 0.01, -0.1,
1, 0.01, 0.1, -0.1,
1, 0.01, 0.5, -0.1,
1, 0.01, 1, -0.1,
1, 0.01, 5, -0.1,
1, 0.01, 10, -0.1,
1, 0.001, 0.01, -0.001,
1, 0.001, 0.1, -0.001,
1, 0.001, 0.5, -0.001,
1, 0.001, 1, -0.001,
1, 0.001, 5, -0.001,
1, 0.001, 10, -0.001,
1, -0.01, 0.01, -0.01,
1, -0.01, 0.1, -0.01,
1, -0.01, 0.5, -0.01,
1, -0.01, 1, -0.01,
1, -0.01, 5, -0.01,
1, -0.01, 10, -0.01,
1, -0.1, 0.01, -0.01,
1, -0.1, 0.1, -0.01,
1, -0.1, 0.5, -0.01,
1, -0.1, 1, -0.01,
1, -0.1, 5, -0.01,
1, -0.1, 10, -0.01,
1, -0.01, 0.01, -0.1,
1, -0.01, 0.1, -0.1,
1, -0.01, 0.5, -0.1,
1, -0.01, 1, -0.1,
1, -0.01, 5, -0.1,
1, -0.01, 10, -0.1,
1, -0.001, 0.01, -0.001,
1, -0.001, 0.1, -0.001,
1, -0.001, 0.5, -0.001,
1, -0.001, 1, -0.001,
1, -0.001, 5, -0.001,
1, -0.001, 10, -0.001,
0.01, 0.01, 0.001, 0.01,
0.01, 0.01, 0.1, 0.01,
0.01, 0.01, 0.5, 0.01,
0.1, 0.01, 0.01, 0.01,
0.1, 0.01, 0.1, 0.01,
0.1, 0.01, 0.5, 0.01,
0.5, 0.01, 0.01, 0.01,
0.5, 0.01, 0.1, 0.01,
0.5, 0.01, 0.5, 0.01,
0.01, 0.1, 0.01, 0.1,
0.01, 0.1, 0.1, 0.1,
0.01, 0.1, 0.5, 0.1,
0.1, 0.1, 0.01, 0.1,
0.1, 0.1, 0.1, 0.1,
0.1, 0.1, 0.5, 0.1,
0.5, 0.1, 0.01, 0.1,
0.5, 0.1, 0.1, 0.1,
0.5, 0.1, 0.5, 0.1,
0.01, 0.1, 0.01, 0.01,
0.01, 0.1, 0.1, 0.01,
0.01, 0.1, 0.5, 0.01,
0.1, 0.1, 0.01, 0.01,
0.1, 0.1, 0.1, 0.01,
0.1, 0.1, 0.5, 0.01,
0.5, 0.1, 0.01, 0.01,
0.5, 0.1, 0.1, 0.01,
0.5, 0.1, 0.5, 0.01,
0.01, 0.1, 0.01, 0.01,
0.01, 0.1, 0.1, 0.01,
0.01, 0.1, 0.5, 0.01,
0.1, 0.1, 0.01, 0.01,
0.1, 0.1, 0.1, 0.01,
0.1, 0.1, 0.5, 0.01,
0.5, 0.1, 0.01, 0.01,
0.5, 0.1, 0.1, 0.01,
0.5, 0.1, 0.5, 0.01,
0.01, -0.01, 0.01, -0.01,
0.01, -0.01, 0.1, -0.01,
0.01, -0.01, 0.5, -0.01,
0.1, -0.01, 0.01, -0.01,
0.1, -0.01, 0.1, -0.01,
0.1, -0.01, 0.5, -0.01,
0.5, -0.01, 0.01, -0.01,
0.5, -0.01, 0.1, -0.01,
0.5, -0.01, 0.5, -0.01,
0.01, -0.1, 0.01, -0.1,
0.01, -0.1, 0.1, -0.1,
0.01, -0.1, 0.5, -0.1,
0.1, -0.1, 0.01, -0.1,
0.1, -0.1, 0.1, -0.1,
0.1, -0.1, 0.5, -0.1,
0.5, -0.1, 0.01, -0.1,
0.5, -0.1, 0.1, -0.1,
0.5, -0.1, 0.5, -0.1,
0.01, -0.1, 0.01, -0.01,
0.01, -0.1, 0.1, -0.01,
0.01, -0.1, 0.5, -0.01,
0.1, -0.1, 0.01, -0.01,
0.1, -0.1, 0.1, -0.01,
0.1, -0.1, 0.5, -0.01,
0.5, -0.1, 0.01, -0.01,
0.5, -0.1, 0.1, -0.01,
0.5, -0.1, 0.5, -0.01,
0.01, -0.1, 0.01, -0.01,
0.01, -0.1, 0.1, -0.01,
0.01, -0.1, 0.5, -0.01,
0.1, -0.1, 0.01, -0.01,
0.1, -0.1, 0.1, -0.01,
0.1, -0.1, 0.5, -0.01,
0.5, -0.1, 0.01, -0.01,
0.5, -0.1, 0.1, -0.01,
0.5, -0.1, 0.5, -0.01,
0.01, 0.01, 0.01, -0.01,
0.01, 0.01, 0.1, -0.01,
0.01, 0.01, 0.5, -0.01,
0.1, 0.01, 0.01, -0.01,
0.1, 0.01, 0.1, -0.01,
0.1, 0.01, 0.5, -0.01,
0.5, 0.01, 0.01, -0.01,
0.5, 0.01, 0.1, -0.01,
0.5, 0.01, 0.5, -0.01,
0.01, 0.1, 0.01, -0.1,
0.01, 0.1, 0.1, -0.1,
0.01, 0.1, 0.5, -0.1,
0.1, 0.1, 0.01, -0.1,
0.1, 0.1, 0.1, -0.1,
0.1, 0.1, 0.5, -0.1,
0.5, 0.1, 0.01, -0.1,
0.5, 0.1, 0.1, -0.1,
0.5, 0.1, 0.5, -0.1,
0.01, 0.1, 0.01, -0.01,
0.01, 0.1, 0.1, -0.01,
0.01, 0.1, 0.5, -0.01,
0.1, 0.1, 0.01, -0.01,
0.1, 0.1, 0.1, -0.01,
0.1, 0.1, 0.5, -0.01,
0.5, 0.1, 0.01, -0.01,
0.5, 0.1, 0.1, -0.01,
0.5, 0.1, 0.5, -0.01,
0.01, 0.1, 0.01, -0.01,
0.01, 0.1, 0.1, -0.01,
0.01, 0.1, 0.5, -0.01,
0.1, 0.1, 0.01, -0.01,
0.1, 0.1, 0.1, -0.01,
0.1, 0.1, 0.5, -0.01,
0.5, 0.1, 0.01, -0.01,
0.5, 0.1, 0.1, -0.01,
0.5, 0.1, 0.5, -0.01,
0.01, -0.01, 0.01, 0.01,
0.01, -0.01, 0.1, 0.01,
0.01, -0.01, 0.5, 0.01,
0.1, -0.01, 0.01, 0.01,
0.1, -0.01, 0.1, 0.01,
0.1, -0.01, 0.5, 0.01,
0.5, -0.01, 0.01, 0.01,
0.5, -0.01, 0.1, 0.01,
0.5, -0.01, 0.5, 0.01,
0.01, -0.1, 0.01, 0.1,
0.01, -0.1, 0.1, 0.1,
0.01, -0.1, 0.5, 0.1,
0.1, -0.1, 0.01, 0.1,
0.1, -0.1, 0.1, 0.1,
0.1, -0.1, 0.5, 0.1,
0.5, -0.1, 0.01, 0.1,
0.5, -0.1, 0.1, 0.1,
0.5, -0.1, 0.5, 0.1,
0.01, -0.1, 0.01, 0.01,
0.01, -0.1, 0.1, 0.01,
0.01, -0.1, 0.5, 0.01,
0.1, -0.1, 0.01, 0.01,
0.1, -0.1, 0.1, 0.01,
0.1, -0.1, 0.5, 0.01,
0.5, -0.1, 0.01, 0.01,
0.5, -0.1, 0.1, 0.01,
0.5, -0.1, 0.5, 0.01,
0.01, -0.1, 0.01, 0.01,
0.01, -0.1, 0.1, 0.01,
0.01, -0.1, 0.5, 0.01,
0.1, -0.1, 0.01, 0.01,
0.1, -0.1, 0.1, 0.01,
0.1, -0.1, 0.5, 0.01,
0.5, -0.1, 0.01, 0.01,
0.5, -0.1, 0.1, 0.01,
0.5, -0.1, 0.5, 0.01
)
p_starting <- matrix(p_matrix, length(p_matrix)/4, 4, byrow=TRUE)
result_matrix <- matrix(NA, nrow(p_starting), 5)
result_matrix[,1:4] <- p_starting
}
if(MODEL == "BM_linear_breakpoint"){
p_matrix <- c(
0.0001, 0.0001, 20, 0.0001,
0.1, 0.0001, 20, 0.0001,
1, 0.0001, 20, 0.0001,
10, 0.0001, 20, 0.0001,
100, 0.0001, 20, 0.0001,
0.0001, 0.01, 20, 0.0001,
0.1, 0.01, 20, 0.0001,
1, 0.01, 20, 0.0001,
10, 0.01, 20, 0.0001,
100, 0.01, 20, 0.0001,
0.0001, 0.1, 20, 0.0001,
0.1, 0.1, 20, 0.0001,
1, 0.1, 20, 0.0001,
10, 0.1, 20, 0.0001,
100, 0.1, 20, 0.0001,
0.0001, 1, 20, 0.0001,
0.1, 1, 20, 0.0001,
1, 1, 20, 0.0001,
10, 1, 20, 0.0001,
100, 1, 20, 0.0001,
0.0001, -0.0001, 20, 0.0001,
0.1, -0.0001, 20, 0.0001,
1, -0.0001, 20, 0.0001,
10, -0.0001, 20, 0.0001,
100, -0.0001, 20, 0.0001,
0.0001, -0.01, 20, 0.0001,
0.1, -0.01, 20, 0.0001,
1, -0.01, 20, 0.0001,
10, -0.01, 20, 0.0001,
100, -0.01, 20, 0.0001,
0.0001, -0.1, 20, 0.0001,
0.1, -0.1, 20, 0.0001,
1, -0.1, 20, 0.0001,
10, -0.1, 20, 0.0001,
100, -0.1, 20, 0.0001,
0.0001, -1, 20, 0.0001,
0.1, -1, 20, 0.0001,
1, -1, 20, 0.0001,
10, -1, 20, 0.0001,
100, -1, 20, 0.0001,
0.0001, 0.0001, 20, 0.01,
0.1, 0.0001, 20, 0.01,
1, 0.0001, 20, 0.01,
10, 0.0001, 20, 0.01,
100, 0.0001, 20, 0.01,
0.0001, 0.01, 20, 0.01,
0.1, 0.01, 20, 0.01,
1, 0.01, 20, 0.01,
10, 0.01, 20, 0.01,
100, 0.01, 20, 0.01,
0.0001, 0.1, 20, 0.01,
0.1, 0.1, 20, 0.01,
1, 0.1, 20, 0.01,
10, 0.1, 20, 0.01,
100, 0.1, 20, 0.01,
0.0001, 1, 20, 0.01,
0.1, 1, 20, 0.01,
1, 1, 20, 0.01,
10, 1, 20, 0.01,
100, 1, 20, 0.01,
0.0001, -0.0001, 20, 0.01,
0.1, -0.0001, 20, 0.01,
1, -0.0001, 20, 0.01,
10, -0.0001, 20, 0.01,
100, -0.0001, 20, 0.01,
0.0001, -0.01, 20, 0.01,
0.1, -0.01, 20, 0.01,
1, -0.01, 20, 0.01,
10, -0.01, 20, 0.01,
100, -0.01, 20, 0.01,
0.0001, -0.1, 20, 0.01,
0.1, -0.1, 20, 0.01,
1, -0.1, 20, 0.01,
10, -0.1, 20, 0.01,
100, -0.1, 20, 0.01,
0.0001, -1, 20, 0.01,
0.1, -1, 20, 0.01,
1, -1, 20, 0.01,
10, -1, 20, 0.01,
100, -1, 20, 0.01,
0.0001, 0.0001, 20, 0.1,
0.1, 0.0001, 20, 0.1,
1, 0.0001, 20, 0.1,
10, 0.0001, 20, 0.1,
100, 0.0001, 20, 0.1,
0.0001, 0.01, 20, 0.1,
0.1, 0.01, 20, 0.1,
1, 0.01, 20, 0.1,
10, 0.01, 20, 0.1,
100, 0.01, 20, 0.1,
0.0001, 0.1, 20, 0.1,
0.1, 0.1, 20, 0.1,
1, 0.1, 20, 0.1,
10, 0.1, 20, 0.1,
100, 0.1, 20, 0.1,
0.0001, 1, 20, 0.1,
0.1, 1, 20, 0.1,
1, 1, 20, 0.1,
10, 1, 20, 0.1,
100, 1, 20, 0.1,
0.0001, -0.0001, 20, 0.1,
0.1, -0.0001, 20, 0.1,
1, -0.0001, 20, 0.1,
10, -0.0001, 20, 0.1,
100, -0.0001, 20, 0.1,
0.0001, -0.01, 20, 0.1,
0.1, -0.01, 20, 0.1,
1, -0.01, 20, 0.1,
10, -0.01, 20, 0.1,
100, -0.01, 20, 0.1,
0.0001, -0.1, 20, 0.1,
0.1, -0.1, 20, 0.1,
1, -0.1, 20, 0.1,
10, -0.1, 20, 0.1,
100, -0.1, 20, 0.1,
0.0001, -1, 20, 0.1,
0.1, -1, 20, 0.1,
1, -1, 20, 0.1,
10, -1, 20, 0.1,
100, -1, 20, 0.1,
0.0001, 0.0001, 20, 0.0001,
0.1, 0.0001, 20, 0.0001,
1, 0.0001, 20, 0.0001,
10, 0.0001, 20, 0.0001,
100, 0.0001, 20, 0.0001,
0.0001, 0.01, 20, 0.0001,
0.1, 0.01, 20, 0.0001,
1, 0.01, 20, 0.0001,
10, 0.01, 20, 0.0001,
100, 0.01, 20, 0.0001,
0.0001, 0.1, 20, 0.0001,
0.1, 0.1, 20, 0.0001,
1, 0.1, 20, 0.0001,
10, 0.1, 20, 0.0001,
100, 0.1, 20, 0.0001,
0.0001, 1, 20, 0.0001,
0.1, 1, 20, 0.0001,
1, 1, 20, 0.0001,
10, 1, 20, 0.0001,
100, 1, 20, 0.0001,
0.0001, -0.0001, 20, 0.0001,
0.1, -0.0001, 20, 0.0001,
1, -0.0001, 20, 0.0001,
10, -0.0001, 20, 0.0001,
100, -0.0001, 20, 0.0001,
0.0001, -0.01, 20, 0.0001,
0.1, -0.01, 20, 0.0001,
1, -0.01, 20, 0.0001,
10, -0.01, 20, 0.0001,
100, -0.01, 20, 0.0001,
0.0001, -0.1, 20, 0.0001,
0.1, -0.1, 20, 0.0001,
1, -0.1, 20, 0.0001,
10, -0.1, 20, 0.0001,
100, -0.1, 20, 0.0001,
0.0001, -1, 20, 0.0001,
0.1, -1, 20, 0.0001,
1, -1, 20, 0.0001,
10, -1, 20, 0.0001,
100, -1, 20, 0.0001,
0.0001, 0.0001, 20, -0.0001,
0.1, 0.0001, 20, -0.0001,
1, 0.0001, 20, -0.0001,
10, 0.0001, 20, -0.0001,
100, 0.0001, 20, -0.0001,
0.0001, 0.01, 20, -0.0001,
0.1, 0.01, 20, -0.0001,
1, 0.01, 20, -0.0001,
10, 0.01, 20, -0.0001,
100, 0.01, 20, -0.0001,
0.0001, 0.1, 20, -0.0001,
0.1, 0.1, 20, -0.0001,
1, 0.1, 20, -0.0001,
10, 0.1, 20, -0.0001,
100, 0.1, 20, -0.0001,
0.0001, 1, 20, -0.0001,
0.1, 1, 20, -0.0001,
1, 1, 20, -0.0001,
10, 1, 20, -0.0001,
100, 1, 20, -0.0001,
0.0001, -0.0001, 20, -0.0001,
0.1, -0.0001, 20, -0.0001,
1, -0.0001, 20, -0.0001,
10, -0.0001, 20, -0.0001,
100, -0.0001, 20, -0.0001,
0.0001, -0.01, 20, -0.0001,
0.1, -0.01, 20, -0.0001,
1, -0.01, 20, -0.0001,
10, -0.01, 20, -0.0001,
100, -0.01, 20, -0.0001,
0.0001, -0.1, 20, -0.0001,
0.1, -0.1, 20, -0.0001,
1, -0.1, 20, -0.0001,
10, -0.1, 20, -0.0001,
100, -0.1, 20, -0.0001,
0.0001, -1, 20, -0.0001,
0.1, -1, 20, -0.0001,
1, -1, 20, -0.0001,
10, -1, 20, -0.0001,
100, -1, 20, -0.0001,
0.0001, 0.0001, 20, -0.01,
0.1, 0.0001, 20, -0.01,
1, 0.0001, 20, -0.01,
10, 0.0001, 20, -0.01,
100, 0.0001, 20, -0.01,
0.0001, 0.01, 20, -0.01,
0.1, 0.01, 20, -0.01,
1, 0.01, 20, -0.01,
10, 0.01, 20, -0.01,
100, 0.01, 20, -0.01,
0.0001, 0.1, 20, -0.01,
0.1, 0.1, 20, -0.01,
1, 0.1, 20, -0.01,
10, 0.1, 20, -0.01,
100, 0.1, 20, -0.01,
0.0001, 1, 20, -0.01,
0.1, 1, 20, -0.01,
1, 1, 20, -0.01,
10, 1, 20, -0.01,
100, 1, 20, -0.01,
0.0001, -0.0001, 20, -0.01,
0.1, -0.0001, 20, -0.01,
1, -0.0001, 20, -0.01,
10, -0.0001, 20, -0.01,
100, -0.0001, 20, -0.01,
0.0001, -0.01, 20, -0.01,
0.1, -0.01, 20, -0.01,
1, -0.01, 20, -0.01,
10, -0.01, 20, -0.01,
100, -0.01, 20, -0.01,
0.0001, -0.1, 20, -0.01,
0.1, -0.1, 20, -0.01,
1, -0.1, 20, -0.01,
10, -0.1, 20, -0.01,
100, -0.1, 20, -0.01,
0.0001, -1, 20, -0.01,
0.1, -1, 20, -0.01,
1, -1, 20, -0.01,
10, -1, 20, -0.01,
100, -1, 20, -0.01,
0.0001, 0.0001, 20, -0.1,
0.1, 0.0001, 20, -0.1,
1, 0.0001, 20, -0.1,
10, 0.0001, 20, -0.1,
100, 0.0001, 20, -0.1,
0.0001, 0.01, 20, -0.1,
0.1, 0.01, 20, -0.1,
1, 0.01, 20, -0.1,
10, 0.01, 20, -0.1,
100, 0.01, 20, -0.1,
0.0001, 0.1, 20, -0.1,
0.1, 0.1, 20, -0.1,
1, 0.1, 20, -0.1,
10, 0.1, 20, -0.1,
100, 0.1, 20, -0.1,
0.0001, 1, 20, -0.1,
0.1, 1, 20, -0.1,
1, 1, 20, -0.1,
10, 1, 20, -0.1,
100, 1, 20, -0.1,
0.0001, -0.0001, 20, -0.1,
0.1, -0.0001, 20, -0.1,
1, -0.0001, 20, -0.1,
10, -0.0001, 20, -0.1,
100, -0.0001, 20, -0.1,
0.0001, -0.01, 20, -0.1,
0.1, -0.01, 20, -0.1,
1, -0.01, 20, -0.1,
10, -0.01, 20, -0.1,
100, -0.01, 20, -0.1,
0.0001, -0.1, 20, -0.1,
0.1, -0.1, 20, -0.1,
1, -0.1, 20, -0.1,
10, -0.1, 20, -0.1,
100, -0.1, 20, -0.1,
0.0001, -1, 20, -0.1,
0.1, -1, 20, -0.1,
1, -1, 20, -0.1,
10, -1, 20, -0.1,
100, -1, 20, -0.1,
0.0001, 0.0001, 20, -0.0001,
0.1, 0.0001, 20, -0.0001,
1, 0.0001, 20, -0.0001,
10, 0.0001, 20, -0.0001,
100, 0.0001, 20, -0.0001,
0.0001, 0.01, 20, -0.0001,
0.1, 0.01, 20, -0.0001,
1, 0.01, 20, -0.0001,
10, 0.01, 20, -0.0001,
100, 0.01, 20, -0.0001,
0.0001, 0.1, 20, -0.0001,
0.1, 0.1, 20, -0.0001,
1, 0.1, 20, -0.0001,
10, 0.1, 20, -0.0001,
100, 0.1, 20, -0.0001,
0.0001, 1, 20, -0.0001,
0.1, 1, 20, -0.0001,
1, 1, 20, -0.0001,
10, 1, 20, -0.0001,
100, 1, 20, -0.0001,
0.0001, -0.0001, 20, -0.0001,
0.1, -0.0001, 20, -0.0001,
1, -0.0001, 20, -0.0001,
10, -0.0001, 20, -0.0001,
100, -0.0001, 20, -0.0001,
0.0001, -0.01, 20, -0.0001,
0.1, -0.01, 20, -0.0001,
1, -0.01, 20, -0.0001,
10, -0.01, 20, -0.0001,
100, -0.01, 20, -0.0001,
0.0001, -0.1, 20, -0.0001,
0.1, -0.1, 20, -0.0001,
1, -0.1, 20, -0.0001,
10, -0.1, 20, -0.0001,
100, -0.1, 20, -0.0001,
0.0001, -1, 20, -0.0001,
0.1, -1, 20, -0.0001,
1, -1, 20, -0.0001,
10, -1, 20, -0.0001,
100, -1, 20, -0.0001,
0.0001, 0.0001, 30, 0.0001,
0.1, 0.0001, 30, 0.0001,
1, 0.0001, 30, 0.0001,
10, 0.0001, 30, 0.0001,
100, 0.0001, 30, 0.0001,
0.0001, 0.01, 30, 0.0001,
0.1, 0.01, 30, 0.0001,
1, 0.01, 30, 0.0001,
10, 0.01, 30, 0.0001,
100, 0.01, 30, 0.0001,
0.0001, 0.1, 30, 0.0001,
0.1, 0.1, 30, 0.0001,
1, 0.1, 30, 0.0001,
10, 0.1, 30, 0.0001,
100, 0.1, 30, 0.0001,
0.0001, 1, 30, 0.0001,
0.1, 1, 30, 0.0001,
1, 1, 30, 0.0001,
10, 1, 30, 0.0001,
100, 1, 30, 0.0001,
0.0001, -0.0001, 30, 0.0001,
0.1, -0.0001, 30, 0.0001,
1, -0.0001, 30, 0.0001,
10, -0.0001, 30, 0.0001,
100, -0.0001, 30, 0.0001,
0.0001, -0.01, 30, 0.0001,
0.1, -0.01, 30, 0.0001,
1, -0.01, 30, 0.0001,
10, -0.01, 30, 0.0001,
100, -0.01, 30, 0.0001,
0.0001, -0.1, 30, 0.0001,
0.1, -0.1, 30, 0.0001,
1, -0.1, 30, 0.0001,
10, -0.1, 30, 0.0001,
100, -0.1, 30, 0.0001,
0.0001, -1, 30, 0.0001,
0.1, -1, 30, 0.0001,
1, -1, 30, 0.0001,
10, -1, 30, 0.0001,
100, -1, 30, 0.0001,
0.0001, 0.0001, 30, 0.01,
0.1, 0.0001, 30, 0.01,
1, 0.0001, 30, 0.01,
10, 0.0001, 30, 0.01,
100, 0.0001, 30, 0.01,
0.0001, 0.01, 30, 0.01,
0.1, 0.01, 30, 0.01,
1, 0.01, 30, 0.01,
10, 0.01, 30, 0.01,
100, 0.01, 30, 0.01,
0.0001, 0.1, 30, 0.01,
0.1, 0.1, 30, 0.01,
1, 0.1, 30, 0.01,
10, 0.1, 30, 0.01,
100, 0.1, 30, 0.01,
0.0001, 1, 30, 0.01,
0.1, 1, 30, 0.01,
1, 1, 30, 0.01,
10, 1, 30, 0.01,
100, 1, 30, 0.01,
0.0001, -0.0001, 30, 0.01,
0.1, -0.0001, 30, 0.01,
1, -0.0001, 30, 0.01,
10, -0.0001, 30, 0.01,
100, -0.0001, 30, 0.01,
0.0001, -0.01, 30, 0.01,
0.1, -0.01, 30, 0.01,
1, -0.01, 30, 0.01,
10, -0.01, 30, 0.01,
100, -0.01, 30, 0.01,
0.0001, -0.1, 30, 0.01,
0.1, -0.1, 30, 0.01,
1, -0.1, 30, 0.01,
10, -0.1, 30, 0.01,
100, -0.1, 30, 0.01,
0.0001, -1, 30, 0.01,
0.1, -1, 30, 0.01,
1, -1, 30, 0.01,
10, -1, 30, 0.01,
100, -1, 30, 0.01,
0.0001, 0.0001, 30, 0.1,
0.1, 0.0001, 30, 0.1,
1, 0.0001, 30, 0.1,
10, 0.0001, 30, 0.1,
100, 0.0001, 30, 0.1,
0.0001, 0.01, 30, 0.1,
0.1, 0.01, 30, 0.1,
1, 0.01, 30, 0.1,
10, 0.01, 30, 0.1,
100, 0.01, 30, 0.1,
0.0001, 0.1, 30, 0.1,
0.1, 0.1, 30, 0.1,
1, 0.1, 30, 0.1,
10, 0.1, 30, 0.1,
100, 0.1, 30, 0.1,
0.0001, 1, 30, 0.1,
0.1, 1, 30, 0.1,
1, 1, 30, 0.1,
10, 1, 30, 0.1,
100, 1, 30, 0.1,
0.0001, -0.0001, 30, 0.1,
0.1, -0.0001, 30, 0.1,
1, -0.0001, 30, 0.1,
10, -0.0001, 30, 0.1,
100, -0.0001, 30, 0.1,
0.0001, -0.01, 30, 0.1,
0.1, -0.01, 30, 0.1,
1, -0.01, 30, 0.1,
10, -0.01, 30, 0.1,
100, -0.01, 30, 0.1,
0.0001, -0.1, 30, 0.1,
0.1, -0.1, 30, 0.1,
1, -0.1, 30, 0.1,
10, -0.1, 30, 0.1,
100, -0.1, 30, 0.1,
0.0001, -1, 30, 0.1,
0.1, -1, 30, 0.1,
1, -1, 30, 0.1,
10, -1, 30, 0.1,
100, -1, 30, 0.1,
0.0001, 0.0001, 30, 0.0001,
0.1, 0.0001, 30, 0.0001,
1, 0.0001, 30, 0.0001,
10, 0.0001, 30, 0.0001,
100, 0.0001, 30, 0.0001,
0.0001, 0.01, 30, 0.0001,
0.1, 0.01, 30, 0.0001,
1, 0.01, 30, 0.0001,
10, 0.01, 30, 0.0001,
100, 0.01, 30, 0.0001,
0.0001, 0.1, 30, 0.0001,
0.1, 0.1, 30, 0.0001,
1, 0.1, 30, 0.0001,
10, 0.1, 30, 0.0001,
100, 0.1, 30, 0.0001,
0.0001, 1, 30, 0.0001,
0.1, 1, 30, 0.0001,
1, 1, 30, 0.0001,
10, 1, 30, 0.0001,
100, 1, 30, 0.0001,
0.0001, -0.0001, 30, 0.0001,
0.1, -0.0001, 30, 0.0001,
1, -0.0001, 30, 0.0001,
10, -0.0001, 30, 0.0001,
100, -0.0001, 30, 0.0001,
0.0001, -0.01, 30, 0.0001,
0.1, -0.01, 30, 0.0001,
1, -0.01, 30, 0.0001,
10, -0.01, 30, 0.0001,
100, -0.01, 30, 0.0001,
0.0001, -0.1, 30, 0.0001,
0.1, -0.1, 30, 0.0001,
1, -0.1, 30, 0.0001,
10, -0.1, 30, 0.0001,
100, -0.1, 30, 0.0001,
0.0001, -1, 30, 0.0001,
0.1, -1, 30, 0.0001,
1, -1, 30, 0.0001,
10, -1, 30, 0.0001,
100, -1, 30, 0.0001,
0.0001, 0.0001, 30, -0.0001,
0.1, 0.0001, 30, -0.0001,
1, 0.0001, 30, -0.0001,
10, 0.0001, 30, -0.0001,
100, 0.0001, 30, -0.0001,
0.0001, 0.01, 30, -0.0001,
0.1, 0.01, 30, -0.0001,
1, 0.01, 30, -0.0001,
10, 0.01, 30, -0.0001,
100, 0.01, 30, -0.0001,
0.0001, 0.1, 30, -0.0001,
0.1, 0.1, 30, -0.0001,
1, 0.1, 30, -0.0001,
10, 0.1, 30, -0.0001,
100, 0.1, 30, -0.0001,
0.0001, 1, 30, -0.0001,
0.1, 1, 30, -0.0001,
1, 1, 30, -0.0001,
10, 1, 30, -0.0001,
100, 1, 30, -0.0001,
0.0001, -0.0001, 30, -0.0001,
0.1, -0.0001, 30, -0.0001,
1, -0.0001, 30, -0.0001,
10, -0.0001, 30, -0.0001,
100, -0.0001, 30, -0.0001,
0.0001, -0.01, 30, -0.0001,
0.1, -0.01, 30, -0.0001,
1, -0.01, 30, -0.0001,
10, -0.01, 30, -0.0001,
100, -0.01, 30, -0.0001,
0.0001, -0.1, 30, -0.0001,
0.1, -0.1, 30, -0.0001,
1, -0.1, 30, -0.0001,
10, -0.1, 30, -0.0001,
100, -0.1, 30, -0.0001,
0.0001, -1, 30, -0.0001,
0.1, -1, 30, -0.0001,
1, -1, 30, -0.0001,
10, -1, 30, -0.0001,
100, -1, 30, -0.0001,
0.0001, 0.0001, 30, -0.01,
0.1, 0.0001, 30, -0.01,
1, 0.0001, 30, -0.01,
10, 0.0001, 30, -0.01,
100, 0.0001, 30, -0.01,
0.0001, 0.01, 30, -0.01,
0.1, 0.01, 30, -0.01,
1, 0.01, 30, -0.01,
10, 0.01, 30, -0.01,
100, 0.01, 30, -0.01,
0.0001, 0.1, 30, -0.01,
0.1, 0.1, 30, -0.01,
1, 0.1, 30, -0.01,
10, 0.1, 30, -0.01,
100, 0.1, 30, -0.01,
0.0001, 1, 30, -0.01,
0.1, 1, 30, -0.01,
1, 1, 30, -0.01,
10, 1, 30, -0.01,
100, 1, 30, -0.01,
0.0001, -0.0001, 30, -0.01,
0.1, -0.0001, 30, -0.01,
1, -0.0001, 30, -0.01,
10, -0.0001, 30, -0.01,
100, -0.0001, 30, -0.01,
0.0001, -0.01, 30, -0.01,
0.1, -0.01, 30, -0.01,
1, -0.01, 30, -0.01,
10, -0.01, 30, -0.01,
100, -0.01, 30, -0.01,
0.0001, -0.1, 30, -0.01,
0.1, -0.1, 30, -0.01,
1, -0.1, 30, -0.01,
10, -0.1, 30, -0.01,
100, -0.1, 30, -0.01,
0.0001, -1, 30, -0.01,
0.1, -1, 30, -0.01,
1, -1, 30, -0.01,
10, -1, 30, -0.01,
100, -1, 30, -0.01,
0.0001, 0.0001, 30, -0.1,
0.1, 0.0001, 30, -0.1,
1, 0.0001, 30, -0.1,
10, 0.0001, 30, -0.1,
100, 0.0001, 30, -0.1,
0.0001, 0.01, 30, -0.1,
0.1, 0.01, 30, -0.1,
1, 0.01, 30, -0.1,
10, 0.01, 30, -0.1,
100, 0.01, 30, -0.1,
0.0001, 0.1, 30, -0.1,
0.1, 0.1, 30, -0.1,
1, 0.1, 30, -0.1,
10, 0.1, 30, -0.1,
100, 0.1, 30, -0.1,
0.0001, 1, 30, -0.1,
0.1, 1, 30, -0.1,
1, 1, 30, -0.1,
10, 1, 30, -0.1,
100, 1, 30, -0.1,
0.0001, -0.0001, 30, -0.1,
0.1, -0.0001, 30, -0.1,
1, -0.0001, 30, -0.1,
10, -0.0001, 30, -0.1,
100, -0.0001, 30, -0.1,
0.0001, -0.01, 30, -0.1,
0.1, -0.01, 30, -0.1,
1, -0.01, 30, -0.1,
10, -0.01, 30, -0.1,
100, -0.01, 30, -0.1,
0.0001, -0.1, 30, -0.1,
0.1, -0.1, 30, -0.1,
1, -0.1, 30, -0.1,
10, -0.1, 30, -0.1,
100, -0.1, 30, -0.1,
0.0001, -1, 30, -0.1,
0.1, -1, 30, -0.1,
1, -1, 30, -0.1,
10, -1, 30, -0.1,
100, -1, 30, -0.1,
0.0001, 0.0001, 30, -0.0001,
0.1, 0.0001, 30, -0.0001,
1, 0.0001, 30, -0.0001,
10, 0.0001, 30, -0.0001,
100, 0.0001, 30, -0.0001,
0.0001, 0.01, 30, -0.0001,
0.1, 0.01, 30, -0.0001,
1, 0.01, 30, -0.0001,
10, 0.01, 30, -0.0001,
100, 0.01, 30, -0.0001,
0.0001, 0.1, 30, -0.0001,
0.1, 0.1, 30, -0.0001,
1, 0.1, 30, -0.0001,
10, 0.1, 30, -0.0001,
100, 0.1, 30, -0.0001,
0.0001, 1, 30, -0.0001,
0.1, 1, 30, -0.0001,
1, 1, 30, -0.0001,
10, 1, 30, -0.0001,
100, 1, 30, -0.0001,
0.0001, -0.0001, 30, -0.0001,
0.1, -0.0001, 30, -0.0001,
1, -0.0001, 30, -0.0001,
10, -0.0001, 30, -0.0001,
100, -0.0001, 30, -0.0001,
0.0001, -0.01, 30, -0.0001,
0.1, -0.01, 30, -0.0001,
1, -0.01, 30, -0.0001,
10, -0.01, 30, -0.0001,
100, -0.01, 30, -0.0001,
0.0001, -0.1, 30, -0.0001,
0.1, -0.1, 30, -0.0001,
1, -0.1, 30, -0.0001,
10, -0.1, 30, -0.0001,
100, -0.1, 30, -0.0001,
0.0001, -1, 30, -0.0001,
0.1, -1, 30, -0.0001,
1, -1, 30, -0.0001,
10, -1, 30, -0.0001,
100, -1, 30, -0.0001,
0.0001, 0.0001, 40, 0.0001,
0.1, 0.0001, 40, 0.0001,
1, 0.0001, 40, 0.0001,
10, 0.0001, 40, 0.0001,
100, 0.0001, 40, 0.0001,
0.0001, 0.01, 40, 0.0001,
0.1, 0.01, 40, 0.0001,
1, 0.01, 40, 0.0001,
10, 0.01, 40, 0.0001,
100, 0.01, 40, 0.0001,
0.0001, 0.1, 40, 0.0001,
0.1, 0.1, 40, 0.0001,
1, 0.1, 40, 0.0001,
10, 0.1, 40, 0.0001,
100, 0.1, 40, 0.0001,
0.0001, 1, 40, 0.0001,
0.1, 1, 40, 0.0001,
1, 1, 40, 0.0001,
10, 1, 40, 0.0001,
100, 1, 40, 0.0001,
0.0001, -0.0001, 40, 0.0001,
0.1, -0.0001, 40, 0.0001,
1, -0.0001, 40, 0.0001,
10, -0.0001, 40, 0.0001,
100, -0.0001, 40, 0.0001,
0.0001, -0.01, 40, 0.0001,
0.1, -0.01, 40, 0.0001,
1, -0.01, 40, 0.0001,
10, -0.01, 40, 0.0001,
100, -0.01, 40, 0.0001,
0.0001, -0.1, 40, 0.0001,
0.1, -0.1, 40, 0.0001,
1, -0.1, 40, 0.0001,
10, -0.1, 40, 0.0001,
100, -0.1, 40, 0.0001,
0.0001, -1, 40, 0.0001,
0.1, -1, 40, 0.0001,
1, -1, 40, 0.0001,
10, -1, 40, 0.0001,
100, -1, 40, 0.0001,
0.0001, 0.0001, 40, 0.01,
0.1, 0.0001, 40, 0.01,
1, 0.0001, 40, 0.01,
10, 0.0001, 40, 0.01,
100, 0.0001, 40, 0.01,
0.0001, 0.01, 40, 0.01,
0.1, 0.01, 40, 0.01,
1, 0.01, 40, 0.01,
10, 0.01, 40, 0.01,
100, 0.01, 40, 0.01,
0.0001, 0.1, 40, 0.01,
0.1, 0.1, 40, 0.01,
1, 0.1, 40, 0.01,
10, 0.1, 40, 0.01,
100, 0.1, 40, 0.01,
0.0001, 1, 40, 0.01,
0.1, 1, 40, 0.01,
1, 1, 40, 0.01,
10, 1, 40, 0.01,
100, 1, 40, 0.01,
0.0001, -0.0001, 40, 0.01,
0.1, -0.0001, 40, 0.01,
1, -0.0001, 40, 0.01,
10, -0.0001, 40, 0.01,
100, -0.0001, 40, 0.01,
0.0001, -0.01, 40, 0.01,
0.1, -0.01, 40, 0.01,
1, -0.01, 40, 0.01,
10, -0.01, 40, 0.01,
100, -0.01, 40, 0.01,
0.0001, -0.1, 40, 0.01,
0.1, -0.1, 40, 0.01,
1, -0.1, 40, 0.01,
10, -0.1, 40, 0.01,
100, -0.1, 40, 0.01,
0.0001, -1, 40, 0.01,
0.1, -1, 40, 0.01,
1, -1, 40, 0.01,
10, -1, 40, 0.01,
100, -1, 40, 0.01,
0.0001, 0.0001, 40, 0.1,
0.1, 0.0001, 40, 0.1,
1, 0.0001, 40, 0.1,
10, 0.0001, 40, 0.1,
100, 0.0001, 40, 0.1,
0.0001, 0.01, 40, 0.1,
0.1, 0.01, 40, 0.1,
1, 0.01, 40, 0.1,
10, 0.01, 40, 0.1,
100, 0.01, 40, 0.1,
0.0001, 0.1, 40, 0.1,
0.1, 0.1, 40, 0.1,
1, 0.1, 40, 0.1,
10, 0.1, 40, 0.1,
100, 0.1, 40, 0.1,
0.0001, 1, 40, 0.1,
0.1, 1, 40, 0.1,
1, 1, 40, 0.1,
10, 1, 40, 0.1,
100, 1, 40, 0.1,
0.0001, -0.0001, 40, 0.1,
0.1, -0.0001, 40, 0.1,
1, -0.0001, 40, 0.1,
10, -0.0001, 40, 0.1,
100, -0.0001, 40, 0.1,
0.0001, -0.01, 40, 0.1,
0.1, -0.01, 40, 0.1,
1, -0.01, 40, 0.1,
10, -0.01, 40, 0.1,
100, -0.01, 40, 0.1,
0.0001, -0.1, 40, 0.1,
0.1, -0.1, 40, 0.1,
1, -0.1, 40, 0.1,
10, -0.1, 40, 0.1,
100, -0.1, 40, 0.1,
0.0001, -1, 40, 0.1,
0.1, -1, 40, 0.1,
1, -1, 40, 0.1,
10, -1, 40, 0.1,
100, -1, 40, 0.1,
0.0001, 0.0001, 40, 0.0001,
0.1, 0.0001, 40, 0.0001,
1, 0.0001, 40, 0.0001,
10, 0.0001, 40, 0.0001,
100, 0.0001, 40, 0.0001,
0.0001, 0.01, 40, 0.0001,
0.1, 0.01, 40, 0.0001,
1, 0.01, 40, 0.0001,
10, 0.01, 40, 0.0001,
100, 0.01, 40, 0.0001,
0.0001, 0.1, 40, 0.0001,
0.1, 0.1, 40, 0.0001,
1, 0.1, 40, 0.0001,
10, 0.1, 40, 0.0001,
100, 0.1, 40, 0.0001,
0.0001, 1, 40, 0.0001,
0.1, 1, 40, 0.0001,
1, 1, 40, 0.0001,
10, 1, 40, 0.0001,
100, 1, 40, 0.0001,
0.0001, -0.0001, 40, 0.0001,
0.1, -0.0001, 40, 0.0001,
1, -0.0001, 40, 0.0001,
10, -0.0001, 40, 0.0001,
100, -0.0001, 40, 0.0001,
0.0001, -0.01, 40, 0.0001,
0.1, -0.01, 40, 0.0001,
1, -0.01, 40, 0.0001,
10, -0.01, 40, 0.0001,
100, -0.01, 40, 0.0001,
0.0001, -0.1, 40, 0.0001,
0.1, -0.1, 40, 0.0001,
1, -0.1, 40, 0.0001,
10, -0.1, 40, 0.0001,
100, -0.1, 40, 0.0001,
0.0001, -1, 40, 0.0001,
0.1, -1, 40, 0.0001,
1, -1, 40, 0.0001,
10, -1, 40, 0.0001,
100, -1, 40, 0.0001,
0.0001, 0.0001, 40, -0.0001,
0.1, 0.0001, 40, -0.0001,
1, 0.0001, 40, -0.0001,
10, 0.0001, 40, -0.0001,
100, 0.0001, 40, -0.0001,
0.0001, 0.01, 40, -0.0001,
0.1, 0.01, 40, -0.0001,
1, 0.01, 40, -0.0001,
10, 0.01, 40, -0.0001,
100, 0.01, 40, -0.0001,
0.0001, 0.1, 40, -0.0001,
0.1, 0.1, 40, -0.0001,
1, 0.1, 40, -0.0001,
10, 0.1, 40, -0.0001,
100, 0.1, 40, -0.0001,
0.0001, 1, 40, -0.0001,
0.1, 1, 40, -0.0001,
1, 1, 40, -0.0001,
10, 1, 40, -0.0001,
100, 1, 40, -0.0001,
0.0001, -0.0001, 40, -0.0001,
0.1, -0.0001, 40, -0.0001,
1, -0.0001, 40, -0.0001,
10, -0.0001, 40, -0.0001,
100, -0.0001, 40, -0.0001,
0.0001, -0.01, 40, -0.0001,
0.1, -0.01, 40, -0.0001,
1, -0.01, 40, -0.0001,
10, -0.01, 40, -0.0001,
100, -0.01, 40, -0.0001,
0.0001, -0.1, 40, -0.0001,
0.1, -0.1, 40, -0.0001,
1, -0.1, 40, -0.0001,
10, -0.1, 40, -0.0001,
100, -0.1, 40, -0.0001,
0.0001, -1, 40, -0.0001,
0.1, -1, 40, -0.0001,
1, -1, 40, -0.0001,
10, -1, 40, -0.0001,
100, -1, 40, -0.0001,
0.0001, 0.0001, 40, -0.01,
0.1, 0.0001, 40, -0.01,
1, 0.0001, 40, -0.01,
10, 0.0001, 40, -0.01,
100, 0.0001, 40, -0.01,
0.0001, 0.01, 40, -0.01,
0.1, 0.01, 40, -0.01,
1, 0.01, 40, -0.01,
10, 0.01, 40, -0.01,
100, 0.01, 40, -0.01,
0.0001, 0.1, 40, -0.01,
0.1, 0.1, 40, -0.01,
1, 0.1, 40, -0.01,
10, 0.1, 40, -0.01,
100, 0.1, 40, -0.01,
0.0001, 1, 40, -0.01,
0.1, 1, 40, -0.01,
1, 1, 40, -0.01,
10, 1, 40, -0.01,
100, 1, 40, -0.01,
0.0001, -0.0001, 40, -0.01,
0.1, -0.0001, 40, -0.01,
1, -0.0001, 40, -0.01,
10, -0.0001, 40, -0.01,
100, -0.0001, 40, -0.01,
0.0001, -0.01, 40, -0.01,
0.1, -0.01, 40, -0.01,
1, -0.01, 40, -0.01,
10, -0.01, 40, -0.01,
100, -0.01, 40, -0.01,
0.0001, -0.1, 40, -0.01,
0.1, -0.1, 40, -0.01,
1, -0.1, 40, -0.01,
10, -0.1, 40, -0.01,
100, -0.1, 40, -0.01,
0.0001, -1, 40, -0.01,
0.1, -1, 40, -0.01,
1, -1, 40, -0.01,
10, -1, 40, -0.01,
100, -1, 40, -0.01,
0.0001, 0.0001, 40, -0.1,
0.1, 0.0001, 40, -0.1,
1, 0.0001, 40, -0.1,
10, 0.0001, 40, -0.1,
100, 0.0001, 40, -0.1,
0.0001, 0.01, 40, -0.1,
0.1, 0.01, 40, -0.1,
1, 0.01, 40, -0.1,
10, 0.01, 40, -0.1,
100, 0.01, 40, -0.1,
0.0001, 0.1, 40, -0.1,
0.1, 0.1, 40, -0.1,
1, 0.1, 40, -0.1,
10, 0.1, 40, -0.1,
100, 0.1, 40, -0.1,
0.0001, 1, 40, -0.1,
0.1, 1, 40, -0.1,
1, 1, 40, -0.1,
10, 1, 40, -0.1,
100, 1, 40, -0.1,
0.0001, -0.0001, 40, -0.1,
0.1, -0.0001, 40, -0.1,
1, -0.0001, 40, -0.1,
10, -0.0001, 40, -0.1,
100, -0.0001, 40, -0.1,
0.0001, -0.01, 40, -0.1,
0.1, -0.01, 40, -0.1,
1, -0.01, 40, -0.1,
10, -0.01, 40, -0.1,
100, -0.01, 40, -0.1,
0.0001, -0.1, 40, -0.1,
0.1, -0.1, 40, -0.1,
1, -0.1, 40, -0.1,
10, -0.1, 40, -0.1,
100, -0.1, 40, -0.1,
0.0001, -1, 40, -0.1,
0.1, -1, 40, -0.1,
1, -1, 40, -0.1,
10, -1, 40, -0.1,
100, -1, 40, -0.1,
0.0001, 0.0001, 40, -0.0001,
0.1, 0.0001, 40, -0.0001,
1, 0.0001, 40, -0.0001,
10, 0.0001, 40, -0.0001,
100, 0.0001, 40, -0.0001,
0.0001, 0.01, 40, -0.0001,
0.1, 0.01, 40, -0.0001,
1, 0.01, 40, -0.0001,
10, 0.01, 40, -0.0001,
100, 0.01, 40, -0.0001,
0.0001, 0.1, 40, -0.0001,
0.1, 0.1, 40, -0.0001,
1, 0.1, 40, -0.0001,
10, 0.1, 40, -0.0001,
100, 0.1, 40, -0.0001,
0.0001, 1, 40, -0.0001,
0.1, 1, 40, -0.0001,
1, 1, 40, -0.0001,
10, 1, 40, -0.0001,
100, 1, 40, -0.0001,
0.0001, -0.0001, 40, -0.0001,
0.1, -0.0001, 40, -0.0001,
1, -0.0001, 40, -0.0001,
10, -0.0001, 40, -0.0001,
100, -0.0001, 40, -0.0001,
0.0001, -0.01, 40, -0.0001,
0.1, -0.01, 40, -0.0001,
1, -0.01, 40, -0.0001,
10, -0.01, 40, -0.0001,
100, -0.01, 40, -0.0001,
0.0001, -0.1, 40, -0.0001,
0.1, -0.1, 40, -0.0001,
1, -0.1, 40, -0.0001,
10, -0.1, 40, -0.0001,
100, -0.1, 40, -0.0001,
0.0001, -1, 40, -0.0001,
0.1, -1, 40, -0.0001,
1, -1, 40, -0.0001,
10, -1, 40, -0.0001,
100, -1, 40, -0.0001
)
p_starting <- matrix(p_matrix, length(p_matrix)/4, 4, byrow=TRUE)
result_matrix <- matrix(NA, nrow(p_starting), 5)
result_matrix[,1:4] <- p_starting
}
if(MODEL == "BM_quadratic"){
p_matrix <- c( #order here is b, c, a b and a may be negative
0.000000001, 100, 3,
0.000000001, 10, 3,
0.000000001, 1, 3,
0.000000001, 0.1, 3,
0.000000001, 0.0000001, 3,
0.000000001, -0.1, 3,
0.000000001, -1, 3,
0.000000001, -10, 3,
0.000000001, -100, 3,
0.000000001, -1000, 3,
0.001, 100, 3,
0.001, 10, 3,
0.001, 1, 3,
0.001, 0.1, 3,
0.001, 0.0000001, 3,
0.001, -0.1, 3,
0.001, -1, 3,
0.001, -10, 3,
0.001, -100, 3,
0.001, -1000, 3,
0.01, 100, 3,
0.01, 10, 3,
0.01, 1, 3,
0.01, 0.1, 3,
0.01, 0.0000001, 3,
0.01, -0.1, 3,
0.01, -1, 3,
0.01, -10, 3,
0.01, -100, 3,
0.01, -1000, 3,
0.1, 100, 3,
0.1, 10, 3,
0.1, 1, 3,
0.1, 0.1, 3,
0.1, 0.0000001, 3,
0.1, -0.1, 3,
0.1, -1, 3,
0.1, -10, 3,
0.1, -100, 3,
0.1, -1000, 3,
1, 100, 3,
1, 10, 3,
1, 1, 3,
1, 0.1, 3,
1, 0.0000001, 3,
1, -0.1, 3,
1, -1, 3,
1, -10, 3,
1, -100, 3,
1, -1000, 3,
10, 100, 3,
10, 10, 3,
10, 1, 3,
10, 0.1, 3,
10, 0.0000001, 3,
10, -0.1, 3,
10, -1, 3,
10, -10, 3,
10, -100, 3,
10, -1000, 3,
100, 100, 3,
100, 10, 3,
100, 1, 3,
100, 0.1, 3,
100, 0.0000001, 3,
100, -0.1, 3,
100, -1, 3,
100, -10, 3,
100, -100, 3,
100, -1000, 3,
0.000000001, 100, 1,
0.000000001, 10, 1,
0.000000001, 1, 1,
0.000000001, 0.1, 1,
0.000000001, 0.0000001, 1,
0.000000001, -0.1, 1,
0.000000001, -1, 1,
0.000000001, -10, 1,
0.000000001, -100, 1,
0.000000001, -1000, 1,
0.001, 100, 1,
0.001, 10, 1,
0.001, 1, 1,
0.001, 0.1, 1,
0.001, 0.0000001, 1,
0.001, -0.1, 1,
0.001, -1, 1,
0.001, -10, 1,
0.001, -100, 1,
0.001, -1000, 1,
0.01, 100, 1,
0.01, 10, 1,
0.01, 1, 1,
0.01, 0.1, 1,
0.01, 0.0000001, 1,
0.01, -0.1, 1,
0.01, -1, 1,
0.01, -10, 1,
0.01, -100, 1,
0.01, -1000, 1,
0.1, 100, 1,
0.1, 10, 1,
0.1, 1, 1,
0.1, 0.1, 1,
0.1, 0.0000001, 1,
0.1, -0.1, 1,
0.1, -1, 1,
0.1, -10, 1,
0.1, -100, 1,
0.1, -1000, 1,
1, 100, 1,
1, 10, 1,
1, 1, 1,
1, 0.1, 1,
1, 0.0000001, 1,
1, -0.1, 1,
1, -1, 1,
1, -10, 1,
1, -100, 1,
1, -1000, 1,
10, 100, 1,
10, 10, 1,
10, 1, 1,
10, 0.1, 1,
10, 0.0000001, 1,
10, -0.1, 1,
10, -1, 1,
10, -10, 1,
10, -100, 1,
10, -1000, 1,
100, 100, 1,
100, 10, 1,
100, 1, 1,
100, 0.1, 1,
100, 0.0000001, 1,
100, -0.1, 1,
100, -1, 1,
100, -10, 1,
100, -100, 1,
100, -1000, 1,
0.000000001, 100, 0.1,
0.000000001, 10, 0.1,
0.000000001, 1, 0.1,
0.000000001, 0.1, 0.1,
0.000000001, 0.0000001, 0.1,
0.000000001, -0.1, 0.1,
0.000000001, -1, 0.1,
0.000000001, -10, 0.1,
0.000000001, -100, 0.1,
0.000000001, -1000, 0.1,
0.001, 100, 0.1,
0.001, 10, 0.1,
0.001, 1, 0.1,
0.001, 0.1, 0.1,
0.001, 0.0000001, 0.1,
0.001, -0.1, 0.1,
0.001, -1, 0.1,
0.001, -10, 0.1,
0.001, -100, 0.1,
0.001, -1000, 0.1,
0.01, 100, 0.1,
0.01, 10, 0.1,
0.01, 1, 0.1,
0.01, 0.1, 0.1,
0.01, 0.0000001, 0.1,
0.01, -0.1, 0.1,
0.01, -1, 0.1,
0.01, -10, 0.1,
0.01, -100, 0.1,
0.01, -1000, 0.1,
0.1, 100, 0.1,
0.1, 10, 0.1,
0.1, 1, 0.1,
0.1, 0.1, 0.1,
0.1, 0.0000001, 0.1,
0.1, -0.1, 0.1,
0.1, -1, 0.1,
0.1, -10, 0.1,
0.1, -100, 0.1,
0.1, -1000, 0.1,
1, 100, 0.1,
1, 10, 0.1,
1, 1, 0.1,
1, 0.1, 0.1,
1, 0.0000001, 0.1,
1, -0.1, 0.1,
1, -1, 0.1,
1, -10, 0.1,
1, -100, 0.1,
1, -1000, 0.1,
10, 100, 0.1,
10, 10, 0.1,
10, 1, 0.1,
10, 0.1, 0.1,
10, 0.0000001, 0.1,
10, -0.1, 0.1,
10, -1, 0.1,
10, -10, 0.1,
10, -100, 0.1,
10, -1000, 0.1,
100, 100, 0.1,
100, 10, 0.1,
100, 1, 0.1,
100, 0.1, 0.1,
100, 0.0000001, 0.1,
100, -0.1, 0.1,
100, -1, 0.1,
100, -10, 0.1,
100, -100, 0.1,
100, -1000, 0.1,
0.000000001, 100, 0.001,
0.000000001, 10, 0.001,
0.000000001, 1, 0.001,
0.000000001, 0.1, 0.001,
0.000000001, 0.0000001, 0.001,
0.000000001, -0.1, 0.001,
0.000000001, -1, 0.001,
0.000000001, -10, 0.001,
0.000000001, -100, 0.001,
0.000000001, -1000, 0.001,
0.001, 100, 0.001,
0.001, 10, 0.001,
0.001, 1, 0.001,
0.001, 0.1, 0.001,
0.001, 0.0000001, 0.001,
0.001, -0.1, 0.001,
0.001, -1, 0.001,
0.001, -10, 0.001,
0.001, -100, 0.001,
0.001, -1000, 0.001,
0.01, 100, 0.001,
0.01, 10, 0.001,
0.01, 1, 0.001,
0.01, 0.1, 0.001,
0.01, 0.0000001, 0.001,
0.01, -0.1, 0.001,
0.01, -1, 0.001,
0.01, -10, 0.001,
0.01, -100, 0.001,
0.01, -1000, 0.001,
0.1, 100, 0.001,
0.1, 10, 0.001,
0.1, 1, 0.001,
0.1, 0.1, 0.001,
0.1, 0.0000001, 0.001,
0.1, -0.1, 0.001,
0.1, -1, 0.001,
0.1, -10, 0.001,
0.1, -100, 0.001,
0.1, -1000, 0.001,
1, 100, 0.001,
1, 10, 0.001,
1, 1, 0.001,
1, 0.1, 0.001,
1, 0.0000001, 0.001,
1, -0.1, 0.001,
1, -1, 0.001,
1, -10, 0.001,
1, -100, 0.001,
1, -1000, 0.001,
10, 100, 0.001,
10, 10, 0.001,
10, 1, 0.001,
10, 0.1, 0.001,
10, 0.0000001, 0.001,
10, -0.1, 0.001,
10, -1, 0.001,
10, -10, 0.001,
10, -100, 0.001,
10, -1000, 0.001,
100, 100, 0.001,
100, 10, 0.001,
100, 1, 0.001,
100, 0.1, 0.001,
100, 0.0000001, 0.001,
100, -0.1, 0.001,
100, -1, 0.001,
100, -10, 0.001,
100, -100, 0.001,
100, -1000, 0.001,
0.000000001, 100, 0.000000001,
0.000000001, 10, 0.000000001,
0.000000001, 1, 0.000000001,
0.000000001, 0.1, 0.000000001,
0.000000001, 0.0000001, 0.000000001,
0.000000001, -0.1, 0.000000001,
0.000000001, -1, 0.000000001,
0.000000001, -10, 0.000000001,
0.000000001, -100, 0.000000001,
0.000000001, -1000, 0.000000001,
0.001, 100, 0.000000001,
0.001, 10, 0.000000001,
0.001, 1, 0.000000001,
0.001, 0.1, 0.000000001,
0.001, 0.0000001, 0.000000001,
0.001, -0.1, 0.000000001,
0.001, -1, 0.000000001,
0.001, -10, 0.000000001,
0.001, -100, 0.000000001,
0.001, -1000, 0.000000001,
0.01, 100, 0.000000001,
0.01, 10, 0.000000001,
0.01, 1, 0.000000001,
0.01, 0.1, 0.000000001,
0.01, 0.0000001, 0.000000001,
0.01, -0.1, 0.000000001,
0.01, -1, 0.000000001,
0.01, -10, 0.000000001,
0.01, -100, 0.000000001,
0.01, -1000, 0.000000001,
0.1, 100, 0.000000001,
0.1, 10, 0.000000001,
0.1, 1, 0.000000001,
0.1, 0.1, 0.000000001,
0.1, 0.0000001, 0.000000001,
0.1, -0.1, 0.000000001,
0.1, -1, 0.000000001,
0.1, -10, 0.000000001,
0.1, -100, 0.000000001,
0.1, -1000, 0.000000001,
1, 100, 0.000000001,
1, 10, 0.000000001,
1, 1, 0.000000001,
1, 0.1, 0.000000001,
1, 0.0000001, 0.000000001,
1, -0.1, 0.000000001,
1, -1, 0.000000001,
1, -10, 0.000000001,
1, -100, 0.000000001,
1, -1000, 0.000000001,
10, 100, 0.000000001,
10, 10, 0.000000001,
10, 1, 0.000000001,
10, 0.1, 0.000000001,
10, 0.0000001, 0.000000001,
10, -0.1, 0.000000001,
10, -1, 0.000000001,
10, -10, 0.000000001,
10, -100, 0.000000001,
10, -1000, 0.000000001,
100, 100, 0.000000001,
100, 10, 0.000000001,
100, 1, 0.000000001,
100, 0.1, 0.000000001,
100, 0.0000001, 0.000000001,
100, -0.1, 0.000000001,
100, -1, 0.000000001,
100, -10, 0.000000001,
100, -100, 0.000000001,
100, -1000, 0.000000001,
0.000000001, 100, -0.001,
0.000000001, 10, -0.001,
0.000000001, 1, -0.001,
0.000000001, 0.1, -0.001,
0.000000001, 0.0000001, -0.001,
0.000000001, -0.1, -0.001,
0.000000001, -1, -0.001,
0.000000001, -10, -0.001,
0.000000001, -100, -0.001,
0.000000001, -1000, -0.001,
0.001, 100, -0.001,
0.001, 10, -0.001,
0.001, 1, -0.001,
0.001, 0.1, -0.001,
0.001, 0.0000001, -0.001,
0.001, -0.1, -0.001,
0.001, -1, -0.001,
0.001, -10, -0.001,
0.001, -100, -0.001,
0.001, -1000, -0.001,
0.01, 100, -0.001,
0.01, 10, -0.001,
0.01, 1, -0.001,
0.01, 0.1, -0.001,
0.01, 0.0000001, -0.001,
0.01, -0.1, -0.001,
0.01, -1, -0.001,
0.01, -10, -0.001,
0.01, -100, -0.001,
0.01, -1000, -0.001,
0.1, 100, -0.001,
0.1, 10, -0.001,
0.1, 1, -0.001,
0.1, 0.1, -0.001,
0.1, 0.0000001, -0.001,
0.1, -0.1, -0.001,
0.1, -1, -0.001,
0.1, -10, -0.001,
0.1, -100, -0.001,
0.1, -1000, -0.001,
1, 100, -0.001,
1, 10, -0.001,
1, 1, -0.001,
1, 0.1, -0.001,
1, 0.0000001, -0.001,
1, -0.1, -0.001,
1, -1, -0.001,
1, -10, -0.001,
1, -100, -0.001,
1, -1000, -0.001,
10, 100, -0.001,
10, 10, -0.001,
10, 1, -0.001,
10, 0.1, -0.001,
10, 0.0000001, -0.001,
10, -0.1, -0.001,
10, -1, -0.001,
10, -10, -0.001,
10, -100, -0.001,
10, -1000, -0.001,
100, 100, -0.001,
100, 10, -0.001,
100, 1, -0.001,
100, 0.1, -0.001,
100, 0.0000001, -0.001,
100, -0.1, -0.001,
100, -1, -0.001,
100, -10, -0.001,
100, -100, -0.001,
100, -1000, -0.001,
0.000000001, 100, -0.01,
0.000000001, 10, -0.01,
0.000000001, 1, -0.01,
0.000000001, 0.1, -0.01,
0.000000001, 0.0000001, -0.01,
0.000000001, -0.1, -0.01,
0.000000001, -1, -0.01,
0.000000001, -10, -0.01,
0.000000001, -100, -0.01,
0.000000001, -1000, -0.01,
0.001, 100, -0.01,
0.001, 10, -0.01,
0.001, 1, -0.01,
0.001, 0.1, -0.01,
0.001, 0.0000001, -0.01,
0.001, -0.1, -0.01,
0.001, -1, -0.01,
0.001, -10, -0.01,
0.001, -100, -0.01,
0.001, -1000, -0.01,
0.01, 100, -0.01,
0.01, 10, -0.01,
0.01, 1, -0.01,
0.01, 0.1, -0.01,
0.01, 0.0000001, -0.01,
0.01, -0.1, -0.01,
0.01, -1, -0.01,
0.01, -10, -0.01,
0.01, -100, -0.01,
0.01, -1000, -0.01,
0.1, 100, -0.01,
0.1, 10, -0.01,
0.1, 1, -0.01,
0.1, 0.1, -0.01,
0.1, 0.0000001, -0.01,
0.1, -0.1, -0.01,
0.1, -1, -0.01,
0.1, -10, -0.01,
0.1, -100, -0.01,
0.1, -1000, -0.01,
1, 100, -0.01,
1, 10, -0.01,
1, 1, -0.01,
1, 0.1, -0.01,
1, 0.0000001, -0.01,
1, -0.1, -0.01,
1, -1, -0.01,
1, -10, -0.01,
1, -100, -0.01,
1, -1000, -0.01,
10, 100, -0.01,
10, 10, -0.01,
10, 1, -0.01,
10, 0.1, -0.01,
10, 0.0000001, -0.01,
10, -0.1, -0.01,
10, -1, -0.01,
10, -10, -0.01,
10, -100, -0.01,
10, -1000, -0.01,
100, 100, -0.01,
100, 10, -0.01,
100, 1, -0.01,
100, 0.1, -0.01,
100, 0.0000001, -0.01,
100, -0.1, -0.01,
100, -1, -0.01,
100, -10, -0.01,
100, -100, -0.01,
100, -1000, -0.01,
0.000000001, 100, -0.1,
0.000000001, 10, -0.1,
0.000000001, 1, -0.1,
0.000000001, 0.1, -0.1,
0.000000001, 0.0000001, -0.1,
0.000000001, -0.1, -0.1,
0.000000001, -1, -0.1,
0.000000001, -10, -0.1,
0.000000001, -100, -0.1,
0.000000001, -1000, -0.1,
0.001, 100, -0.1,
0.001, 10, -0.1,
0.001, 1, -0.1,
0.001, 0.1, -0.1,
0.001, 0.0000001, -0.1,
0.001, -0.1, -0.1,
0.001, -1, -0.1,
0.001, -10, -0.1,
0.001, -100, -0.1,
0.001, -1000, -0.1,
0.01, 100, -0.1,
0.01, 10, -0.1,
0.01, 1, -0.1,
0.01, 0.1, -0.1,
0.01, 0.0000001, -0.1,
0.01, -0.1, -0.1,
0.01, -1, -0.1,
0.01, -10, -0.1,
0.01, -100, -0.1,
0.01, -1000, -0.1,
0.1, 100, -0.1,
0.1, 10, -0.1,
0.1, 1, -0.1,
0.1, 0.1, -0.1,
0.1, 0.0000001, -0.1,
0.1, -0.1, -0.1,
0.1, -1, -0.1,
0.1, -10, -0.1,
0.1, -100, -0.1,
0.1, -1000, -0.1,
1, 100, -0.1,
1, 10, -0.1,
1, 1, -0.1,
1, 0.1, -0.1,
1, 0.0000001, -0.1,
1, -0.1, -0.1,
1, -1, -0.1,
1, -10, -0.1,
1, -100, -0.1,
1, -1000, -0.1,
10, 100, -0.1,
10, 10, -0.1,
10, 1, -0.1,
10, 0.1, -0.1,
10, 0.0000001, -0.1,
10, -0.1, -0.1,
10, -1, -0.1,
10, -10, -0.1,
10, -100, -0.1,
10, -1000, -0.1,
100, 100, -0.1,
100, 10, -0.1,
100, 1, -0.1,
100, 0.1, -0.1,
100, 0.0000001, -0.1,
100, -0.1, -0.1,
100, -1, -0.1,
100, -10, -0.1,
100, -100, -0.1,
100, -1000, -0.1,
0.000000001, 100, -1,
0.000000001, 10, -1,
0.000000001, 1, -1,
0.000000001, 0.1, -1,
0.000000001, 0.0000001, -1,
0.000000001, -0.1, -1,
0.000000001, -1, -1,
0.000000001, -10, -1,
0.000000001, -100, -1,
0.000000001, -1000, -1,
0.001, 100, -1,
0.001, 10, -1,
0.001, 1, -1,
0.001, 0.1, -1,
0.001, 0.0000001, -1,
0.001, -0.1, -1,
0.001, -1, -1,
0.001, -10, -1,
0.001, -100, -1,
0.001, -1000, -1,
0.01, 100, -1,
0.01, 10, -1,
0.01, 1, -1,
0.01, 0.1, -1,
0.01, 0.0000001, -1,
0.01, -0.1, -1,
0.01, -1, -1,
0.01, -10, -1,
0.01, -100, -1,
0.01, -1000, -1,
0.1, 100, -1,
0.1, 10, -1,
0.1, 1, -1,
0.1, 0.1, -1,
0.1, 0.0000001, -1,
0.1, -0.1, -1,
0.1, -1, -1,
0.1, -10, -1,
0.1, -100, -1,
0.1, -1000, -1,
1, 100, -1,
1, 10, -1,
1, 1, -1,
1, 0.1, -1,
1, 0.0000001, -1,
1, -0.1, -1,
1, -1, -1,
1, -10, -1,
1, -100, -1,
1, -1000, -1,
10, 100, -1,
10, 10, -1,
10, 1, -1,
10, 0.1, -1,
10, 0.0000001, -1,
10, -0.1, -1,
10, -1, -1,
10, -10, -1,
10, -100, -1,
10, -1000, -1,
100, 100, -1,
100, 10, -1,
100, 1, -1,
100, 0.1, -1,
100, 0.0000001, -1,
100, -0.1, -1,
100, -1, -1,
100, -10, -1,
100, -100, -1,
100, -1000, -1,
0.000000001, 100, -3,
0.000000001, 10, -3,
0.000000001, 1, -3,
0.000000001, 0.1, -3,
0.000000001, 0.0000001, -3,
0.000000001, -0.1, -3,
0.000000001, -1, -3,
0.000000001, -10, -3,
0.000000001, -100, -3,
0.000000001, -1000, -3,
0.001, 100, -3,
0.001, 10, -3,
0.001, 1, -3,
0.001, 0.1, -3,
0.001, 0.0000001, -3,
0.001, -0.1, -3,
0.001, -1, -3,
0.001, -10, -3,
0.001, -100, -3,
0.001, -1000, -3,
0.01, 100, -3,
0.01, 10, -3,
0.01, 1, -3,
0.01, 0.1, -3,
0.01, 0.0000001, -3,
0.01, -0.1, -3,
0.01, -1, -3,
0.01, -10, -3,
0.01, -100, -3,
0.01, -1000, -3,
0.1, 100, -3,
0.1, 10, -3,
0.1, 1, -3,
0.1, 0.1, -3,
0.1, 0.0000001, -3,
0.1, -0.1, -3,
0.1, -1, -3,
0.1, -10, -3,
0.1, -100, -3,
0.1, -1000, -3,
1, 100, -3,
1, 10, -3,
1, 1, -3,
1, 0.1, -3,
1, 0.0000001, -3,
1, -0.1, -3,
1, -1, -3,
1, -10, -3,
1, -100, -3,
1, -1000, -3,
10, 100, -3,
10, 10, -3,
10, 1, -3,
10, 0.1, -3,
10, 0.0000001, -3,
10, -0.1, -3,
10, -1, -3,
10, -10, -3,
10, -100, -3,
10, -1000, -3,
100, 100, -3,
100, 10, -3,
100, 1, -3,
100, 0.1, -3,
100, 0.0000001, -3,
100, -0.1, -3,
100, -1, -3,
100, -10, -3,
100, -100, -3,
100, -1000, -3
)
p_starting <- matrix(p_matrix, length(p_matrix)/3, 3, byrow=TRUE)
result_matrix <- matrix(NA, nrow(p_starting), 4)
result_matrix[,1:3] <- p_starting
}
if(MODEL == "OU_linear_breakpoint"){
p_matrix <- c(
0.0001, 0.000001, 20, 0.000001, 0.1, 0.000001, 0.000001,
0.1, 0.000001, 20, 0.000001, 0.1, 0.000001, 0.000001,
1, 0.000001, 20, 0.000001, 0.1, 0.000001, 0.000001,
10, 0.000001, 20, 0.000001, 0.1, 0.000001, 0.000001,
100, 0.000001, 20, 0.000001, 0.1, 0.000001, 0.000001,
0.0001, 0.01, 20, 0.000001, 0.1, 0.000001, 0.000001,
0.1, 0.01, 20, 0.000001, 0.1, 0.000001, 0.000001,
1, 0.01, 20, 0.000001, 0.1, 0.000001, 0.000001,
10, 0.01, 20, 0.000001, 0.1, 0.000001, 0.000001,
100, 0.01, 20, 0.000001, 0.1, 0.000001, 0.000001,
0.0001, 1, 20, 0.000001, 0.1, 0.000001, 0.000001,
0.1, 1, 20, 0.000001, 0.1, 0.000001, 0.000001,
1, 1, 20, 0.000001, 0.1, 0.000001, 0.000001,
10, 1, 20, 0.000001, 0.1, 0.000001, 0.000001,
100, 1, 20, 0.000001, 0.1, 0.000001, 0.000001,
0.0001, -0.01, 20, 0.000001, 0.1, 0.000001, 0.000001,
0.1, -0.01, 20, 0.000001, 0.1, 0.000001, 0.000001,
1, -0.01, 20, 0.000001, 0.1, 0.000001, 0.000001,
10, -0.01, 20, 0.000001, 0.1, 0.000001, 0.000001,
100, -0.01, 20, 0.000001, 0.1, 0.000001, 0.000001,
0.0001, -1, 20, 0.000001, 0.1, 0.000001, 0.000001,
0.1, -1, 20, 0.000001, 0.1, 0.000001, 0.000001,
1, -1, 20, 0.000001, 0.1, 0.000001, 0.000001,
10, -1, 20, 0.000001, 0.1, 0.000001, 0.000001,
100, -1, 20, 0.000001, 0.1, 0.000001, 0.000001,
0.0001, 0.000001, 20, 0.01, 0.1, 0.000001, 0.000001,
0.1, 0.000001, 20, 0.01, 0.1, 0.000001, 0.000001,
1, 0.000001, 20, 0.01, 0.1, 0.000001, 0.000001,
10, 0.000001, 20, 0.01, 0.1, 0.000001, 0.000001,
100, 0.000001, 20, 0.01, 0.1, 0.000001, 0.000001,
0.0001, 0.01, 20, 0.01, 0.1, 0.000001, 0.000001,
0.1, 0.01, 20, 0.01, 0.1, 0.000001, 0.000001,
1, 0.01, 20, 0.01, 0.1, 0.000001, 0.000001,
10, 0.01, 20, 0.01, 0.1, 0.000001, 0.000001,
100, 0.01, 20, 0.01, 0.1, 0.000001, 0.000001,
0.0001, 1, 20, 0.01, 0.1, 0.000001, 0.000001,
0.1, 1, 20, 0.01, 0.1, 0.000001, 0.000001,
1, 1, 20, 0.01, 0.1, 0.000001, 0.000001,
10, 1, 20, 0.01, 0.1, 0.000001, 0.000001,
100, 1, 20, 0.01, 0.1, 0.000001, 0.000001,
0.0001, -0.01, 20, 0.01, 0.1, 0.000001, 0.000001,
0.1, -0.01, 20, 0.01, 0.1, 0.000001, 0.000001,
1, -0.01, 20, 0.01, 0.1, 0.000001, 0.000001,
10, -0.01, 20, 0.01, 0.1, 0.000001, 0.000001,
100, -0.01, 20, 0.01, 0.1, 0.000001, 0.000001,
0.0001, -1, 20, 0.01, 0.1, 0.000001, 0.000001,
0.1, -1, 20, 0.01, 0.1, 0.000001, 0.000001,
1, -1, 20, 0.01, 0.1, 0.000001, 0.000001,
10, -1, 20, 0.01, 0.1, 0.000001, 0.000001,
100, -1, 20, 0.01, 0.1, 0.000001, 0.000001,
0.0001, 0.000001, 20, 1, 0.1, 0.000001, 0.000001,
0.1, 0.000001, 20, 1, 0.1, 0.000001, 0.000001,
1, 0.000001, 20, 1, 0.1, 0.000001, 0.000001,
10, 0.000001, 20, 1, 0.1, 0.000001, 0.000001,
100, 0.000001, 20, 1, 0.1, 0.000001, 0.000001,
0.0001, 0.01, 20, 1, 0.1, 0.000001, 0.000001,
0.1, 0.01, 20, 1, 0.1, 0.000001, 0.000001,
1, 0.01, 20, 1, 0.1, 0.000001, 0.000001,
10, 0.01, 20, 1, 0.1, 0.000001, 0.000001,
100, 0.01, 20, 1, 0.1, 0.000001, 0.000001,
0.0001, 1, 20, 1, 0.1, 0.000001, 0.000001,
0.1, 1, 20, 1, 0.1, 0.000001, 0.000001,
1, 1, 20, 1, 0.1, 0.000001, 0.000001,
10, 1, 20, 1, 0.1, 0.000001, 0.000001,
100, 1, 20, 1, 0.1, 0.000001, 0.000001,
0.0001, -0.01, 20, 1, 0.1, 0.000001, 0.000001,
0.1, -0.01, 20, 1, 0.1, 0.000001, 0.000001,
1, -0.01, 20, 1, 0.1, 0.000001, 0.000001,
10, -0.01, 20, 1, 0.1, 0.000001, 0.000001,
100, -0.01, 20, 1, 0.1, 0.000001, 0.000001,
0.0001, -1, 20, 1, 0.1, 0.000001, 0.000001,
0.1, -1, 20, 1, 0.1, 0.000001, 0.000001,
1, -1, 20, 1, 0.1, 0.000001, 0.000001,
10, -1, 20, 1, 0.1, 0.000001, 0.000001,
100, -1, 20, 1, 0.1, 0.000001, 0.000001,
0.0001, 0.000001, 20, -0.01, 0.1, 0.000001, 0.000001,
0.1, 0.000001, 20, -0.01, 0.1, 0.000001, 0.000001,
1, 0.000001, 20, -0.01, 0.1, 0.000001, 0.000001,
10, 0.000001, 20, -0.01, 0.1, 0.000001, 0.000001,
100, 0.000001, 20, -0.01, 0.1, 0.000001, 0.000001,
0.0001, 0.01, 20, -0.01, 0.1, 0.000001, 0.000001,
0.1, 0.01, 20, -0.01, 0.1, 0.000001, 0.000001,
1, 0.01, 20, -0.01, 0.1, 0.000001, 0.000001,
10, 0.01, 20, -0.01, 0.1, 0.000001, 0.000001,
100, 0.01, 20, -0.01, 0.1, 0.000001, 0.000001,
0.0001, 1, 20, -0.01, 0.1, 0.000001, 0.000001,
0.1, 1, 20, -0.01, 0.1, 0.000001, 0.000001,
1, 1, 20, -0.01, 0.1, 0.000001, 0.000001,
10, 1, 20, -0.01, 0.1, 0.000001, 0.000001,
100, 1, 20, -0.01, 0.1, 0.000001, 0.000001,
0.0001, -0.01, 20, -0.01, 0.1, 0.000001, 0.000001,
0.1, -0.01, 20, -0.01, 0.1, 0.000001, 0.000001,
1, -0.01, 20, -0.01, 0.1, 0.000001, 0.000001,
10, -0.01, 20, -0.01, 0.1, 0.000001, 0.000001,
100, -0.01, 20, -0.01, 0.1, 0.000001, 0.000001,
0.0001, -1, 20, -0.01, 0.1, 0.000001, 0.000001,
0.1, -1, 20, -0.01, 0.1, 0.000001, 0.000001,
1, -1, 20, -0.01, 0.1, 0.000001, 0.000001,
10, -1, 20, -0.01, 0.1, 0.000001, 0.000001,
100, -1, 20, -0.01, 0.1, 0.000001, 0.000001,
0.0001, 0.000001, 20, -1, 0.1, 0.000001, 0.000001,
0.1, 0.000001, 20, -1, 0.1, 0.000001, 0.000001,
1, 0.000001, 20, -1, 0.1, 0.000001, 0.000001,
10, 0.000001, 20, -1, 0.1, 0.000001, 0.000001,
100, 0.000001, 20, -1, 0.1, 0.000001, 0.000001,
0.0001, 0.01, 20, -1, 0.1, 0.000001, 0.000001,
0.1, 0.01, 20, -1, 0.1, 0.000001, 0.000001,
1, 0.01, 20, -1, 0.1, 0.000001, 0.000001,
10, 0.01, 20, -1, 0.1, 0.000001, 0.000001,
100, 0.01, 20, -1, 0.1, 0.000001, 0.000001,
0.0001, 1, 20, -1, 0.1, 0.000001, 0.000001,
0.1, 1, 20, -1, 0.1, 0.000001, 0.000001,
1, 1, 20, -1, 0.1, 0.000001, 0.000001,
10, 1, 20, -1, 0.1, 0.000001, 0.000001,
100, 1, 20, -1, 0.1, 0.000001, 0.000001,
0.0001, -0.01, 20, -1, 0.1, 0.000001, 0.000001,
0.1, -0.01, 20, -1, 0.1, 0.000001, 0.000001,
1, -0.01, 20, -1, 0.1, 0.000001, 0.000001,
10, -0.01, 20, -1, 0.1, 0.000001, 0.000001,
100, -0.01, 20, -1, 0.1, 0.000001, 0.000001,
0.0001, -1, 20, -1, 0.1, 0.000001, 0.000001,
0.1, -1, 20, -1, 0.1, 0.000001, 0.000001,
1, -1, 20, -1, 0.1, 0.000001, 0.000001,
10, -1, 20, -1, 0.1, 0.000001, 0.000001,
100, -1, 20, -1, 0.1, 0.000001, 0.000001,
0.0001, 0.000001, 20, 0.000001, 0.1, 0.01, 0.01,
0.1, 0.000001, 20, 0.000001, 0.1, 0.01, 0.01,
1, 0.000001, 20, 0.000001, 0.1, 0.01, 0.01,
10, 0.000001, 20, 0.000001, 0.1, 0.01, 0.01,
100, 0.000001, 20, 0.000001, 0.1, 0.01, 0.01,
0.0001, 0.01, 20, 0.000001, 0.1, 0.01, 0.01,
0.1, 0.01, 20, 0.000001, 0.1, 0.01, 0.01,
1, 0.01, 20, 0.000001, 0.1, 0.01, 0.01,
10, 0.01, 20, 0.000001, 0.1, 0.01, 0.01,
100, 0.01, 20, 0.000001, 0.1, 0.01, 0.01,
0.0001, 1, 20, 0.000001, 0.1, 0.01, 0.01,
0.1, 1, 20, 0.000001, 0.1, 0.01, 0.01,
1, 1, 20, 0.000001, 0.1, 0.01, 0.01,
10, 1, 20, 0.000001, 0.1, 0.01, 0.01,
100, 1, 20, 0.000001, 0.1, 0.01, 0.01,
0.0001, -0.01, 20, 0.000001, 0.1, 0.01, 0.01,
0.1, -0.01, 20, 0.000001, 0.1, 0.01, 0.01,
1, -0.01, 20, 0.000001, 0.1, 0.01, 0.01,
10, -0.01, 20, 0.000001, 0.1, 0.01, 0.01,
100, -0.01, 20, 0.000001, 0.1, 0.01, 0.01,
0.0001, -1, 20, 0.000001, 0.1, 0.01, 0.01,
0.1, -1, 20, 0.000001, 0.1, 0.01, 0.01,
1, -1, 20, 0.000001, 0.1, 0.01, 0.01,
10, -1, 20, 0.000001, 0.1, 0.01, 0.01,
100, -1, 20, 0.000001, 0.1, 0.01, 0.01,
0.0001, 0.000001, 20, 0.01, 0.1, 0.01, 0.01,
0.1, 0.000001, 20, 0.01, 0.1, 0.01, 0.01,
1, 0.000001, 20, 0.01, 0.1, 0.01, 0.01,
10, 0.000001, 20, 0.01, 0.1, 0.01, 0.01,
100, 0.000001, 20, 0.01, 0.1, 0.01, 0.01,
0.0001, 0.01, 20, 0.01, 0.1, 0.01, 0.01,
0.1, 0.01, 20, 0.01, 0.1, 0.01, 0.01,
1, 0.01, 20, 0.01, 0.1, 0.01, 0.01,
10, 0.01, 20, 0.01, 0.1, 0.01, 0.01,
100, 0.01, 20, 0.01, 0.1, 0.01, 0.01,
0.0001, 1, 20, 0.01, 0.1, 0.01, 0.01,
0.1, 1, 20, 0.01, 0.1, 0.01, 0.01,
1, 1, 20, 0.01, 0.1, 0.01, 0.01,
10, 1, 20, 0.01, 0.1, 0.01, 0.01,
100, 1, 20, 0.01, 0.1, 0.01, 0.01,
0.0001, -0.01, 20, 0.01, 0.1, 0.01, 0.01,
0.1, -0.01, 20, 0.01, 0.1, 0.01, 0.01,
1, -0.01, 20, 0.01, 0.1, 0.01, 0.01,
10, -0.01, 20, 0.01, 0.1, 0.01, 0.01,
100, -0.01, 20, 0.01, 0.1, 0.01, 0.01,
0.0001, -1, 20, 0.01, 0.1, 0.01, 0.01,
0.1, -1, 20, 0.01, 0.1, 0.01, 0.01,
1, -1, 20, 0.01, 0.1, 0.01, 0.01,
10, -1, 20, 0.01, 0.1, 0.01, 0.01,
100, -1, 20, 0.01, 0.1, 0.01, 0.01,
0.0001, 0.000001, 20, 1, 0.1, 0.01, 0.01,
0.1, 0.000001, 20, 1, 0.1, 0.01, 0.01,
1, 0.000001, 20, 1, 0.1, 0.01, 0.01,
10, 0.000001, 20, 1, 0.1, 0.01, 0.01,
100, 0.000001, 20, 1, 0.1, 0.01, 0.01,
0.0001, 0.01, 20, 1, 0.1, 0.01, 0.01,
0.1, 0.01, 20, 1, 0.1, 0.01, 0.01,
1, 0.01, 20, 1, 0.1, 0.01, 0.01,
10, 0.01, 20, 1, 0.1, 0.01, 0.01,
100, 0.01, 20, 1, 0.1, 0.01, 0.01,
0.0001, 1, 20, 1, 0.1, 0.01, 0.01,
0.1, 1, 20, 1, 0.1, 0.01, 0.01,
1, 1, 20, 1, 0.1, 0.01, 0.01,
10, 1, 20, 1, 0.1, 0.01, 0.01,
100, 1, 20, 1, 0.1, 0.01, 0.01,
0.0001, -0.01, 20, 1, 0.1, 0.01, 0.01,
0.1, -0.01, 20, 1, 0.1, 0.01, 0.01,
1, -0.01, 20, 1, 0.1, 0.01, 0.01,
10, -0.01, 20, 1, 0.1, 0.01, 0.01,
100, -0.01, 20, 1, 0.1, 0.01, 0.01,
0.0001, -1, 20, 1, 0.1, 0.01, 0.01,
0.1, -1, 20, 1, 0.1, 0.01, 0.01,
1, -1, 20, 1, 0.1, 0.01, 0.01,
10, -1, 20, 1, 0.1, 0.01, 0.01,
100, -1, 20, 1, 0.1, 0.01, 0.01,
0.0001, 0.000001, 20, -0.01, 0.1, 0.01, 0.01,
0.1, 0.000001, 20, -0.01, 0.1, 0.01, 0.01,
1, 0.000001, 20, -0.01, 0.1, 0.01, 0.01,
10, 0.000001, 20, -0.01, 0.1, 0.01, 0.01,
100, 0.000001, 20, -0.01, 0.1, 0.01, 0.01,
0.0001, 0.01, 20, -0.01, 0.1, 0.01, 0.01,
0.1, 0.01, 20, -0.01, 0.1, 0.01, 0.01,
1, 0.01, 20, -0.01, 0.1, 0.01, 0.01,
10, 0.01, 20, -0.01, 0.1, 0.01, 0.01,
100, 0.01, 20, -0.01, 0.1, 0.01, 0.01,
0.0001, 1, 20, -0.01, 0.1, 0.01, 0.01,
0.1, 1, 20, -0.01, 0.1, 0.01, 0.01,
1, 1, 20, -0.01, 0.1, 0.01, 0.01,
10, 1, 20, -0.01, 0.1, 0.01, 0.01,
100, 1, 20, -0.01, 0.1, 0.01, 0.01,
0.0001, -0.01, 20, -0.01, 0.1, 0.01, 0.01,
0.1, -0.01, 20, -0.01, 0.1, 0.01, 0.01,
1, -0.01, 20, -0.01, 0.1, 0.01, 0.01,
10, -0.01, 20, -0.01, 0.1, 0.01, 0.01,
100, -0.01, 20, -0.01, 0.1, 0.01, 0.01,
0.0001, -1, 20, -0.01, 0.1, 0.01, 0.01,
0.1, -1, 20, -0.01, 0.1, 0.01, 0.01,
1, -1, 20, -0.01, 0.1, 0.01, 0.01,
10, -1, 20, -0.01, 0.1, 0.01, 0.01,
100, -1, 20, -0.01, 0.1, 0.01, 0.01,
0.0001, 0.000001, 20, -1, 0.1, 0.01, 0.01,
0.1, 0.000001, 20, -1, 0.1, 0.01, 0.01,
1, 0.000001, 20, -1, 0.1, 0.01, 0.01,
10, 0.000001, 20, -1, 0.1, 0.01, 0.01,
100, 0.000001, 20, -1, 0.1, 0.01, 0.01,
0.0001, 0.01, 20, -1, 0.1, 0.01, 0.01,
0.1, 0.01, 20, -1, 0.1, 0.01, 0.01,
1, 0.01, 20, -1, 0.1, 0.01, 0.01,
10, 0.01, 20, -1, 0.1, 0.01, 0.01,
100, 0.01, 20, -1, 0.1, 0.01, 0.01,
0.0001, 1, 20, -1, 0.1, 0.01, 0.01,
0.1, 1, 20, -1, 0.1, 0.01, 0.01,
1, 1, 20, -1, 0.1, 0.01, 0.01,
10, 1, 20, -1, 0.1, 0.01, 0.01,
100, 1, 20, -1, 0.1, 0.01, 0.01,
0.0001, -0.01, 20, -1, 0.1, 0.01, 0.01,
0.1, -0.01, 20, -1, 0.1, 0.01, 0.01,
1, -0.01, 20, -1, 0.1, 0.01, 0.01,
10, -0.01, 20, -1, 0.1, 0.01, 0.01,
100, -0.01, 20, -1, 0.1, 0.01, 0.01,
0.0001, -1, 20, -1, 0.1, 0.01, 0.01,
0.1, -1, 20, -1, 0.1, 0.01, 0.01,
1, -1, 20, -1, 0.1, 0.01, 0.01,
10, -1, 20, -1, 0.1, 0.01, 0.01,
100, -1, 20, -1, 0.1, 0.01, 0.01,
0.0001, 0.000001, 20, 0.000001, 0.1, 1, 1,
0.1, 0.000001, 20, 0.000001, 0.1, 1, 1,
1, 0.000001, 20, 0.000001, 0.1, 1, 1,
10, 0.000001, 20, 0.000001, 0.1, 1, 1,
100, 0.000001, 20, 0.000001, 0.1, 1, 1,
0.0001, 0.01, 20, 0.000001, 0.1, 1, 1,
0.1, 0.01, 20, 0.000001, 0.1, 1, 1,
1, 0.01, 20, 0.000001, 0.1, 1, 1,
10, 0.01, 20, 0.000001, 0.1, 1, 1,
100, 0.01, 20, 0.000001, 0.1, 1, 1,
0.0001, 1, 20, 0.000001, 0.1, 1, 1,
0.1, 1, 20, 0.000001, 0.1, 1, 1,
1, 1, 20, 0.000001, 0.1, 1, 1,
10, 1, 20, 0.000001, 0.1, 1, 1,
100, 1, 20, 0.000001, 0.1, 1, 1,
0.0001, -0.01, 20, 0.000001, 0.1, 1, 1,
0.1, -0.01, 20, 0.000001, 0.1, 1, 1,
1, -0.01, 20, 0.000001, 0.1, 1, 1,
10, -0.01, 20, 0.000001, 0.1, 1, 1,
100, -0.01, 20, 0.000001, 0.1, 1, 1,
0.0001, -1, 20, 0.000001, 0.1, 1, 1,
0.1, -1, 20, 0.000001, 0.1, 1, 1,
1, -1, 20, 0.000001, 0.1, 1, 1,
10, -1, 20, 0.000001, 0.1, 1, 1,
100, -1, 20, 0.000001, 0.1, 1, 1,
0.0001, 0.000001, 20, 0.01, 0.1, 1, 1,
0.1, 0.000001, 20, 0.01, 0.1, 1, 1,
1, 0.000001, 20, 0.01, 0.1, 1, 1,
10, 0.000001, 20, 0.01, 0.1, 1, 1,
100, 0.000001, 20, 0.01, 0.1, 1, 1,
0.0001, 0.01, 20, 0.01, 0.1, 1, 1,
0.1, 0.01, 20, 0.01, 0.1, 1, 1,
1, 0.01, 20, 0.01, 0.1, 1, 1,
10, 0.01, 20, 0.01, 0.1, 1, 1,
100, 0.01, 20, 0.01, 0.1, 1, 1,
0.0001, 1, 20, 0.01, 0.1, 1, 1,
0.1, 1, 20, 0.01, 0.1, 1, 1,
1, 1, 20, 0.01, 0.1, 1, 1,
10, 1, 20, 0.01, 0.1, 1, 1,
100, 1, 20, 0.01, 0.1, 1, 1,
0.0001, -0.01, 20, 0.01, 0.1, 1, 1,
0.1, -0.01, 20, 0.01, 0.1, 1, 1,
1, -0.01, 20, 0.01, 0.1, 1, 1,
10, -0.01, 20, 0.01, 0.1, 1, 1,
100, -0.01, 20, 0.01, 0.1, 1, 1,
0.0001, -1, 20, 0.01, 0.1, 1, 1,
0.1, -1, 20, 0.01, 0.1, 1, 1,
1, -1, 20, 0.01, 0.1, 1, 1,
10, -1, 20, 0.01, 0.1, 1, 1,
100, -1, 20, 0.01, 0.1, 1, 1,
0.0001, 0.000001, 20, 1, 0.1, 1, 1,
0.1, 0.000001, 20, 1, 0.1, 1, 1,
1, 0.000001, 20, 1, 0.1, 1, 1,
10, 0.000001, 20, 1, 0.1, 1, 1,
100, 0.000001, 20, 1, 0.1, 1, 1,
0.0001, 0.01, 20, 1, 0.1, 1, 1,
0.1, 0.01, 20, 1, 0.1, 1, 1,
1, 0.01, 20, 1, 0.1, 1, 1,
10, 0.01, 20, 1, 0.1, 1, 1,
100, 0.01, 20, 1, 0.1, 1, 1,
0.0001, 1, 20, 1, 0.1, 1, 1,
0.1, 1, 20, 1, 0.1, 1, 1,
1, 1, 20, 1, 0.1, 1, 1,
10, 1, 20, 1, 0.1, 1, 1,
100, 1, 20, 1, 0.1, 1, 1,
0.0001, -0.01, 20, 1, 0.1, 1, 1,
0.1, -0.01, 20, 1, 0.1, 1, 1,
1, -0.01, 20, 1, 0.1, 1, 1,
10, -0.01, 20, 1, 0.1, 1, 1,
100, -0.01, 20, 1, 0.1, 1, 1,
0.0001, -1, 20, 1, 0.1, 1, 1,
0.1, -1, 20, 1, 0.1, 1, 1,
1, -1, 20, 1, 0.1, 1, 1,
10, -1, 20, 1, 0.1, 1, 1,
100, -1, 20, 1, 0.1, 1, 1,
0.0001, 0.000001, 20, -0.01, 0.1, 1, 1,
0.1, 0.000001, 20, -0.01, 0.1, 1, 1,
1, 0.000001, 20, -0.01, 0.1, 1, 1,
10, 0.000001, 20, -0.01, 0.1, 1, 1,
100, 0.000001, 20, -0.01, 0.1, 1, 1,
0.0001, 0.01, 20, -0.01, 0.1, 1, 1,
0.1, 0.01, 20, -0.01, 0.1, 1, 1,
1, 0.01, 20, -0.01, 0.1, 1, 1,
10, 0.01, 20, -0.01, 0.1, 1, 1,
100, 0.01, 20, -0.01, 0.1, 1, 1,
0.0001, 1, 20, -0.01, 0.1, 1, 1,
0.1, 1, 20, -0.01, 0.1, 1, 1,
1, 1, 20, -0.01, 0.1, 1, 1,
10, 1, 20, -0.01, 0.1, 1, 1,
100, 1, 20, -0.01, 0.1, 1, 1,
0.0001, -0.01, 20, -0.01, 0.1, 1, 1,
0.1, -0.01, 20, -0.01, 0.1, 1, 1,
1, -0.01, 20, -0.01, 0.1, 1, 1,
10, -0.01, 20, -0.01, 0.1, 1, 1,
100, -0.01, 20, -0.01, 0.1, 1, 1,
0.0001, -1, 20, -0.01, 0.1, 1, 1,
0.1, -1, 20, -0.01, 0.1, 1, 1,
1, -1, 20, -0.01, 0.1, 1, 1,
10, -1, 20, -0.01, 0.1, 1, 1,
100, -1, 20, -0.01, 0.1, 1, 1,
0.0001, 0.000001, 20, -1, 0.1, 1, 1,
0.1, 0.000001, 20, -1, 0.1, 1, 1,
1, 0.000001, 20, -1, 0.1, 1, 1,
10, 0.000001, 20, -1, 0.1, 1, 1,
100, 0.000001, 20, -1, 0.1, 1, 1,
0.0001, 0.01, 20, -1, 0.1, 1, 1,
0.1, 0.01, 20, -1, 0.1, 1, 1,
1, 0.01, 20, -1, 0.1, 1, 1,
10, 0.01, 20, -1, 0.1, 1, 1,
100, 0.01, 20, -1, 0.1, 1, 1,
0.0001, 1, 20, -1, 0.1, 1, 1,
0.1, 1, 20, -1, 0.1, 1, 1,
1, 1, 20, -1, 0.1, 1, 1,
10, 1, 20, -1, 0.1, 1, 1,
100, 1, 20, -1, 0.1, 1, 1,
0.0001, -0.01, 20, -1, 0.1, 1, 1,
0.1, -0.01, 20, -1, 0.1, 1, 1,
1, -0.01, 20, -1, 0.1, 1, 1,
10, -0.01, 20, -1, 0.1, 1, 1,
100, -0.01, 20, -1, 0.1, 1, 1,
0.0001, -1, 20, -1, 0.1, 1, 1,
0.1, -1, 20, -1, 0.1, 1, 1,
1, -1, 20, -1, 0.1, 1, 1,
10, -1, 20, -1, 0.1, 1, 1,
100, -1, 20, -1, 0.1, 1, 1,
0.0001, 0.000001, 20, 0.000001, 0.1, -0.01, -0.01,
0.1, 0.000001, 20, 0.000001, 0.1, -0.01, -0.01,
1, 0.000001, 20, 0.000001, 0.1, -0.01, -0.01,
10, 0.000001, 20, 0.000001, 0.1, -0.01, -0.01,
100, 0.000001, 20, 0.000001, 0.1, -0.01, -0.01,
0.0001, 0.01, 20, 0.000001, 0.1, -0.01, -0.01,
0.1, 0.01, 20, 0.000001, 0.1, -0.01, -0.01,
1, 0.01, 20, 0.000001, 0.1, -0.01, -0.01,
10, 0.01, 20, 0.000001, 0.1, -0.01, -0.01,
100, 0.01, 20, 0.000001, 0.1, -0.01, -0.01,
0.0001, 1, 20, 0.000001, 0.1, -0.01, -0.01,
0.1, 1, 20, 0.000001, 0.1, -0.01, -0.01,
1, 1, 20, 0.000001, 0.1, -0.01, -0.01,
10, 1, 20, 0.000001, 0.1, -0.01, -0.01,
100, 1, 20, 0.000001, 0.1, -0.01, -0.01,
0.0001, -0.01, 20, 0.000001, 0.1, -0.01, -0.01,
0.1, -0.01, 20, 0.000001, 0.1, -0.01, -0.01,
1, -0.01, 20, 0.000001, 0.1, -0.01, -0.01,
10, -0.01, 20, 0.000001, 0.1, -0.01, -0.01,
100, -0.01, 20, 0.000001, 0.1, -0.01, -0.01,
0.0001, -1, 20, 0.000001, 0.1, -0.01, -0.01,
0.1, -1, 20, 0.000001, 0.1, -0.01, -0.01,
1, -1, 20, 0.000001, 0.1, -0.01, -0.01,
10, -1, 20, 0.000001, 0.1, -0.01, -0.01,
100, -1, 20, 0.000001, 0.1, -0.01, -0.01,
0.0001, 0.000001, 20, 0.01, 0.1, -0.01, -0.01,
0.1, 0.000001, 20, 0.01, 0.1, -0.01, -0.01,
1, 0.000001, 20, 0.01, 0.1, -0.01, -0.01,
10, 0.000001, 20, 0.01, 0.1, -0.01, -0.01,
100, 0.000001, 20, 0.01, 0.1, -0.01, -0.01,
0.0001, 0.01, 20, 0.01, 0.1, -0.01, -0.01,
0.1, 0.01, 20, 0.01, 0.1, -0.01, -0.01,
1, 0.01, 20, 0.01, 0.1, -0.01, -0.01,
10, 0.01, 20, 0.01, 0.1, -0.01, -0.01,
100, 0.01, 20, 0.01, 0.1, -0.01, -0.01,
0.0001, 1, 20, 0.01, 0.1, -0.01, -0.01,
0.1, 1, 20, 0.01, 0.1, -0.01, -0.01,
1, 1, 20, 0.01, 0.1, -0.01, -0.01,
10, 1, 20, 0.01, 0.1, -0.01, -0.01,
100, 1, 20, 0.01, 0.1, -0.01, -0.01,
0.0001, -0.01, 20, 0.01, 0.1, -0.01, -0.01,
0.1, -0.01, 20, 0.01, 0.1, -0.01, -0.01,
1, -0.01, 20, 0.01, 0.1, -0.01, -0.01,
10, -0.01, 20, 0.01, 0.1, -0.01, -0.01,
100, -0.01, 20, 0.01, 0.1, -0.01, -0.01,
0.0001, -1, 20, 0.01, 0.1, -0.01, -0.01,
0.1, -1, 20, 0.01, 0.1, -0.01, -0.01,
1, -1, 20, 0.01, 0.1, -0.01, -0.01,
10, -1, 20, 0.01, 0.1, -0.01, -0.01,
100, -1, 20, 0.01, 0.1, -0.01, -0.01,
0.0001, 0.000001, 20, 1, 0.1, -0.01, -0.01,
0.1, 0.000001, 20, 1, 0.1, -0.01, -0.01,
1, 0.000001, 20, 1, 0.1, -0.01, -0.01,
10, 0.000001, 20, 1, 0.1, -0.01, -0.01,
100, 0.000001, 20, 1, 0.1, -0.01, -0.01,
0.0001, 0.01, 20, 1, 0.1, -0.01, -0.01,
0.1, 0.01, 20, 1, 0.1, -0.01, -0.01,
1, 0.01, 20, 1, 0.1, -0.01, -0.01,
10, 0.01, 20, 1, 0.1, -0.01, -0.01,
100, 0.01, 20, 1, 0.1, -0.01, -0.01,
0.0001, 1, 20, 1, 0.1, -0.01, -0.01,
0.1, 1, 20, 1, 0.1, -0.01, -0.01,
1, 1, 20, 1, 0.1, -0.01, -0.01,
10, 1, 20, 1, 0.1, -0.01, -0.01,
100, 1, 20, 1, 0.1, -0.01, -0.01,
0.0001, -0.01, 20, 1, 0.1, -0.01, -0.01,
0.1, -0.01, 20, 1, 0.1, -0.01, -0.01,
1, -0.01, 20, 1, 0.1, -0.01, -0.01,
10, -0.01, 20, 1, 0.1, -0.01, -0.01,
100, -0.01, 20, 1, 0.1, -0.01, -0.01,
0.0001, -1, 20, 1, 0.1, -0.01, -0.01,
0.1, -1, 20, 1, 0.1, -0.01, -0.01,
1, -1, 20, 1, 0.1, -0.01, -0.01,
10, -1, 20, 1, 0.1, -0.01, -0.01,
100, -1, 20, 1, 0.1, -0.01, -0.01,
0.0001, 0.000001, 20, -0.01, 0.1, -0.01, -0.01,
0.1, 0.000001, 20, -0.01, 0.1, -0.01, -0.01,
1, 0.000001, 20, -0.01, 0.1, -0.01, -0.01,
10, 0.000001, 20, -0.01, 0.1, -0.01, -0.01,
100, 0.000001, 20, -0.01, 0.1, -0.01, -0.01,
0.0001, 0.01, 20, -0.01, 0.1, -0.01, -0.01,
0.1, 0.01, 20, -0.01, 0.1, -0.01, -0.01,
1, 0.01, 20, -0.01, 0.1, -0.01, -0.01,
10, 0.01, 20, -0.01, 0.1, -0.01, -0.01,
100, 0.01, 20, -0.01, 0.1, -0.01, -0.01,
0.0001, 1, 20, -0.01, 0.1, -0.01, -0.01,
0.1, 1, 20, -0.01, 0.1, -0.01, -0.01,
1, 1, 20, -0.01, 0.1, -0.01, -0.01,
10, 1, 20, -0.01, 0.1, -0.01, -0.01,
100, 1, 20, -0.01, 0.1, -0.01, -0.01,
0.0001, -0.01, 20, -0.01, 0.1, -0.01, -0.01,
0.1, -0.01, 20, -0.01, 0.1, -0.01, -0.01,
1, -0.01, 20, -0.01, 0.1, -0.01, -0.01,
10, -0.01, 20, -0.01, 0.1, -0.01, -0.01,
100, -0.01, 20, -0.01, 0.1, -0.01, -0.01,
0.0001, -1, 20, -0.01, 0.1, -0.01, -0.01,
0.1, -1, 20, -0.01, 0.1, -0.01, -0.01,
1, -1, 20, -0.01, 0.1, -0.01, -0.01,
10, -1, 20, -0.01, 0.1, -0.01, -0.01,
100, -1, 20, -0.01, 0.1, -0.01, -0.01,
0.0001, 0.000001, 20, -1, 0.1, -0.01, -0.01,
0.1, 0.000001, 20, -1, 0.1, -0.01, -0.01,
1, 0.000001, 20, -1, 0.1, -0.01, -0.01,
10, 0.000001, 20, -1, 0.1, -0.01, -0.01,
100, 0.000001, 20, -1, 0.1, -0.01, -0.01,
0.0001, 0.01, 20, -1, 0.1, -0.01, -0.01,
0.1, 0.01, 20, -1, 0.1, -0.01, -0.01,
1, 0.01, 20, -1, 0.1, -0.01, -0.01,
10, 0.01, 20, -1, 0.1, -0.01, -0.01,
100, 0.01, 20, -1, 0.1, -0.01, -0.01,
0.0001, 1, 20, -1, 0.1, -0.01, -0.01,
0.1, 1, 20, -1, 0.1, -0.01, -0.01,
1, 1, 20, -1, 0.1, -0.01, -0.01,
10, 1, 20, -1, 0.1, -0.01, -0.01,
100, 1, 20, -1, 0.1, -0.01, -0.01,
0.0001, -0.01, 20, -1, 0.1, -0.01, -0.01,
0.1, -0.01, 20, -1, 0.1, -0.01, -0.01,
1, -0.01, 20, -1, 0.1, -0.01, -0.01,
10, -0.01, 20, -1, 0.1, -0.01, -0.01,
100, -0.01, 20, -1, 0.1, -0.01, -0.01,
0.0001, -1, 20, -1, 0.1, -0.01, -0.01,
0.1, -1, 20, -1, 0.1, -0.01, -0.01,
1, -1, 20, -1, 0.1, -0.01, -0.01,
10, -1, 20, -1, 0.1, -0.01, -0.01,
100, -1, 20, -1, 0.1, -0.01, -0.01
)
p_starting <- matrix(p_matrix, length(p_matrix)/7, 7, byrow=TRUE)
result_matrix <- matrix(NA, nrow(p_starting), 8)
result_matrix[,1:7] <- p_starting
}
if(MODEL == "BM_linear_profile_par1"){
A <- c(10, 5, 1, 0.75, 0.5, 0.4, 0.3, 0.2, 0.1, 0.05, 0.01, 0.001, 0.0001, 0.00001,-10, -5, -1, -0.75, -0.5, -0.4, -0.3, -0.2, -0.1, -0.05, -0.01, -0.001, -0.0001, -0.00001)
NROW <- length(A)
result_matrix <- matrix(NA, nrow = NROW, 2)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
result_matrix[count,c(1)] <- c(AA)
count = count + 1
}
}
if(MODEL == "BM_linear_profile_par2"){ #when par 2 is held constant and par 1 is estimated
A <- c(0.000001, 0.00001, 0.0001, 0.001, 0.01, 0.1,0.2, 0.3, 0.4, 0.5, 0.75, 1, 1.25, 1.5, 2,3,4,5,6,7,8,9,10,15,20,25,30, 40, 50, 75, 100, 200, 500, 1000)
NROW <- length(A)
result_matrix <- matrix(NA, nrow = NROW, 2)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
result_matrix[count,c(1)] <- c(AA)
count = count + 1
}
}
if(MODEL == "OU_linear_beta_profile_par1"){
A <- c(100, 1, 0.1, 0.01, 0.001, -0.01, -0.1, -1)
B <- c(100, 25, 10, 1, 0.1, 0.01, 0.0001)
NROW <- length(A) * length(B)
result_matrix <- matrix(NA, nrow = NROW, 3)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
for(p in 1:length(B)){
BB <- B[p]
result_matrix[count,c(1:2)] <- c(AA, BB)
count = count + 1
}
}
}
if(MODEL == "OU_linear_beta_profile_par2"){
A <- c(100, 25, 10, 1, 0.1, 0.01, 0.0001)
B <- c(100, 25, 10, 1, 0.1, 0.01, 0.0001)
NROW <- length(A) * length(B)
result_matrix <- matrix(NA, nrow = NROW, 3)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
for(p in 1:length(B)){
BB <- B[p]
result_matrix[count,c(1:2)] <- c(AA, BB)
count = count + 1
}
}
}
if(MODEL == "OU_linear_beta_profile_par3"){
A <- c(100, 25, 10, 1, 0.1, 0.01, 0.0001)
B <- c(100, 1, 0.1, 0.01, 0.001, -0.01, -0.1, -1)
NROW <- length(A) * length(B)
result_matrix <- matrix(NA, nrow = NROW, 3)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
for(p in 1:length(B)){
BB <- B[p]
result_matrix[count,c(1:2)] <- c(AA, BB)
count = count + 1
}
}
}
if(MODEL == "OU_linear_profile_par2"){
A <- c(100, 10, 1, 0.1, 0.01)
B <- c(100, 10, 1, 0.1, 0.01)
C <- c(100, 0.1, 0.01, 0.001, -0.01, -0.1)
NROW <- length(A) * length(B) * length(C)
result_matrix <- matrix(NA, nrow = NROW, 4)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
for(p in 1:length(B)){
BB <- B[p]
for(z in 1:length(C)){
CC <- C[z]
result_matrix[count,c(1:3)] <- c(AA, BB, CC)
count = count + 1
}
}
}
}
if(MODEL == "OU_linear_profile_par4"){
A <- c(10, 1, 0.1, 0.01)
B <- c(0.1, 0.01, 0.001, -0.01, -0.1)
C <- c(10, 1, 0.1, 0.01)
NROW <- length(A) * length(B) * length(C)
result_matrix <- matrix(NA, nrow = NROW, 4)
count <- 1
for(i in 1:length(A)){
AA <- A[i]
for(p in 1:length(B)){
BB <- B[p]
for(z in 1:length(C)){
CC <- C[z]
result_matrix[count,c(1:3)] <- c(AA, BB, CC)
count = count + 1
}
}
}
}
return(result_matrix)
}
sisterContinuous_logSpace<- function(parameters, model,breakpoint="NULL", DIST, TIME, GRAD, GRAD2 = NULL, meserr1 = 0, meserr2 = 0, transformation_beta="NULL", transformation_alpha="NULL", transformation_beta1 = "NULL", transformation_beta2 = "NULL", transformation_interaction = "NULL", transformation_b = "NULL", transformation_a = "NULL", transformation_alpha1 = "NULL", transformation_alpha2 = "NULL")
{
if (model == "BM_null") {
Cstart_B <- exp(parameters[1])
Slope_B <- 0
B <- Slope_B * GRAD + Cstart_B
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(Cstart_B <= 0.000001) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
}
if (model == "BM_2rate") {
c1 <- exp(parameters[1])
c2 <- exp(parameters[2])
B <- (c1)*(GRAD <= breakpoint) + (c2) * (GRAD > breakpoint)
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= 0.000001 | is.nan(min(B))) negLogL = 1e20
}
else if (model == "BM_linear") {
Cstart_B <- exp(parameters[1] )
if(transformation_beta != "NULL"){
Slope_B <- exp(parameters[2]) - transformation_beta
}
if(transformation_beta == "NULL"){
Slope_B <- exp(parameters[2] )
}
B <- Slope_B * GRAD + Cstart_B
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(Cstart_B <= 0.000001) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
#This allows Beta to vary as a linear function of two continuous variables
#Beta = Cstart_B + GRAD1*Slope1_B + GRAD2*Slope2_B
else if (model == "BM_linear_2") {
Cstart_B <- exp(parameters[1] )
if(transformation_beta1 != "NULL"){
Slope1_B <- exp(parameters[2]) - transformation_beta1
}
if(transformation_beta1 == "NULL"){
Slope1_B <- exp(parameters[2] )
}
if(transformation_beta2 != "NULL"){
Slope2_B <- exp(parameters[3]) - transformation_beta2
}
if(transformation_beta2 == "NULL"){
Slope2_B <- exp(parameters[3] )
}
#B <- Slope_B * GRAD + Cstart_B
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(Cstart_B <= 0.000001) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
#This allows Beta to vary as a lienar function of two continuous variables
#Beta = Cstart_B + L1*Slope1_B + GRAD2*Slope2_B
else if (model == "BM_linear_3") {
Cstart_B <- exp(parameters[1] )
if(transformation_beta1 != "NULL"){
Slope1_B <- exp(parameters[2]) - transformation_beta1
}
if(transformation_beta1 == "NULL"){
Slope1_B <- exp(parameters[2] )
}
if(transformation_beta2 != "NULL"){
Slope2_B <- exp(parameters[3]) - transformation_beta2
}
if(transformation_beta2 == "NULL"){
Slope2_B <- exp(parameters[3] )
}
if(transformation_interaction != "NULL"){
Interaction <- exp(parameters[4]) - transformation_interaction
}
if(transformation_interaction == "NULL"){
Interaction <- exp(parameters[4] )
}
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B + GRAD*GRAD2*Interaction
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(Cstart_B <= 0.000001) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "BM_linear_breakpoint") {
#This backtransforms variables
c1 <- exp(parameters[1] ) #Cstart_B intercept
breakpoint <- exp(parameters[3] ) #breakpoint latitude
if(transformation_beta1 != "NULL"){
b1 <- exp(parameters[2]) - transformation_beta1
}
if(transformation_beta1 == "NULL"){
b1 <- exp(parameters[2] )
}
if(transformation_beta2 != "NULL"){
b2 <- exp(parameters[4]) - transformation_beta2
}
if(transformation_beta2 == "NULL"){
b2 <- exp(parameters[4] )
}
c2 = breakpoint * b1 + c1 - breakpoint * b2
B <- (b1 * GRAD + c1)*(GRAD <= breakpoint) + (b2 * GRAD + c2) * (GRAD > breakpoint)
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(c1 < 0) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "BM_quadratic") {
#This now works well
#where y = c + bX + aX^2 a > 0 parabola curves upward, a < 0 downward. a != 0
#This backtransforms variables
c <- exp(parameters[1] ) #Cstart_B intercept
if(transformation_b != "NULL"){
b <- exp(parameters[2]) - transformation_b
}
if(transformation_b == "NULL"){
b <- exp(parameters[2] ) #coefficient
}
if(transformation_a != "NULL"){
a <- exp(parameters[3]) - transformation_a
}
if(transformation_a == "NULL"){
a <- exp(parameters[3] ) #coefficient
}
B <- c + b*GRAD + a*GRAD^2
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(c < 0) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_null") {
Cstart_B <- exp(parameters[1] )
Slope_B <- 0
Cstart_A <- exp(parameters[2] )
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Slope_B * GRAD + Cstart_B
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= 0.000001) negLogL = 1e20
if(Cstart_B <= 0.000001) negLogL = 1e20
}
else if (model == "OU_linear_beta") {
#Only Beta changes linearly with latitude
Cstart_B <- exp(parameters[1])
Cstart_A <- exp(parameters[3])
if(transformation_beta != "NULL"){
Slope_B <- exp(parameters[2]) - transformation_beta
}
if(transformation_beta == "NULL"){
Slope_B <- exp(parameters[2] )
}
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Slope_B * GRAD + Cstart_B
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0.000001)) negLogL = 1e20
if(Cstart_B <= (0.000001)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_linear_beta_2") {
#Only Beta changes linearly with latitude
Cstart_B <- exp(parameters[1])
Cstart_A <- exp(parameters[4])
if(transformation_beta1 != "NULL"){
Slope1_B <- exp(parameters[2]) - transformation_beta1
}
if(transformation_beta1 == "NULL"){
Slope1_B <- exp(parameters[2] )
}
if(transformation_beta2 != "NULL"){
Slope2_B <- exp(parameters[3]) - transformation_beta2
}
if(transformation_beta2 == "NULL"){
Slope2_B <- exp(parameters[3] )
}
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0.000001)) negLogL = 1e20
if(Cstart_B <= (0.000001)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_linear_beta_3") {
#Only Beta changes linearly with latitude
Cstart_B <- exp(parameters[1])
Cstart_A <- exp(parameters[5])
if(transformation_beta1 != "NULL"){
Slope1_B <- exp(parameters[2]) - transformation_beta1
}
if(transformation_beta1 == "NULL"){
Slope1_B <- exp(parameters[2] )
}
if(transformation_beta2 != "NULL"){
Slope2_B <- exp(parameters[3]) - transformation_beta2
}
if(transformation_beta2 == "NULL"){
Slope2_B <- exp(parameters[3] )
}
if(transformation_interaction != "NULL"){
Interaction <- exp(parameters[4]) - transformation_interaction
}
if(transformation_interaction == "NULL"){
Interaction <- exp(parameters[4] )
}
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B + GRAD*GRAD2*Interaction
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0.000001)) negLogL = 1e20
if(Cstart_B <= (0.000001)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_linear") {
Cstart_B <- exp(parameters[1])
Cstart_A <- exp(parameters[3])
if(transformation_beta != "NULL"){
Slope_B <- exp(parameters[2]) - transformation_beta
}
if(transformation_beta == "NULL"){
Slope_B <- exp(parameters[2] )
}
if(transformation_alpha != "NULL"){
Slope_A <- exp(parameters[4]) - transformation_alpha
}
if(transformation_alpha == "NULL"){
Slope_A <- exp(parameters[4] )
}
Alpha <- Slope_A * GRAD + Cstart_A
B <- Slope_B * GRAD + Cstart_B
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0.000001)) negLogL = 1e20
if(Cstart_B <= (0.000001)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_linear_breakpoint") {
c1 <- exp(parameters[1] ) #Cstart_B intercept
breakpoint <- exp(parameters[3] ) #breakpoint latitude
if(transformation_beta1 != "NULL"){
b1 <- exp(parameters[2]) - transformation_beta1
}
if(transformation_beta1 == "NULL"){
b1 <- exp(parameters[2] )
}
if(transformation_beta2 != "NULL"){
b2 <- exp(parameters[4]) - transformation_beta2
}
if(transformation_beta2 == "NULL"){
b2 <- exp(parameters[4] )
}
c1_alpha <- exp(parameters[5] ) #Cstart_B intercept
if(transformation_alpha1 != "NULL"){
b1_alpha <- exp(parameters[6]) - transformation_alpha1
}
if(transformation_alpha1 == "NULL"){
b1_alpha <- exp(parameters[6] )
}
if(transformation_alpha2 != "NULL"){
b2_alpha <- exp(parameters[7]) - transformation_alpha2
}
if(transformation_alpha2 == "NULL"){
b2_alpha <- exp(parameters[7] )
}
c2 = breakpoint * b1 + c1 - breakpoint * b2
c2_alpha = breakpoint * b1_alpha + c1_alpha - breakpoint * b2_alpha
B <- (b1 * GRAD + c1)*(GRAD <= breakpoint) + (b2 * GRAD + c2) * (GRAD > breakpoint) #Beta for actual data
Alpha <- (b1_alpha * GRAD + c1_alpha)*(GRAD <= breakpoint) + (b2_alpha * GRAD + c2_alpha) * (GRAD > breakpoint) #Alpha for actual data
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(c1 < 0) negLogL = 1e20
if(c1_alpha < 0) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
if (model == "OU_2rate") {
c1 <- exp(parameters[1])
c2 <- exp(parameters[2])
c3 <- exp(parameters[3])
c4 <- exp(parameters[4])
B <- (c1)*(GRAD <= breakpoint) + (c2) * (GRAD > breakpoint)
Alpha <- (c3)*(GRAD <= breakpoint) + (c4) * (GRAD > breakpoint)
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= 0.000001 | is.nan(min(B))) negLogL = 1e20
if(min(Alpha) <= 0.000001 | is.nan(min(Alpha))) negLogL = 1e20
}
return(negLogL)
}
sisterContinuous <- function(parameters, meserr1 = 0, meserr2 = 0, model = c("BM_null", "BM_2rate","BM_linear", "BM_linear_breakpoint",
"BM_quadratic", "OU_null", "OU_2rate", "OU_linear", "OU_linear_beta", "OU_linear_breakpoint"), breakpoint="NULL", DIST, TIME, GRAD, GRAD2 = NULL)
{
#Parameters = a list of starting values for parameter estimates
#model = "OU" or "BM"
#range = a list of the start and endpoints of the gradient over which to calculate rates. These must span the range of values in the dataset.
#DIST = list of euclidean distance
#TIM = list of ages of independent contrasts / sister pairs
#GRAD = list of gradient values
#Code updated 12 Feb 2013 to exclude B and alpha values less than 0 (i.e. "if(min(Alpha) <= 0) negLogL = 1e20")
#A second update to code by transforming parameters so that search in nlm is done in log parameter space, with parameter estimates back transformed after the nlm search
#The transofrmation method results in much faster likelihood searches and allows us to find the true MLE much more readily than when not transformed for the OU model
if (model == "BM_null") {
Cstart_B <- parameters[1]
Slope_B <- 0
B <- Slope_B * GRAD + Cstart_B
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(Cstart_B <= 0.000001) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
}
if (model == "BM_2rate") {
c1 <- (parameters[1])
c2 <- (parameters[2])
B <- (c1)*(GRAD <= breakpoint) + (c2) * (GRAD > breakpoint)
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= 0.000001 | is.nan(min(B))) negLogL = 1e20
}
else if (model == "BM_linear") {
Cstart_B <- parameters[1]
Slope_B <- parameters[2]
B <- Slope_B * GRAD + Cstart_B
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(Cstart_B <= 0) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= 0.000001) negLogL = 1e20
}
else if (model == "BM_linear_2") {
Cstart_B <- parameters[1]
Slope1_B <- parameters[2]
Slope2_B <- parameters[3]
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(Cstart_B <= 0) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= 0.000001) negLogL = 1e20
}
else if (model == "BM_linear_3") {
Cstart_B <- parameters[1]
Slope1_B <- parameters[2]
Slope2_B <- parameters[3]
Interaction <- parameters[4]
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B + GRAD*GRAD2*Interaction
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(Cstart_B <= 0) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= 0.000001) negLogL = 1e20
}
else if (model == "BM_linear_breakpoint") {
#where y = c + bX + aX^2 a > 0 parabola curves upward, a < 0 downward. a != 0
#This backtransforms variables
c1 <- parameters[1] #Cstart_B intercept
breakpoint <- parameters[3] #breakpoint latitude
b1 <- parameters[2]
b2 <- parameters[4]
c2 = breakpoint * b1 + c1 - breakpoint * b2
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(c1 < 0) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= 0.000001) negLogL = 1e20
}
else if (model == "BM_quadratic") {
#This now works well
#where y = c + bX + aX^2 a > 0 parabola curves upward, a < 0 downward. a != 0
#This backtransforms variables
c <- parameters[1]
b <- parameters[2]
a <- parameters[3]
B <- c + b*GRAD + a*GRAD^2
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
#if(a == 0) negLogL = 1e20
if(c < 0) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= 0.000001) negLogL = 1e20
}
else if (model == "OU_null") {
Cstart_B <- parameters[1]
Slope_B <- 0
Cstart_A <- parameters[2]
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Slope_B * GRAD + Cstart_B
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= 0.000001) negLogL = 1e20
if(Cstart_B <= 0.000001) negLogL = 1e20
}
else if (model == "OU_linear") {
Cstart_B <- parameters[1]
Cstart_A <- parameters[3]
Slope_B <- parameters[2]
Slope_A <- parameters[4]
Alpha <- Slope_A * GRAD + Cstart_A
B <- Slope_B * GRAD + Cstart_B
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0.000001)) negLogL = 1e20
if(Cstart_B <= (0.000001)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_linear_beta") {
#Only Beta changes linearly with latitude
Cstart_B <- parameters[1]
Cstart_A <- parameters[3]
Slope_B <- parameters[2]
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Slope_B * GRAD + Cstart_B
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0.000001)) negLogL = 1e20
if(Cstart_B <= (0.000001)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_linear_beta_2") {
#Only Beta changes linearly with latitude
Cstart_B <- parameters[1]
Slope1_B <- parameters[2]
Slope2_B <- parameters[3]
Cstart_A <- parameters[4]
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0.000001)) negLogL = 1e20
if(Cstart_B <= (0.000001)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_linear_beta_3") {
#Only Beta changes linearly with latitude
Cstart_B <- parameters[1]
Slope1_B <- parameters[2]
Slope2_B <- parameters[3]
Interaction <- parameters[4]
Cstart_A <- parameters[5]
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B + GRAD*GRAD2*Interaction
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0.000001)) negLogL = 1e20
if(Cstart_B <= (0.000001)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_linear_breakpoint") {
c1 <- parameters[1]
breakpoint <- parameters[3]
b1 <- parameters[2]
b2 <- parameters[4]
c1_alpha <- parameters[5] #Cstart_B intercept
b1_alpha <- parameters[6]
b2_alpha <- parameters[7]
c2 = breakpoint * b1 + c1 - breakpoint * b2
c2_alpha = breakpoint * b1_alpha + c1_alpha - breakpoint * b2_alpha
B <- (b1 * GRAD + c1)*(GRAD <= breakpoint) + (b2 * GRAD + c2) * (GRAD > breakpoint) #Beta for actual data
Alpha <- (b1_alpha * GRAD + c1_alpha)*(GRAD <= breakpoint) + (b2_alpha * GRAD + c2_alpha) * (GRAD > breakpoint) #Alpha for actual data
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(c1 < 0) negLogL = 1e20
if(c1_alpha < 0) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
if (model == "OU_2rate") {
c1 <- (parameters[1])
c2 <- (parameters[2])
c3 <- (parameters[3])
c4 <- (parameters[4])
B <- (c1)*(GRAD <= breakpoint) + (c2) * (GRAD > breakpoint)
Alpha <- (c3)*(GRAD <= breakpoint) + (c4) * (GRAD > breakpoint)
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= 0.000001 | is.nan(min(B))) negLogL = 1e20
if(min(Alpha) <= 0.000001 | is.nan(min(Alpha))) negLogL = 1e2
}
return(negLogL)
}
find.mle.sister <- function(MODEL, p_starting=NULL, Beta_starting = NULL, Alpha_starting = NULL, meserr1 = 0, meserr2 = 0, DIST, TIME, GRAD, GRAD2 = NULL){
###################################
#start BM_null
if(MODEL == "BM_null"){
if(MODEL == "BM_null" & p_starting[1] != "NULL"){
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 3)
result_matrix[,1] <- p_starting
}
if(MODEL == "BM_null" & p_starting[1] == "NULL"){result_matrix <- starting.values(MODEL)}
result_matrix_values <- result_matrix #this is to store the actual values
result_matrix_values <- result_matrix_values * NA
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1]
TRANSFORMATION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1])), model=c("BM_null"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
try(suppressWarnings(if(as.numeric(res$code)<3) res$estimate <- c(exp(res$estimate))), silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix[i,3] <- res$minimum else result_matrix[i,3] <- NA, silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix_values[i,3] <- res$minimum else result_matrix[i,3] <- NA, silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix_values[i,1] <- res$estimate else result_matrix[i,1] <- NA, silent = TRUE)
}
result_matrix[,3] <- round(as.numeric(result_matrix[,3]), 4)
result_matrix_values[,3] <- round(as.numeric(result_matrix_values[,3]), 4)
DD_order <- as.numeric(result_matrix_values[,1] )
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,3]), as.numeric(DD_order), decreasing = FALSE, na.last = TRUE),];
result_matrix_ordered_values <- result_matrix_values[order(as.numeric(result_matrix_values[,3]), as.numeric(DD_order), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1]
TRANSFORMATION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1])), model=c("BM_null"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]))
if(round(res$minimum, 4) > round(result_matrix_ordered_values[1,3], 4)) {print("BM_NULL: final result is not MLE")}
}#End BM_null
###################################
#start BM_linear
if(MODEL == "BM_linear"){
if(MODEL == "BM_linear" & p_starting[1] != "NULL"){
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 3)
result_matrix[,1:2] <- p_starting
}
if(MODEL == "BM_linear" & p_starting[1] == "NULL"){result_matrix <- starting.values(MODEL)}
result_matrix_values <- result_matrix #this is to store the actual values
result_matrix_values <- result_matrix_values * NA
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:2]
if(p[2] <= 0) {
TRANSFORMATION = 0- p[2] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION)), model=c("BM_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
try(suppressWarnings(if(as.numeric(res$code)<3) res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION))), silent = TRUE)
}
if(p[2] > 0) {
TRANSFORMATION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2])), model=c("BM_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
try(suppressWarnings(if(as.numeric(res$code)<3) res$estimate <- c(exp(res$estimate))), silent = TRUE)
}
try(if(as.numeric(res$code)<3) result_matrix[i,3] <- res$minimum else result_matrix[i,3] <- NA, silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix_values[i,3] <- res$minimum else result_matrix[i,3] <- NA, silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix_values[i,1:2] <- res$estimate else result_matrix[i,1:2] <- NA, silent = TRUE)
}
result_matrix[,3] <- round(as.numeric(result_matrix[,3]), 4)
result_matrix_values[,3] <- round(as.numeric(result_matrix_values[,3]), 4)
DD_order <- as.numeric(result_matrix_values[,1] + result_matrix_values[,1] + result_matrix_values[,2]*max(GRAD)) #This sums the Bstart, Bend. We calculate Bend rather than use Bslope
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,3]), as.numeric(DD_order), decreasing = FALSE, na.last = TRUE),];
result_matrix_ordered_values <- result_matrix_values[order(as.numeric(result_matrix_values[,3]), as.numeric(DD_order), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:2]
if(p[2] <= 0) {
TRANSFORMATION = 0 - p[2] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION)), model=c("BM_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2])-TRANSFORMATION)
}
if(p[2] > 0) {
TRANSFORMATION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2])), model=c("BM_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]),exp(res$estimate[2]))
}
if(round(res$minimum, 4) > round(result_matrix_ordered_values[1,3], 4)) {print("BM_linear: final result is not MLE")}
}#End BM_linear
###################################
#start BM_linear_2
if(MODEL == "BM_linear_2"){
if(MODEL == "BM_linear_2" & p_starting[1] != "NULL"){ #shouldn't p_starting[4] or similar?? For all models here, not just this one
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 4) #this hasn? been tested yet
result_matrix[,1:3] <- p_starting
}
if(MODEL == "BM_linear_2" & p_starting[1] == "NULL"){result_matrix <- starting.values(MODEL)}
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:3]
if(p[2] <= 0 & p[3] > 0) {
TRANSFORMATION_BETA1 = 0- p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3])), model=c("BM_linear_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("BM_linear_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] <= 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2)), model=c("BM_linear_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] <= 0 & p[3] <= 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]+TRANSFORMATION_BETA2)), model=c("BM_linear_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
try(if(as.numeric(res$code)<3) result_matrix[i,4] <- res$minimum else result_matrix[i,4] <- NA, silent = TRUE)
}
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,4]), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:3]
if(p[2] <= 0 & p[3] > 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3])), model=c("BM_linear_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA1), exp(res$estimate[3]))
}
if(p[2] > 0 & p[3] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("BM_linear_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate))
}
if(p[2] > 0 & p[3] <= 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2)), model=c("BM_linear_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), (exp(res$estimate[3]) - TRANSFORMATION_BETA2))
}
if(p[2] <= 0 & p[3] <= 0){
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]+TRANSFORMATION_BETA2)), model=c("BM_linear_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2]) - TRANSFORMATION_BETA1), (exp(res$estimate[3]) - TRANSFORMATION_BETA2))
}
}#End BM_linear_2
##################################
#start BM_linear_3
if(MODEL == "BM_linear_3"){
if(MODEL == "BM_linear_2" & p_starting[1] != "NULL"){ #shouldn't p_starting[4] or similar?? For all models here, not just this one
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 5) #this hasnt been tested yet
result_matrix[,1:3] <- p_starting
}
if(MODEL == "BM_linear_3" & p_starting[1] == "NULL"){result_matrix <- starting.values(MODEL)}
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:4]
if(p[2] <= 0 & p[3] > 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = 0- p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4])), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", transformation_interaction = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] <= 0 & p[3] > 0 & p[4] < 0) {
TRANSFORMATION_BETA1 = 0- p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4]+TRANSFORMATION_INTERACTION)), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", transformation_interaction = TRANSFORMATION_INTERACTION, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] > 0 & p[4] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2), log(p[4])), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] <= 0 & p[4] < 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2), log(p[4]+TRANSFORMATION_INTERACTION)), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = TRANSFORMATION_INTERACTION, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] < 0 & p[3] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]), log(p[4]+TRANSFORMATION_INTERACTION)), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = "NULL", transformation_interaction = TRANSFORMATION_INTERACTION, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] <= 0 & p[3] <= 0 & p[4] <= 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]+TRANSFORMATION_BETA2), log(p[4]+TRANSFORMATION_INTERACTION)), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = TRANSFORMATION_INTERACTION, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
try(if(as.numeric(res$code)<3) result_matrix[i,5] <- res$minimum else result_matrix[i,5] <- NA, silent = TRUE)
}
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,5]), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:4]
if(p[2] <= 0 & p[3] > 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = 0- p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4])), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", transformation_interaction = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA1), exp(res$estimate[3]), exp(res$estimate[4]))
}
if(p[2] <= 0 & p[3] > 0 & p[4] < 0) {
TRANSFORMATION_BETA1 = 0- p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4]+TRANSFORMATION_INTERACTION)), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", transformation_interaction = TRANSFORMATION_INTERACTION, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA1), exp(res$estimate[3]), (exp(res$estimate[4])-TRANSFORMATION_INTERACTION))
}
if(p[2] > 0 & p[3] > 0 & p[4] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate))
}
if(p[2] > 0 & p[3] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2), log(p[4])), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), (exp(res$estimate[3]) - TRANSFORMATION_BETA2), exp(res$estimate[4]))
}
if(p[2] > 0 & p[3] <= 0 & p[4] < 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2), log(p[4]+TRANSFORMATION_INTERACTION)), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = TRANSFORMATION_INTERACTION, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), (exp(res$estimate[3]) - TRANSFORMATION_BETA2), (exp(res$estimate[4])-TRANSFORMATION_INTERACTION))
}
if(p[2] < 0 & p[3] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]), log(p[4]+TRANSFORMATION_INTERACTION)), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = "NULL", transformation_interaction = TRANSFORMATION_INTERACTION, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), exp(res$estimate[3]), (exp(res$estimate[4])-TRANSFORMATION_INTERACTION))
}
if(p[2] <= 0 & p[3] <= 0 & p[4] <= 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]+TRANSFORMATION_BETA2), log(p[4]+TRANSFORMATION_INTERACTION)), model=c("BM_linear_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = TRANSFORMATION_INTERACTION, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA1), (exp(res$estimate[3]) - TRANSFORMATION_BETA2), (exp(res$estimate[4])-TRANSFORMATION_INTERACTION))
}
}#End BM_linear_3
##################################
#start OU_NULL
if(MODEL == "OU_null"){
if(MODEL == "OU_null" & p_starting != "NULL"){
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 3)
result_matrix[,1:2] <- p_starting
}
if(MODEL == "OU_null" & p_starting == "NULL"){result_matrix <- starting.values(MODEL)}
result_matrix_values <- result_matrix #this is to store the actual values
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:2]
TRANSFORMATION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("OU_null"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
try(suppressWarnings(if(as.numeric(res$code)<3) res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]))), silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix[i,3] <- res$minimum else result_matrix[i,3] <- NA, silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix_values[i,3] <- res$minimum else result_matrix[i,3] <- NA, silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix_values[i,1:2] <- res$estimate else result_matrix[i,1:2] <- NA, silent = TRUE)
}
result_matrix[,3] <- round(as.numeric(result_matrix[,3]), 4)
result_matrix_values[,3] <- round(as.numeric(result_matrix_values[,3]), 4)
DD_order <- as.numeric(result_matrix_values[,1] + result_matrix_values[,2]) #This sums the Bstart, Bend, and alpha. We calculate Bend rather than use Bslope
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,3]), as.numeric(DD_order), decreasing = FALSE, na.last = TRUE),];
result_matrix_ordered_values <- result_matrix_values[order(as.numeric(result_matrix_values[,3]), as.numeric(DD_order), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:2]
TRANSFORMATION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("OU_null"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate))
if(round(res$minimum, 4) > round(result_matrix_ordered_values[1,3], 4)) {print("OU_NULL: final result is not MLE")}
}#End_OU_null
###################################
#start OU_linear_BETA
if(MODEL == "OU_linear_beta"){
if(MODEL == "OU_linear_beta" & p_starting != "NULL"){
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 4)
result_matrix[,1:3] <- p_starting
}
if(MODEL == "OU_linear_beta" & p_starting == "NULL"){result_matrix <- starting.values(MODEL)}
result_matrix_values <- result_matrix #this is to store the actual values
result_matrix_values <- result_matrix_values * NA
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:3]
if(p[2] <= 0){
TRANSFORMATION_BETA = 0 - p[2] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA), log(p[3])), model=c("OU_linear_beta"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION_BETA, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000, ndigit = 5)), silent = TRUE)
try(suppressWarnings(if(as.numeric(res$code)<3) res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA), exp(res$estimate[3]))), silent = TRUE)
}
if(p[2] > 0) {
TRANSFORMATION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("OU_linear_beta"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000, ndigit = 5)), silent = TRUE)
try(suppressWarnings(if(as.numeric(res$code)<3) res$estimate <- c(exp(res$estimate))), silent = TRUE)
}
try(if(as.numeric(res$code)<3) result_matrix[i,4] <- res$minimum else result_matrix[i,4] <- NA, silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix_values[i,4] <- res$minimum else result_matrix[i,4] <- NA, silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix_values[i,1:3] <- res$estimate else result_matrix[i,1:3] <- NA, silent = TRUE)
}
result_matrix[,4] <- round(as.numeric(result_matrix[,4]), 4)
result_matrix_values[,4] <- round(as.numeric(result_matrix_values[,4]), 4)
#DD_order <- as.numeric(result_matrix_values[,1] + result_matrix_values[,1] + result_matrix_values[,2]*max(GRAD) + result_matrix_values[,3]) #This sums the Bstart, Bend, and alpha. We calculate Bend rather than use Bslope
DD_order <- as.numeric(result_matrix_values[,1] + result_matrix_values[,1] + result_matrix_values[,2]*max(GRAD)) #This sums the Bstart, Bend, and alpha. We calculate Bend rather than use Bslope
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,4]), as.numeric(DD_order), decreasing = FALSE, na.last = TRUE),];
result_matrix_ordered_values <- result_matrix_values[order(as.numeric(result_matrix_values[,4]), as.numeric(DD_order), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:3]
if(p[2] <= 0){
TRANSFORMATION_BETA = 0 - p[2] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA), log(p[3])), model=c("OU_linear_beta"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION_BETA, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000, ndigit = 5)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA), exp(res$estimate[3]))
}
if(p[2] > 0){
TRANSFORMATION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("OU_linear_beta"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000, ndigit = 5)), silent = TRUE)
res$estimate <- c(exp(res$estimate))
}
if(round(res$minimum, 4) > round(result_matrix_ordered_values[1,4], 4)) {
print("OU_linear_beta: final result is not MLE")
print(round(res$minimum, 4) - round(result_matrix_ordered_values[1,4], 4))
print("OU_linear_beta: best MLE")
print(result_matrix_ordered_values[1,])
print("OU_linear_beta: final suboptimal MLE")
print(res$minimum)
print(res$estimate)
}
}#End OU_linear_BETA
###################################
#start OU_linear_beta_2
if(MODEL == "OU_linear_beta_2"){
if(MODEL == "OU_linear_beta_2" & p_starting != "NULL"){
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 5)
result_matrix[,1:5] <- p_starting
}
if(MODEL == "OU_linear_beta_2" & p_starting == "NULL"){result_matrix <- starting.values(MODEL)}
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:4]
if(p[2] <= 0 & p[3] > 0) {
TRANSFORMATION_BETA1 = 0- p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4])), model=c("OU_linear_beta_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("OU_linear_beta_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] <= 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2), log(p[4])), model=c("OU_linear_beta_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] <= 0 & p[3] <= 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]+TRANSFORMATION_BETA2), log(p[4])), model=c("OU_linear_beta_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
try(if(as.numeric(res$code)<3) result_matrix[i,5] <- res$minimum else result_matrix[i,5] <- NA, silent = TRUE)
}
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,5]), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:4]
if(p[2] <= 0 & p[3] > 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4])), model=c("OU_linear_beta_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA1), exp(res$estimate[3]), exp(res$estimate[4]))
}
if(p[2] > 0 & p[3] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("OU_linear_beta_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate))
}
if(p[2] > 0 & p[3] <= 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2), log(p[4])), model=c("OU_linear_beta_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), (exp(res$estimate[3]) - TRANSFORMATION_BETA2), exp(res$estimate[4]))
}
if(p[2] <= 0 & p[3] <= 0){
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]+TRANSFORMATION_BETA2), log(p[4])), model=c("OU_linear_beta_2"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2]) - TRANSFORMATION_BETA1), (exp(res$estimate[3]) - TRANSFORMATION_BETA2), exp(res$estimate[4]))
}
}#End OU_linear_beta_2
###################################
#start OU_linear_beta_3
if(MODEL == "OU_linear_beta_3"){
if(MODEL == "OU_linear_beta_3" & p_starting != "NULL"){
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 6)
result_matrix[,1:6] <- p_starting
}
if(MODEL == "OU_linear_beta_3" & p_starting == "NULL"){result_matrix <- starting.values(MODEL)}
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:5]
if(p[2] <= 0 & p[3] > 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = 0- p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = "NULL"
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4]), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", transformation_interaction = "NULL", transformation_alpha = "NULL",hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] <= 0 & p[3] > 0 & p[4] < 0) {
TRANSFORMATION_BETA1 = 0- p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4]+TRANSFORMATION_INTERACTION), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", transformation_interaction = TRANSFORMATION_INTERACTION, transformation_alpha = "NULL",hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] > 0 & p[4] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = "NULL"
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2), log(p[4]), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = "NULL", transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] <= 0 & p[4] < 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2), log(p[4]+TRANSFORMATION_INTERACTION), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = TRANSFORMATION_INTERACTION, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] < 0 & p[3] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]), log(p[4]+TRANSFORMATION_INTERACTION), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = "NULL", transformation_interaction = TRANSFORMATION_INTERACTION, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] <= 0 & p[3] <= 0 & p[4] <= 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]+TRANSFORMATION_BETA2), log(p[4]+TRANSFORMATION_INTERACTION), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = TRANSFORMATION_INTERACTION, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
try(if(as.numeric(res$code)<3) result_matrix[i,6] <- res$minimum else result_matrix[i,6] <- NA, silent = TRUE)
}
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,6]), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:5]
if(p[2] <= 0 & p[3] > 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = 0- p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = "NULL"
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4]), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", transformation_interaction = "NULL", transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA1), exp(res$estimate[3]), exp(res$estimate[4]), exp(res$estimate[5]))
}
if(p[2] <= 0 & p[3] > 0 & p[4] < 0) {
TRANSFORMATION_BETA1 = 0- p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4]+TRANSFORMATION_INTERACTION), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", transformation_interaction = TRANSFORMATION_INTERACTION, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA1), exp(res$estimate[3]), (exp(res$estimate[4])-TRANSFORMATION_INTERACTION), exp(res$estimate[5]))
}
if(p[2] > 0 & p[3] > 0 & p[4] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate))
}
if(p[2] > 0 & p[3] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = "NULL"
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2), log(p[4]), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), (exp(res$estimate[3]) - TRANSFORMATION_BETA2), exp(res$estimate[4]), exp(res$estimate[5]))
}
if(p[2] > 0 & p[3] <= 0 & p[4] < 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_BETA2), log(p[4]+TRANSFORMATION_INTERACTION), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = TRANSFORMATION_INTERACTION, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), (exp(res$estimate[3]) - TRANSFORMATION_BETA2), (exp(res$estimate[4])-TRANSFORMATION_INTERACTION), exp(res$estimate[5]))
}
if(p[2] < 0 & p[3] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = "NULL"
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]), log(p[4]+TRANSFORMATION_INTERACTION), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = "NULL", transformation_beta2 = "NULL", transformation_interaction = TRANSFORMATION_INTERACTION, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), exp(res$estimate[3]), (exp(res$estimate[4])-TRANSFORMATION_INTERACTION), exp(res$estimate[5]))
}
if(p[2] <= 0 & p[3] <= 0 & p[4] <= 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = 0 - p[3] + 0.0001
TRANSFORMATION_INTERACTION = 0 - p[4] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]+TRANSFORMATION_BETA2), log(p[4]+TRANSFORMATION_INTERACTION), log(p[5])), model=c("OU_linear_beta_3"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2 =GRAD2,transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, transformation_interaction = TRANSFORMATION_INTERACTION, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA1), (exp(res$estimate[3]) - TRANSFORMATION_BETA2), (exp(res$estimate[4])-TRANSFORMATION_INTERACTION), exp(res$estimate[5]))
}
}#End OU_linear_beta_3
###################################
#start OU_linear
if(MODEL == "OU_linear"){
if(MODEL == "OU_linear" & p_starting != "NULL"){
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 5)
result_matrix[,1:4] <- p_starting
}
if(MODEL == "OU_linear" & p_starting == "NULL"){result_matrix <- starting.values(MODEL)}
result_matrix_values <- result_matrix #this is to store the actual values
result_matrix_values <- result_matrix_values * NA
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:4]
if(p[2] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA = 0 - p[2] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA), log(p[3]), log(p[4])), model=c("OU_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION_BETA, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
try(suppressWarnings(res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA), exp(res$estimate[3]), exp(res$estimate[4]))), silent = TRUE)
}
if(p[2] > 0 & p[4] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("OU_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, hessian = FALSE, iterlim=50000)), silent = TRUE)
try(suppressWarnings(res$estimate <- c(exp(res$estimate))), silent = TRUE)
}
if(p[2] > 0 & p[4] <= 0) {
TRANSFORMATION_BETA = "NULL"
TRANSFORMATION_ALPHA = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]), log(p[4]+TRANSFORMATION_ALPHA)), model=c("OU_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = "NULL", transformation_alpha = TRANSFORMATION_ALPHA, hessian = FALSE, iterlim=50000)), silent = TRUE)
try(suppressWarnings(res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), exp(res$estimate[3]), (exp(res$estimate[4])-TRANSFORMATION_ALPHA))), silent = TRUE)
}
if(p[2] <= 0 & p[4] <= 0) {
TRANSFORMATION_BETA = 0 - p[2] + 0.0001
TRANSFORMATION_ALPHA = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA), log(p[3]), log(p[4]+TRANSFORMATION_ALPHA)), model=c("OU_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION_BETA, transformation_alpha = TRANSFORMATION_ALPHA, hessian = FALSE, iterlim=50000)), silent = TRUE)
try(suppressWarnings(res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA), exp(res$estimate[3]), (exp(res$estimate[4])-TRANSFORMATION_ALPHA))), silent = TRUE)
}
try(if(as.numeric(res$code)<3) result_matrix[i,5] <- res$minimum else result_matrix[i,5] <- NA, silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix_values[i,5] <- res$minimum else result_matrix[i,5] <- NA, silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix_values[i,1:4] <- res$estimate else result_matrix[i,1:4] <- NA, silent = TRUE)
}
result_matrix[,5] <- round(as.numeric(result_matrix[,5]), 4)
result_matrix_values[,5] <- round(as.numeric(result_matrix_values[,5]), 4)
DD_order <- as.numeric(result_matrix_values[,1] + result_matrix_values[,1] + result_matrix_values[,2]*max(GRAD) + result_matrix_values[,3]+ result_matrix_values[,4] + result_matrix_values[,4]*max(GRAD) ) #This sums the Bstart, Bend, and alpha and alpha end. We calculate Bend and Alpha end rather than use Bslope and A slope
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,5]), as.numeric(DD_order), decreasing = FALSE, na.last = TRUE),];
result_matrix_ordered_values <- result_matrix_values[order(as.numeric(result_matrix_values[,5]), as.numeric(DD_order), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:4]
if(p[2] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA = 0 - p[2] + 0.0001
TRANSFORMATION_ALPHA = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA), log(p[3]), log(p[4])), model=c("OU_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION_BETA, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA), exp(res$estimate[3]), exp(res$estimate[4]))
}
if(p[2] > 0 & p[4] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("OU_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate))
}
if(p[2] > 0 & p[4] <= 0) {
TRANSFORMATION_BETA = "NULL"
TRANSFORMATION_ALPHA = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]), log(p[4]+TRANSFORMATION_ALPHA)), model=c("OU_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = "NULL", transformation_alpha = TRANSFORMATION_ALPHA, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), exp(res$estimate[3]), (exp(res$estimate[4]) - TRANSFORMATION_ALPHA))
}
if(p[2] <= 0 & p[4] <= 0) {
TRANSFORMATION_BETA = 0 - p[2] + 0.0001
TRANSFORMATION_ALPHA = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA), log(p[3]), log(p[4]+TRANSFORMATION_ALPHA)), model=c("OU_linear"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta = TRANSFORMATION_BETA, transformation_alpha = TRANSFORMATION_ALPHA, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2]) - TRANSFORMATION_BETA), exp(res$estimate[3]), (exp(res$estimate[4]) - TRANSFORMATION_ALPHA))
}
if(round(res$minimum, 4) > round(result_matrix_ordered_values[1,5], 4)) {print("OU_linear: final result is not MLE")}
}#End OU_linear
###########################################
#start BM_linear_breakpoint
if(MODEL == "BM_linear_breakpoint"){
if(MODEL == "BM_linear_breakpoint" & p_starting != "NULL"){
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 5)
result_matrix[,1:4] <- p_starting
}
if(MODEL == "BM_linear_breakpoint" & p_starting == "NULL"){result_matrix <- starting.values(MODEL)}
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:4]
if(p[2] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4])), model=c("BM_linear_breakpoint"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[4] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("BM_linear_breakpoint"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[4] <= 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]), log(p[4]+TRANSFORMATION_BETA2)), model=c("BM_linear_breakpoint"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] <= 0 & p[4] <= 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4]+TRANSFORMATION_BETA2)), model=c("BM_linear_breakpoint"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
try(if(as.numeric(res$code)<3) result_matrix[i,5] <- res$minimum else result_matrix[i,5] <- NA, silent = TRUE)
}
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,5]), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:4]
if(p[2] <= 0 & p[4] > 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4])), model=c("BM_linear_breakpoint"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_BETA1), exp(res$estimate[3]), exp(res$estimate[4]))
}
if(p[2] > 0 & p[4] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("BM_linear_breakpoint"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate))
}
if(p[2] > 0 & p[4] <= 0) {
TRANSFORMATION_BETA1 = "NULL"
TRANSFORMATION_BETA2 = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]), log(p[4]+TRANSFORMATION_BETA2)), model=c("BM_linear_breakpoint"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta1 = "NULL", transformation_beta2 = TRANSFORMATION_BETA2, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), exp(res$estimate[3]), (exp(res$estimate[4]) - TRANSFORMATION_BETA2))
}
if(p[2] <= 0 & p[4] <= 0) {
TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001
TRANSFORMATION_BETA2 = 0 - p[4] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_BETA1), log(p[3]), log(p[4]+TRANSFORMATION_BETA2)), model=c("BM_linear_breakpoint"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2]) - TRANSFORMATION_BETA1), exp(res$estimate[3]), (exp(res$estimate[4]) - TRANSFORMATION_BETA2))
}
}#End BM_linear_breakpoint
###########################################
#start BM_quadratic
if(MODEL == "BM_quadratic"){
if(MODEL == "BM_quadratic" & p_starting != "NULL"){
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 4)
result_matrix[,1:3] <- p_starting
}
if(MODEL == "BM_quadratic" & p_starting == "NULL"){result_matrix <- starting.values(MODEL)}
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:3]
if(p[2] <= 0 & p[3] > 0) {
TRANSFORMATION_b = 0 - p[2] + 0.0001
TRANSFORMATION_a = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_b), log(p[3])), model=c("BM_quadratic"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_b = TRANSFORMATION_b, transformation_a = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("BM_quadratic"), DIST=DIST, TIME=TIME, GRAD=GRAD, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] > 0 & p[3] <= 0) {
TRANSFORMATION_b = "NULL"
TRANSFORMATION_a = 0 - p[3] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_a)), model=c("BM_quadratic"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_b = "NULL", transformation_a = TRANSFORMATION_a, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(p[2] <= 0 & p[3] <= 0) {
TRANSFORMATION_b = 0 - p[2] + 0.0001
TRANSFORMATION_a = 0 - p[3] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_b), log(p[3]+TRANSFORMATION_a)), model=c("BM_quadratic"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_b = TRANSFORMATION_b, transformation_a = TRANSFORMATION_a, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
try(if(as.numeric(res$code)<3) result_matrix[i,4] <- res$minimum else result_matrix[i,4] <- NA, silent = TRUE)
}
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,4]), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:3]
if(p[2] <= 0 & p[3] > 0) {
TRANSFORMATION_b = 0 - p[2] + 0.0001
TRANSFORMATION_a = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_b), log(p[3])), model=c("BM_quadratic"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_b = TRANSFORMATION_b, transformation_a = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2])-TRANSFORMATION_b), exp(res$estimate[3]))
}
if(p[2] > 0 & p[3] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p)), model=c("BM_quadratic"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- exp(res$estimate)
}
if(p[2] > 0 & p[3] <= 0) {
TRANSFORMATION_b = "NULL"
TRANSFORMATION_a = 0 - p[3] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]), log(p[3]+TRANSFORMATION_a)), model=c("BM_quadratic"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_b = "NULL", transformation_a = TRANSFORMATION_a, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), exp(res$estimate[2]), (exp(res$estimate[3]) - TRANSFORMATION_a))
}
if(p[2] <= 0 & p[3] <= 0) {
TRANSFORMATION_b = 0 - p[2] + 0.0001
TRANSFORMATION_a = 0 - p[3] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p[1]), log(p[2]+TRANSFORMATION_b), log(p[3]+TRANSFORMATION_a)), model=c("BM_quadratic"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_b = TRANSFORMATION_b, transformation_a = TRANSFORMATION_a, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2]) - TRANSFORMATION_b), (exp(res$estimate[3]) - TRANSFORMATION_a))
}
}#End BM_quadratic
############################
#start BM_2rate
if(MODEL == "BM_2rate"){
LS <- sort(GRAD)
N_LS <- length(LS)
LS_acceptable <- LS[11:(N_LS - 10)]
BREAKPOINTS <- LS_acceptable[-length(LS_acceptable)] + (LS_acceptable[-1] - LS_acceptable[-length(LS_acceptable)] ) / 2
if(p_starting == "NULL"){
RATE1 <- c(0.001, 0.01, 0.1, 1, 10, 100, 1000)
RATE2 <- c(0.001, 0.01, 0.1, 1, 10, 100, 1000)
}
if(p_starting != "NULL"){
RATE1 <- Beta_starting
RATE2 <- Beta_starting
}
negLogL = 1e20
for(a in 1:length(BREAKPOINTS)){
BREAKPOINT_a <- BREAKPOINTS[a]
for(b in 1:length(RATE1)){
RATE1_b <- RATE1[b]
for(c in 1:length(RATE2)){
RATE2_c <- RATE2[c]
parameters = c(RATE1_b, RATE2_c)
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(parameters)), model=c("BM_2rate"), breakpoint = BREAKPOINT_a, meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, hessian = FALSE, iterlim=50000)), silent = TRUE)
#try(if(as.numeric(res$code)<3) result_matrix[i,4] <- res$minimum else result_matrix[i,4] <- NA, silent = TRUE)
if(res$minimum < negLogL){
negLogL <- res$minimum
breakpoint <- BREAKPOINT_a
best_result <- res
}
}
}
}
best_result$estimate <- exp(best_result$estimate)
res <- best_result
res$estimate[3] <- breakpoint
}#End BM_2rate
############################
#start OU_2rate
if(MODEL == "OU_2rate"){
if(p_starting != "NULL"){
RATE1_Beta <- Beta_starting
RATE2_Beta <- Beta_starting
RATE1_Alpha <- Alpha_starting
RATE2_Alpha <- Alpha_starting
}
if(p_starting == "NULL"){
RATE1_Beta <- c(0.01, 0.1, 1, 10, 100)
RATE2_Beta <- c(0.01, 0.1, 1, 10, 100)
RATE1_Alpha <- c(0.01, 0.1, 1, 10)
RATE2_Alpha <- c(0.01, 0.1, 1, 10)
}
LS <- sort(GRAD)
N_LS <- length(LS)
LS_acceptable <- LS[11:(N_LS - 10)]
MaxL <- max(LS_acceptable)
MinL <- min(LS_acceptable)
RangeL <- MaxL - MinL
Div <- RangeL/6
Break1 <- MinL + Div
Break2 <- Break1 + Div
Break3 <- Break2 + Div
Break4 <- Break3 + Div
Break5 <- Break4 + Div
BREAKPOINTS <- c(Break1, Break2, Break3, Break4, Break5)
negLogL = 1e20
for(a in 1:length(BREAKPOINTS)){
BREAKPOINT_a <- BREAKPOINTS[a]
for(b in 1:length(RATE1_Beta)){
RATE1_Beta_b <- RATE1_Beta[b]
for(c in 1:length(RATE2_Beta)){
RATE2_Beta_c <- RATE2_Beta[c]
for(d in 1:length(RATE1_Alpha)){
RATE1_Alpha_d <- RATE1_Alpha[d]
for(e in 1:length(RATE2_Alpha)){
RATE2_Alpha_e <- RATE2_Alpha[e]
parameters = c(RATE1_Beta_b, RATE2_Beta_c, RATE1_Alpha_d, RATE2_Alpha_e)
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(parameters)), model=c("OU_2rate"), breakpoint = BREAKPOINT_a, meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, hessian = FALSE, iterlim=50000)), silent = TRUE)
if(res$minimum < negLogL){
negLogL <- res$minimum
breakpoint <- BREAKPOINT_a
best_result <- res
}
}
}
}
}
}
best_result$estimate <- exp(best_result$estimate)
#this bit now exhaustively searches around the best of the 5 breakpoints above.
MIN <- breakpoint - Div
MAX <- breakpoint + Div
LS <- sort(GRAD[(GRAD < MAX & GRAD > MIN)])
BREAKPOINTS <- LS[-length(LS)] + (LS[-1] - LS[-length(LS)] ) / 2
RATE1_Beta <- c((best_result$estimate[1] / 10), best_result$estimate[1], (best_result$estimate[1] *10))
RATE2_Beta <- c((best_result$estimate[2] / 10), best_result$estimate[2], (best_result$estimate[2] *10))
RATE1_Alpha <- c((best_result$estimate[3] / 10), best_result$estimate[3], (best_result$estimate[3] *10))
RATE2_Alpha <- c((best_result$estimate[4] / 10), best_result$estimate[4], (best_result$estimate[4] *10))
negLogL = 1e20
for(a in 1:length(BREAKPOINTS)){
BREAKPOINT_a <- BREAKPOINTS[a]
for(b in 1:length(RATE1_Beta)){
RATE1_Beta_b <- RATE1_Beta[b]
for(c in 1:length(RATE2_Beta)){
RATE2_Beta_c <- RATE2_Beta[c]
for(d in 1:length(RATE1_Alpha)){
RATE1_Alpha_d <- RATE1_Alpha[d]
for(e in 1:length(RATE2_Alpha)){
RATE2_Alpha_e <- RATE2_Alpha[e]
parameters = c(RATE1_Beta_b, RATE2_Beta_c, RATE1_Alpha_d, RATE2_Alpha_e)
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(parameters)), model=c("OU_2rate"), breakpoint = BREAKPOINT_a, meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, hessian = FALSE, iterlim=50000)), silent = TRUE)
if(res$minimum < negLogL){
negLogL <- res$minimum
breakpoint <- BREAKPOINT_a
best_result <- res
}
}
}
}
}
}
best_result$estimate <- exp(best_result$estimate)
res = best_result
res$estimate[5] <- breakpoint
}
############################
#start OU_linear_breakpoint
if(MODEL == "OU_linear_breakpoint"){
if(MODEL == "OU_linear_breakpoint" & p_starting != "NULL"){
p_starting = p_starting
result_matrix <- matrix(NA, nrow(p_starting), 8)
result_matrix[,1:7] <- p_starting
}
if(MODEL == "OU_linear_breakpoint" & p_starting == "NULL"){result_matrix <- starting.values(MODEL)}
for(i in 1:nrow(result_matrix)){
res = "NA"
p = result_matrix[i,1:7]
TRANSFORMATION_BETA1 = 0
TRANSFORMATION_BETA2 = 0
TRANSFORMATION_ALPHA1 = 0
TRANSFORMATION_ALPHA2 = 0
if(p[2] <= 0){TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001}
if(p[4] <= 0){TRANSFORMATION_BETA2 = 0 - p[4] + 0.0001}
if(p[6] <= 0){TRANSFORMATION_ALPHA1 = 0 - p[6] + 0.0001}
if(p[7] <= 0){TRANSFORMATION_ALPHA2 = 0 - p[7] + 0.0001}
p2 <- c(p[1], p[2]+TRANSFORMATION_BETA1, p[3], p[4]+TRANSFORMATION_BETA2, p[5], p[6]+ TRANSFORMATION_ALPHA1, p[7]+TRANSFORMATION_ALPHA1)
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p2)), model=c("OU_linear_breakpoint"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, transformation_alpha1 = TRANSFORMATION_ALPHA1, transformation_alpha2 = TRANSFORMATION_ALPHA2, hessian = FALSE, iterlim=50000)), silent = TRUE)
try(if(as.numeric(res$code)<3) result_matrix[i,8] <- res$minimum else result_matrix[i,8] <- NA, silent = TRUE)
}
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,8]), decreasing = FALSE, na.last = TRUE),];
p <- result_matrix_ordered[1,1:7]
res = "NA"
TRANSFORMATION_BETA1 = 0
TRANSFORMATION_BETA2 = 0
TRANSFORMATION_ALPHA1 = 0
TRANSFORMATION_ALPHA2 = 0
if(p[2] <= 0){TRANSFORMATION_BETA1 = 0 - p[2] + 0.0001}
if(p[4] <= 0){TRANSFORMATION_BETA2 = 0 - p[4] + 0.0001}
if(p[6] <= 0){TRANSFORMATION_ALPHA1 = 0 - p[6] + 0.0001}
if(p[7] <= 0){TRANSFORMATION_ALPHA2 = 0 - p[7] + 0.0001}
p2 <- c(p[1], p[2]+TRANSFORMATION_BETA1, p[3], p[4]+TRANSFORMATION_BETA2, p[5], p[6]+ TRANSFORMATION_ALPHA1, p[7]+TRANSFORMATION_ALPHA1)
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace, p = c(log(p2)), model=c("OU_linear_breakpoint"), meserr1 = meserr1, meserr2 = meserr2, DIST=DIST, TIME=TIME, GRAD=GRAD, transformation_beta1 = TRANSFORMATION_BETA1, transformation_beta2 = TRANSFORMATION_BETA2, transformation_alpha1 = TRANSFORMATION_ALPHA1, transformation_alpha2 = TRANSFORMATION_ALPHA2, hessian = FALSE, iterlim=50000)), silent = TRUE)
res$estimate <- c(exp(res$estimate[1]), (exp(res$estimate[2]) - TRANSFORMATION_BETA1), exp(res$estimate[3]), (exp(res$estimate[4]) - TRANSFORMATION_BETA2), exp(res$estimate[5]),exp(res$estimate[6])- TRANSFORMATION_ALPHA1,exp(res$estimate[3])- TRANSFORMATION_ALPHA2)
}#End OU_linear_breakpoint
return(res)
}
MScorrection <- function(nA,nB, VarA, VarB, MSwithin = NA, DIST_actual){
#Jason T. Weir June 6 2010 based on ideas of Trevor Price
#Function corrects for finite sample size in Euclidean distances given known variances in each sample
#nA = number individuals in species A
#nB = number individuals in species B
#VarA = variance species A
#VarB = variance species B
#DIST_actual = measured Euclidean distance
k <- 2
N <- nA +nB
if(is.na(MSwithin)==1){MSwithin1 <- ( VarA * (nA - 1) + VarB * (nB - 1) ) / ( N-k ) } else MSwithin1 = MSwithin
GRAND_MEAN <- (nB*abs(DIST_actual)) / (nA+nB)
MSbetween <- (nA * (0 - GRAND_MEAN)^2) + (nB * (abs(DIST_actual) - GRAND_MEAN)^2) #this is always correct
#MSbetween <- (nA * (0 - 0.5*abs(DIST_actual))^2) + (nB * (abs(DIST_actual) - 0.5*abs(DIST_actual))^2) #This is correct only if nA=nB
No <- (nA+nB) - (nA^2+nB^2)/(nA+nB)
SA2 <- 2* (MSbetween - MSwithin1) / No
for(i in 1:length(SA2)){
if(SA2[i] < 0) { SA2[i] <- 0 }
}
SA <- SA2^0.5
return(SA)
}
model.test.sisters <- function(DIST, TIME, GRAD, GRAD2 = NULL, meserr1 = 0, meserr2 = 0, models = c("BM_null", "BM_linear","BM_2rate", "BM_linear_breakpoint", "BM_quadratic", "OU_null", "OU_linear_beta", "OU_linear", "OU_2rate", "OU_linear_breakpoint"), starting=NULL, Beta_starting = NULL, Alpha_starting = NULL){
RESULTS_SUMMARY <- matrix(NA,length(models),19)
colnames(RESULTS_SUMMARY) <- c("MODEL","logLik","n","AIC","AICc","b1","b1_slope","breakpoint","b2","b2_slope","quadratic_term","a1","a1_slope","a2", "a2_slope","Quadratic_c","Quadratic_b","Quadratic_a","nlm_termination_code")
rownames(RESULTS_SUMMARY) <- models
N <- length(models)
if(length(starting) == 1){
gg <- "NULL"
if(starting[1] == "NULL"){starting[1:N] <- "NULL"}
}
if(sum(models == "BM_null") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "BM_null") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="BM_null", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="BM_null", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(1, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "BM_linear") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "BM_linear") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="BM_linear", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="BM_linear", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(2, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,7] <- res$estimate[2]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "BM_linear_2") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "BM_linear_2") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="BM_linear_2", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2=GRAD2)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="BM_linear_2", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2=GRAD2)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(3, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,7] <- res$estimate[2]
RESULTS_SUMMARY[j,8] <- res$estimate[3]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "BM_linear_3") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "BM_linear_3") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="BM_linear_3", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2=GRAD2)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="BM_linear_3", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2=GRAD2)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(4, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,7] <- res$estimate[2]
RESULTS_SUMMARY[j,8] <- res$estimate[3]
RESULTS_SUMMARY[j,9] <- res$estimate[4]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "BM_2rate") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "BM_2rate") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="BM_2rate", Beta_starting, DIST=DIST, TIME=TIME, GRAD=GRAD)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="BM_2rate", Beta_starting = "NULL", DIST=DIST, TIME=TIME, GRAD=GRAD)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(3, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,8] <- res$estimate[3]
RESULTS_SUMMARY[j,9] <- res$estimate[2]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "BM_linear_breakpoint") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "BM_linear_breakpoint") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="BM_linear_breakpoint", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="BM_linear_breakpoint", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(4, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,7] <- res$estimate[2]
RESULTS_SUMMARY[j,8] <- res$estimate[3]
RESULTS_SUMMARY[j,10] <- res$estimate[4]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "BM_quadratic") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "BM_quadratic") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="BM_quadratic", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="BM_quadratic", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(3, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,16] <- res$estimate[1]
RESULTS_SUMMARY[j,17] <- res$estimate[2]
RESULTS_SUMMARY[j,18] <- res$estimate[3]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "OU_null") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "OU_null") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="OU_null", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="OU_null", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(2, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,12] <- res$estimate[2]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "OU_linear_beta") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "OU_linear_beta") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="OU_linear_beta", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="OU_linear_beta", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(3, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,7] <- res$estimate[2]
RESULTS_SUMMARY[j,12] <- res$estimate[3]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "OU_linear_beta_2") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "OU_linear_beta_2") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="OU_linear_beta_2", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2=GRAD2)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="OU_linear_beta_2", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2=GRAD2)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(4, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,7] <- res$estimate[2]
RESULTS_SUMMARY[j,8] <- res$estimate[3]
RESULTS_SUMMARY[j,9] <- res$estimate[4]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "OU_linear_beta_3") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "OU_linear_beta_3") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="OU_linear_beta_3", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2=GRAD2)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="OU_linear_beta_3", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD, GRAD2=GRAD2)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(5, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,7] <- res$estimate[2]
RESULTS_SUMMARY[j,8] <- res$estimate[3]
RESULTS_SUMMARY[j,9] <- res$estimate[4]
RESULTS_SUMMARY[j,10] <- res$estimate[5]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "OU_linear") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "OU_linear") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="OU_linear", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="OU_linear", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(4, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,7] <- res$estimate[2]
RESULTS_SUMMARY[j,12] <- res$estimate[3]
RESULTS_SUMMARY[j,13] <- res$estimate[4]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "OU_2rate") == 1){
j <- sum((rownames(RESULTS_SUMMARY) == "OU_2rate") * 1:N)
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="OU_2rate", Beta_starting, Alpha_starting, DIST=DIST, TIME=TIME, GRAD=GRAD)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="OU_2rate", Beta_starting = "NULL", Alpha_starting = "NULL", DIST=DIST, TIME=TIME, GRAD=GRAD)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(5, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,8] <- res$estimate[5]
RESULTS_SUMMARY[j,9] <- res$estimate[2]
RESULTS_SUMMARY[j,12] <- res$estimate[3]
RESULTS_SUMMARY[j,14] <- res$estimate[4]
RESULTS_SUMMARY[j,19]<- res$code
}
if(sum(models == "OU_linear_breakpoint") == 1){
if(is.null(starting[[j]][1]) ==FALSE){res <- find.mle.sister(MODEL="OU_linear_breakpoint", meserr1 = meserr1, meserr2 = meserr2, p_starting=starting[[j]], DIST=DIST, TIME=TIME, GRAD=GRAD)}
if(is.null(starting[[j]][1])){res <- find.mle.sister(MODEL="OU_linear_breakpoint", meserr1 = meserr1, meserr2 = meserr2, p_starting="NULL", DIST=DIST, TIME=TIME, GRAD=GRAD)}
RESULTS_SUMMARY[j,2] <- -res$minimum
RESULTS_SUMMARY[j,3] <- round(7, 0)
RESULTS_SUMMARY[j,4] <- 2 * as.numeric(RESULTS_SUMMARY[j,3]) - 2*as.numeric(RESULTS_SUMMARY[j,2])
RESULTS_SUMMARY[j,5] <- as.numeric(RESULTS_SUMMARY[j,4]) + (2 * as.numeric(RESULTS_SUMMARY[j,3])*(as.numeric(RESULTS_SUMMARY[j,3]) + 1)) / (length(GRAD) - as.numeric(RESULTS_SUMMARY[j,3]) - 1)
RESULTS_SUMMARY[j,6] <- res$estimate[1]
RESULTS_SUMMARY[j,7] <- res$estimate[2]
RESULTS_SUMMARY[j,8] <- res$estimate[3]
RESULTS_SUMMARY[j,10] <- res$estimate[4]
RESULTS_SUMMARY[j,12] <- res$estimate[5]
RESULTS_SUMMARY[j,13] <- res$estimate[6]
RESULTS_SUMMARY[j,15] <- res$estimate[7]
RESULTS_SUMMARY[j,19]<- res$code
}
ROWLABELS <- rownames(RESULTS_SUMMARY)
RESULTS_SUMMARY <- RESULTS_SUMMARY[,-1,drop=FALSE]
rownames(RESULTS_SUMMARY) <- ROWLABELS
RESULTS_SUMMARY <- t(RESULTS_SUMMARY)
# RESULTS_SUMMARY[rowSums(is.na(RESULTS_SUMMARY))!=ncol(RESULTS_SUMMARY), ]
return(RESULTS_SUMMARY)
}
sim.sisters <- function(TIME, GRAD, GRAD2 = NULL, parameters, model, MULT=1)
{
if(model=="BM_null"){
B <- parameters[1]
VAR_NORM = B*TIME
}
if(model=="BM_linear"){
cB <- parameters[1]
SlopeB <- parameters[2]
B = GRAD*SlopeB + cB
VAR_NORM = B*TIME
}
if(model=="BM_2rate"){
cB1 <- parameters[1]
cB2 <- parameters[2]
breakpoint <- parameters[3]
B <- (cB1)*(GRAD <= breakpoint) + (cB2) * (GRAD > breakpoint)
VAR_NORM = B*TIME
}
if(model=="BM_linear_breakpoint"){
cB1 <- parameters[1]
breakpoint <- parameters[3]
SlopeB1 <- parameters[2]
SlopeB2 <- parameters[4]
cB2 = breakpoint * SlopeB1 + cB1 - breakpoint * SlopeB2
B <- (SlopeB1 * GRAD + cB1)*(GRAD <= breakpoint) + (SlopeB2 * GRAD + cB2) * (GRAD > breakpoint)
VAR_NORM = B*TIME
}
if(model=="BM_quadratic"){
c <- parameters[1]
b <- parameters[2]
a <- parameters[3]
B <- c + b*GRAD + a*GRAD^2
VAR_NORM = B*TIME
}
if(model=="OU_null"){
B <- parameters[1]
A <- parameters[2]
VAR_NORM = (B / (2*A)) * (1-exp(-2*A*TIME))
}
if(model=="OU_linear_beta"){
cB <- parameters[1]
SlopeB <- parameters[2]
A <- parameters[3]
SlopeA <- 0
B = GRAD*SlopeB + cB
VAR_NORM = (B / (2*A)) * (1-exp(-2*A*TIME))
}
if(model=="BM_linear_2"){
Cstart_B <- parameters[1]
Slope1_B <- parameters[2]
Slope2_B <- parameters[3]
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B
VAR_NORM = B*TIME
}
if(model=="BM_linear_3"){
Cstart_B <- parameters[1]
Slope1_B <- parameters[2]
Slope2_B <- parameters[3]
Interaction <- parameters[4]
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B + GRAD*GRAD2*Interaction
VAR_NORM = B*TIME
}
if(model=="OU_linear_beta_2"){
Cstart_B <- parameters[1]
Cstart_A <- parameters[4]
Slope1_B <- parameters[2]
Slope2_B <- parameters[3]
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B
VAR_NORM <- (B / (2*Alpha)) * (1-exp(-2*Alpha*TIME))
}
if(model=="OU_linear_beta_3"){
Cstart_B <- parameters[1]
Cstart_A <- parameters[5]
Slope1_B <- parameters[2]
Slope2_B <- parameters[3]
Interaction <- parameters[4]
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Cstart_B + GRAD*Slope1_B + GRAD2*Slope2_B
VAR_NORM <- (B / (2*Alpha)) * (1-exp(-2*Alpha*TIME))
}
if(model=="OU_linear"){
cB <- parameters[1]
SlopeB <- parameters[2]
cA <- parameters[3]
SlopeA <- parameters[4]
B = GRAD*SlopeB + cB
A = GRAD*SlopeA + cA
VAR_NORM = (B / (2*A)) * (1-exp(-2*A*TIME))
}
if(model=="OU_2rate"){
cB1 <- parameters[1]
cB2 <- parameters[3]
breakpoint <- parameters[2]
cA1 <- parameters[4]
cA2 <- parameters[5]
B <- (cB1)*(GRAD <= breakpoint) + (cB2) * (GRAD > breakpoint)
A <- (cA1)*(GRAD <= breakpoint) + (cA2) * (GRAD > breakpoint)
VAR_NORM = (B / (2*A)) * (1-exp(-2*A*TIME))
}
if(model=="OU_linear_breakpoint"){
cB1 <- parameters[1]
breakpoint <- parameters[3]
SlopeB1 <- parameters[2]
SlopeB2 <- parameters[4]
cA1 <- parameters[5]
SlopeA1 <- parameters[6]
SlopeA2 <- parameters[7]
cB2 = breakpoint * SlopeB1 + cB1 - breakpoint * SlopeB2
B <- (SlopeB1 * GRAD + cB1)*(GRAD <= breakpoint) + (SlopeB2 * GRAD + cB2) * (GRAD > breakpoint)
cA2 = breakpoint * SlopeA1 + cA1 - breakpoint * SlopeA2
A <- (SlopeA1 * GRAD + cA1)*(GRAD <= breakpoint) + (SlopeA2 * GRAD + cA2) * (GRAD > breakpoint)
VAR_NORM = (B / (2*A)) * (1-exp(-2*A*TIME))
}
SD_NORM = VAR_NORM^0.5
dd1 <- rnorm(n=length(TIME)*MULT, mean = 0, sd = SD_NORM)
dd2 <- rnorm(n=length(TIME)*MULT, mean = 0, sd = SD_NORM)
ee <- abs(dd1-dd2)
results <- matrix(NA, length(TIME)*MULT, 3)
colnames(results) <- c("GRAD", "TIME", "DIST")
results[,1] <- rep.int(GRAD, times=MULT)
results[,2] <- rep.int(TIME, times=MULT)
results[,3] <- ee
return(results)
}
expectation.time <- function(Beta, Alpha="NULL", time.span=c(0, 10), values=TRUE, plot=TRUE, quantile=FALSE){
if(length(time.span)==1){TIME <- time.span}
if(length(time.span) >2){TIME <- time.span}
if(length(time.span)==2){
N <- time.span[2] *1000
TIME <- (0:N)*0.001
}
if(Alpha == "NULL"){
V <- Beta*TIME*2
DIST <- ((2*V)/pi)^0.5
}
if(Alpha != "NULL"){
V <- (Beta / (Alpha)) * (1-exp(-2*Alpha*TIME))
DIST <- ((2*V)/pi)^0.5
}
if(quantile == TRUE){
QUANTILE_95 <- qnorm(p=0.975, mean = 0, sd = V^0.5)
QUANTILE_90 <- qnorm(p=0.95, mean = 0, sd = V^0.5)
QUANTILE_80 <- qnorm(p=0.90, mean = 0, sd = V^0.5)
QUANTILE_70 <- qnorm(p=0.85, mean = 0, sd = V^0.5)
QUANTILE_60 <- qnorm(p=0.80, mean = 0, sd = V^0.5)
QUANTILE_50 <- qnorm(p=0.75, mean = 0, sd = V^0.5)
QUANTILE_40 <- qnorm(p=0.70, mean = 0, sd = V^0.5)
QUANTILE_30 <- qnorm(p=0.65, mean = 0, sd = V^0.5)
QUANTILE_20 <- qnorm(p=0.60, mean = 0, sd = V^0.5)
QUANTILE_10 <- qnorm(p=0.55, mean = 0, sd = V^0.5)
}
if(plot == TRUE){
if(quantile == TRUE){
plot(QUANTILE_95 ~ TIME, xlab="Genetic distance of sister pair", ylab = "Euclidean distance", ylim=c(0,12), type="l", lty = 2)
lines(QUANTILE_90 ~ TIME, lty = 2)
lines(QUANTILE_80 ~ TIME, lty = 2)
lines(QUANTILE_70 ~ TIME, lty = 2)
lines(QUANTILE_60 ~ TIME, lty = 2)
lines(QUANTILE_50 ~ TIME, lty = 2)
lines(QUANTILE_40 ~ TIME, lty = 2)
lines(QUANTILE_30 ~ TIME, lty = 2)
lines(QUANTILE_20 ~ TIME, lty = 2)
lines(QUANTILE_10 ~ TIME, lty = 2)
lines(DIST ~ TIME)
}
if(quantile == FALSE){plot(DIST ~ TIME, xlab="Genetic distance of sister pair", ylab = "Euclidean distance", type="l")}
}
if(values == TRUE){
if(quantile == FALSE){
RESULTS <- matrix(NA, length(TIME),2)
colnames(RESULTS) <- c("TIME", "Expectation")
RESULTS[,1] <- TIME
RESULTS[,2] <- DIST
}
if(quantile == TRUE){
RESULTS <- matrix(NA,length(TIME),12)
colnames(RESULTS) <- c("TIME", "Expectation", "q10", "q20", "q30", "q40", "q50", "q60", "q70", "q80", "q90", "q95")
RESULTS[,1] <- TIME
RESULTS[,2] <- DIST
RESULTS[,3] <- QUANTILE_10
RESULTS[,4] <- QUANTILE_20
RESULTS[,5] <- QUANTILE_30
RESULTS[,6] <- QUANTILE_40
RESULTS[,7] <- QUANTILE_50
RESULTS[,8] <- QUANTILE_60
RESULTS[,9] <- QUANTILE_70
RESULTS[,10] <- QUANTILE_80
RESULTS[,11] <- QUANTILE_90
RESULTS[,12] <- QUANTILE_95
}
return(RESULTS)
}
}
expectation.gradient <- function(gradient.span = c(0, 10), model = c("BM_null", "BM_linear", "BM_2rate", "BM_linear_breakpoint", "BM_quadratic", "OU_null", "OU_linear_beta", "OU_linear", "OU_2rate", "OU_linear_breakpoint"), parameters, time=c(3), values=TRUE, plot=TRUE, quantile=FALSE){
if(length(gradient.span) >2){GRAD <- gradient.span}
if(length(gradient.span)==2){
START <- gradient.span[1] *1000
END <- gradient.span[2] *1000
GRAD <- (START:END)*0.001
}
TIME = time
if(model=="BM_null"){
B <- parameters[1]
V = B*TIME*2
DIST <- ((2*V)/pi)^0.5
}
if(model=="BM_linear"){
cB <- parameters[1]
SlopeB <- parameters[2]
B = GRAD*SlopeB + cB
V = B*TIME*2
DIST <- ((2*V)/pi)^0.5
}
if(model=="BM_2rate"){
cB1 <- parameters[1]
cB2 <- parameters[2]
breakpoint <- parameters[3]
B <- (cB1)*(GRAD <= breakpoint) + (cB2) * (GRAD > breakpoint)
V = B*TIME*2
DIST <- ((2*V)/pi)^0.5
}
if(model=="BM_linear_breakpoint"){
cB1 <- parameters[1]
breakpoint <- parameters[3]
SlopeB1 <- parameters[2]
SlopeB2 <- parameters[4]
cB2 = breakpoint * SlopeB1 + cB1 - breakpoint * SlopeB2
B <- (SlopeB1 * GRAD + cB1)*(GRAD <= breakpoint) + (SlopeB2 * GRAD + cB2) * (GRAD > breakpoint)
V = B*TIME*2
DIST <- ((2*V)/pi)^0.5
}
if(model=="BM_quadratic"){
c <- parameters[1]
b <- parameters[2]
a <- parameters[3]
B <- c + b*GRAD + a*GRAD^2
V = B*TIME*2
DIST <- ((2*V)/pi)^0.5
}
if(model=="OU_null"){
B <- parameters[1]
A <- parameters[2]
V = (B / (A)) * (1-exp(-2*A*TIME))
DIST <- ((2*V)/pi)^0.5
}
if(model=="OU_linear_beta"){
cB <- parameters[1]
SlopeB <- parameters[2]
A <- parameters[3]
SlopeA <- 0
B = GRAD*SlopeB + cB
V = (B / (A)) * (1-exp(-2*A*TIME))
DIST <- ((2*V)/pi)^0.5
}
if(model=="OU_linear"){
cB <- parameters[1]
SlopeB <- parameters[2]
cA <- parameters[3]
SlopeA <- parameters[4]
B = GRAD*SlopeB + cB
A = GRAD*SlopeA + cA
V = (B / (A)) * (1-exp(-2*A*TIME))
DIST <- ((2*V)/pi)^0.5
}
if(model=="OU_2rate"){
cB1 <- parameters[1]
cB2 <- parameters[3]
breakpoint <- parameters[2]
cA1 <- parameters[4]
cA2 <- parameters[5]
B <- (cB1)*(GRAD <= breakpoint) + (cB2) * (GRAD > breakpoint)
A <- (cA1)*(GRAD <= breakpoint) + (cA2) * (GRAD > breakpoint)
V = (B / (A)) * (1-exp(-2*A*TIME))
DIST <- ((2*V)/pi)^0.5
}
if(model=="OU_linear_breakpoint"){
cB1 <- parameters[1]
breakpoint <- parameters[3]
SlopeB1 <- parameters[2]
SlopeB2 <- parameters[4]
cA1 <- parameters[5]
SlopeA1 <- parameters[6]
SlopeA2 <- parameters[7]
cB2 = breakpoint * SlopeB1 + cB1 - breakpoint * SlopeB2
B <- (SlopeB1 * GRAD + cB1)*(GRAD <= breakpoint) + (SlopeB2 * GRAD + cB2) * (GRAD > breakpoint)
cA2 = breakpoint * SlopeA1 + cA1 - breakpoint * SlopeA2
A <- (SlopeA1 * GRAD + cA1)*(GRAD <= breakpoint) + (SlopeA2 * GRAD + cA2) * (GRAD > breakpoint)
V = (B / (A)) * (1-exp(-2*A*TIME))
DIST <- ((2*V)/pi)^0.5
}
if(quantile == TRUE){
QUANTILE_99 <- qnorm(p=0.995, mean = 0, sd = V^0.5)
QUANTILE_95 <- qnorm(p=0.975, mean = 0, sd = V^0.5)
QUANTILE_90 <- qnorm(p=0.95, mean = 0, sd = V^0.5)
QUANTILE_80 <- qnorm(p=0.90, mean = 0, sd = V^0.5)
QUANTILE_70 <- qnorm(p=0.85, mean = 0, sd = V^0.5)
QUANTILE_60 <- qnorm(p=0.80, mean = 0, sd = V^0.5)
QUANTILE_50 <- qnorm(p=0.75, mean = 0, sd = V^0.5)
QUANTILE_40 <- qnorm(p=0.70, mean = 0, sd = V^0.5)
QUANTILE_30 <- qnorm(p=0.65, mean = 0, sd = V^0.5)
QUANTILE_20 <- qnorm(p=0.60, mean = 0, sd = V^0.5)
QUANTILE_10 <- qnorm(p=0.55, mean = 0, sd = V^0.5)
}
if(plot == TRUE){
if(quantile == TRUE){
X <- c(min(GRAD), max(GRAD))
Y <- c(min(QUANTILE_10), max(QUANTILE_99))
plot(Y ~ X, xlab="Gradient", ylab = "Euclidean distance", col="white", lty = 2)
lines(QUANTILE_99 ~ GRAD, lty = 2)
lines(QUANTILE_95 ~ GRAD, lty = 2)
lines(QUANTILE_90 ~ GRAD, lty = 2)
lines(QUANTILE_80 ~ GRAD, lty = 2)
lines(QUANTILE_70 ~ GRAD, lty = 2)
lines(QUANTILE_60 ~ GRAD, lty = 2)
lines(QUANTILE_50 ~ GRAD, lty = 2)
lines(QUANTILE_40 ~ GRAD, lty = 2)
lines(QUANTILE_30 ~ GRAD, lty = 2)
lines(QUANTILE_20 ~ GRAD, lty = 2)
lines(QUANTILE_10 ~ GRAD, lty = 2)
lines(DIST ~ GRAD)
}
if(quantile == FALSE){plot(DIST ~ GRAD, xlab="Gradient", ylab = "Euclidean distance", type="l")}
}
if(values == TRUE){
if(quantile == FALSE){
RESULTS <- matrix(NA,length(GRAD), 2)
colnames(RESULTS) <- c("GRAD","Expectation")
RESULTS[,1] <- GRAD
RESULTS[,2] <- DIST
}
if(quantile == TRUE){
RESULTS <- matrix(NA,length(GRAD),13)
colnames(RESULTS) <- c("GRAD","Expectation", "q10", "q20", "q30", "q40", "q50", "q60", "q70", "q80", "q90", "q95", "q99")
RESULTS[,1] <- GRAD
RESULTS[,2] <- DIST
RESULTS[,3] <- QUANTILE_10
RESULTS[,4] <- QUANTILE_20
RESULTS[,5] <- QUANTILE_30
RESULTS[,6] <- QUANTILE_40
RESULTS[,7] <- QUANTILE_50
RESULTS[,8] <- QUANTILE_60
RESULTS[,9] <- QUANTILE_70
RESULTS[,10] <- QUANTILE_80
RESULTS[,11] <- QUANTILE_90
RESULTS[,12] <- QUANTILE_95
RESULTS[,13] <- QUANTILE_99
}
return(RESULTS)
}
}
bootstrap.test <- function(DIST, TIME, GRAD, model, parameters, meserr1=0, meserr2=0, breakpoint = "NULL", N = c(1000), starting=NULL){
BOOTSTRAP.OUTPUT <- matrix(data = NA, nrow = N, ncol = 13)
BOOTSTRAP.OUTPUT_CV <- matrix(data = NA, nrow = length(DIST), ncol = 13)
colnames(BOOTSTRAP.OUTPUT) <- c("b1", "b1_slope", "breakpoint", "b2", "b2_slope", "quadratic_term", "a1", "a1_slope", "a2", "a2_slope", "Quadratic_c",
"Quadratic_b", "Quadratic_a")
par_length <- length(parameters)
pb <- txtProgressBar(min = 0, max = N, style = 3)
for(i in 1:N){
RANDOM_NUMEBRS <- sample(x=c(1:length(GRAD)), size=length(GRAD), replace = TRUE, prob = NULL)
GRAD_boot = GRAD[RANDOM_NUMEBRS]
TIME_boot = TIME[RANDOM_NUMEBRS]
DIST_boot = DIST[RANDOM_NUMEBRS]
if(sum(c(meserr1, meserr1)) == 0){
meserr1_boot = 0
meserr2_boot = 0
}
if(sum(c(meserr1, meserr1)) > 0){
meserr1_boot = meserr1[RANDOM_NUMEBRS]
meserr2_boot = meserr2[RANDOM_NUMEBRS]
}
RESULT <- model.test.sisters(DIST=DIST_boot, TIME=TIME_boot, GRAD=GRAD_boot, meserr1 = meserr1_boot, meserr2 = meserr2_boot, models=model, starting=starting)
RESULT <- t(RESULT)
BOOTSTRAP.OUTPUT[i,c(1:13)] <- as.numeric(RESULT[1,c(5:17)])
#Sys.sleep(0.1)
setTxtProgressBar(pb, i)
}
close(pb)
alpha <- c(0.025, 0.975)
TEMP <- t(BOOTSTRAP.OUTPUT)
TEMP <- TEMP[complete.cases(TEMP),]
if(length(parameters) > 1){BOOTSTRAP.OUTPUT <- t(TEMP)}
if(length(parameters) == 1){
BOOTSTRAP.OUTPUT <- matrix(NA, ncol=length(1), nrow = nrow(BOOTSTRAP.OUTPUT))
BOOTSTRAP.OUTPUT[1:nrow(BOOTSTRAP.OUTPUT), 1] <- TEMP
colnames(BOOTSTRAP.OUTPUT) <- "b1"
}
SUMMARY.OUTPUT <- matrix(data = NA, nrow = 5, ncol = ncol(BOOTSTRAP.OUTPUT))
rownames(SUMMARY.OUTPUT) <- c("mean","median", "percentile_low_95CI", "percentile_high_95CI", "boot_SE")
colnames(SUMMARY.OUTPUT) <- colnames(BOOTSTRAP.OUTPUT)
for(d in 1:ncol(BOOTSTRAP.OUTPUT)){
boot_mean <- mean(BOOTSTRAP.OUTPUT[,d])
boot_median <- median(BOOTSTRAP.OUTPUT[,d])
QUANTILES <- quantile(x = BOOTSTRAP.OUTPUT[,d], probs = seq(0,1,0.025), na.rm=TRUE)
percentile_CI95_low <- QUANTILES[2]
percentile_CI95_high <- QUANTILES[40]
boot_SE <- sqrt(1/(N-1) * sum((BOOTSTRAP.OUTPUT[,d] - 1/N * sum(BOOTSTRAP.OUTPUT[,d]))^2) )
SUMMARY.OUTPUT[1,d] <- boot_mean
SUMMARY.OUTPUT[2,d] <- boot_median
SUMMARY.OUTPUT[3,d] <- percentile_CI95_low
SUMMARY.OUTPUT[4,d] <- percentile_CI95_high
SUMMARY.OUTPUT[5,d] <- boot_SE
}
#SUMMARY.OUTPUTIME <- SUMMARY.OUTPUT[c(1:4, 7, 8), ]
#colnames(SUMMARY.OUTPUT) <- c("b1","b1_slope","breakpoint","b2","b2_slope","quadratic_term","a1","a1_slope","a2","a2_slope","Quadratic_c","Quadratic_b","Quadratic_a")
return(list(bootstrap_model =model, bootstrap_parameters = parameters, N_bootstraps = N, summary = SUMMARY.OUTPUT, bootstraps = BOOTSTRAP.OUTPUT))
}
############################################################################################################################
Profile.like.CI <- function(DIST, TIME, GRAD, meserr1 = 0, meserr2 = 0, like, par, MODEL, test.values.par1, test.values.par2, p_starting="NULL"){
#performs a profile likelihood confidence interval by holding one parameter constant, and maximizing the rest, and then testing a range of values for the first.
#par = MLE of all parameters
#SE = Standard errors of all estimates
#for BM_linear
#like = likelihood of model
#cutoff= (like - 1.92)
###TO DO: As of 30may 2014 i have properly set up OU_linear_beta for beta slope and OU_linear for slope of beta only. i need to do the same for OU)linear alpha slope and the BM models
###In particular, need to put the troper sortting in (see DD_order)
if(MODEL == "BM_linear"){
###first parameter 1 is constrained
PROFILES1 <- matrix(NA,length(test.values.par1),4)
colnames(PROFILES1) <- c("test.value", "logLike", "logLikeDifference", "CI_range")
PROFILES1[,1] <- test.values.par1
constrain.value.p1 <- test.values.par1
for(i in 1:length(constrain.value.p1)){
if(p_starting == "NULL"){result_matrix <- starting.values(MODEL = "BM_linear_profile_par1")}
if(p_starting != "NULL"){result_matrix <- p_starting}
for(y in 1:nrow(result_matrix)){
res = "NA"
if(par[2] <= 0) {
TRANSFORMATION = 0 - par[2] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace_profile_CI, p = c(log(par[2]+TRANSFORMATION)), model=c("BM_linear"), DIST=DIST, TIME=TIME, GRAD=GRAD, constrained = c(1,0), par_constrained = constrain.value.p1[i], transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(par[2] > 0) {
TRANSFORMATION = "NULL"
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace_profile_CI, p = c(log(par[2])), model=c("BM_linear"), DIST=DIST, TIME=TIME, GRAD=GRAD, constrained = c(1,0), par_constrained = constrain.value.p1[i], transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
}
try(if(as.numeric(res$code)<4) result_matrix[y,2] <- res$minimum else result_matrix[y,2] <- NA, silent = TRUE)
}
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,2]), decreasing = FALSE, na.last = TRUE),];
PROFILES1[i,2] <- result_matrix_ordered[1,2]
print(i)
}
PROFILES1[,2] <- PROFILES1[,2] * -1
PROFILES1[,3] <- like - PROFILES1[,2]
for(y in nrow(PROFILES1):1){
if(PROFILES1[y,2] == -1.000000e+20){PROFILES1 <- PROFILES1[-y,]}
}
PROFILES1[,4] <- as.numeric(PROFILES1[,3] > 1.92)
SUPPORT1 <- subset(PROFILES1[,1], subset=(PROFILES1[,4] == 0)) #values not sig from MLE
CI1 <- c(min(SUPPORT1), max(SUPPORT1))
warning1 <- c(NA, NA)
if(PROFILES1[1,4] == 0) {warning1[1] <- "lower bound of CI for par 1 not reached"}
if(PROFILES1[nrow(PROFILES1),4] == 0) {warning1[2] <- "upper bound of CI for par 1 not reached"}
###Now parameter 2 is constrained
PROFILES2 <- matrix(NA,length(test.values.par2),4)
PROFILES2[,1] <- test.values.par2
colnames(PROFILES2) <- c("test.value", "logLike", "logLikeDifference", "CI_range")
constrain.value.p2 <- test.values.par2
for(i in 1:length(constrain.value.p2)){
if(p_starting == "NULL"){result_matrix <- starting.values(MODEL = "BM_linear_profile_par2")}
if(p_starting != "NULL"){result_matrix <- p_starting}
for(y in 1:nrow(result_matrix)){
res = "NA"
par1 = result_matrix[y,1]
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace_profile_CI, p = c(log(par[1])), model=c("BM_linear"), DIST=DIST, TIME=TIME, GRAD=GRAD, constrained = c(0,1), par_constrained = constrain.value.p2[i], transformation_beta = TRANSFORMATION, hessian = FALSE, iterlim=50000)), silent = TRUE)
try(if(as.numeric(res$code)<4) result_matrix[y,2] <- res$minimum else result_matrix[y,2] <- NA, silent = TRUE)
}
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,2]), decreasing = FALSE, na.last = TRUE),];
PROFILES2[i,2] <- result_matrix_ordered[1,2]
print(i)
}
PROFILES2[,2] <- PROFILES2[,2] * -1
PROFILES2[,3] <- like - PROFILES2[,2]
for(y in nrow(PROFILES2):1){
if(PROFILES2[y,2] == -1.000000e+20){PROFILES2 <- PROFILES2[-y,]}
}
PROFILES2[,3] <- like - PROFILES2[,2]
PROFILES2[,4] <- as.numeric(PROFILES2[,3] > 1.92)
SUPPORT2 <- subset(PROFILES2[,1], subset=(PROFILES2[,4] == 0)) #values not sig from MLE
CI2 <- c(min(SUPPORT2), max(SUPPORT2))
warning2 <- c(NA, NA)
if(PROFILES2[1,4] == 0) {warning2[1] <- "lower bound of CI for par 2 not reached"}
if(PROFILES2[nrow(PROFILES2),4] == 0) {warning2[2] <- "upper bound of CI for par 2 not reached"}
#plot(PROFILES2[,2] ~ PROFILES2[,1]
}#End BM_linear
if(MODEL == "OU_linear_beta"){
###parameter 2 (beta slope) is constrained
PROFILES2 <- matrix(NA,length(test.values.par1),6)
colnames(PROFILES2) <- c("test.value", "logLike", "logLikeDifference", "CI_range")
PROFILES2[,1] <- test.values.par1
constrain.value.p2 <- test.values.par1
for(i in 1:length(constrain.value.p2)){
if(p_starting == "NULL"){result_matrix <- starting.values(MODEL = "OU_linear_beta_profile_par2")} #change for other models, the placement of this
if(p_starting != "NULL"){result_matrix <- p_starting}
for(y in 1:nrow(result_matrix)){
res = "NA"
par1 = result_matrix[y,1:2]
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace_profile_CI, p = c(log(par1)), model=c("OU_linear_beta"), DIST=DIST, TIME=TIME, GRAD=GRAD, constrained = c(0,1,0), par_constrained = constrain.value.p2[i], transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
try(if(as.numeric(res$code)<4) {
result_matrix[y,1:2] <- exp(res$estimate)
result_matrix[y,3] <- res$minimum
} else result_matrix[y,3] <- NA, silent = TRUE)
}
result_matrix[,3] <- round(as.numeric(result_matrix[,3]), 4)
DD_order <- as.numeric(result_matrix[,1] + result_matrix[,2]) #This sums the Bstart and alpha.
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,3]),DD_order, decreasing = FALSE, na.last = TRUE),];
PROFILES2[i,2:3] <- result_matrix_ordered[1,1:2]
PROFILES2[i,4] <- result_matrix_ordered[1,3]
print(i)
}
PROFILES2[,4] <- PROFILES2[,4] * -1
PROFILES2[,5] <- like - PROFILES2[,4]
for(y in nrow(PROFILES2):1){
if(PROFILES2[y,4] == -1.000000e+20){PROFILES2 <- PROFILES2[-y,]}
}
PROFILES2[,6] <- as.numeric(PROFILES2[,5] > 1.92)
SUPPORT2 <- subset(PROFILES2[,1], subset=(PROFILES2[,6] == 0)) #values not sig from MLE
CI2 <- c(min(SUPPORT2), max(SUPPORT2))
warning2 <- c(NA, NA)
if(PROFILES2[1,6] == 0) {warning2[1] <- "lower bound of CI for par 2 not reached"}
if(PROFILES2[nrow(PROFILES2),6] == 0) {warning2[2] <- "upper bound of CI for par 2 not reached"}
#plot(PROFILES2[,2] ~ PROFILES2[,1])
}
if(MODEL == "OU_linear"){
###parameter 2 (beta slope) is constrained
PROFILES2 <- matrix(NA,length(test.values.par1),7)
colnames(PROFILES2) <- c("test.value", "logLike", "logLikeDifference", "CI_range")
PROFILES2[,1] <- test.values.par1
constrain.value.p2 <- test.values.par1
for(i in 1:length(constrain.value.p2)){
if(p_starting == "NULL"){result_matrix <- starting.values(MODEL = "OU_linear_profile_par2")} #change for other modes, the placement of this
if(p_starting != "NULL"){result_matrix <- p_starting}
for(y in 1:nrow(result_matrix)){
res = "NA"
par1 = result_matrix[y,1:3]
if(par1[3] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace_profile_CI, p = c(log(par1)), model=c("OU_linear"), DIST=DIST, TIME=TIME, GRAD=GRAD, constrained = c(0,1,0,0), par_constrained = constrain.value.p2[i], transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
try(if(as.numeric(res$code)<4) {
result_matrix[y,1:3] <- exp(res$estimate)
result_matrix[y,4] <- res$minimum
} else result_matrix[y,4] <- NA, silent = TRUE)
}
if(par1[3] <= 0) {
TRANSFORMATION_ALPHA = 0 - par1[3] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace_profile_CI, p = c(log(par1[1]), log(par1[2]), log(par1[3]+TRANSFORMATION_ALPHA)), model=c("OU_linear"), DIST=DIST, TIME=TIME, GRAD=GRAD, constrained = c(0,1,0,0), par_constrained = constrain.value.p2[i], transformation_beta = "NULL", transformation_alpha = TRANSFORMATION_ALPHA, hessian = FALSE, iterlim=50000)), silent = TRUE)
try(if(as.numeric(res$code)<4) {
result_matrix[y,1:3] <- c(exp(res$estimate[1]), exp(res$estimate[2]), (exp(res$estimate[3])-TRANSFORMATION_ALPHA))
result_matrix[y,4] <- res$minimum
} else result_matrix[y,4] <- NA, silent = TRUE)
}
}
result_matrix[,3] <- round(as.numeric(result_matrix[,3]), 4)
DD_order <- as.numeric(result_matrix[,1] + result_matrix[,2] + result_matrix[,2] +result_matrix[,3]*max(GRAD)) #This sums the Bstart and Astart and Aend.
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,4]),DD_order, decreasing = FALSE, na.last = TRUE),];
PROFILES2[i,2:4] <- result_matrix_ordered[1,1:3]
PROFILES2[i,5] <- result_matrix_ordered[1,4]
print(i)
}
PROFILES2[,5] <- PROFILES2[,5] * -1
PROFILES2[,6] <- like - PROFILES2[,5]
for(y in nrow(PROFILES2):1){
if(PROFILES2[y,5] == -1.000000e+20){PROFILES2 <- PROFILES2[-y,]}
}
PROFILES2[,7] <- as.numeric(PROFILES2[,6] > 1.92)
SUPPORT2 <- subset(PROFILES2[,1], subset=(PROFILES2[,7] == 0)) #values not sig from MLE
CI2 <- c(min(SUPPORT2), max(SUPPORT2))
warning2 <- c(NA, NA)
if(PROFILES2[1,7] == 0) {warning2[1] <- "lower bound of CI for par 2 not reached"}
if(PROFILES2[nrow(PROFILES2),7] == 0) {warning2[2] <- "upper bound of CI for par 2 not reached"}
#plot(PROFILES2[,2] ~ PROFILES2[,1])
###parameter 4 (alpha slope) is constrained
PROFILES4 <- matrix(NA,length(test.values.par2),4)
colnames(PROFILES4) <- c("test.value", "logLike", "logLikeDifference", "CI_range")
PROFILES4[,1] <- test.values.par2
constrain.value.p4 <- test.values.par2
for(i in 1:length(constrain.value.p4)){
if(p_starting == "NULL"){result_matrix <- starting.values(MODEL = "OU_linear_profile_par4")}
if(p_starting != "NULL"){result_matrix <- p_starting}
for(y in 1:nrow(result_matrix)){
res = "NA"
par1 = result_matrix[y,1:3]
if(par1[2] > 0) {
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace_profile_CI, p = c(log(par1)), model=c("OU_linear"), DIST=DIST, TIME=TIME, GRAD=GRAD, constrained = c(0,0,0,1), par_constrained = constrain.value.p4[i], transformation_beta = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
if(par1[2] <= 0) {
TRANSFORMATION_BETA = 0 - par1[2] + 0.0001
res = try(suppressWarnings(nlm(f = sisterContinuous_logSpace_profile_CI, p = c(log(par1[1]), log(par1[2]+TRANSFORMATION_BETA), log(par1[3])), model=c("OU_linear"), DIST=DIST, TIME=TIME, GRAD=GRAD, constrained = c(0,0,0,1), par_constrained = constrain.value.p4[i], transformation_beta = TRANSFORMATION_BETA, transformation_alpha = "NULL", hessian = FALSE, iterlim=50000)), silent = TRUE)
}
try(if(as.numeric(res$code)<4) result_matrix[y,4] <- res$minimum else result_matrix[y,4] <- NA, silent = TRUE)
}
result_matrix_ordered <- result_matrix[order(as.numeric(result_matrix[,4]), decreasing = FALSE, na.last = TRUE),];
PROFILES4[i,2] <- result_matrix_ordered[1,4]
print(i)
}
PROFILES4[,2] <- PROFILES4[,2] * -1
PROFILES4[,3] <- like - PROFILES4[,2]
for(y in nrow(PROFILES4):1){
if(PROFILES4[y,2] == -1.000000e+20){PROFILES4 <- PROFILES4[-y,]}
}
PROFILES4[,3] <- like - PROFILES4[,2]
PROFILES4[,4] <- as.numeric(PROFILES4[,3] > 1.92)
SUPPORT4 <- subset(PROFILES4[,1], subset=(PROFILES4[,4] == 0)) #values not sig from MLE
CI4 <- c(min(SUPPORT4), max(SUPPORT4))
warning4 <- c(NA, NA)
if(PROFILES4[1,4] == 0) {warning4[1] <- "lower bound of CI for par 2 not reached"}
if(PROFILES4[nrow(PROFILES4),4] == 0) {warning4[2] <- "upper bound of CI for par 2 not reached"}
#plot(PROFILES4[,2] ~ PROFILES4[,1])
}
if(MODEL == "BM_linear"){
return(list(profile.likelihoods_par1 = PROFILES1, profile.likelihoods_par2 = PROFILES2, model = MODEL, MLE_par1 = par[1], CI_par1 = CI1, warnings_par1 = warning1, MLE_par2 = par[2], CI_par2 = CI2, warnings_par2 = warning2))
}
if(MODEL == "OU_linear"){
return(list(profile.likelihoods_par2 = PROFILES2, profile.likelihoods_par4 = PROFILES4, model = MODEL, MLE_par2 = par[2], CI_par2 = CI2, warnings_par2 = warning2, MLE_par4 = par[4], CI_par4 = CI4, warnings_par4 = warning4))
}
if(MODEL == "OU_linear_beta"){
return(list(profile.likelihoods_par2 = PROFILES2, model = MODEL, MLE_par2 = par[2], CI_par2 = CI2, warnings_par2 = warning2))
}
}
sisterContinuous_logSpace_profile_CI<- function(parameters, model,breakpoint="NULL", DIST, TIME, GRAD, GRAD2 = NULL, constrained, par_constrained, transformation_beta="NULL", transformation_alpha="NULL", transformation_beta1 = "NULL", transformation_beta2 = "NULL", transformation_interaction = "NULL", transformation_b = "NULL", transformation_a = "NULL", transformation_alpha1 = "NULL", transformation_alpha2 = "NULL", meserr1 = 0, meserr2 = 0)
{
if (model == "BM_linear") {
if(constrained[1] == 1){
Cstart_B <- par_constrained[1]
if(transformation_beta != "NULL"){
Slope_B <- exp(parameters[1]) - transformation_beta
}
if(transformation_beta == "NULL"){
Slope_B <- exp(parameters[1] )
}
}
if(constrained[2] == 1){
Cstart_B <- exp(parameters[1] )
Slope_B <- par_constrained[1]
}
B <- Slope_B * GRAD + Cstart_B
V <- B*TIME*2
SD = (V)^0.5
VAR1 <- B*TIME*2
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(Cstart_B <= 0.000001) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_linear_beta") {
if(constrained[1] == 1){
Cstart_B <- par_constrained[1]
Cstart_A <- exp(parameters[2])
if(transformation_beta != "NULL"){
Slope_B <- exp(parameters[1]) - transformation_beta
}
if(transformation_beta == "NULL"){
Slope_B <- exp(parameters[1])
}
}
if(constrained[2] == 1){
Cstart_B <- exp(parameters[1])
Slope_B <- par_constrained[1]
Cstart_A <- exp(parameters[2])
}
if(constrained[3] == 1){
Cstart_B <- exp(parameters[1])
if(transformation_beta != "NULL"){
Slope_B <- exp(parameters[2]) - transformation_beta
}
if(transformation_beta == "NULL"){
Slope_B <- exp(parameters[2])
}
Cstart_A <- par_constrained[1]
}
Slope_A <- 0
Alpha <- Slope_A * GRAD + Cstart_A
B <- Slope_B * GRAD + Cstart_B
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0.000001)) negLogL = 1e20
if(Cstart_B <= (0.000001)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0)) negLogL = 1e20
if(Cstart_B <= (0)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
else if (model == "OU_linear") {
if(constrained[1] == 1){
# Cstart_B <- exp(parameters[1])
# Slope_B <- par_constrained[1]
# Cstart_A <- exp(parameters[3])
if(transformation_beta != "NULL"){
Slope_B <- exp(parameters[1]) - transformation_beta
}
if(transformation_beta == "NULL"){
Slope_B <- exp(parameters[1] )
}
}
if(constrained[2] == 1){
Cstart_B <- exp(parameters[1])
Slope_B <- par_constrained[1]
Cstart_A <- exp(parameters[2])
if(transformation_alpha != "NULL"){
Slope_A <- exp(parameters[3]) - transformation_alpha
}
if(transformation_alpha == "NULL"){
Slope_A <- exp(parameters[3] )
}
}
if(constrained[4] == 1){
Cstart_B <- exp(parameters[1])
if(transformation_beta != "NULL"){
Slope_B <- exp(parameters[2]) - transformation_beta
}
if(transformation_beta == "NULL"){
Slope_B <- exp(parameters[2] )
}
Cstart_A <- exp(parameters[3])
Slope_A <- par_constrained[1]
}
Alpha <- Slope_A * GRAD + Cstart_A
B <- Slope_B * GRAD + Cstart_B
VAR1 <- (B / (Alpha)) * (1-exp(-2*Alpha*TIME))
if(sum(c(meserr1, meserr2)) == 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1)^0.5, log = TRUE)
}
if(sum(c(meserr1, meserr2)) != 0){
kk3 <- dnorm(x=DIST, mean = 0, sd = (VAR1 + meserr1^2 + meserr2^2)^0.5, log = TRUE)
}
negLogL = -sum(kk3)
if(is.nan(negLogL)) negLogL = 1e20
if(Cstart_A <= (0.000001)) negLogL = 1e20
if(Cstart_B <= (0.000001)) negLogL = 1e20
if(min(Alpha) <= (0.000001)) negLogL = 1e20
if(min(B) <= (0.000001)) negLogL = 1e20
}
return(negLogL)
}
simulation.analysis <- function(GRAD, TIME, PARAMETERS, null.model, test.models, N){
#GRAD = gradient values
#TIME = ages
#PARAMETERS = PARAMETERS of null model to simulate under
#null.model = null model to simulate under.
#test.models = list of models to fit the simulated data to. Should include null.model as the first model in the list
#N = sumber of simulations
OUTPUT_MATRIX <- matrix(NA, N, 22)
colnames(OUTPUT_MATRIX) <- c("logL__BM_null", "logL__BM_linear", "logL__OU_null", "logL__OU_linear_beta", "logL__OU_linear",
"AICc__BM_null", "AICc__BM_linear", "AICc__OU_null", "AICc__OU_linear_beta", "AICc__OU_linear",
"Beta__BM_null", "Beta_starting__BM_linear", "Beta__OU_null", "Beta_starting__OU_linear_beta","Beta_starting__OU_linear",
"Beta_slope__BM_linear", "Beta_slope__OU_linear_beta", "Beta_slope__OU_linear",
"Alpha__OU_null", "Alpha__OU_linear_beta", "Alpha_starting__OU_linear", "Alpha_slope__OU_linear")
for(i in 1:N){
DATA2 <- sim.sisters(GRAD=GRAD, TIME=TIME, parameters = PARAMETERS, model=null.model, MULT=1)
DIST=DATA2[,3]
FITi <- model.test.sisters(DIST, TIME, GRAD, GRAD2="NULL", models=test.models)
FITi <- t(FITi)
N_models <- nrow(FITi)
if(sum(test.models == "BM_null") == 1){
DD = 0
DD <- sum((rownames(FITi) == "BM_null") * 1:N_models) #this tells us what row the current model is in in FITi
OUTPUT_MATRIX[i, 1] <- FITi[DD,1] #logLike
OUTPUT_MATRIX[i, 6] <- FITi[DD,4] #AICc
OUTPUT_MATRIX[i, 11] <- FITi[DD,5] #b1
}
if(sum(test.models == "BM_linear") == 1){
DD = 0
DD <- sum((rownames(FITi) == "BM_linear") * 1:N_models) #this tells us what row the current model is in in FITi
OUTPUT_MATRIX[i, 2] <- FITi[DD,1] #logLike
OUTPUT_MATRIX[i, 7] <- FITi[DD,4] #AICc
OUTPUT_MATRIX[i, 12] <- FITi[DD,5] #b1
OUTPUT_MATRIX[i, 16] <- FITi[DD,6] #b1_slope
}
if(sum(test.models == "OU_null") == 1){
DD = 0
DD <- sum((rownames(FITi) == "OU_null") * 1:N_models) #this tells us what row the current model is in in FITi
OUTPUT_MATRIX[i, 3] <- FITi[DD,1] #logLike
OUTPUT_MATRIX[i, 8] <- FITi[DD,4] #AICc
OUTPUT_MATRIX[i, 13] <- FITi[DD,5] #b1
OUTPUT_MATRIX[i, 19] <- FITi[DD,11] #a1
}
if(sum(test.models == "OU_linear_beta") == 1){
DD = 0
DD <- sum((rownames(FITi) == "OU_linear_beta") * 1:N_models) #this tells us what row the current model is in in FITi
OUTPUT_MATRIX[i, 4] <- FITi[DD,1] #logLike
OUTPUT_MATRIX[i, 9] <- FITi[DD,4] #AICc
OUTPUT_MATRIX[i, 14] <- FITi[DD,5] #b1
OUTPUT_MATRIX[i, 17] <- FITi[DD,6] #b1_slope
OUTPUT_MATRIX[i, 20] <- FITi[DD,11] #a1
}
if(sum(test.models == "OU_linear") == 1){
DD = 0
DD <- sum((rownames(FITi) == "OU_linear") * 1:N_models) #this tells us what row the current model is in in FITi
OUTPUT_MATRIX[i, 5] <- FITi[DD,1] #logLike
OUTPUT_MATRIX[i, 10] <- FITi[DD,4] #AICc
OUTPUT_MATRIX[i, 15] <- FITi[DD,5] #b1
OUTPUT_MATRIX[i, 18] <- FITi[DD,6] #b1_slope
OUTPUT_MATRIX[i, 21] <- FITi[DD,11] #a1
OUTPUT_MATRIX[i, 22] <- FITi[DD,12] #a1_slope
}
print(i)
}
return(OUTPUT_MATRIX)
}
parameter.reestimation <- function(GRAD, TIME, model, PARAMETERS, N, REP = 1){
#N = number of sims
RESULTS=NA
TIME_y = rep(TIME, each = REP)
GRAD_y <- rep(GRAD, each = REP)
AA <- simulation.analysis(GRAD = GRAD_y, TIME = TIME_y, PARAMETERS, null.model=model, test.models = model, N)
AA2 <- AA[,colSums(is.na(AA)) != nrow(AA)]
RESULTS <- matrix(NA, ncol=ncol(AA2), nrow = 12)
colnames(RESULTS) <- colnames(AA2)
rownames(RESULTS) <- c("n_sims", "n_sisters", "starting_parameters", "mean", "median", "min", "max", "2.5percentile", "97.5percentile", "25percentile", "75percentile", "standard_error")
for(i in 1:ncol(AA2)){
BB <- NA
BB <- as.numeric(AA2[,i])
RESULTS[4,i] <- mean(BB)
RESULTS[5,i] <- median(BB)
RESULTS[6,i] <- min(BB)
RESULTS[7,i] <- max(BB)
RESULTS[8,i] <- quantile(x=BB, probs = c(0.025)) #2.5percentile(AA[,i])
RESULTS[9,i] <- quantile(x=BB, probs = c(0.975)) #97.5percentile(AA[,i])
RESULTS[10,i] <- quantile(x=BB, probs = c(0.25)) #25percentile(AA[,i])
RESULTS[11,i] <- quantile(x=BB, probs = c(0.75)) #75percentile(AA[,i])
RESULTS[12,i] <- sd(BB) #standard error
}
if(model == "BM_null"){
RESULTS2 <- RESULTS
RESULTS2[1,] <- N
RESULTS2[2,] <- length(GRAD_y) #number
RESULTS2[3,] <- PARAMETERS
}
if(model != "BM_null"){
RESULTS2 <- RESULTS[,-c(1,2)]
RESULTS2[1,] <- N
RESULTS2[2,] <- length(GRAD_y) #number
RESULTS2[3,] <- PARAMETERS
}
return(RESULTS2)
}
TypeI.error <- function(TIME, GRAD, beta, alpha=0, null.model, REP=1, N, write.file = "FALSE", wd = ""){
#a single value for alpha, beta, and N, meant to be same as estimated for actual data
test.models=c("BM_null", "OU_null", "BM_linear", "OU_linear_beta", "OU_linear")
RESULTS=NA
TIME_y = rep(TIME, each = REP)
GRAD_y <- rep(GRAD, each = REP)
RESULTS1 <- matrix(NA, 4, nrow = 1)
colnames(RESULTS1) <- c("beta", "alpha", "N_sisters", "N_sims")
RESULTS1[1, 1] <- beta
RESULTS1[1, 2] <- alpha
RESULTS1[1, 3] <- length(GRAD_y)
RESULTS1[1, 4] <- N
if(null.model == "BM_null"){
AA <- simulation.analysis(GRAD = GRAD_y, TIME = TIME_y, PARAMETERS = c(beta), null.model, test.models, N)
RESULTS2 <- matrix(NA, 4, nrow = 4)
colnames(RESULTS2) <- c("TypeIerror", "5percentile", "95percentile", "THRESHOLD_deltaAICc")
rownames(RESULTS2) <- c("BMnull_vs_BMlinear", "BMnull_and_OUnull__vs__BMlinear_and_OUlinearBeta", "BMnull_and_OUnull_vs__BMlinear_and_OUlinear", "BMnull_and_OUnull_vs_gradientModels")
MIN_NULL <- as.numeric(AA[,1]) * NA
MIN_BM_null <- MIN_NULL
MIN_BM_linear <- MIN_NULL
MIN_2TESTa <- MIN_NULL
MIN_2TESTb <- MIN_NULL
MIN_3TEST <- MIN_NULL
for(i in 1:length(MIN_NULL)){
MIN_NULL[i] <- min(as.numeric(AA[i,c(6,8)]) )
MIN_BM_null[i] <- min(as.numeric(AA[i,c(6)]) )
MIN_BM_linear[i] <- min(as.numeric(AA[i,c(7)]) )
MIN_2TESTa[i] <- min(as.numeric(AA[i,c(7,9)]) )
MIN_2TESTb[i] <- min(as.numeric(AA[i,c(7,10)]) )
MIN_3TEST[i] <- min(as.numeric(AA[i,c(7,9,10)]) )
}
DELTA_AIC_1 <- (MIN_BM_null - MIN_BM_linear) #this is for when testing on Bm BM_linear models and not OU
RESULTS2[1, 1] <- 1 - (sum(DELTA_AIC_1 < 0) / N) #Type I error BM vs BMlinear
RESULTS2[1, 2] <- quantile(x=DELTA_AIC_1, probs = c(0))
RESULTS2[1, 3] <- quantile(x=DELTA_AIC_1, probs = c(0.95))
RESULTS2[1, 4] <- max(0, quantile(x=DELTA_AIC_1, probs = c(0.95)) )
DELTA_AIC_4 <- (MIN_NULL - MIN_2TESTa)
RESULTS2[2, 1] <- 1 - (sum(DELTA_AIC_4 < 0) / N) #Type I error OU vs BMlinear
RESULTS2[2, 2] <- quantile(x=DELTA_AIC_4, probs = c(0))
RESULTS2[2, 3] <- quantile(x=DELTA_AIC_4, probs = c(0.95))
RESULTS2[2, 4] <- max(0, quantile(x=DELTA_AIC_4, probs = c(0.95)) )
DELTA_AIC_5 <- (MIN_NULL - MIN_2TESTb)
RESULTS2[3, 1] <- 1 - (sum(DELTA_AIC_5 < 0) / N) #Type I error OU vs BMlinear
RESULTS2[3, 2] <- quantile(x=DELTA_AIC_5, probs = c(0))
RESULTS2[3, 3] <- quantile(x=DELTA_AIC_5, probs = c(0.95))
RESULTS2[3, 4] <- max(0, quantile(x=DELTA_AIC_5, probs = c(0.95)) )
DELTA_AIC_6 <- (MIN_NULL - MIN_3TEST)
RESULTS2[4, 1] <- 1 - (sum(DELTA_AIC_6 < 0) / N) #Type I error OU vs BMlinear
RESULTS2[4, 2] <- quantile(x=DELTA_AIC_6, probs = c(0))
RESULTS2[4, 3] <- quantile(x=DELTA_AIC_6, probs = c(0.95))
RESULTS2[4, 4] <- max(0, quantile(x=DELTA_AIC_6, probs = c(0.95)) )
}
if(null.model == "OU_null"){
AA <- simulation.analysis(GRAD = GRAD_y, TIME = TIME_y, PARAMETERS = c(beta, alpha), null.model, test.models, N)
RESULTS2 <- matrix(NA, 4, nrow = 3)
colnames(RESULTS2) <- c("TypeIerror", "5percentile", "95percentile", "THRESHOLD_deltaAIC")
rownames(RESULTS2) <- c("BMnull_and_OUnull__vs__BMlinear_and_OUlinearBeta", "BMnull_and_OUnull_vs__BMlinear_and_OUlinear", "BMnull_and_OUnull_vs_gradientModels")
MIN_NULL <- as.numeric(AA[,1]) * NA
MIN_BM_null <- MIN_NULL
MIN_BM_linear <- MIN_NULL
MIN_2TESTa <- MIN_NULL
MIN_2TESTb <- MIN_NULL
MIN_3TEST <- MIN_NULL
for(i in 1:length(MIN_NULL)){
MIN_NULL[i] <- min(as.numeric(AA[i,c(6,8)]) )
MIN_BM_linear[i] <- min(as.numeric(AA[i,c(7)]) )
MIN_2TESTa[i] <- min(as.numeric(AA[i,c(7,9)]) )
MIN_2TESTb[i] <- min(as.numeric(AA[i,c(7,10)]) )
MIN_3TEST[i] <- min(as.numeric(AA[i,c(7,9,10)]) )
}
DELTA_AIC_4 <- (MIN_NULL - MIN_2TESTa)
RESULTS2[1, 1] <- 1 - (sum(DELTA_AIC_4 < 0) / N) #Type I error OU vs BMlinear
RESULTS2[1, 2] <- quantile(x=DELTA_AIC_4, probs = c(0))
RESULTS2[1, 3] <- quantile(x=DELTA_AIC_4, probs = c(0.95))
RESULTS2[1, 4] <- max(0, quantile(x=DELTA_AIC_4, probs = c(0.95)) )
DELTA_AIC_5 <- (MIN_NULL - MIN_2TESTb)
RESULTS2[2, 1] <- 1 - (sum(DELTA_AIC_5 < 0) / N) #Type I error OU vs BMlinear
RESULTS2[2, 2] <- quantile(x=DELTA_AIC_5, probs = c(0))
RESULTS2[2, 3] <- quantile(x=DELTA_AIC_5, probs = c(0.95))
RESULTS2[2, 4] <- max(0, quantile(x=DELTA_AIC_5, probs = c(0.95)) )
DELTA_AIC_6 <- (MIN_NULL - MIN_3TEST)
RESULTS2[3, 1] <- 1 - (sum(DELTA_AIC_6 < 0) / N) #Type I error OU vs BMlinear
RESULTS2[3, 2] <- quantile(x=DELTA_AIC_6, probs = c(0))
RESULTS2[3, 3] <- quantile(x=DELTA_AIC_6, probs = c(0.95))
RESULTS2[3, 4] <- max(0, quantile(x=DELTA_AIC_6, probs = c(0.95)) )
}
RESULTS3 <- matrix(NA, 3, nrow = 12)
colnames(RESULTS3) <- c("median", "0percentile", "95percentile")
rownames(RESULTS3) <- c("beta_BMnull", "beta_start_BMlinear", "beta_OUnull", "beta_start_OUlinearBeta", "beta_start_OUlinear",
"beta_slope_BMlinear", "beta_slope_OUlinearBeta", "beta_slope_OUlinear",
"alpha_OUnull", "alpha_OUlinearBeta", "alpha_start_OUlinear", "alpha_slope_OUlinear")
RESULTS3[1,1] <- median(as.numeric(AA[,11])) #median value of beta for BM_null
RESULTS3[1,2] <- quantile(x=as.numeric(AA[,11]), probs = c(0))
RESULTS3[1,3] <- quantile(x=as.numeric(AA[,11]), probs = c(0.95))
RESULTS3[2,1] <- median(as.numeric(AA[,12])) #median value of beta for BM_linear
RESULTS3[2,2] <- quantile(x=as.numeric(AA[,12]), probs = c(0))
RESULTS3[2,3] <- quantile(x=as.numeric(AA[,12]), probs = c(0.95))
RESULTS3[3,1] <- median(as.numeric(AA[,13])) #median value of beta for OU_null
RESULTS3[3,2] <- quantile(x=as.numeric(AA[,13]), probs = c(0))
RESULTS3[3,3] <- quantile(x=as.numeric(AA[,13]), probs = c(0.95))
RESULTS3[4,1] <- median(as.numeric(AA[,14])) #median value of beta for OU_linear_beta
RESULTS3[4,2] <- quantile(x=as.numeric(AA[,14]), probs = c(0))
RESULTS3[4,3] <- quantile(x=as.numeric(AA[,14]), probs = c(0.95))
RESULTS3[5,1] <- median(as.numeric(AA[,15])) #median value of beta for OU_linear
RESULTS3[5,2] <- quantile(x=as.numeric(AA[,15]), probs = c(0))
RESULTS3[5,3] <- quantile(x=as.numeric(AA[,15]), probs = c(0.95))
RESULTS3[6,1] <- median(as.numeric(AA[,16])) #median value of beta_slope for BM_linear
RESULTS3[6,2] <- quantile(x=as.numeric(AA[,16]), probs = c(0))
RESULTS3[6,3] <- quantile(x=as.numeric(AA[,16]), probs = c(0.95))
RESULTS3[7,1] <- median(as.numeric(AA[,17])) #median value of beta_slope for OU_linear_beta
RESULTS3[7,2] <- quantile(x=as.numeric(AA[,17]), probs = c(0))
RESULTS3[7,3] <- quantile(x=as.numeric(AA[,17]), probs = c(0.95))
RESULTS3[8,1] <- median(as.numeric(AA[,18])) #median value of beta_slope for OU_linear
RESULTS3[8,2] <- quantile(x=as.numeric(AA[,18]), probs = c(0))
RESULTS3[8,3] <- quantile(x=as.numeric(AA[,18]), probs = c(0.95))
RESULTS3[9,1] <- median(as.numeric(AA[,19])) #median value of Alpha for OU_null
RESULTS3[9,2] <- quantile(x=as.numeric(AA[,19]), probs = c(0))
RESULTS3[9,3] <- quantile(x=as.numeric(AA[,19]), probs = c(0.95))
RESULTS3[10,1] <- median(as.numeric(AA[,20])) #median value of Alpha for OU_linear_beta
RESULTS3[10,2] <- quantile(x=as.numeric(AA[,20]), probs = c(0))
RESULTS3[10,3] <- quantile(x=as.numeric(AA[,20]), probs = c(0.95))
RESULTS3[11,1] <- median(as.numeric(AA[,21])) #median value of Alpha for OU_linear
RESULTS3[11,2] <- quantile(x=as.numeric(AA[,21]), probs = c(0))
RESULTS3[11,3] <- quantile(x=as.numeric(AA[,21]), probs = c(0.95))
RESULTS3[12,1] <- median(as.numeric(AA[,22])) #median value of Alpha_slope for OU_linear
RESULTS3[12,2] <- quantile(x=as.numeric(AA[,22]), probs = c(0))
RESULTS3[12,3] <- quantile(x=as.numeric(AA[,22]), probs = c(0.95))
if(write.file == "TRUE"){
FILE1 <- paste(wd, null.model, "_beta_", beta, "__alpha_", alpha, "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__Raw_data.txt", sep='')
write.table(RESULTS1, FILE1)
FILE2 <- paste(wd, null.model, "_beta_", beta, "__alpha_", alpha, "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__TYPE1errors.txt", sep='')
write.table(RESULTS2, FILE2)
FILE3 <- paste(wd, null.model, "_beta_", beta, "__alpha_", alpha, "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__model_parameters.txt", sep='')
write.table(RESULTS3, FILE3)
}
return(list(simulation_parameters = RESULTS1, TypeI_errors = RESULTS2, model_parameters <- RESULTS3))
}
power.test <- function(TIME, GRAD, parameters, test.model, threshold_deltaAICc, REP=1, N, write = "FALSE", wd = ""){
#calculates statsitical power of a gradient model versus BM_null and OU_null
#threshold_deltaAICc = a single value or a list of threshold delta AIC values to calculate
RESULTS=NA
TIME_y = rep(TIME, each = REP)
GRAD_y <- rep(GRAD, each = REP)
RESULTS2 <- matrix(NA, length(threshold_deltaAICc), nrow = 3)
colnames(RESULTS2) <- c(threshold_deltaAICc)
rownames(RESULTS2) <- c("BMlinear_and_OU_linear_beta_vs_2null", "BMlinear_and_OUlinear_vs_2null", "3gradient_vs_2null")
RESULTS3 <- matrix(NA, length(threshold_deltaAICc), nrow = 5)
colnames(RESULTS3) <- c(threshold_deltaAICc)
rownames(RESULTS3) <- c("testModel_vs_BMnull", "testModel_vs_BMlinear", "testModel_vs_OUnull", "testModel_VS_OUlinearBeta", "testModel_vs_OUlinear")
AA <- simulation.analysis(GRAD = GRAD_y, TIME = TIME_y, PARAMETERS = parameters, null.model=c(test.model), test.models=c("BM_null", "OU_null", "BM_linear", "OU_linear_beta", "OU_linear"), N)
if(test.model == "BM_null") jj = 6
if(test.model == "OU_null") jj = 8
if(test.model == "BM_linear") jj = 7
if(test.model == "OU_linear_beta") jj = 9
if(test.model == "OU_linear") jj = 10
MIN_NULL <- as.numeric(AA[,1]) * NA
MIN_BM_null <- MIN_NULL
MIN_BM_linear <- MIN_NULL
MIN_OU_linear_beta <- MIN_NULL
MIN_OU_linear <- MIN_NULL
MIN_OU_null <- MIN_NULL
MIN_2TESTa <- MIN_NULL
MIN_2TESTb <- MIN_NULL
MIN_3TEST <- MIN_NULL
MIN_TEST <- MIN_NULL
for(i in 1:length(MIN_NULL)){
MIN_NULL[i] <- min(as.numeric(AA[i,c(6,8)]) )
MIN_BM_null[i] <- min(as.numeric(AA[i,c(6)]) )
MIN_BM_linear[i] <- min(as.numeric(AA[i,c(7)]) )
MIN_OU_linear_beta[i] <- min(as.numeric(AA[i,c(9)]) )
MIN_OU_linear[i] <- min(as.numeric(AA[i,c(10)]) )
MIN_OU_null[i] <- min(as.numeric(AA[i,c(8)]) )
MIN_2TESTa[i] <- min(as.numeric(AA[i,c(7,9)]) )
MIN_2TESTb[i] <- min(as.numeric(AA[i,c(7,10)]) )
MIN_3TEST[i] <- min(as.numeric(AA[i,c(7,9,10)]) )
MIN_TEST[i] <- min(as.numeric(AA[i,jj]) )
}
DELTA_AIC_2m <- MIN_BM_null - MIN_BM_linear
DELTA_AIC_4mA <- MIN_NULL - MIN_2TESTa
DELTA_AIC_4mB <- MIN_NULL - MIN_2TESTb
DELTA_AIC_5m <- MIN_NULL - MIN_3TEST
DELTA_AIC_BMnull <- MIN_BM_null - MIN_TEST
DELTA_AIC_BMlinear <- MIN_BM_linear - MIN_TEST
DELTA_AIC_OUnull <- MIN_OU_null - MIN_TEST
DELTA_AIC_OUlinearBeta <- MIN_OU_linear_beta - MIN_TEST
DELTA_AIC_OUlinear <- MIN_OU_linear - MIN_TEST
for(y in 1:length(threshold_deltaAICc)){
RESULTS2[1, y] <- (sum(DELTA_AIC_4mA > threshold_deltaAICc[y]) / N)
RESULTS2[2, y] <- (sum(DELTA_AIC_4mB > threshold_deltaAICc[y]) / N)
RESULTS2[3, y] <- (sum(DELTA_AIC_5m > threshold_deltaAICc[y]) / N)
RESULTS3[1, y] <- (sum(DELTA_AIC_BMnull > threshold_deltaAICc[y]) / N)
RESULTS3[2, y] <- (sum(MIN_BM_linear > threshold_deltaAICc[y]) / N)
RESULTS3[3, y] <- (sum(DELTA_AIC_OUnull > threshold_deltaAICc[y]) / N)
RESULTS3[4, y] <- (sum(DELTA_AIC_OUlinearBeta > threshold_deltaAICc[y]) / N)
RESULTS3[5, y] <- (sum(DELTA_AIC_OUlinear > threshold_deltaAICc[y]) / N)
}
if(write == "TRUE"){
if(test.model == "BM_null"){
FILE3 <- paste(wd, test.model, "_beta_", parameters[1], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__StatisticalPowerTestHypothesis.txt", sep='')
FILE2 <- paste(wd, test.model, "_beta_", parameters[1], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__StatisticalPowerModelPairs.txt", sep='')
FILE1 <- paste(wd, test.model, "_beta_", parameters[1], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__Raw_data.txt", sep='')
}
if(test.model == "OU_null"){
FILE3 <- paste(wd, test.model, "_beta_", parameters[1], "__alpha_", parameters[3], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__StatisticalPowerTestHypothesis.txt", sep='')
FILE2 <- paste(wd, test.model, "_beta_", parameters[1], "__alpha_", parameters[3], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__StatisticalPowerModelPairs.txt", sep='')
FILE1 <- paste(wd, test.model, "_beta_", parameters[1], "__alpha_", parameters[3], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__Raw_data.txt", sep='')
}
if(test.model == "BM_linear"){
FILE3 <- paste(wd, test.model, "_beta_", parameters[1], "__betaSlope_", parameters[2], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__StatisticalPowerTestHypothesis.txt", sep='')
FILE2 <- paste(wd, test.model, "_beta_", parameters[1], "__betaSlope_", parameters[2], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__StatisticalPowerModelPairs.txt", sep='')
FILE1 <- paste(wd, test.model, "_beta_", parameters[1], "__betaSlope_", parameters[2], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__Raw_data.txt", sep='')
}
if(test.model == "OU_linear_beta"){
FILE3 <- paste(wd, test.model, "_beta_", parameters[1], "__betaSlope_", parameters[2], "__alpha_", parameters[3], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__StatisticalPowerTestHypothesis.txt", sep='')
FILE2 <- paste(wd, test.model, "_beta_", parameters[1], "__betaSlope_", parameters[2], "__alpha_", parameters[3], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__StatisticalPowerModelPairs.txt", sep='')
FILE1 <- paste(wd, test.model, "_beta_", parameters[1], "__betaSlope_", parameters[2], "__alpha_", parameters[3], "__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__Raw_data.txt", sep='')
}
if(test.model == "OU_linear"){
FILE3 <- paste(wd, test.model, "_beta_", parameters[1], "__betaSlope_", parameters[2], "__alpha_", parameters[3], "__alphaSlope_", parameters[4],"__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__StatisticalPowerTestHypothesis.txt", sep='')
FILE2 <- paste(wd, test.model, "_beta_", parameters[1], "__betaSlope_", parameters[2], "__alpha_", parameters[3], "__alphaSlope_", parameters[4],"__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__StatisticalPowerModelPairs.txt", sep='')
FILE1 <- paste(wd, test.model, "_beta_", parameters[1], "__betaSlope_", parameters[2], "__alpha_", parameters[3], "__alphaSlope_", parameters[4],"__REP", REP, "__nsims", N, "__nsisters", length(GRAD_y), "__Raw_data.txt", sep='')
}
write.table(AA, FILE1)
write.table(RESULTS2, FILE3)
write.table(RESULTS3, FILE2)
}
return(list(test.model = test.model, parameters = parameters, N_sisters = length(GRAD_y), N_sims = N, power_test_hypothesis = RESULTS2, power_model_pairs = RESULTS3))
}
plotGradient.ci <- function(bootstraps1, bootstraps2=c("FALSE"), Lmin, Lmax, ylim, MLE = FALSE, MLE1, MLE2, xlab="Gradient"){
Lrange <- Lmax-Lmin
lats <- Lrange / 1000 * 0:1000 + Lmin
bootstrapsA <- matrix(NA, nrow=10000, ncol=length(lats)+2)
bootstrapsA[,1] <- bootstraps1[,1]
bootstrapsA[,2] <- bootstraps1[,2]
for(i in 1:nrow(bootstraps1)){
bootstrapsA[i, 3:(length(lats)+2)] <- as.numeric(bootstrapsA[i,1])+as.numeric(bootstrapsA[i,2])*lats
}
summary1 <- matrix(NA, nrow=4, ncol=length(lats)+2)
summary1[1,] <- c(NA, NA, lats)
for(i in 1:ncol(bootstrapsA)){
TEMP <- as.numeric(bootstrapsA[,i])
summary1[2,i] <- mean(TEMP)
QUANTILES <- quantile(x = TEMP, probs = seq(0, 1, 0.025), na.rm = TRUE)
percentile_CI95_low <- QUANTILES[2]
percentile_CI95_high <- QUANTILES[40]
summary1[3,i] <- percentile_CI95_low
summary1[4,i] <- percentile_CI95_high
}
summary2 <- summary1[,-c(1,2)]
plot(summary2[4,]~summary2[1,], type="l", ylim = ylim, ylab = "Evolutionary Rate", xlab=xlab)
lines(summary2[3,]~summary2[1,] )
if(MLE==FALSE){lines(summary2[2,]~summary2[1,], lwd = 2)}
if(MLE==TRUE){lines(x=c(Lmin, Lmax), y=c((Lmin*MLE1[2] +MLE1[1]), (Lmax*MLE1[2] +MLE1[1])), lwd = 2)}
if(length(bootstraps2) > 1){
bootstrapsB <- matrix(NA, nrow=10000, ncol=length(lats)+2)
bootstrapsB[,1] <- bootstraps2[,1]
bootstrapsB[,2] <- bootstraps2[,2]
for(i in 1:nrow(bootstraps2)){
bootstrapsB[i, 3:(length(lats)+2)] <- as.numeric(bootstrapsB[i,1])+as.numeric(bootstrapsB[i,2])*lats
}
summary1 <- matrix(NA, nrow=4, ncol=length(lats)+2)
summary1[1,] <- c(NA, NA, lats)
for(i in 1:ncol(bootstrapsB)){
TEMP <- as.numeric(bootstrapsB[,i])
summary1[2,i] <- mean(TEMP)
QUANTILES <- quantile(x = TEMP, probs = seq(0, 1, 0.025), na.rm = TRUE)
percentile_CI95_low <- QUANTILES[2]
percentile_CI95_high <- QUANTILES[40]
summary1[3,i] <- percentile_CI95_low
summary1[4,i] <- percentile_CI95_high
}
summary2 <- summary1[,-c(1,2)]
lines(summary2[4,]~summary2[1,], lty = 2)
lines(summary2[3,]~summary2[1,], lty = 2)
lines(summary2[2,]~summary2[1,], lty = 2, lwd = 2)
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.