Recent Changes - Search:
 HomePage

ECD

ACED

Bayesian Networks in Educational Assessment

Cognition and Assessment

PmWiki

pmwiki.org

edit SideBar

ACEDBNInR

Description: A Bayesian Network for ACED data using the gRain and bnlearn packages in R
Authors: Gertrudes Velasquez
Maintainer: gv10c@my.fsu.edu
Version: 0.1
Last Modified Date:08/04/2016
Change History:
Date -- initials -- description

R packages for data manipulation and color selection in graphical displays

library(RBGL)
library(car)

R packages to create Bayesian Networks

library(gRain)
library(bnlearn)
library(ggm)

R packages for graphics associated with the above packages for BN

library(Rgraphviz)
library(gRbase)
library(igraph)
library(lattice)

R package to create conditional probability tables
located at https://pluto.coe.fsu.edu/RNetica/CPTtools.html%%

library(CPTtools)

Set working directory; change as necessary

setwd("c:/EDF5906DCM/ACED")

Assign ACED data to an R object

aced.total <- read.csv("ACED-total4.csv",na.strings="NA", header = TRUE)

Subset ACED data Includes only observed students' responses

aced.total1 <- aced.total[,87:149] aced.total1 <- apply(aced.total1, 2,

                     function(x) {x <- recode(x,"1= 'True'; 0='False' "); x})

Experimental condition: adaptive sequencing, simple feedback

aced.total2 <- aced.total[,c(4,87:149)] aced.total2a <- subset(aced.total2, Condition_Code=="adaptive_acc",select=2:64)
aced.total2a <- apply(aced.total2a, 2,

                      function(x) {x <- recode(x,"1= 'True'; 0='False' "); x})

Experimental condition: adaptive sequencing, elaborated feedback

aced.total2b <- subset(aced.total2, Condition_Code=="adaptive_full",select=2:64)
aced.total2b <- apply(aced.total2b, 2,

                      function(x) {x <- recode(x,"1= 'True'; 0='False' "); x})

Experimental condition: linear sequencing, elaborated feedback:

aced.total2c <- subset(aced.total2, Condition_Code=="linear_full",select=2:64)
aced.total2c <- apply(aced.total2c, 2,

                      function(x) {x <- recode(x,"1= 'True'; 0='False' "); x})

Create directed acyclic graph for Bayesian Network using gRain package Includes proficiency variables and task variables

aced.dag <- dag(~SolveGeometricProblems + CommonRatio|SolveGeometricProblems

           + ExamplesGeometric|SolveGeometricProblems + ExtendGeometric|SolveGeometricProblems
           + TableGeometric|SolveGeometricProblems + ModelGeometric|SolveGeometricProblems
           + InduceRulesGeometric|SolveGeometricProblems + VisualGeometric|SolveGeometricProblems
           + AlgebraRuleGeometric|InduceRulesGeometric + VerbalRuleGeometric|InduceRulesGeometric 
           + ExplicitGeometric|AlgebraRuleGeometric + RecursiveRuleGeometric|AlgebraRuleGeometric
           + T1|CommonRatio + T2|CommonRatio + T3|CommonRatio + T4|CommonRatio
           + T5|CommonRatio + T6|CommonRatio
           + T7|ExamplesGeometric + T8|ExamplesGeometric + T9|ExamplesGeometric 
           + T10|ExamplesGeometric + T11|ExamplesGeometric + T12|ExamplesGeometric
           + T13|ExplicitGeometric + T14|ExplicitGeometric + T15|ExplicitGeometric 
           + T16|ExplicitGeometric + T17|ExplicitGeometric + T18|ExplicitGeometric
           + T19|ExtendGeometric + T20|ExtendGeometric + T21|ExtendGeometric 
           + T22|ExtendGeometric + T23|ExtendGeometric + T24|ExtendGeometric
           + T25|ModelGeometric + T25|ExtendGeometric + T25|TableGeometric 
           + T26|ModelGeometric + T26|ExtendGeometric + T26|TableGeometric
           + T27|ModelGeometric + T27|ExtendGeometric + T27|TableGeometric
           + T28|ModelGeometric + T28|ExtendGeometric + T28|TableGeometric
           + T29|ModelGeometric + T29|ExtendGeometric + T30|TableGeometric
           + T31|RecursiveRuleGeometric + T32|RecursiveRuleGeometric
           + T33|RecursiveRuleGeometric + T34|RecursiveRuleGeometric
           + T35|RecursiveRuleGeometric + T36|RecursiveRuleGeometric
           + T37|SolveGeometricProblems + T38|SolveGeometricProblems
           + T39|SolveGeometricProblems + T40|SolveGeometricProblems
           + T41|SolveGeometricProblems + T42|SolveGeometricProblems
           + T43|TableGeometric + T43|ExtendGeometric + T44|TableGeometric 
           + T44|ExtendGeometric + T45|TableGeometric + T45|ExtendGeometric      
           + T46|TableGeometric + T46|ExtendGeometric + T47|TableGeometric 
           + T47|ExtendGeometric + T48|TableGeometric + T48|ExtendGeometric      
           + T49|VerbalRuleGeometric + T49|ExplicitGeometric + T49|ModelGeometric
           + T50|VerbalRuleGeometric + T50|ExplicitGeometric + T50|ModelGeometric
           + T51|VerbalRuleGeometric + T51|ExtendGeometric + T51|ModelGeometric
           + T52|VerbalRuleGeometric + T52|ExtendGeometric + T52|ModelGeometric      
           + T53|VerbalRuleGeometric + T53|ExtendGeometric + T53|ModelGeometric
           + T54|VerbalRuleGeometric + T54|ModelGeometric
           + T55|ExplicitGeometric + T55|VerbalRuleGeometric + T55|ModelGeometric 
           + T55|VisualGeometric
           + T56|ExplicitGeometric + T56|VerbalRuleGeometric + T56|ModelGeometric 
           + T56|VisualGeometric
           + T57|ExtendGeometric + T57|VisualGeometric
           + T58|ExtendGeometric + T58|VisualGeometric
           + T59|ExtendGeometric + T59|VisualGeometric
           + T60|ExtendGeometric + T60|VisualGeometric
           + T61|ExtendGeometric + T61|VisualGeometric
           + T62|VisualGeometric + T62|ExtendGeometric + T62|TableGeometric 
           + T62|ModelGeometric + T62|VerbalRuleGeometric 
           + T63|VisualGeometric + T63|ExtendGeometric + T63|VerbalRuleGeometric 
           + T63|ModelGeometric)#, result = "igraph")

