## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 4.5
)
library(knitr)
library(mstATA)
library(highs)
library(ggplot2)

## ----echo=FALSE---------------------------------------------------------------
tab <- data.frame(
  Attribute = c("Discrimination",
                "Difficulty",
                "Guessing",
                "Response Time",
                "Word Counts"),
  Level = c("Item", "Item", "Item", "Item", "Stimulus"),
  Mean = c(0.92, -0.01, 0.10, 120.11, 123.47),
  SD = c(0.19, 0.97, 0.04, 35.01, 35.01),
  Min = c(0.51, -3.24, 0.01, 60, 52),
  Max = c(1.59, 2.14, 0.26, 180, 199)
)

kable(tab,
      caption = "Descriptive statistics for item and stimulus quantitative attributes.",
      col.names = c("Attribute", "Level", "Mean", "SD", "Min", "Max"),
      digits = 2,
      align = c("l", "l", "r", "r", "r", "r"))


## -----------------------------------------------------------------------------
data("reading_itempool")
REE<-c(-1.39,-0.97,-0.68)
REM<-c(-0.43,-0.21,0)
RHM<-c(0,0.21,0.43)
RHH<-c(0.68,0.97,1.39)
theta_values<-unique(c(REE,REM,RHM,RHH))
item_par_cols<-list("3PL"=c("discrimination","difficulty","guessing"))
theta_iif<-compute_iif(reading_itempool,
                       item_par_cols = item_par_cols,
                       theta = theta_values,model_col = "model",
                       D = 1.7)
reading_itempool[,paste0("iif(theta=",theta_values,")")]<-theta_iif
enemyitem_set<-create_enemy_sets(reading_itempool$item_id,
                                 reading_itempool$enemy_item)
enemystim_set<-create_enemy_sets(reading_itempool$stimulus,
                                 reading_itempool$enemy_stimulus)
pivot_stim_map<-create_pivot_stimulus_map(reading_itempool,
                                          item_id_col = "item_id",
                                          stimulus = "stimulus",
                                          pivot_item = "pivot_item")

## -----------------------------------------------------------------------------
mst_123 <- mst_design(itempool = reading_itempool,item_id_col = "item_id",
                      design = "1-2-3",rdps = list(c(0),c(-0.43,0.43)),
                      exclude_pathways = c("1-1-3","1-2-1"),
                      module_length = c(12,12,12,12,12,12),
                      enemyitem_set = enemyitem_set,
                      enemystim_set = enemystim_set,
                      pivot_stim_map = pivot_stim_map)

## -----------------------------------------------------------------------------
mst_structure<-mst_structure_con(x = mst_123,info_tol = 0.1)
mst_noreuse<-panel_itemreuse_con(x = mst_123,overlap = FALSE)
mst_noenemyitem<-enemyitem_exclu_con(x = mst_123)
mst_noenemystim<-enemystim_exclu_con(x = mst_123)
mst_content<-test_itemcat_range_con(x = mst_123,attribute = "content",
                                    cat_levels = paste0("content",1:4),
                                    min = 7,max = 11,
                                    which_pathway = 1:4)
mst_tei<-test_itemcat_con(x = mst_123,attribute = "itemtype",
                          cat_levels = "TEI",
                          operator = "=",target_num = 2,
                          which_module = 1:6)
mst_passtype<-test_stimcat_con(x = mst_123,attribute = "stimulus_type",
                               cat_levels = c("history","social studies"),
                               operator = "=",target_num = 1,
                               which_module = 1:6)
mst_time<-test_itemquant_range_con(x = mst_123,attribute = "time",
                                   min = 110*12,max = 130*12,
                                   which_module = 1:6)
mst_stimitem<-stim_itemcount_con(x = mst_123,min = 4,max = 8,
                                 which_module = 1:6)
mst_stimquant<-stimquant_con(x = mst_123,attribute = "stimulus_words",
                             min = 90,max = 150,
                             which_module = 1:6)
obj1<-objective_term(x = mst_123,attribute = "iif(theta=-1.39)",
                     applied_level = "Pathway-level",
                     which_pathway = 1,sense = "max")
obj2<-objective_term(x = mst_123,attribute = "iif(theta=-0.97)",
                     applied_level = "Pathway-level",
                     which_pathway = 1,sense = "max")
obj3<-objective_term(x = mst_123,attribute = "iif(theta=-0.68)",
                     applied_level = "Pathway-level",
                     which_pathway = 1,sense = "max")
obj4<-objective_term(x = mst_123,attribute = "iif(theta=-0.43)",
                     applied_level = "Pathway-level",
                     which_pathway = 2,sense = "max")
obj5<-objective_term(x = mst_123,attribute = "iif(theta=-0.21)",
                     applied_level = "Pathway-level",
                     which_pathway = 2,sense = "max")
obj6<-objective_term(x = mst_123,attribute = "iif(theta=0)",
                     applied_level = "Pathway-level",
                     which_pathway = 2,sense = "max")
