### packages
library(shiny)
library(kst)
library(pks)
library(shinyBS)
library(Rgraphviz)
library(plotrix)
data(DoignonFalmagne7)
data(Taagepera)
### define Buttons
# choose data
data_set <- radioButtons(
"data_set", "", width = 300,
c("Doignon & Falmagne", "Density 97 (Taagepera)", "Matter 97 (Taagepera)"),
inline = FALSE
)
# define variables
#DF7
strcdf <- as.pattern(DoignonFalmagne7$K, as.set = TRUE)
respdf <- as.binmat(DoignonFalmagne7$N.R, uniq = FALSE)
#Density
strcd <- as.pattern(density97$K, as.set = TRUE)
respd <- as.binmat(density97$N.R, uniq = FALSE)
#Matter
strcm <- as.pattern(matter97$K, as.set = TRUE)
respm <- as.binmat(matter97$N.R, uniq = FALSE)
# calculate n_in and n_out
#DF7
mat <- 1 * t(apply(respdf, 1, function(r) {
apply(DoignonFalmagne7$K, 1, function(s) {
all(r == s)
})
}))
ladf <- as.logical(rowSums(mat))
# n of people involved in structure
n_indf <- dim(as.data.frame(respdf)[ladf, ])[1]
# n of people not involved
n_outdf <- dim(as.data.frame(respdf))[1] - dim(as.data.frame(respdf)[ladf, ])[1]
#Density
mat <- 1 * t(apply(respd, 1, function(r) {
apply(density97$K, 1, function(s) {
all(r == s)
})
}))
lad <- as.logical(rowSums(mat))
# n of people involved in structure
n_ind <- dim(as.data.frame(respd)[lad, ])[1]
# n of people not involved
n_outd <- dim(as.data.frame(respd))[1] - dim(as.data.frame(respd)[lad, ])[1]
#Matter
mat <- 1 * t(apply(respm, 1, function(r) {
apply(matter97$K, 1, function(s) {
all(r == s)
})
}))
lam <- as.logical(rowSums(mat))
# n of people involved in structure
n_inm <- dim(as.data.frame(respm)[lam, ])[1]
# n of people not involved
n_outm <- dim(as.data.frame(respm))[1] - dim(as.data.frame(respm)[lam, ])[1]
### draw it
ui <- fluidPage(
includeScript("../../../Matomo-tquant.js"),
titlePanel(h1("KNOWLEDGE SPACE THEORY", style = "color: #660d2a")),
h2("Fitting a knowledge structure to the data", style="color: #db2561"),
fluidRow(
## first column
column(width = 4,
# choose data set
br(),
br(),
h4("Choose a data set:"),
data_set,
br(),
br(),
# choose coefficient
h4("Choose a coefficient:"),
coeff_choice <- selectInput("coeff_choice", "", c("Gamma Index" = "gamma", "Distance Agreement Coefficient" = "DA", "Violational Coefficient" = "VC")),
textOutput("coeff"),
textOutput("coeff1"),
textOutput("coeff2"),
br(),
br(),
br(),
br(),
# info button
br()
),
## second column
column(width = 8,
# hasse plot
plotOutput(outputId = "hasseplot"),
column(width = 6, offset = 4,
textOutput("n_in"),
textOutput("n_out")),
br(),
br(),
br()
)),
absolutePanel(
actionButton("infoT", label = "", icon = icon("info-circle"),
style="color: #fff; background-color: #db2561; border-color: #db2561"),
bsModal("infoM", "Glossary of Coefficients", "infoT",
size = "large", htmlOutput("infoM")),
actionButton("infoUs", label = "", icon = icon("child"),
style="color: #fff; background-color: #660d2a; border-color: #660d2a"),
bsModal("infoAboutUs", " ", "infoUs",
size = "large", htmlOutput("infoAboutUs")), top = 600, bottom = 300),
absolutePanel(
h5("Patterns of responses not included in the diagram:"),
textOutput("patt"), top = 600, bottom = 600, left = 600, right = 100))
### server function
server <- function(input, output){
# hasse plot
output$hasseplot <- renderPlot({
if (input$data_set == "Doignon & Falmagne"){
plot(kstructure(strcdf),
main = "Knowledge structure of Doignon & Falmagne")
output$n_in <- renderText(c("Number of participants included: ", n_indf))
output$n_out <- renderText(c("Number of participants excluded: ", n_outdf))
output$patt <- renderPrint(print(as.pattern(as.data.frame(respdf)[!ladf, ], as.letters = TRUE,
as.set = TRUE ), quote = FALSE))
}
else if(input$data_set == "Density 97 (Taagepera)"){
plot(kstructure(strcd),
main = "Knowledge structure of Density 97")
output$n_in <- renderText(c("Number of participants included: ", n_ind))
output$n_out <- renderText(c("Number of participants excluded: ", n_outd))
output$patt <- renderPrint(print(as.pattern(as.data.frame(respd)[!lad, ], as.letters = TRUE,
as.set = TRUE ), quote = FALSE))
}
else {
plot(kstructure(strcm),
main = "Knowledge structure of Matter 97")
output$n_in <- renderText(c("Number of participants included: ", n_inm))
output$n_out <- renderText(c("Number of participants excluded: ", n_outm))
output$patt <- renderPrint(print(as.pattern(as.data.frame(respm)[!lam, ], as.letters = TRUE,
as.set = TRUE ), quote = FALSE))
}
})
# coefficients
observeEvent(input$coeff_choice, {
if (input$coeff_choice == "DA") {
output$coeff <- renderText({
if (input$data_set == "Doignon & Falmagne"){
da_stuff <- kvalidate(x = kstructure(strcdf), rpattern = respdf,
method = input$coeff_choice)
}
else if(input$data_set == "Density 97 (Taagepera)") {
da_stuff <- kvalidate(x = kstructure(strcd), rpattern = respd,
method = input$coeff_choice)
}
else {
da_stuff <- kvalidate(x = kstructure(strcm), rpattern = respm,
method = input$coeff_choice)
}
c("ddat =", round(da_stuff$ddat, 3))
})
output$coeff1 <- renderText({
if (input$data_set == "Doignon & Falmagne"){
da_stuff <- kvalidate(x = kstructure(strcdf), rpattern = respdf,
method = input$coeff_choice)
}
else if(input$data_set == "Density 97 (Taagepera)") {
da_stuff <- kvalidate(x = kstructure(strcd), rpattern = respd,
method = input$coeff_choice)
}
else {
da_stuff <- kvalidate(x = kstructure(strcm), rpattern = respm,
method = input$coeff_choice)
}
c("dpot =", round(da_stuff$dpot, 3))
})
output$coeff2 <- renderText({
if (input$data_set == "Doignon & Falmagne"){
da_stuff <- kvalidate(x = kstructure(strcdf), rpattern = respdf,
method = input$coeff_choice)
}
else if(input$data_set == "Density 97 (Taagepera)") {
da_stuff <- kvalidate(x = kstructure(strcd), rpattern = respd,
method = input$coeff_choice)
}
else {
da_stuff <- kvalidate(x = kstructure(strcm), rpattern = respm,
method = input$coeff_choice)
}
c("DA =", round(da_stuff$DA, 3))
})
}
else if(input$coeff_choice == "gamma") {
output$coeff1 <- renderText(" ")
output$coeff2 <- renderText(" ")
output$coeff <- renderText({
if (input$data_set == "Doignon & Falmagne"){
kval <- kvalidate(x = kstructure(strcdf), rpattern = respdf,
method = input$coeff_choice)
str(kval)
gamma_stuff <- round(kval$gamma, 3)
}
else if(input$data_set == "Density 97 (Taagepera)") {
gamma_stuff <- round(kvalidate(x = kstructure(strcd), rpattern = respd,
method = input$coeff_choice)$gamma, 3)
}
else {
gamma_stuff <- round(kvalidate(x = kstructure(strcm), rpattern = respm,
method = input$coeff_choice)$gamma, 3)
}
c("Gamma =", gamma_stuff)
})}
else if (input$coeff_choice == "VC") {
output$coeff1 <- renderText(" ")
output$coeff2 <- renderText(" ")
output$coeff <- renderText({
if (input$data_set == "Doignon & Falmagne"){
vc_stuff <- round(kvalidate(x = kstructure(strcdf), rpattern = respdf,
method = input$coeff_choice)$vc, 3)
}
else if(input$data_set == "Density 97 (Taagepera)") {
vc_stuff <- round(kvalidate(x = kstructure(strcd), rpattern = respd,
method = input$coeff_choice)$vc, 3)
}
else {
vc_stuff <- round(kvalidate(x = kstructure(strcm), rpattern = respm,
method = input$coeff_choice)$vc, 3)
}
c("VC =", vc_stuff) })
}
else {}
})
#us button
output$infoAboutUs <- renderText({
"<center><b>This amazing app was built by </b>
 
<p>
<p>  
Arne John
<p>
Alice Maurer
<p>
Benjamin Heikkinen
<p>
M?? Leonor Neto
</center>
"
})
# info button
output$infoM <- renderText({
"<b> Gamma Index: </b> It was proposed by Goodman & Kruskal (1972) as a way of validating the prerequisite relations and assumes that not
every response pattern is represented by a prerequisite relation. It compares the number of response patterns
that are represented by a prerequisite relation with the number of response patterns that are not.
<p>
<center>γ = (N<sub>c</sub> - N<sub>d</sub>) / (N<sub>c</sub> + N<sub>d</sub>)</center>
<p>
<p>
Generally, a positive Gamma Index supports the validity of the <b>prerequisite relations</b> and a negative Gamma Index
violates the its validity.
<p>
 
 
 
<p>
<b> Distance Agreement Coefficient: </b> It was proposef by Schrepp (1999) as a way of validating the competence space and allows for the evaluation
of its quality. It compares the average symmetric distance between the competence states and participant's response patterns (<i>ddat</i>) with the
average distance between the resulting competence states and the power set of elementary competencies (<i>dpot</i>).
<p>
<b><i>ddat</i></b> calculates the average minimal distance between each response pattern and the nearest state in the competence space.
<p>
<p>
<center><i>ddat</i> = ∑ min{ <i>d</i> (<i>r, k</i>) | <i>r</i> ∈ <i>R</i> } / <i>n</i></center>
<p>
<p>
<b><i>dpot</i></b> calculates the average minimal distance between the power set of all potencial response patterns and the nearest state in the competence
space.
<p>
<p>
<center><i>dpot</i> = ∑ min{ <i>d</i> (<i>p, k</i>) | <i>p</i> ∈ <i>P</i> } / 2<sup>|E|</sup></center>
<p>
<p>
Generally, a low Distance Agreement Coefficient supports the validity of the <b>competence space</b> and a high Distance Agreement Coefficient violates its validity.
<p>
<p>
<center>DA = <i>ddat</i> / <i>dpot</i></center><p>
 
 
 
<p>
<b>Violational Coefficient: </b>It validades <b>prerequisite relations</b>. For this purpose, the number of violations against the prerequisite relations are calculated.
A low VC supports the validity of prerequisite relations.
<p>
<p>
<center>VC = ∑ <i>v<sub>xy</sub></i> / <i>n</i>(|S| - <i>m</i>)</center>
"
})
}
shinyApp(ui, server)