Examine class of aced.dag:

class(aced.dag)

Graphical display of aced.dag

plot(aced.dag, "dot",attrs=list(node = list(fillcolor="lightgrey",

                                            fontcolor="red",fontsize = 200, overlap = FALSE)))

Create levels of proficiency and task variables

hml <- c("High","Medium", "Low")
tf <- c("True", "False")

Set up variables

Skill1 <- c("High","Medium","Low")
Skill2 <- c("High","Medium","Low")
Skill3 <- c("High","Medium","Low")
Skill4 <- c("High","Medium","Low")
Skill5 <- c("High","Medium","Low")
ObsLvl <- c("True","False")

Create input for conditional tables using CPTtools package

cptCorrect1a <- calcDPCFrame(list(S1=Skill1),ObsLvl,

                           log(c(S1=0.5)),betas=-1,rule="Compensatory",
                           link="gradedResponse")
cptCorrect1a <- c(rbind(cptCorrect1a$True,cptCorrect1a$False))

cptCorrect1b <- calcDPCFrame(list(S1=Skill1),ObsLvl,

                           log(c(S1=1)),betas=0,rule="Compensatory",
                           link="gradedResponse")
cptCorrect1b <- c(rbind(cptCorrect1b$True,cptCorrect1b$False))

cptCorrect1c <- calcDPCFrame(list(S1=Skill1),ObsLvl,

                           log(c(S1=1.5)),betas=1,rule="Compensatory",
                           link="gradedResponse")
cptCorrect1c <- c(rbind(cptCorrect1c$True,cptCorrect1c$False))

cptCorrect2a <- calcDPCFrame(list(S1=Skill1,Skill2),ObsLvl,

                             log(c(S1=0.5,S2=0.5)),betas=-1,rule="Compensatory",
                             link="gradedResponse")
cptCorrect2a <- c(rbind(cptCorrect2a$True,cptCorrect2a$False))

cptCorrect2b <- calcDPCFrame(list(S1=Skill1,Skill2),ObsLvl,

                             log(c(S1=1,S2=1)),betas=0,rule="Compensatory",
                             link="gradedResponse")
cptCorrect2b <- c(rbind(cptCorrect2b$True,cptCorrect2b$False))

cptCorrect2c <- calcDPCFrame(list(S1=Skill1,Skill2),ObsLvl,

                             log(c(S1=1.5,S2=1.5)),betas=1,rule="Compensatory",
                             link="gradedResponse")
cptCorrect2c <- c(rbind(cptCorrect2c$True,cptCorrect2c$False))

Easy items: IRT item discrimination param (slope, alpha) = 0.5; IRT difficulty param (intcpt, beta)=-1

cptCorrect3a <- calcDPCFrame(list(S1=Skill1, S2=Skill2, S3=Skill3),ObsLvl,

                            log(c(S1=0.5,S2=0.5,S3=0.5)),betas=-1,rule="Compensatory",
                            link="gradedResponse")
cptCorrect3a <- c(rbind(cptCorrect3a$True,cptCorrect3a$False))

Medium items: IRT item discrimination param (slope, alpha) = 1; IRT difficulty param (intcpt, beta)=0

cptCorrect3b <- calcDPCFrame(list(S1=Skill1, S2=Skill2, S3=Skill3),ObsLvl,

                            log(c(S1=1,S2=1,S3=1)),betas=0,rule="Compensatory",
                            link="gradedResponse")
cptCorrect3b <- c(rbind(cptCorrect3b$True,cptCorrect3b$False))

High items:IRT item discrimination param (slope, alpha) = 1.5; IRT difficulty param (intcpt, beta)=1

cptCorrect3c <- calcDPCFrame(list(S1=Skill1, S2=Skill2, S3=Skill3),ObsLvl,

                            log(c(S1=1.5,S2=1.5,S3=1.5)),betas=1,rule="Compensatory",
                            link="gradedResponse")
cptCorrect3c <- c(rbind(cptCorrect3c$True,cptCorrect3c$False))

cptCorrect4a <- calcDPCFrame(list(S1=Skill1, S2=Skill2, S3=Skill3, S4=Skill4),ObsLvl,

                             log(c(S1=0.5,S2=0.5,S3=0.5,S4=0.5)),betas=-1,rule="Compensatory",
                             link="gradedResponse")