obj7<-objective_term(x = mst_123,attribute = "iif(theta=0)",
                     applied_level = "Pathway-level",
                     which_pathway = 3,sense = "max")
obj8<-objective_term(x = mst_123,attribute = "iif(theta=0.21)",
                     applied_level = "Pathway-level",
                     which_pathway = 3,sense = "max")
obj9<-objective_term(x = mst_123,attribute = "iif(theta=0.43)",
                     applied_level = "Pathway-level",
                     which_pathway = 3,sense = "max")
obj10<-objective_term(x = mst_123,attribute = "iif(theta=0.68)",
                      applied_level = "Pathway-level",
                     which_pathway = 4,sense = "max")
obj11<-objective_term(x = mst_123,attribute = "iif(theta=0.97)",
                      applied_level = "Pathway-level",
                     which_pathway = 4,sense = "max")
obj12<-objective_term(x = mst_123,attribute = "iif(theta=1.39)",
                      applied_level = "Pathway-level",
                     which_pathway = 4,sense = "max")
mst_obj<-capped_maximin_obj(x = mst_123,
                            multiple_terms = list(obj1,obj2,obj3,
                                                  obj4,obj5,obj6,
                                                  obj7,obj8,obj9,
                                                  obj10,obj11,obj12),
                            strategy_args = list(proportions = rep(c(1,1.5,1),4)))
mst_model<-onepanel_spec(x = mst_123,
                         constraints = list(mst_structure,mst_noreuse,
                                            mst_content,mst_noenemyitem,mst_noenemystim,
                                            mst_tei,mst_passtype,mst_time,
                                            mst_stimitem,
                                            mst_stimquant),
                         objective = mst_obj)


## -----------------------------------------------------------------------------
# It is not executed in the vignette to avoid long build times.
# \dontrun{
# mst_result<-solve_model(model_spec = mst_model,solver = "HiGHS",time_limit = 5*60)
# reading_panel<-assembled_panel(x = mst_123,result = mst_result)
# }

## ----echo=FALSE---------------------------------------------------------------
data("reading_panel")
# RDP information check
RDP_check<-rbind(report_test_tif(assembled_panel = reading_panel,
                                 theta = 0,
                                 item_par_cols = item_par_cols,
                                 model_col = "model",D = 1.7,
                                 which_module = 2:3),
                 report_test_tif(assembled_panel = reading_panel,
                                 theta = -0.43,
                                 item_par_cols = item_par_cols,
                                 model_col = "model",D = 1.7,
                                 which_module = 4:5),
                 report_test_tif(assembled_panel = reading_panel,
                                 theta = 0.43,
                                 item_par_cols = item_par_cols,
                                 model_col = "model",D = 1.7,
                                 which_module = 5:6))
kable(RDP_check,
      caption = "Routing decision points information check",
      digits = 2,
      align = c("l","r", "r", "r"))

Content_check<-report_test_itemcat(assembled_panel = reading_panel,
                                   attribute = "content",
                                   cat_levels = paste0("content",1:4),
                                   which_pathway = 1:4)
kable(Content_check,
      caption = "Number of items per content check")

time_check<-report_test_itemquant(assembled_panel = reading_panel,
                                  attribute = "time",
                                  statistic = "average",
                                  which_module = 1:6)
kable(time_check,
      caption = "Average response time per item check")

pathway_tifcheck <- data.frame(theta = c(-1.39, -0.97, -0.68, -0.43, -0.21, 0, 0,
                                         0.21, 0.43, 0.68, 0.97, 1.39),
                               pathway_id = c("M-E-E", "M-E-E", "M-E-E",
                                              "M-E-M", "M-E-M", "M-E-M",
                                              "M-H-M", "M-H-M", "M-H-M",
                                              "M-H-H", "M-H-H", "M-H-H"),
                               must_greater_than = c(8.941002, 13.4115, 8.941002,
                                                     8.941002, 13.4115, 8.941002,
                                                     8.941002, 13.4115, 8.941002,
                                                     8.941002, 13.4115, 8.941002),
                               realized_information = c(11.64047, 13.4115, 13.72838,
                                                        13.24364, 13.48899, 13.29367,
                                                        13.25245, 13.4666, 13.35719,
                                                        13.72612, 13.47349, 11.21304),
                               must_lower_than = c(13.72838, 18.19888, 13.72838,
                                                   13.72838, 18.19888, 13.72838,
                                                   13.72838, 18.19888, 13.72838,
                                                   13.72838, 18.19888, 13.72838))

kable(pathway_tifcheck,
      caption = "Pathway-level information requirements and realized information at selected ability levels.",
      digits = 3,
      align = c("r","l","r", "r", "r"))
plot_panel_tif(assembled_panel = reading_panel,item_par_cols = item_par_cols,
               model_col = "model",D = 1.7,theta = seq(-3,3,0.1),unit = "pathway")

