library(mvtnorm)
library(brms)
## Loading required package: Rcpp
## Loading 'brms' package (version 2.16.3). Useful instructions
## can be found by typing help('brms'). A more detailed introduction
## to the package is available through vignette('brms_overview').
##
## Attaching package: 'brms'
## The following object is masked from 'package:stats':
##
## ar
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
## ✓ ggplot2 3.3.5 ✓ purrr 0.3.4
## ✓ tibble 3.1.6 ✓ dplyr 1.0.7
## ✓ tidyr 1.1.4 ✓ stringr 1.4.0
## ✓ readr 2.1.1 ✓ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(sirt)
## - sirt 3.11-21 (2021-12-09 11:21:10)
##
## Attaching package: 'sirt'
## The following object is masked from 'package:brms':
##
## mcmc_plot
d <- NULL
total = tibble(value=integer(), item=character(), Part=character(), task=character())
sigma <- matrix(c(4,2.5,2.5,3), ncol=2)
## check sigma
cov2cor(sigma)
## [,1] [,2]
## [1,] 1.0000000 0.7216878
## [2,] 0.7216878 1.0000000
for(i in 1:1000){
df1 <- NULL
df2 <- NULL
df3 <- NULL
df4 <- NULL
df5 <- NULL
df6 <- NULL
df7 <- NULL
d <- rmvnorm(1, c(0, 0), sigma)
for(j in 1:40){
df1[j] = rbinom(1,1, inv_logit_scaled(d[1]))
df2[j] = paste("A", j)
}
df1 <- tibble(value = df1)
df2 <- tibble(item = df2)
df3 = bind_cols(df1, df2)
for(j in 1:400){
df4[j] = rbinom(1,1, inv_logit_scaled(d[2]))
df5[j] = paste("B", j)
}
df4 = tibble(value=df4)
df5 = tibble(item = df5)
df6 = bind_cols(df4, df5)
df7 <- bind_rows(df3, df6)
df7$Part = paste("Part", i)
df7$task = c(rep("A", 40), rep("B", 400))
total <- bind_rows(total, df7)
}
total %>%
group_by(Part, task) %>%
mutate(
total = sum(value)
) %>%
slice(1) %>%
ungroup() %>%
dplyr::select(-c("value", "item")) %>%
pivot_wider(id_cols=Part, names_from = task, values_from = total) %>%
ggplot(aes(A, B)) + geom_point() + stat_smooth(method="loess")
## `geom_smooth()` using formula 'y ~ x'
ttl1 <- total %>%
dplyr::select(-"task") %>%
pivot_wider(id_cols=Part, names_from=item, values_from=value) %>%
dplyr::select(-"Part")
dtct <- c(rep(1, 40), rep(2, 400))
ttl2 <- data.frame(ttl1)
fscores = rowSums(ttl2)
conf <- conf.detect(ttl2, fscores, dtct)
## -----------------------------------------------------------
## Confirmatory DETECT Analysis
## Conditioning on 1 Score
## Bandwidth Scale: 1.1
## Pairwise Estimation of Conditional Covariances
## ...........................................................
## Nonparametric ICC estimation
## 5% 10% 15% 20% 25% 30% 35% 40% 45% 50%
## 55% 60% 65% 70% 75% 80% 85% 90% 95%
## ...........................................................
## Nonparametric Estimation of conditional covariances
## 5% 10% 15% 20% 25% 30% 35% 40% 45% 50%
## 55% 60% 65% 70% 75% 80% 85% 90% 95%
## -----------------------------------------------------------
## unweighted weighted
## DETECT 0.177 0.177
## ASSI 0.190 0.190
## RATIO 0.337 0.337
## MADCOV100 0.526 0.526
## MCOV100 0.045 0.045
dtct <- c(rep(1, 40), rep(2, 80))
ttl2 <- data.frame(ttl1)[,1:80]
fscores = rowSums(ttl2)
conf <- conf.detect(ttl2, fscores, dtct)
## -----------------------------------------------------------
## Confirmatory DETECT Analysis
## Conditioning on 1 Score
## Bandwidth Scale: 1.1
## Pairwise Estimation of Conditional Covariances
## ...........................................................
## Nonparametric ICC estimation
## 5% 10% 15% 20% 25% 30% 35% 40% 45% 50%
## 55% 60% 65% 70% 75% 80% 85% 90% 95%
## ...........................................................
## Nonparametric Estimation of conditional covariances
## 5% 10% 15% 20% 25% 30% 35% 40% 45% 50%
## 55% 60% 65% 70% 75% 80% 85% 90% 95%
## -----------------------------------------------------------
## unweighted weighted
## DETECT 1.422 1.422
## ASSI 0.984 0.984
## RATIO 0.998 0.998
## MADCOV100 1.424 1.424
## MCOV100 -0.138 -0.138
dtct <- c(rep(1, 40), rep(2, 180))
ttl2 <- data.frame(ttl1)[,1:220]
fscores = rowSums(ttl2)
conf <- conf.detect(ttl2, fscores, dtct)
## -----------------------------------------------------------
## Confirmatory DETECT Analysis
## Conditioning on 1 Score
## Bandwidth Scale: 1.1
## Pairwise Estimation of Conditional Covariances
## ...........................................................
## Nonparametric ICC estimation
## 5% 10% 15% 20% 25% 30% 35% 40% 45% 50%
## 55% 60% 65% 70% 75% 80% 85% 90% 95%
## ...........................................................
## Nonparametric Estimation of conditional covariances
## 5% 10% 15% 20% 25% 30% 35% 40% 45% 50%
## 55% 60% 65% 70% 75% 80% 85% 90% 95%
## -----------------------------------------------------------
## unweighted weighted
## DETECT 0.499 0.499
## ASSI 0.450 0.450
## RATIO 0.692 0.692
## MADCOV100 0.720 0.720
## MCOV100 0.003 0.003
dtct <- c(rep(1, 40), rep(2, 280))
ttl2 <- data.frame(ttl1)[,1:320]
fscores = rowSums(ttl2)
conf <- conf.detect(ttl2, fscores, dtct)
## -----------------------------------------------------------
## Confirmatory DETECT Analysis
## Conditioning on 1 Score
## Bandwidth Scale: 1.1
## Pairwise Estimation of Conditional Covariances
## ...........................................................
## Nonparametric ICC estimation
## 5% 10% 15% 20% 25% 30% 35% 40% 45% 50%
## 55% 60% 65% 70% 75% 80% 85% 90% 95%
## ...........................................................
## Nonparametric Estimation of conditional covariances
## 5% 10% 15% 20% 25% 30% 35% 40% 45% 50%
## 55% 60% 65% 70% 75% 80% 85% 90% 95%
## -----------------------------------------------------------
## unweighted weighted
## DETECT 0.277 0.277
## ASSI 0.279 0.279
## RATIO 0.476 0.476
## MADCOV100 0.583 0.583
## MCOV100 0.030 0.030