cptCorrect4a <- c(rbind(cptCorrect4a$True,cptCorrect4a$False))

cptCorrect4b <- calcDPCFrame(list(S1=Skill1, S2=Skill2, S3=Skill3, S4=Skill4),ObsLvl,

                             log(c(S1=1,S2=1,S3=1,S4=1)),betas=0,rule="Compensatory",
                             link="gradedResponse")
cptCorrect4b <- c(rbind(cptCorrect4b$True,cptCorrect4b$False))

cptCorrect4c <- calcDPCFrame(list(S1=Skill1, S2=Skill2, S3=Skill3, S4=Skill4),ObsLvl,

                             log(c(S1=0.5,S2=0.5,S3=0.5,S4=0.5)),betas=1,rule="Compensatory",
                             link="gradedResponse")
cptCorrect4c <- c(rbind(cptCorrect4c$True,cptCorrect4c$False))

cptCorrect5b <- calcDPCFrame(list(S1=Skill1, S2=Skill2, S3=Skill3, S4=Skill4, S5=Skill5),ObsLvl,

                             log(c(S1=1,S2=1,S3=1,S4=1,S5=1)),betas=0,rule="Compensatory",
                             link="gradedResponse")
cptCorrect5b <- c(rbind(cptCorrect5b$True,cptCorrect5b$False))

Construct Conditional Probability Tables

Columns represent parent states; rows represent child states
Proficiency variables:

sgp <- cptable(~SolveGeometricProblems, values=c(0.2,0.5,0.3),levels=hml, normalize=T)

cr.sgp <- cptable(~CommonRatio|SolveGeometricProblems,

                  values=c(100,0,0,96.3,3.6,0.1,56.7,37.9,5.4),levels=hml,normalize = T)

exmpls.sgp <- cptable(~ExamplesGeometric|SolveGeometricProblems,

                  values=c(51.8,35.1,13.1,12.2,34.4,53.4,0.9,8.9,90.2),levels=hml,normalize = T)

induce.sgp <- cptable(~InduceRulesGeometric|SolveGeometricProblems,

                  values=c(39.5,39.6,20.9,7,27.5,65.5,0.4,5.0,94.6),levels=hml,normalize = T)

extend.sgp <- cptable(~ExtendGeometric|SolveGeometricProblems,

                  values=c(100,0,0,96.3,3.6,0.1,56.7,37.9,5.4),levels=hml,normalize = T)

table.sgp <- cptable(~TableGeometric|SolveGeometricProblems,

                  values=c(71.3,21.6,7.1,32.6,34.8,32.6,7.1,21.6,71.3),levels=hml,normalize = T)

model.sgp <- cptable(~ModelGeometric|SolveGeometricProblems,

                  values=c(28.1,41,30.9,3.7,20.1,76.2,0.1,2.6,97.3),levels=hml,normalize = T)

visual.sgp <- cptable(~VisualGeometric|SolveGeometricProblems,

                  values=c(74.9,21.1,4,29.5,41,29.5,4,21.1,74.9),levels=hml,normalize = T)

algbr.indc <- cptable(~AlgebraRuleGeometric|InduceRulesGeometric,

                  values=c(15.894,42.323,41.782,0.929,11.635,87.436,0.0104,0.607,99.382),levels=hml,normalize = T)

vrbl.indc <- cptable(~VerbalRuleGeometric|InduceRulesGeometric,

                  values=c(89.093,10.84,0.0669,16.152,67.697,16.152,0.0669,10.84,89.093),levels=hml,normalize = T)

explct.algbr <- cptable(~ExplicitGeometric|AlgebraRuleGeometric,

                  values=c(25.826,45.345,28.829,2.25,19.012,78.738,0.039,1.53,98.431),levels=hml,normalize = T)

rcrsv.algbr <- cptable(~RecursiveRuleGeometric|AlgebraRuleGeometric,

                  values=c(96.419,3.451,0.13,67.26,27.83,4.91,18.2,43.54,38.26),levels=hml,normalize = T)

Task variables: Common ratio items

t1.cr <- cptable(~T1|CommonRatio,values=c(87.73,12.27,73.11,26.89,50.8,49.2),levels=tf,normalize = T)
t2.cr <- cptable(~T2|CommonRatio,values=c(87.73,12.27,73.11,26.89,50.8,49.2),levels=tf,normalize = T)
t3.cr <- cptable(~T3|CommonRatio,values=c(49.18,50.82,26.89,73.11,12.27,87.73),levels=tf,normalize = T)
t4.cr <- cptable(~T4|CommonRatio,values=c(49.18,50.82,26.89,73.11,12.27,87.73),levels=tf,normalize = T)
t5.cr <- cptable(~T5|CommonRatio,values=c(72.46,27.54,50,50,27.54,72.46),levels=tf,normalize = T)
t6.cr <- cptable(~T6|CommonRatio,values=c(72.46,27.54,50,50,27.54,72.46),levels=tf,normalize = T)
Examples Geometric items

