Development Team:

Jessica Loke

Martin Losert

David de Segovia

Wai Wong

Chris Yndgaard

Extended by:

Cord Hockemeyer

Knowledge Space Theory:
Estimating Knowledge Structure


In mathematical psychology, a knowledge space is a combinatorial structure describing the possible states of knowledge of a human learner.

    Let's look at a simple analogy -



    Imagine the town you live in as a complete domain of knowledge, if you know every part of the town, you have a knowledge state which covers the complete domain of knowledge. But, if you only know the street where you live in; then, you have a knowledge state which only covers a part of the complete domain - highlighted in yellow now.



    By identifying the user's knowledge states, we can understand his/her knowledge boundaries. In the illustration above, you can imagine the boundary to be the yellow circle. Within educational settings, this is helpful because we can then find out what the user knows and does not know.

    To estimate the user's knowledge state, we use a deterministic approach by relating the observed data to the yet eligible knowledge states.

    In this application, we want to demonstrate this process by allowing you to (1) build a knowledge structure on elementary probability theory, and (2) complete a quiz to estimate your probable knowledge states.


In this application, you have two options:

  • using a knowledge structure observed from a previous sample, or

  • building your own knowledge structure.


  • Then, you can simulate being a new student by answering a quiz.

    After each of your answers, we will update the list of still eligible possible knowledge states.

    These are all the possible response patterns.

    As a default structure, we have checked the patterns which belong the knowledge structure observed from a previous classroom sample. Both the empty set and the Q (full) set states have already been included.

    You can use the one available, or create your own.

    Don't forget to press the 'Done' button when you are finished


    Please note that the empty set (marked by 0) and the full item set Q are always contained.





     
    In the "quiz" tab, you can experience a deterministic adaptive assessment of your knowledge in our small probability domain.

    We start with the full knowledge structure. As soon as you answer questions, states are eliminated. In the Hasse diagram on the right, the eliminated and the still eligible knowledge states are shown in different colors.

    Please answer the following questions


    The Assessment is completed.

    Still eligible knowledge states




    The Assessment is completed.

    Still eligible knowledge states




    The Assessment is completed.

    Still eligible knowledge states




    The Assessment is completed.

    Still eligible knowledge states




    The Assessment is completed.

    Still eligible knowledge states

    show with app
    # app.R
    # Visualisation of Parameter Estimation
    #
    # Enter response frequencies and visualize parameter estimates
    #
    # Claudia Glemser, last edited: 26/Jan/17
    
    library(shiny)
    library(shinydashboard)
    library(pks)
    library(xtable)
    library(igraph)
    library(markdown)
    
    
    
    
    #question
    {# 10 11  9  3  4
      questions <- data.frame( 
        q1 = c("A bag contains 5-cent, 10-cent, and 20-cent coins. The probability of drawing a 5-cent coin is 0.20, that of drawing a 10-cent coin is 0.45, and that of drawing a 20-cent coin is 0.35. What is the probability that the coin randomly drawn is a 5-cent coin or a 20-cent coin?"),
        q2 = c("In a school, 40% of the pupils are boys and 80% of the pupils are right-handed. Suppose that gender and handedness are independent. What is the probability of randomly selecting a right-handed boy?"),
        q3 = c("Given a standard deck containing 32 different cards, what is the probability of drawing a 4 in a black suit?"),
        q4 = c("A box contains marbles that are red or yellow, small or large. The probability of drawing a red marble is 0.70, the probability of drawing a small marble is 0.40. Suppose that the color of the marbles is independent of their size. What is the probability of randomly drawing a small marble that is not red?"),
        q5 = c("In a garage there are 50 cars. 20 are black and 10 are diesel powered. Suppose that the color of the cars is independent of the kind of fuel. What is the probability that a randomly selected car is not black and it is diesel powered?"))
      
      plotheadline <- c("Still eligible knowledge states")
    }
    
    eta <- 0.0
    beta <- 0.0
    
    
    waiplot_p <- function(a,p){
      n <- ncol(a)
      b = diag(0,n)
      
      for(i in 1:n){
        for(j in 1:n){
          if(sum(a[,i]*a[,j])==sum(a[,i])) b[i,j]=1
        }
      }
      diag(b)<-0
      d <- b
      for(i in 1:n){
        for(j in c(1:n)[-i]){
          if(b[j,i]==1) d[j,]=d[j,]*(1-b[i,])
        }
      }
      ed <- NULL
      for(i in 1:n) for(j in 1:n) if(d[i,j]==1) ed <- c(ed,i,j) 
      g1 <- graph( edges=ed, n=n, directed=T ) 
      l <- list("0")
      for(i in 2:(n-1)) l[[i]] <- paste(c(c("a","b","c","d","e")[a[,i]*c(1:5)]),collapse = '')
      l[[n]] <- c("Q") 
      V(g1)$label <- l
      coord = layout_with_sugiyama(g1)$layout
      E(g1)$color <- 'black'
      V(g1)$color <- cm.colors(1001)[1001-1000*p]
      plot(g1,layout=-coord,vertex.frame.color="white",vertex.size=35)
      # legend( x="right", 
      #         legend=c(10:0)/10,
      #         col=terrain.colors(1001)[c(1+100*c(0:10))],
      #         pch = rep(15,11))
    }
    
    waiplot <- function(a){
      n <- ncol(a)
      b = diag(0,n)
      
      for(i in 1:n){
        for(j in 1:n){
          if(sum(a[,i]*a[,j])==sum(a[,i])) b[i,j]=1
        }
      }
      diag(b)<-0
      d <- b
      for(i in 1:n){
        for(j in c(1:n)[-i]){
          if(b[j,i]==1) d[j,]=d[j,]*(1-b[i,])
        }
      }
      ed <- NULL
      for(i in 1:n) for(j in 1:n) if(d[i,j]==1) ed <- c(ed,i,j) 
      g1 <- graph( edges=ed, n=n, directed=T ) 
      l <- list("0")
      for(i in 2:(n-1)) l[[i]] <- paste(c(c("a","b","c","d","e")[a[,i]*c(1:5)]),collapse = '')
      l[[n]] <- c("Q") 
      V(g1)$label <- l
      coord = layout_with_sugiyama(g1)$layout
      E(g1)$color <- 'black'
      V(g1)$color <- 'orange'
      plot(g1,layout=-coord,vertex.frame.color="white",vertex.size=30)
    }
    
    Ks1.list <- c("{a}" = "10000", "{b}" = "01000",
                  "{c}" = "00100", "{d}" = "00010",
                  "{e}" = "00001", "{a,b}" = "11000",
                  "{a,c}" = "10100", "{a,d}" = "10010",
                  "{a,e}" = "10001", "{b,c}" = "01100",
                  "{b,d}" = "01010", "{b,e}" = "01001",
                  "{c,d}" = "00110", "{c,e}" = "00101",
                  "{d,e}" = "00011")
    Ks2.list <- c("{a,b,c}" = "11100","{a,b,d}" = "11010","{a,b,e}" = "11001",
                  "{a,c,d}" = "10110","{a,c,e}" = "10101","{a,d,e}" = "10011",
                  "{b,c,d}" = "01110","{b,c,e}" = "01101","{b,d,e}" = "01011",
                  "{c,d,e}" = "00111","{a,b,c,d}" = "11110","{a,b,c,e}" = "11101",
                  "{a,b,d,e}" = "11011","{a,c,d,e}" = "10111",
                  "{b,c,d,e}" = "01111"
    )
    Ks1.model.list <- c("01000", "10000", "01010", "01100",
                        "11000")
    Ks2.model.list <- c("11100", "11010", "01111")
    prob.model <- c(1.0, 1.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0,
                     0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 0.0, 0.0,
                     1.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0,
                     0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 1.0)
    sets1 <- c("00000", "10000", "01000", "00100", "00010", "00001", "11000", "10100", 
               "10010", "10001", "01100", "01010", "01001", "00110", "00101", "00011",
               "11100", "11010", "11001", "10110", "10101", "10011", "01110", "01101", 
               "01011", "00111", "11110", "11101", "11011", "10111", "01111", "11111")
    sets2 <- c("{}", "{a}", "{b}", "{c}", "{d}", "{e}", "{a, b}", "{a, c}",
               "{a, d}", "a, e}", "{b, c}", "b, d}", "{b, e}", "{c, d}", "{c, e}", "{d, e}",
               "{a, b, c}", "{a, b, d}", "{a, b, e}", "{a, c, d}", "{a, c, e}", "{a, d, e}", "{b, c, d}", "{b, c, e}",
               "{b, d, e}", "{c, d, e}", "{a, b, c, d}", "{a, b, c, e}", "{a, b, d, e}", "{a, c, d, e}", "{b, c, d, e}", "{a, b, c, d, e}")
    probac <- c(eta, 1-beta, eta, eta, eta, eta, 1-beta, 1-beta,
                1-beta, 1-beta, eta, eta, eta, eta, eta, eta,
                1-beta, 1-beta, 1-beta, 1-beta, 1-beta, 1-beta, eta, eta,
                eta, eta, 1-beta, 1-beta, 1-beta, 1-beta, eta, 1-beta)
    probaf <- 1-probac
    probbc <- c(eta, eta, 1-beta, eta, eta, eta, 1-beta, eta,
                eta, eta, 1-beta, 1-beta, 1-beta, eta, eta, eta,
                1-beta, 1-beta, 1-beta, eta, eta, eta, 1-beta, 1-beta,
                1-beta, eta, 1-beta, 1-beta, 1-beta, eta, 1-beta, 1-beta)
    probbf <- 1-probbc
    probcc <- c(eta, eta, eta, 1-beta, eta, eta, eta, 1-beta,
                eta, eta, 1-beta, eta, eta, 1-beta, 1-beta, eta,
                1-beta, eta, eta, 1-beta, 1-beta, eta, 1-beta, 1-beta,
                eta, 1-beta, 1-beta, 1-beta, eta, 1-beta, 1-beta, 1-beta)
    probcf <- 1-probcc
    probdc <- c(eta, eta, eta, eta, 1-beta, eta, eta, eta,
                1-beta, eta, eta, 1-beta, eta, 1-beta, eta, 1-beta,
                eta, 1-beta, eta, 1-beta, eta, 1-beta, 1-beta, eta,
                1-beta, 1-beta, 1-beta, eta, 1-beta, 1-beta, 1-beta, 1-beta)
    probdf <- 1-probdc
    probec <- c(eta, eta, eta, eta, eta, 1-beta, eta, eta,
                eta, 1-beta, eta, eta, 1-beta, eta, 1-beta, 1-beta,
                eta, eta, 1-beta, eta, 1-beta, 1-beta, eta, 1-beta,
                1-beta, 1-beta, eta, 1-beta, 1-beta, 1-beta, 1-beta, 1-beta)
    probef <- 1-probec
    ############### UI ###############
    ui <- dashboardPage(
      skin="yellow",
      
      #dashboardHeader
      {dashboardHeader(
        title = "Deterministic Knowledge Assessment",
        tags$li(a(href = 'https://tquant.eu/',
                  img(src = 'logo_TquanT.jpg',
                      title = "TquanT Home", height = "30px"),
                  style = "padding-top:10px; padding-bottom:10px;"),
                class = "dropdown"),
        titleWidth = "45%"
      )},
      
      #dashboardSidebar
      {dashboardSidebar(
        sidebarMenu(
          menuItem("Introduction", tabName = "theory",
                   icon = icon("info-circle")),
          menuItem("Choose your Structure", tabName = "turn", icon = icon("pencil-square-o")),
          menuItem("Questions", tabName = "quiz", icon = icon("check-square-o"))  # question-circle-o
        )
      )},
      
      #dashboardBody
      {dashboardBody(skin="blue",
                     tabItems(
                       #tabItems
                       {tabItem(tabName = "theory",
                                tabsetPanel(
                                  #tabPanel
                                  {tabPanel("Welcome to the World of Knowledge",br(),br(),
                                            fluidPage(
                                              includeScript("../../../Matomo-tquant.js"),
                                              fluidRow(
                                                column(7,
                                                       img(src="webhomes-brain-gear-470x371.png", height = "430", width="500"),
                                                       br(),
                                                       br(),
                                                       br()
                                                       
                                                ),
                                                column(5,
                                                       box(title=h4("Development Team:"), 
                                                           solidHeader = TRUE,
                                                           status = "info",
                                                           width = '13',
                                                           h4(img(src="amsterdam_logo.png", width = "50"),
                                                              "   Jessica Loke"),
                                                           h4(img(src="tuebingen_logo.png", width = "50"),
                                                              "  Martin Losert"),
                                                           h4(img(src="madrid_logo.png", width = "50"),
                                                              "  David de Segovia"),
                                                           h4(img(src="leuven_logo.png", width="50"),
                                                              "   Wai Wong"),
                                                           h4(img(src="debrecen-logo.png", width = "50"),
                                                              "   Chris Yndgaard"),
                                                           h4("Extended by:"),
                                                           h4(img(src="LogoUniGraz.png", width = "50"),
                                                              "   Cord Hockemeyer")
                                                           
                                                       ))
                                              )
                                            )
                                  )},
                                  #66tabPanel
                                  {tabPanel("Knowledge Space Theory",
                                            #HTML
                                            {HTML(  
                                              "<h3 align ='center'><b>Knowledge Space Theory:
                                              <br>
                                              Estimating Knowledge Structure</b></h3>
                                              <br>
                                              <div style=\"text-indent: 40px\">
                                              In mathematical psychology, a <i><b>knowledge space</b></i> is a combinatorial structure 
                                              describing the possible <i><b>states of knowledge</i></b> of a human learner. 
                                              </div>                             
                                              <br><ul>
                                              Let's look at a simple analogy -
                                              <br>
                                              <br>"
                                            )},
                                            div(tags$img(src="township.jpg", width="300px", height="300px"), style="text-align:center;"),
                                            tags$br(),
                                            tags$br(),
                                            {HTML("Imagine the town you live in as a complete domain of knowledge, if you know every part of the town, 
                                                  you have a <i><b>knowledge state</b></i> which covers the complete domain of knowledge. But, if you only know the street where you live in; 
                                                  then, you have a <i><b>knowledge state</i></b> which only covers a part of the complete domain - highlighted in yellow now.
                                                  <br>
                                                  <br>
                                                  ")},
                                            div(tags$img(src="townshiphighlight.jpg", width="300px", height="300px"), style="text-align:center;"),
                                            tags$br(),
                                            tags$br(),
                                            {HTML("By identifying the user's <b><i>knowledge states</b></i>, we can understand his/her knowledge boundaries. 
                                                  In the illustration above, you can imagine the boundary to be the yellow circle. 
                                                  Within educational settings, this is helpful because we can then find out what the user knows 
                                                  and does not know.
                                                  <br>
                                                  <br>
                                                  To estimate the user's <b><i>knowledge state</b></i>, we use a deterministic approach by relating 
                                                  the observed data to the yet eligible <b><i>knowledge states</b></i>.
                                                  <br>
                                                  <br>
                                                  In this application, we want to demonstrate this process by allowing you to 
                                                  (1) build a <b><i>knowledge structure on elementary probability theory</b></i>, and (2) complete a quiz to estimate your probable <b><i>knowledge states</b></i>.
                                                  ")},
                                            
                                            tags$head(tags$style(HTML(
                                              "table, th, td {
                                              border: 1px solid black;
                                              border-collapse: collapse;
                                            }
                                              
                                              th {
                                              text-align: center;
                                              }
                                              
                                              th, td {
                                              padding: 10px;
                                              }
                                              
                                              table#t01 th {
                                              background-color: #367fa9;
                                              color: white;
                                            }")))	      
                                  )}
                                )
                       )},
                       tabItem(tabName = "turn",
                               tabsetPanel(
                                 # TABPANEL OUTLINE
                                 {tabPanel("Outline",
                                           div(tags$img(src="maxresdefault.jpg", width="600px", height="300px"), style="text-align:left;"),
                                           
                                           HTML(
                                             "<h5 align='left'> 
                                           
                                           <br>
                                           <br>
                                           In this application, you have two options:
                                           <br><br>
                                           <li>using a knowledge structure observed from a previous sample, or </li>
                                           <br>
                                           <li>building your own knowledge structure.</li>
                                           <br><br>
                                           Then, you can simulate being a new student by answering a quiz. 
                                           <br><br>
                                           After each of your answers, we will update the list of still eligible possible knowledge states.
                                           </h5>")
                                           
                                 )},
                                 #TABPANEL YOUR FREAKING STRUCTURE
                                 {tabPanel("Your Structure",
                                           br(), HTML(
                                             "<h5 align='left'>
                                           These are all the possible response patterns. 
                                           <br><br>
                                           As a default structure, we have checked the patterns which belong the knowledge structure observed from a previous 
                                           classroom sample. Both the empty set and the Q (full) set states have already been included.
                                           <br><br>
                                           You can use the one available, or create your own. 
                                           </h5>
                                           <h4>Don't forget to press the 'Done' button when you
                                           are finished</h4>"),
                                           br(),
                                           #fluidRow
                                           {fluidRow(
                                             #column
                                             {column(4,
                                                     #fluidRow
                                                     {fluidRow(
                                                       #column
                                                       {column(3,checkboxGroupInput("Ks1", NULL, Ks1.list, selected = Ks1.model.list))},
                                                       #column
                                                       {column(3,checkboxGroupInput("Ks2", NULL, Ks2.list, selected = Ks2.model.list))}
                                                     )}                                      
                                             )},
                                             #column
                                             {column(8,
                                                     plotOutput("plot.KS")
                                             )}
                                           )},
                                           fluidRow(
                                             column(10,
                                                    HTML("Please note that the empty set (marked by 0) and the full item set Q are always contained."),
                                                    offset = 1
                                             )
                                           ),
                                           #fluidRow
                                           {fluidRow(
                                             column(2,
                                                    br(),
                                                    actionButton("clearall", "Clear all")
                                             ),
                                             column(2,
                                                    br(),
                                                    actionButton("selectall", "Select all")
                                             ),
                                             column(2,
                                                    br(),
                                                    actionButton("defaultmodel", "Default model")
                                             )
                                           )},
                                           column(2,
                                                  br(),
                                                  actionButton("KSdone", "Done",  #icon("paper-plane"),
                                                               style="color: #ffffff; background-color: #003399; border-color: #001133")
                                           )
                                           
                                 )}
                               )
                       ),
                       tabItem(tabName = "quiz", 
                               tabsetPanel(
                                 tabPanel("Outline",
                                          includeHTML("www/quizOutline.html")),
                                 tabPanel("Quiz",
                                          conditionalPanel(condition = "output.numStates > 1", h3(textOutput("question"))),
                                          #Question a
                                          {conditionalPanel(condition = "output.question == 'Question a'",
                                                            fluidPage(
                                                              fluidRow(
                                                                column(4, 
                                                                       conditionalPanel(condition = "output.numStates > 1",
                                                                       h4("Please answer the following questions"), br(),
                                                                       selectInput("q1", questions$q1,        # question b1
                                                                                   choices =  c('  '   = 'empty',
                                                                                                '0.55' = 'correct',
                                                                                                '0.33'  = 'choice1',
                                                                                                '0.45'  = 'choice2',
                                                                                                '0.65'  = 'choice3'),
                                                                                   width = '100%')
                                                                       ),
                                                                       conditionalPanel(condition = "output.numStates == 1",
                                                                                        h3("The Assessment is completed."))
                                                                       ),
                                                                column(8,h3(plotheadline),plotOutput("outplot.1"))
                                                              ))
                                                            )},
                                          #Question b
                                          {conditionalPanel(condition = "output.question == 'Question b'",
                                                            fluidPage(
                                                              fluidRow(
                                                                column(4,
                                                                       conditionalPanel(condition = "output.numStates > 1",
                                                                                        br(), br(), br(),
                                                                       selectInput("q2", questions$q2,        # question b1
                                                                                   choices =  c('  '   = 'empty',
                                                                                                '0.38' = 'choice2',
                                                                                                '0.27'  = 'choice1',
                                                                                                '0.32'  = 'correct',
                                                                                                '0.25'  = 'choice3'),
                                                                                   width = '100%')
                                                                ),
                                                                conditionalPanel(condition = "output.numStates == 1",
                                                                                 h3("The Assessment is completed."))
                                                                ),
                                                                column(8,
                                                                       h3(plotheadline),
                                                                       plotOutput("outplot.2"))
                                                              )))},
                                          #Question c
                                          {conditionalPanel(condition = "output.question == 'Question c'",
                                                            fluidPage(
                                                              fluidRow(
                                                                column(4,
                                                                       conditionalPanel(condition = "output.numStates > 1",
                                                                                        br(), br(), br(),
                                                                       selectInput("q3", questions$q3,        # question b1
                                                                                   choices =  c('  '   = 'empty',
                                                                                                '6/32' = 'choice1',
                                                                                                '4/32'  = 'choice2',
                                                                                                '1/32'  = 'choice3',
                                                                                                '2/32'  = 'correct'),
                                                                                   width = '100%')
                                                                ),
                                                                conditionalPanel(condition = "output.numStates == 1",
                                                                                 h3("The Assessment is completed."))
                                                                ),
                                                                column(8,
                                                                       h3(plotheadline),
                                                                       plotOutput("outplot.3"))
                                                              )))},
                                          #Question d
                                          {conditionalPanel(condition = "output.question == 'Question d'",
                                                            fluidPage(
                                                              fluidRow(
                                                                column(4,
                                                                       conditionalPanel(condition = "output.numStates > 1",
                                                                                        br(), br(), br(),
                                                                       selectInput("q4", questions$q4,        # question b1
                                                                                   choices =  c('  '   = 'empty',
                                                                                                '0.12' = 'correct',
                                                                                                '0.09'  = 'choice1',
                                                                                                '0.22'  = 'choice2',
                                                                                                '0.18'  = 'choice3'),
                                                                                   width = '100%')
                                                                ),
                                                                conditionalPanel(condition = "output.numStates == 1",
                                                                                 h3("The Assessment is completed."))
                                                                ),
                                                                column(8,
                                                                       h3(plotheadline),
                                                                       plotOutput("outplot.4")))
                                                            ))},
                                          #Question e
                                          {conditionalPanel(condition = "output.question == 'Question e'",
                                                            fluidPage(
                                                              fluidRow(
                                                                column(4,
                                                                       conditionalPanel(condition = "output.numStates > 1",
                                                                                        br(), br(), br(),
                                                                       selectInput("q5", questions$q5,        # question b1
                                                                                   choices =  c('  '   = 'empty',
                                                                                                '0.08' = 'choice1',
                                                                                                '0.12'  = 'correct',
                                                                                                '0.16'  = 'choice2',
                                                                                                '0.04'  = 'choice3'),
                                                                                   width = '100%')
                                                                ),
                                                                conditionalPanel(condition = "output.numStates == 1",
                                                                                 h3("The Assessment is completed.")  )
                                                                ),
                                                                column(8,
                                                                       h3(plotheadline),
                                                                       plotOutput("outplot.5")))
                                                            ))},
                                          fluidRow(
                                            column(8, offset = 4,
                                                   h4(textOutput("assessment")),
                                                   h4(textOutput("assessmentlist"))
                                            )
                                          )
                                 )
                               ))
                     ))}
    )
    
    
    
    
    
    ############### SERVER ###############
    
    server <- function(input, output, session){
      
      probK <- reactiveValues(val = prob.model)
      probMaxK <- reactiveValues(val = max(prob.model))
      probSum <- reactiveValues(val = round(sum(prob.model)))
      probQ <- reactiveValues(val = rep(0.0, 5))
      observeEvent(probK$val, {
        t1 <- sum(probK$val[c(2, 7, 8, 9, 10, 17, 18, 19, 20, 21, 22, 27, 28, 29, 30, 32)])
        t2 <- sum(probK$val[c(3, 7, 11, 12, 13, 17, 18, 19, 23, 24, 25, 27, 28, 29, 31, 32)])
        t3 <- sum(probK$val[c(4, 8, 11, 14, 15, 17, 20, 21, 23, 24, 26, 27, 28, 30, 31, 32)])
        t4 <- sum(probK$val[c(5, 9, 12, 14, 16, 18, 20, 22, 23, 25, 26, 27, 29, 30, 31, 32)])
        t5 <- sum(probK$val[c(6, 10, 13, 15, 16, 19, 21, 22, 24, 25, 26, 28, 29, 30, 31, 32)]) 
        probQ$val <- c(t1, t2, t3, t4, t5) / sum(probK$val)
        probMaxK$val <- max(probK$val)
        probSum$val <- round(sum(probK$val))
        statelist <- which(probK$val == probMaxK$val)
        statelisttext <- sets2[statelist]
        output$assessment <- renderText(paste(
          probSum$val,
          "knowledge states are still eligible:"
        ))
        output$assessmentlist <- renderText(statelisttext)
      })
      output$numStates <- renderText(probSum$val)
      
      problist <- reactiveValues(val = c(1, 2, 3, 7, 11, 12, 17, 18, 31, 32))
      
      item <- reactiveValues(val=6)
      observeEvent(probQ$val, {
        cert <- abs(probQ$val - 0.5)
        q <- which(cert == min(cert))
        item$val <<- q[sample(1:length(q), 1)]
      })
      output$question <- renderText(paste("Question", letters[item$val]))
      
      observeEvent(input$clearall,{
        updateCheckboxGroupInput(session,"Ks1", NULL, choices = Ks1.list, selected = NULL)
        updateCheckboxGroupInput(session,"Ks2", NULL, choices = Ks2.list, selected = NULL)
      })
      observeEvent(input$selectall,{
        updateCheckboxGroupInput(session,"Ks1", NULL, choices = Ks1.list, selected = sets1[1:16])
        updateCheckboxGroupInput(session,"Ks2", NULL, choices = Ks2.list, selected = sets1[17:32])
      })
      observeEvent(input$defaultmodel,{
        updateCheckboxGroupInput(session,"Ks1", NULL, choices = Ks1.list, selected = Ks1.model.list)
        updateCheckboxGroupInput(session,"Ks2", NULL, choices = Ks2.list, selected = Ks2.model.list)
      })
      output$plot.KS <- renderPlot({
        waiplot(t(as.binmat(c("00000",input$Ks1,input$Ks2,"11111"))))
      })
      
      observeEvent(input$KSdone, {
        problist = c(1, match(input$Ks1,sets1), match(input$Ks2, sets1), 32)
        cat(problist, file=stderr())
        tempp <- rep(0.0,32)
        tempp[problist] <- 1.0
        probK$val <- tempp 
      })
      
      #output-block1 
      {
        K1 <- reactive(as.binmat(c("00000",input$Ks1,input$Ks2,"11111")))
        ## Blim for calibration sample
        
        
        #      R <- reactive({
        #      matrix(c(ifelse(input$q1=="empty", NA, as.numeric(input$q1 == "correct")),
        #               ifelse(input$q2=="empty", NA, as.numeric(input$q2 == "correct")),
        #               ifelse(input$q3=="empty", NA, as.numeric(input$q3 == "correct")),
        #               ifelse(input$q4=="empty", NA, as.numeric(input$q4 == "correct")),
        #               ifelse(input$q5=="empty", NA, as.numeric(input$q5 == "correct"))),
        #             nrow=1, byrow=T)
        #    })
        
        
        #    output$block1 <- renderTable(R())
        #    output$block2 <- renderTable(R())
        #    output$block3 <- renderTable(R())
        #    output$block4 <- renderTable(R())
        #    output$block5 <- renderTable(R())
        
        output$outplot.1 <- renderPlot(waiplot_p(t(K1()), probK$val[problist$val]))
        output$outplot.2 <- renderPlot(waiplot_p(t(K1()), probK$val[problist$val]))
        output$outplot.3 <- renderPlot(waiplot_p(t(K1()), probK$val[problist$val]))
        output$outplot.4 <- renderPlot(waiplot_p(t(K1()), probK$val[problist$val]))
        output$outplot.5 <- renderPlot(waiplot_p(t(K1()), probK$val[problist$val]))
        #    output$outplot.1 <- renderPlot(waiplot(t(K1())))
        #    output$outplot.2 <- renderPlot(waiplot(t(K1())))
        #    output$outplot.3 <- renderPlot(waiplot(t(K1())))
        #    output$outplot.4 <- renderPlot(waiplot(t(K1())))
        #    output$outplot.5 <- renderPlot(waiplot(t(K1())))
        
        
        
        observeEvent(input$q1,{
          if (input$q1 != "empty") {
            if (input$q1 == "correct") {
              tempu <- probK$val * probac
            } else {
              tempu <- probK$val * probaf
            }
            probK$val <- tempu 
            updateSelectInput(session,"q1", questions$q1,        # question b1
                              choices =  c('  '   = 'empty',
                                           '0.55' = 'correct',
                                           '0.33'  = 'choice1',
                                           '0.45'  = 'choice2',
                                           '0.65'  = 'choice3'))
          }})
        observeEvent(input$q2,{
          if (input$q2 != "empty") {
            if (input$q2 == "correct") {
              tempu <- probK$val * probbc
            } else {
              tempu <- probK$val * probbf
            }
            probK$val <- tempu 
            updateSelectInput(session,"q2", questions$q2,        # question b1
                              choices =  c('  '   = 'empty',
                                           '0.38' = 'choice2',
                                           '0.27'  = 'choice1',                           
                                           '0.32'  = 'correct',
                                           '0.25'  = 'choice3'))
          }})
        observeEvent(input$q3,{
          if (input$q3 != "empty") {
            if (input$q3 == "correct") {
              tempu <- probK$val * probcc
            } else {
              tempu <- probK$val * probcf
            }
            probK$val <- tempu 
            updateSelectInput(session,"q3", questions$q3,        # question b1
                              choices =  c('  '   = 'empty',
                                           '6/32' = 'choice1',
                                           '4/32'  = 'choice2',
                                           '1/32'  = 'choice3',
                                           '2/32'  = 'correct'))
          }})
        observeEvent(input$q4,{
          if (input$q4 != "empty") {
            if (input$q4 == "correct") {
              tempu <- probK$val * probdc
            } else {
              tempu <- probK$val * probdf
            }
            probK$val <- tempu 
            updateSelectInput(session,"q4", questions$q4,        # question b1
                              choices =  c('  '   = 'empty',
                                           '0.12' = 'correct',
                                           '0.09'  = 'choice1',
                                           '0.22'  = 'choice2',
                                           '0.18'  = 'choice3'))
          }})
        observeEvent(input$q5,{
          if (input$q5 != "empty") {
            if (input$q5 == "correct") {
              tempu <- probK$val * probec
            } else {
              tempu <- probK$val * probef
            }
            probK$val <- tempu 
            updateSelectInput(session,"q5", questions$q5,        # question b1
                              choices =  c('  '   = 'empty',
                                           '0.08' = 'choice1',
                                           '0.12'  = 'correct',
                                           '0.16'  = 'choice2',
                                           '0.04'  = 'choice3'))
          }})
    
      }
    #  outputOptions(output)
      outputOptions(output, "question", suspendWhenHidden = FALSE)  
      outputOptions(output, "numStates", suspendWhenHidden = FALSE)  
      
    }
    
    
    shinyApp(ui = ui, server = server)
    <br>&nbsp;<br>
    In the "quiz" tab, you can experience a deterministic adaptive assessment of your knowledge in our small probability domain.
    <p />
    We start with the full knowledge structure. As soon as you answer questions, states are eliminated. 
    In the Hasse diagram on the right, the eliminated and the still eligible knowledge states are shown in different colors.