@@ -104,17 +104,17 @@ select.explore <- function(object,
104 104
BF_cut = 3,
105 105
alternative = "two.sided",
106 106
...){
107 -
# rename
107 +
## rename
108 108
x <- object
109 109 110 -
# hyp probability
110 +
## hyp probability
111 111
hyp_prob <- BF_cut / (BF_cut + 1)
112 112 113 -
# posterior samples
114 -
post_samp <- x$post_samp
113 +
## posterior samples
114 +
post_samp <- x$post_samp
115 115 116 -
# prior samples
117 -
prior_samp <- x$prior_samp
116 +
## prior samples
117 +
prior_samp <- x$prior_samp
118 118 119 119 120 120
@@ -129,7 +129,7 @@ select.explore <- function(object,
129 129 130 130
# prior
131 131
prior_sd <- apply(prior_samp$fisher_z[,,(51:x$iter)], 1:2, sd)
132 -
prior_dens <- dnorm(0, 0, mean(prior_sd[upper.tri(diag(3))]))
132 +
prior_dens <- dnorm(0, 0, mean(prior_sd[upper.tri(diag(nrow(prior_sd)))]))
133 133 134 134
# BF
135 135
BF_10_mat <- prior_dens / post_dens
@@ -146,9 +146,9 @@ select.explore <- function(object,
146 146
diag(Adj_10) <- 0
147 147 148 148
# returned object
149 -
returned_object = list(pcor_mat_zero = post_mean * Adj_10,
150 -
pcor_mat = round(post_mean, 3),
151 -
pcor_sd = round(post_sd, 3),
149 +
returned_object = list(pcor_mat_zero = tanh(post_mean) * Adj_10,
150 +
pcor_mat = round(tanh(post_mean), 3),
151 +
pcor_sd_fisher = round(post_sd, 3),
152 152
Adj_10 = Adj_10,
153 153
Adj_01 = Adj_01,
154 154
BF_10 = BF_10_mat,
@@ -168,7 +168,7 @@ select.explore <- function(object,
168 168
# posterior
169 169
post_sd <- apply(post_samp$fisher_z[,,(51:x$iter)], 1:2, sd)
170 170
post_mean <- apply(post_samp$fisher_z[,,(51:x$iter)], 1:2, mean)
171 -
#x$pcor_mat
171 +
#x$pcor_mat
172 172
post_dens <- dnorm(0, post_mean, post_sd )
173 173 174 174
# prior
@@ -196,9 +196,9 @@ select.explore <- function(object,
196 196 197 197
# returned object
198 198
returned_object = list(
199 -
pcor_mat_zero = post_mean * Adj_20,
200 -
pcor_mat = round(post_mean, 3),
201 -
pcor_sd = round(post_sd, 3),
199 +
pcor_mat_zero = tanh(post_mean) * Adj_20,
200 +
pcor_mat = round(tanh(post_mean), 3),
201 +
pcor_sd_fisher = round(post_sd, 3),
202 202
Adj_20 = Adj_20,
203 203
Adj_02 = Adj_02,
204 204
BF_20 = BF_20_mat,
@@ -217,7 +217,7 @@ select.explore <- function(object,
217 217 218 218
# posterior
219 219
post_sd <- apply(post_samp$fisher_z[,,(51:x$iter)], 1:2, sd)
220 -
post_mean <- x$pcor_mat
220 +
post_mean <- apply(post_samp$fisher_z[,,(51:x$iter)], 1:2, mean)
221 221
post_dens <- dnorm(0, post_mean, post_sd )
222 222 223 223
# prior
@@ -245,9 +245,9 @@ select.explore <- function(object,
245 245 246 246
# returned object
247 247
returned_object = list(
248 -
pcor_mat_zero = post_mean * Adj_20,
249 -
pcor_mat = round(post_mean, 3),
250 -
pcor_sd = round(post_sd, 3),
248 +
pcor_mat_zero = tanh(post_mean) * Adj_20,
249 +
pcor_mat = round(tanh(post_mean), 3),
250 +
pcor_sd_fisher = round(post_sd, 3),
251 251
Adj_20 = Adj_20,
252 252
Adj_02 = Adj_02,
253 253
BF_20 = BF_20_mat,
@@ -291,7 +291,7 @@ select.explore <- function(object,
291 291 292 292
# posterior
293 293
post_sd <- apply(post_samp$fisher_z[,,(51:x$iter)], 1:2, sd)
294 -
post_mean <- x$pcor_mat
294 +
post_mean <- apply(post_samp$fisher_z[,,(51:x$iter)], 1:2, mean)
295 295
post_dens <- dnorm(0, post_mean, post_sd)
296 296 297 297
# prior
@@ -339,8 +339,8 @@ select.explore <- function(object,
339 339
pos_mat = pos_mat,
340 340
null_mat = null_mat,
341 341
alternative = alternative,
342 -
pcor_mat = round(post_mean, 3),
343 -
pcor_sd = round(post_sd, 3),
342 +
pcor_mat = round(tanh(post_mean), 3),
343 +
pcor_sd_fisher = round(post_sd, 3),
344 344
call = match.call(),
345 345
prob = hyp_prob,
346 346
type = x$type,
@@ -502,27 +502,27 @@ summary.select.explore <- function(object,
502 502
if(x$alternative == "two.sided"){
503 503 504 504
post_mean <- x$pcor_mat[upper.tri(x$pcor_mat)]
505 -
post_sd <- x$pcor_sd[upper.tri(x$pcor_sd)]
505 +
post_sd <- x$pcor_sd_fisher[upper.tri(x$pcor_sd_fisher)]
506 506
prob_H1 <- x$BF_10[upper.tri(x$BF_10)] / (x$BF_10[upper.tri(x$BF_10)] + 1)
507 507
prob_H0 <- 1 - prob_H1
508 508
summ <- data.frame(
509 509
Relation = mat_names,
510 510
Post.mean = post_mean,
511 -
Post.sd = post_sd,
511 +
Post.sd.fisher = post_sd,
512 512
Pr.H0 = round(prob_H0, 3),
513 513
Pr.H1 = round(prob_H1, 3)
514 514
)
515 515 516 516
} else if (x$alternative == "greater"){
517 517 518 518
post_mean <- x$pcor_mat[upper.tri(x$pcor_mat)]
519 -
post_sd <- x$pcor_sd[upper.tri(x$pcor_sd)]
519 +
post_sd <- x$pcor_sd_fisher[upper.tri(x$pcor_sd_fisher)]
520 520
prob_H1 <- x$BF_20[upper.tri(x$BF_20)] / (x$BF_20[upper.tri(x$BF_20)] + 1)
521 521
prob_H0 <- 1 - prob_H1
522 522
summ <- data.frame(
523 523
Relation = mat_names,
524 524
Post.mean = post_mean,
525 -
Post.sd = post_sd,
525 +
Post.sd.fisher = post_sd,
526 526
Pr.H0 = round(prob_H0, 3),
527 527
Pr.H1 = round(prob_H1, 3)
528 528
)
@@ -532,13 +532,13 @@ summary.select.explore <- function(object,
532 532
} else if (x$alternative == "less" | x$alternative == "greater"){
533 533 534 534
post_mean <- x$pcor_mat[upper.tri(x$pcor_mat)]
535 -
post_sd <- x$pcor_sd[upper.tri(x$pcor_sd)]
535 +
post_sd <- x$pcor_sd_fisher[upper.tri(x$pcor_sd_fisher)]
536 536
prob_H1 <- x$BF_20[upper.tri(x$BF_20)] / (x$BF_20[upper.tri(x$BF_20)] + 1)
537 537
prob_H0 <- 1 - prob_H1
538 538
summ <- data.frame(
539 539
Relation = mat_names[upper.tri(mat_names)],
540 540
Post.mean = post_mean,
541 -
Post.sd = post_sd,
541 +
Post.sd.fisher = post_sd,
542 542
Pr.H0 = round(prob_H0, 3),
543 543
Pr.H1 = round(prob_H1, 3)
544 544
)
@@ -549,12 +549,12 @@ summary.select.explore <- function(object,
549 549 550 550
summ <- cbind.data.frame( x$post_prob[,1],
551 551
x$pcor_mat[upper.tri(x$pcor_mat)],
552 -
x$pcor_sd[upper.tri(x$pcor_sd)],
552 +
x$pcor_sd_fisher[upper.tri(x$pcor_sd_fisher)],
553 553
round(x$post_prob[,2:4], 3))
554 554 555 555
colnames(summ) <- c("Relation",
556 556
"Post.mean",
557 -
"Post.sd",
557 +
"Post.sd.fisher",
558 558
"Pr.H0",
559 559
"Pr.H1",
560 560
"Pr.H2")
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4