t7.exmpls <- cptable(~T7|ExamplesGeometric,values=c(87.73,12.27,73.11,26.89,50.8,49.2),levels=tf,normalize = T)
t8.exmpls <- cptable(~T8|ExamplesGeometric,values=c(87.73,12.27,73.11,26.89,50.8,49.2),levels=tf,normalize = T)
t9.exmpls <- cptable(~T9|ExamplesGeometric,values=c(49.18,50.82,26.89,73.11,12.27,87.73),levels=tf,normalize = T)
t10.exmpls <- cptable(~T10|ExamplesGeometric,values=c(49.18,50.82,26.89,73.11,12.27,87.73),levels=tf,normalize = T)
t11.exmpls <- cptable(~T11|ExamplesGeometric,values=c(72.46,27.54,50,50,27.54,72.46),levels=tf,normalize = T)
t12.exmpls <- cptable(~T12|ExamplesGeometric,values=c(72.46,27.54,50,50,27.54,72.46),levels=tf,normalize = T)

Explicit Geometric items

t13.explct <- cptable(~T13|ExplicitGeometric,values=c(87.73,12.27,73.11,26.89,50.8,49.2),levels=tf,normalize = T)
t14.explct <- cptable(~T14|ExplicitGeometric,values=c(87.73,12.27,73.11,26.89,50.8,49.2),levels=tf,normalize = T)
t15.explct <- cptable(~T15|ExplicitGeometric,values=c(49.18,50.82,26.89,73.11,12.27,87.73),levels=tf,normalize = T)
t16.explct <- cptable(~T16|ExplicitGeometric,values=c(49.18,50.82,26.89,73.11,12.27,87.73),levels=tf,normalize = T)
t17.explct <- cptable(~T17|ExplicitGeometric,values=c(72.46,27.54,50,50,27.54,72.46),levels=tf,normalize = T)
t18.explct <- cptable(~T18|ExplicitGeometric,values=c(72.46,27.54,50,50,27.54,72.46),levels=tf,normalize = T)

Extend Geometric items

t19.extnd <- cptable(~T19|ExtendGeometric,values=c(87.73,12.27,73.11,26.89,50.8,49.2),levels=tf,normalize = T)
t20.extnd <- cptable(~T20|ExtendGeometric,values=c(87.73,12.27,73.11,26.89,50.8,49.2),levels=tf,normalize = T)
t21.extnd <- cptable(~T21|ExtendGeometric,values=c(49.18,50.82,26.89,73.11,12.27,87.73),levels=tf,normalize = T)
t22.extnd <- cptable(~T22|ExtendGeometric,values=c(49.18,50.82,26.89,73.11,12.27,87.73),levels=tf,normalize = T)
t23.extnd <- cptable(~T23|ExtendGeometric,values=c(72.46,27.54,50,50,27.54,72.46),levels=tf,normalize = T)
t24.extnd <- cptable(~T24|ExtendGeometric,values=c(72.46,27.54,50,50,27.54,72.46),levels=tf,normalize = T)

Model Extend Table Geometric items

t25.mte <- cptable(~T25|ModelGeometric:ExtendGeometric:TableGeometric,

                   values=cptCorrect3a,levels=tf,normalize = T)
t26.mte <- cptable(~T26|ModelGeometric:ExtendGeometric:TableGeometric, values=cptCorrect3a,levels=tf,normalize = T)
t27.mte <- cptable(~T27|ModelGeometric:ExtendGeometric:TableGeometric, values=cptCorrect3c,levels=tf,normalize = T)
t28.mte <- cptable(~T28|ModelGeometric:ExtendGeometric:TableGeometric, values=cptCorrect3c,levels=tf,normalize = T)
t29.mte <- cptable(~T29|ModelGeometric:ExtendGeometric:TableGeometric, values=cptCorrect3b,levels=tf,normalize = T)
t30.mte <- cptable(~T30|ModelGeometric:ExtendGeometric:TableGeometric, values=cptCorrect3b,levels=tf,normalize = T)

Recursive Geometric Items

t31.rc <- cptable(~T31|RecursiveRuleGeometric, values = cptCorrect1a, levels = tf, normalize = T)
t32.rc <- cptable(~T32|RecursiveRuleGeometric, values = cptCorrect1a, levels = tf, normalize = T)
t33.rc <- cptable(~T33|RecursiveRuleGeometric, values = cptCorrect1c, levels = tf, normalize = T)
t34.rc <- cptable(~T34|RecursiveRuleGeometric, values = cptCorrect1c, levels = tf, normalize = T)
t35.rc <- cptable(~T35|RecursiveRuleGeometric, values = cptCorrect1b, levels = tf, normalize = T)
t36.rc <- cptable(~T36|RecursiveRuleGeometric, values = cptCorrect1b, levels = tf, normalize = T)

Solve Geometric Items

t37.sg <- cptable(~T37|SolveGeometricProblems, values = cptCorrect1a, levels = tf, normalize = T)
t38.sg <- cptable(~T38|SolveGeometricProblems, values = cptCorrect1a, levels = tf, normalize = T)
t39.sg <- cptable(~T39|SolveGeometricProblems, values = cptCorrect1c, levels = tf, normalize = T)
t40.sg <- cptable(~T40|SolveGeometricProblems, values = cptCorrect1c, levels = tf, normalize = T)
t41.sg <- cptable(~T41|SolveGeometricProblems, values = cptCorrect1b, levels = tf, normalize = T)
t42.sg <- cptable(~T42|SolveGeometricProblems, values = cptCorrect1b, levels = tf, normalize = T)

Table Extend Geometric Items

t43.te <- cptable(~T43|TableGeometric:ExtendGeometric, values = cptCorrect2a, levels = tf, normalize = T)
t44.te <- cptable(~T44|TableGeometric:ExtendGeometric, values = cptCorrect2a, levels = tf, normalize = T)
t45.te <- cptable(~T45|TableGeometric:ExtendGeometric, values = cptCorrect2c, levels = tf, normalize = T)
t46.te <- cptable(~T46|TableGeometric:ExtendGeometric, values = cptCorrect2c, levels = tf, normalize = T)
t47.te <- cptable(~T47|TableGeometric:ExtendGeometric, values = cptCorrect2b, levels = tf, normalize = T)
t48.te <- cptable(~T48|TableGeometric:ExtendGeometric, values = cptCorrect2b, levels = tf, normalize = T)

Verbal Explicit Model Items

t49.vem <- cptable(~T49|VerbalRuleGeometric:ExplicitGeometric:ModelGeometric,

                   values=cptCorrect3c,levels=tf,normalize = T)
t50.vem <- cptable(~T50|VerbalRuleGeometric:ExplicitGeometric:ModelGeometric, values=cptCorrect3b,levels=tf,normalize = T)

Verbal Extend Model Items

t51.vexm <- cptable(~T51|VerbalRuleGeometric:ExtendGeometric:ModelGeometric,

                   values=cptCorrect3a,levels=tf,normalize = T)
t52.vexm <- cptable(~T52|VerbalRuleGeometric:ExtendGeometric:ModelGeometric, values=cptCorrect3a,levels=tf,normalize = T)
t53.vexm <- cptable(~T53|VerbalRuleGeometric:ExtendGeometric:ModelGeometric, values=cptCorrect3b,levels=tf,normalize = T)

Verbal Model Item

t54.vm <- cptable(~T54|VerbalRuleGeometric:ModelGeometric, values = cptCorrect2c, levels = tf, normalize = T)

Visual Explicit Verbal Model Item

t55.vevm <- cptable(~T55|VisualGeometric:ExplicitGeometric:VerbalRuleGeometric:ModelGeometric,

                    values=cptCorrect4c,levels=tf,normalize=T)
t56.vevm <- cptable(~T56|VisualGeometric:ExplicitGeometric:VerbalRuleGeometric:ModelGeometric, values=cptCorrect4c,levels=tf,normalize=T)

Visual Extend Items

t57.vex <- cptable(~T57|VisualGeometric:ExtendGeometric,values = cptCorrect2a, levels = tf, normalize = T)
t58.vex <- cptable(~T58|VisualGeometric:ExtendGeometric,values = cptCorrect2a, levels = tf, normalize = T)
t59.vex <- cptable(~T59|VisualGeometric:ExtendGeometric,values = cptCorrect2a, levels = tf, normalize = T)
t60.vex <- cptable(~T60|VisualGeometric:ExtendGeometric,values = cptCorrect2c, levels = tf, normalize = T)
t61.vex <- cptable(~T61|VisualGeometric:ExtendGeometric,values = cptCorrect2b, levels = tf, normalize = T)

Visual Extend Table Model VerbalRule Geometric Item

t62.vetmv <- cptable(~T62|VisualGeometric:ExtendGeometric:TableGeometric:ModelGeometric:VerbalRuleGeometric,

                     values=cptCorrect5b,levels=tf,normalize=T)

Visual Extend Verbal Model Geometric Item

t63.vevm <- cptable(~T63|VisualGeometric:ExtendGeometric:VerbalRuleGeometric:ModelGeometric,

                    values=cptCorrect4b,levels=tf,normalize=T)

Compile CPTs

plist <- compileCPT(list(sgp,cr.sgp,exmpls.sgp,induce.sgp,extend.sgp,table.sgp,

                         model.sgp,visual.sgp,algbr.indc,vrbl.indc,explct.algbr,rcrsv.algbr,
                         t1.cr,t2.cr,t3.cr,t4.cr,t5.cr,t6.cr,t7.exmpls,t8.exmpls,t9.exmpls,
                         t10.exmpls,t11.exmpls,t12.exmpls,t13.explct,t14.explct,t15.explct,
                         t15.explct,t17.explct,t18.explct,t19.extnd,t20.extnd,t21.extnd,
                         t22.extnd,t23.extnd,t24.extnd,t25.mte,t26.mte,t27.mte,t28.mte,t29.mte,
                         t30.mte,t31.rc,t32.rc,t33.rc,t34.rc,t35.rc,t36.rc,t37.sg,t38.sg,
                         t39.sg,t40.sg,t41.sg,t42.sg,t43.te,t44.te,t45.te,t46.te,t47.te,t48.te,
                         t49.vem,t50.vem,t51.vexm,t52.vexm,t53.vexm,t54.vm,t55.vevm,t56.vevm,
                         t57.vex,t58.vex,t59.vex,t60.vex,t61.vex,t62.vetmv,t63.vevm))

Create a gRain object for analysis

aced.grn1 <- grain(plist)
summary(aced.grn1)
querygrain(aced.grn1)

Compilation of ACED DAG to find the clique potentials; can also use 'querygrain' function

aced.grn1c <- compile(aced.grn1)
summary(aced.grn1c)

Moralization and triangulation of DAG to form a chordal (triangulated) graph

aced.g <- aced.grn1$dag
aced.mg <- moralize(aced.g) #moralized DAG
aced.tmg <- triangulate(aced.mg) #triangulated moralized DAG
plot(aced.tmg,attrs=list(node = list(fillcolor="lightgrey",

                                     fontcolor="red",fontsize = 200, overlap = FALSE)))

running intersection property

rip(aced.tmg)

Organize cliques of ACED DAG in a junction tree iff the graph is triangulated

getCliques(aced.dag)
numbers on nodes refer to the clique number in the RIP-ordering

plot(aced.grn1c, type = "jt")

Propagation - from clique potentials to clique marginals
Clique potentials must be calibrated (adjusted) to each other

aced.grn1c <- propagate(aced.grn1c) summary(aced.grn1c)

Absorbing evidence and answer queries
Overall skills distribution

for(i in 1:nrow(aced.total1)){

      aced.grn1c.2t <- setEvidence(aced.grn1c, 
                  nodes = c("T1","T2","T3","T4","T5","T6","T7","T8","T9","T10",
                  "T11","T12","T13","T14","T15","T16","T17","T18","T19","T20",
                  "T21","T22","T23","T24","T25","T26","T27","T28","T29","T30",
                  "T31","T32","T33","T34","T35","T36","T37","T38","T39","T40",
                  "T41","T42","T43","T44","T45","T46","T47","T48","T49","T50",
                  "T51","T52","T53","T54","T55","T56","T57","T58","T59","T60",
                  "T61","T62","T63"), states=aced.total1[i,],propagate=T)

}

querygrain(aced.grn1c.2t, nodes = c("SolveGeometricProblems"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("CommonRatio"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("ExamplesGeometric"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("ExtendGeometric"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("ModelGeometric"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("VisualGeometric"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("TableGeometric"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("InduceRulesGeometric"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("VerbalRuleGeometric"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("AlgebraRuleGeometric"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("ExplicitGeometric"),type="marginal")
querygrain(aced.grn1c.2t, nodes = c("RecursiveRuleGeometric"),type="marginal")

Making Plots: Skill distribution

margins.2t <- data.frame(

      Geometric=c(Low=86.68,Medium=13.31,High=.001),
      CommonRatio=c(Low=52.04,Medium=41.18,High=6.78),
      Examples=c(Low=90.16,Medium=9.47,High=.42),
      Extend=c(Low=2.14,Medium=58.71,High=39.15),
      Model=c(Low=75.86,Medium=21.45,High=2.70),
      Visual=c(Low=97.15,Medium=2.82,High=.025),
      Table=c(Low=52.15,Medium=40.16,High=7.69),
      InduceRules=c(Low=89.64,Medium=9.36,High=.1),
      Verbal=c(Low=77.25,Medium=20.71,High=2.03),
      AlgebraRule=c(Low=97.15,Medium=2.67,High=.18),
      Explicit=c(Low=99.04,Medium=.94,High=.019),
      RecursiveRules=c(Low=2.50,Medium=65.99,High=31.51))

margins.2t <- as.matrix(margins.2t)
margins.2t
stackedBars(margins.2t,profindex=1,

            main="Marginal Distributions for ACED skills",digits=2,
            cex.main=1,cex.names=.75, col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F,
            legend.text=T,args.legend = list(x = "topleft"))

retractFinding(aced.grn1c.2t,

                nodes = c("T1","T2","T3","T4","T5","T6","T7","T8","T9","T10",
                  "T11","T12","T13","T14","T15","T16","T17","T18","T19","T20",
                  "T21","T22","T23","T24","T25","T26","T27","T28","T29","T30",
                  "T31","T32","T33","T34","T35","T36","T37","T38","T39","T40",
                  "T41","T42","T43","T44","T45","T46","T47","T48","T49","T50",
                  "T51","T52","T53","T54","T55","T56","T57","T58","T59","T60",
                  "T61","T62","T63"))

Skills distribution for adaptive sequencing, simple feedback

for(i in 1:nrow(aced.total2a)){

      aced.grn1c.2a <- setEvidence(aced.grn1c, 
            nodes = c("T1","T2","T3","T4","T5","T6","T7","T8","T9","T10",
                  "T11","T12","T13","T14","T15","T16","T17","T18","T19","T20",
                  "T21","T22","T23","T24","T25","T26","T27","T28","T29","T30",
                  "T31","T32","T33","T34","T35","T36","T37","T38","T39","T40",
                  "T41","T42","T43","T44","T45","T46","T47","T48","T49","T50",
                  "T51","T52","T53","T54","T55","T56","T57","T58","T59","T60",
                  "T61","T62","T63"), states=aced.total2a[i,],propagate=T)

}

querygrain(aced.grn1c.2a, nodes = c("SolveGeometricProblems"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("CommonRatio"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("ExamplesGeometric"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("ExtendGeometric"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("ModelGeometric"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("VisualGeometric"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("TableGeometric"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("InduceRulesGeometric"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("VerbalRuleGeometric"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("AlgebraRuleGeometric"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("ExplicitGeometric"),type="marginal")
querygrain(aced.grn1c.2a, nodes = c("RecursiveRuleGeometric"),type="marginal")

Making Plots: Skill distribution

margins.2a <- data.frame(

      Geometric=c(Low=86.68,Medium=13.31,High=.0086),
      CommonRatio=c(Low=52.04,Medium=41.18,High=6.78),
      Examples=c(Low=90.12,Medium=9.47,High=.42),
      Extend=c(Low=2.14,Medium=58.71,High=39.15),
      Model=c(Low=75.86,Medium=21.45,High=2.7),
      Visual=c(Low=97.15,Medium=2.82,High=.025),
      Table=c(Low=52.15,Medium=40.16,High=7.69),
      InduceRules=c(Low=89.64,Medium=9.36,High=1.00),
      Verbal=c(Low=77.25,Medium=20.71,High=2.03),
      AlgebraRule=c(Low=97.15,Medium=2.67,High=.18),
      Explicit=c(Low=99.04,Medium=.94,High=.019),
      RecursiveRules=c(Low=2.504,Medium=65.99,High=31.51))

margins.2a <- as.matrix(margins.2a)

retractFinding(aced.grn1c.2a,

               nodes = c("T1","T2","T3","T4","T5","T6","T7","T8","T9","T10",
                         "T11","T12","T13","T14","T15","T16","T17","T18","T19","T20",
                         "T21","T22","T23","T24","T25","T26","T27","T28","T29","T30",
                         "T31","T32","T33","T34","T35","T36","T37","T38","T39","T40",
                         "T41","T42","T43","T44","T45","T46","T47","T48","T49","T50",
                         "T51","T52","T53","T54","T55","T56","T57","T58","T59","T60",
                         "T61","T62","T63"))

Skills distribution for adaptive sequencing, elaborated feedback

for(i in 1:nrow(aced.total2b)){

      aced.grn1c.2b <- setEvidence(aced.grn1c, 
            nodes = c("T1","T2","T3","T4","T5","T6","T7","T8","T9","T10",
                  "T11","T12","T13","T14","T15","T16","T17","T18","T19","T20",
                  "T21","T22","T23","T24","T25","T26","T27","T28","T29","T30",
                  "T31","T32","T33","T34","T35","T36","T37","T38","T39","T40",
                  "T41","T42","T43","T44","T45","T46","T47","T48","T49","T50",
                  "T51","T52","T53","T54","T55","T56","T57","T58","T59","T60",
                  "T61","T62","T63"), states=aced.total2b[i,],propagate=T)

}

querygrain(aced.grn1c.2b, nodes = c("SolveGeometricProblems"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("CommonRatio"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("ExamplesGeometric"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("ExtendGeometric"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("ModelGeometric"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("VisualGeometric"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("TableGeometric"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("InduceRulesGeometric"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("VerbalRuleGeometric"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("AlgebraRuleGeometric"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("ExplicitGeometric"),type="marginal")
querygrain(aced.grn1c.2b, nodes = c("RecursiveRuleGeometric"),type="marginal")

Making Plots: Skill distribution

margins.2b <- data.frame(

      Geometric=c(Low=99.94,Medium=.059,High=0),
      CommonRatio=c(Low=57.94,Medium=40.2,High=1.86),
      Examples=c(Low=99.03,Medium=.97,High=.003),
      Extend=c(Low=95.94,Medium=4.06,High=.002),
      Model=c(Low=99.26,Medium=.74,High=.003),
      Visual=c(Low=94.25,Medium=5.63,High=.12),
      Table=c(Low=96.22,Medium=3.73,High=.05),
      InduceRules=c(Low=96.86,Medium=3.08,High=.06),
      Verbal=c(Low=90.63,Medium=9.12,High=.25),
      AlgebraRule=c(Low=99.73,Medium=.27,High=.001),
      Explicit=c(Low=99.05,Medium=.94,High=.004),
      RecursiveRules=c(Low=69.78,Medium=30,High=.23))

margins.2b <- as.matrix(margins.2b)

retractFinding(aced.grn1c.2b,

               nodes = c("T1","T2","T3","T4","T5","T6","T7","T8","T9","T10",
                         "T11","T12","T13","T14","T15","T16","T17","T18","T19","T20",
                         "T21","T22","T23","T24","T25","T26","T27","T28","T29","T30",
                         "T31","T32","T33","T34","T35","T36","T37","T38","T39","T40",
                         "T41","T42","T43","T44","T45","T46","T47","T48","T49","T50",
                         "T51","T52","T53","T54","T55","T56","T57","T58","T59","T60",
                         "T61","T62","T63"))

Skills distribution for adaptive sequencing, elaborated feedback

for(i in 1:nrow(aced.total2c)){

      aced.grn1c.2c <- setEvidence(aced.grn1c, 
                  nodes = c("T1","T2","T3","T4","T5","T6","T7","T8","T9","T10",
                        "T11","T12","T13","T14","T15","T16","T17","T18","T19","T20",
                        "T21","T22","T23","T24","T25","T26","T27","T28","T29","T30",
                        "T31","T32","T33","T34","T35","T36","T37","T38","T39","T40",
                        "T41","T42","T43","T44","T45","T46","T47","T48","T49","T50",
                        "T51","T52","T53","T54","T55","T56","T57","T58","T59","T60",
                        "T61","T62","T63"), states=aced.total2c[i,],propagate=T)

}

querygrain(aced.grn1c.2c, nodes = c("SolveGeometricProblems"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("CommonRatio"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("ExamplesGeometric"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("ExtendGeometric"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("ModelGeometric"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("VisualGeometric"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("TableGeometric"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("InduceRulesGeometric"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("VerbalRuleGeometric"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("AlgebraRuleGeometric"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("ExplicitGeometric"),type="marginal")
querygrain(aced.grn1c.2c, nodes = c("RecursiveRuleGeometric"),type="marginal")

Making Plots: Skill distribution

margins.2c <- data.frame(

      Geometric=c(Low=99.81,Medium=.19,High=0),
      CommonRatio=c(Low=57.89,Medium=40.2,High=1.90),
      Examples=c(Low=97.46,Medium=2.52,High=.021),
      Extend=c(Low=54.68,Medium=44.92,High=.40),
      Model=c(Low=86.69,Medium=12.28,High=1.03),
      Visual=c(Low=95.51,Medium=4.41,High=.07),
      Table=c(Low=78.05,Medium=19.94,High=2.01),
      InduceRules=c(Low=94.16,Medium=5.59,High=.25),
      Verbal=c(Low=81.35,Medium=17.60,High=1.04),
      AlgebraRule=c(Low=99.50,Medium=.5,High=0),
      Explicit=c(Low=99.64,Medium=.36,High=0),
      RecursiveRules=c(Low=50.08,Medium=49.07,High=0.86))

margins.2c <- as.matrix(margins.2c)

Graphical Displays
Marginal Distributions

png(file = "C:/EDF5906DCM/ACED/ACED_skills_ByGroup.png", width = 1500, height =1920)
oldpar <- par(mfrow=c(3,1), mar=c(3,3,3,1), oma=c(0,0,5,1)) ## oma creates space

stackedBars(margins.2a,profindex=1,

            main="Adaptive Sequencing, Simple Feedback",digits=2,
            cex.main=2.5,cex.names=2, col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F,
            legend.text=T,args.legend = list(x = "topleft"))

stackedBars(margins.2b,profindex=1,

            main="Adaptive Sequencing, Elaborated Feedback",digits=2,
            cex.main=2.5,cex.names=2, col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(margins.2c,profindex=1,

            main="Linear Sequencing, Elaborated Feedback",digits=2,
            cex.main = 2.5, cex.names=2, col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

mtext("ACED Skill Distribution by Experimental Group", side=3, line=1, outer=TRUE, cex=2, font=2)
par(oldpar)
dev.off()

Comparison of Marginal Distributions for ACED Skills
Solve Geometric Problems skills

geom <-cbind(margins.2a[,1],margins.2b[,1],margins.2c[,1])
colnames(geom)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Common Ratio skills

cratio <-cbind(margins.2a[,2],margins.2b[,2],margins.2c[,2])
colnames(cratio)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Examples skills

examp <-cbind(margins.2a[,3],margins.2b[,3],margins.2c[,3])
colnames(examp)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Extend skills

extnd <-cbind(margins.2a[,4],margins.2b[,4],margins.2c[,4])
colnames(extnd)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Model skills

mdl <-cbind(margins.2a[,5],margins.2b[,5],margins.2c[,5])
colnames(mdl)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Visual skills

vsl <-cbind(margins.2a[,6],margins.2b[,6],margins.2c[,6])
colnames(vsl)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Table skills

tble <-cbind(margins.2a[,7],margins.2b[,7],margins.2c[,7])
colnames(tble)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear,Elaborated")

Induce Rules skills

indce <-cbind(margins.2a[,8],margins.2b[,8],margins.2c[,8])
colnames(indce)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Verbal skills

vrbal <-cbind(margins.2a[,9],margins.2b[,9],margins.2c[,9])
colnames(vrbal)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Algebra rule skills

algbra <-cbind(margins.2a[,10],margins.2b[,10],margins.2c[,10])
colnames(algbra)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Explicit skills

xplct <-cbind(margins.2a[,11],margins.2b[,11],margins.2c[,11])
colnames(xplct)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Recursive rules skills

rcrsv <-cbind(margins.2a[,12],margins.2b[,12],margins.2c[,12])
colnames(rcrsv)<-c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated")

Graphical displays

png(file = "C:/EDF5906DCM/ACED/ACED_skillscomparison_BNplot.png", width = 1920, height =2120)
oldpar2 <- par(mfrow=c(3,4), mar=c(3,3,3,1), oma=c(0,0,5,1)) ## oma creates space
stackedBars(rcrsv,profindex=1,

            main="Recursive Rules",digits=2,
            names.arg=c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated"),
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F,
            legend.text=T,args.legend = list(x = "topright"))

stackedBars(geom,profindex=1,

            main="Solve Geometric Problems", digits=2,
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(cratio,profindex=1,

            main="Common Ratio",digits=2,
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(examp,profindex=1,

            main="Examples",digits=2,
            names.arg=c("Adaptive, Simple","Adaptive, Elaborated","Linear,Elaborated"),
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(examp,profindex=1,

            main="Extend",digits=2,
            names.arg=c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated"),
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(mdl,profindex=1,

            main="Model",digits=2,
            names.arg=c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated"),
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(examp,profindex=1,

            main="Visual",digits=2,
            names.arg=c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated"),
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(tble,profindex=1,

            main="Table",digits=2,
            names.arg=c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated"),
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(indce,profindex=1,

            main="Induce Rules",digits=2,
            names.arg=c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated"),
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(vrbal,profindex=1,

            main="Verbal",digits=2,
            names.arg=c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated"),
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(algbra,profindex=1,

            main="Algebra Rules",digits=2,
            names.arg=c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated"),
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

stackedBars(xplct,profindex=1,

            main="Explicit",digits=2,
            names.arg=c("Adaptive, Simple","Adaptive, Elaborated","Linear, Elaborated"),
            cex.main = 2.5,cex.names=1.5,col=hsv(223/360,.2,0.10*(5:1)+.5),labrot=F)

mtext("Distribution of ACED Skills across Experimental Group", side=3, line=1, outer=TRUE, cex=2, font=2)
par(oldpar2)
dev.off()

Edit - History - Print - Recent Changes - Search
Page last modified on August 04, 2016, at 10:35 PM