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 probabilistic approach by relating (1) the observed data to (2) all the possible 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 probabilities of your 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 an adaptive assessment of your knowledge in out small probability domain.

    We start with an equal probability distribution over the knowledge structure you have developed. After each of your answers, the probabilities are update according to the Bayesian Updating formula.

    On the left side, you see the question and answer possibilities, on the right side a Hasse diagram of your knowledge structure indicating the current probability distribution.

    Select the probabilities for careless errors and lucky guesses which influence the strength of the probability update.

    Please answer the following questions


    The Assessment is completed.

    Your probabilites of knowledge states: P(K|R)




    The Assessment is completed.

    Your probabilites of knowledge states: P(K|R)




    The Assessment is completed.

    Your probabilites of knowledge states: P(K|R)




    The Assessment is completed.

    Your probabilites of knowledge states: P(K|R)




    The Assessment is completed.

    Your probabilites of knowledge states: P(K|R)

    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("Your probabilites of knowledge states: P(K|R)")
    }
    
    eta <- 0.25
    beta <- 0.10
    
    
    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 <- terrain.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.model1 <- 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)
    prob.model <- prob.model1 / sum(prob.model1)
    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}")
    ############### UI ###############
    ui <- dashboardPage(
      skin="green",
      
      #dashboardHeader
      {dashboardHeader(
        title = "Probabilistic 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 probabilistic approach by relating 
                                                  (1) the observed data to (2) all the possible <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 probabilities of your 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",
                                          fluidRow(
                                            "Select the probabilities for careless errors and lucky guesses
                                            which influence the strength of the probability update.",
                                            style = "background-color: #f4fff4;"
                                          ),
                                          fluidRow(
                                            column(6, sliderInput("beta",
                                                                  HTML("Careless error probability &beta;"),
                                                                  0, 0.49, beta, 0.01)),
                                            column(6, sliderInput("eta",
                                                                  HTML("Lucky guess probabilty &eta;"),
                                                                  0, 0.49, eta, 0.01)),
                                            
                                            style = "background-color: #f4fff4;"
                                          ),
                                          conditionalPanel(condition = "output.maxProbK <= 0.5", h3(textOutput("question"))),
                                          #Question a
                                          {conditionalPanel(condition = "output.question == 'Question a'",
                                                            fluidPage(
                                                              fluidRow(
                                                                column(4, 
                                                                       conditionalPanel(condition = "output.maxProbK <= 0.5",
                                                                       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.maxProbK > 0.5",
                                                                                        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.maxProbK <= 0.5",
                                                                                        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.maxProbK > 0.5",
                                                                                 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.maxProbK <= 0.5",
                                                                                        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.maxProbK > 0.5",
                                                                                 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.maxProbK <= 0.5",
                                                                                        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.maxProbK > 0.5",
                                                                                 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.maxProbK <= 0.5",
                                                                                        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.maxProbK > 0.5",
                                                                                 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){
    
      probac <- reactiveValues(val = 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 <- reactiveValues(val = 1-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))
      probbc <- reactiveValues(val = 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 <- reactiveValues(val = 1-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))
      probcc <- reactiveValues(val = 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 <- reactiveValues(val = 1-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))
      probdc <- reactiveValues(val = 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 <- reactiveValues(val = 1-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))
      probec <- reactiveValues(val = 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 <- reactiveValues(val = 1-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))
      
      observeEvent(input$beta, {
        probac$val <- c(input$eta, 1-input$beta, input$eta, input$eta, input$eta, 
                        input$eta, 1-input$beta, 1-input$beta,
                        1-input$beta, 1-input$beta, input$eta, input$eta, input$eta, 
                        input$eta, input$eta, input$eta,
                        1-input$beta, 1-input$beta, 1-input$beta, 1-input$beta, 1-input$beta, 
                        1-input$beta, input$eta, input$eta,
                        input$eta, input$eta, 1-input$beta, 1-input$beta, 1-input$beta, 
                        1-input$beta, input$eta, 1-input$beta)
        probaf$val <- 1-probac$val
        probbc$val <- c(input$eta, input$eta, 1-input$beta, input$eta, input$eta, 
                        input$eta, 1-input$beta, input$eta,
                        input$eta, input$eta, 1-input$beta, 1-input$beta, 1-input$beta, 
                        input$eta, input$eta, input$eta,
                        1-input$beta, 1-input$beta, 1-input$beta, input$eta, input$eta, 
                        input$eta, 1-input$beta, 1-input$beta,
                        1-input$beta, input$eta, 1-input$beta, 1-input$beta, 1-input$beta, 
                        input$eta, 1-input$beta, 1-input$beta)
        probbf$val <- 1-probbc$val
        probcc$val <- c(input$eta, input$eta, input$eta, 1-input$beta, input$eta, 
                        input$eta, input$eta, 1-input$beta,
                        input$eta, input$eta, 1-input$beta, input$eta, input$eta, 
                        1-input$beta, 1-input$beta, input$eta,
                        1-input$beta, input$eta, input$eta, 1-input$beta, 1-input$beta, 
                        input$eta, 1-input$beta, 1-input$beta,
                        input$eta, 1-input$beta, 1-input$beta, 1-input$beta, input$eta, 
                        1-input$beta, 1-input$beta, 1-input$beta)
        probcf$val <- 1-probcc$val
        probdc$val <- c(input$eta, input$eta, input$eta, input$eta, 1-input$beta, 
                        input$eta, input$eta, input$eta,
                        1-input$beta, input$eta, input$eta, 1-input$beta, input$eta, 
                        1-input$beta, input$eta, 1-input$beta,
                        input$eta, 1-input$beta, input$eta, 1-input$beta, input$eta, 
                        1-input$beta, 1-input$beta, input$eta,
                        1-input$beta, 1-input$beta, 1-input$beta, input$eta, 1-input$beta, 
                        1-input$beta, 1-input$beta, 1-input$beta)
        probdf$val <- 1-probdc$val
        probec$val <- c(input$eta, input$eta, input$eta, input$eta, input$eta, 
                        1-input$beta, input$eta, input$eta,
                        input$eta, 1-input$beta, input$eta, input$eta, 1-input$beta, 
                        input$eta, 1-input$beta, 1-input$beta,
                        input$eta, input$eta, 1-input$beta, input$eta, 1-input$beta, 
                        1-input$beta, input$eta, 1-input$beta,
                        1-input$beta, 1-input$beta, input$eta, 1-input$beta, 
                        1-input$beta, 1-input$beta, 1-input$beta, 1-input$beta)
        probef$val <- 1-probec$val
      })
      
      observeEvent(input$eta, {
        probac$val <- c(input$eta, 1-input$beta, input$eta, input$eta, input$eta, 
                        input$eta, 1-input$beta, 1-input$beta,
                        1-input$beta, 1-input$beta, input$eta, input$eta, input$eta, 
                        input$eta, input$eta, input$eta,
                        1-input$beta, 1-input$beta, 1-input$beta, 1-input$beta, 1-input$beta, 
                        1-input$beta, input$eta, input$eta,
                        input$eta, input$eta, 1-input$beta, 1-input$beta, 1-input$beta, 
                        1-input$beta, input$eta, 1-input$beta)
        probaf$val <- 1-probac$val
        probbc$val <- c(input$eta, input$eta, 1-input$beta, input$eta, input$eta, 
                        input$eta, 1-input$beta, input$eta,
                        input$eta, input$eta, 1-input$beta, 1-input$beta, 1-input$beta, 
                        input$eta, input$eta, input$eta,
                        1-input$beta, 1-input$beta, 1-input$beta, input$eta, input$eta, 
                        input$eta, 1-input$beta, 1-input$beta,
                        1-input$beta, input$eta, 1-input$beta, 1-input$beta, 1-input$beta, 
                        input$eta, 1-input$beta, 1-input$beta)
        probbf$val <- 1-probbc$val
        probcc$val <- c(input$eta, input$eta, input$eta, 1-input$beta, input$eta, 
                        input$eta, input$eta, 1-input$beta,
                        input$eta, input$eta, 1-input$beta, input$eta, input$eta, 
                        1-input$beta, 1-input$beta, input$eta,
                        1-input$beta, input$eta, input$eta, 1-input$beta, 1-input$beta, 
                        input$eta, 1-input$beta, 1-input$beta,
                        input$eta, 1-input$beta, 1-input$beta, 1-input$beta, input$eta, 
                        1-input$beta, 1-input$beta, 1-input$beta)
        probcf$val <- 1-probcc$val
        probdc$val <- c(input$eta, input$eta, input$eta, input$eta, 1-input$beta, 
                        input$eta, input$eta, input$eta,
                        1-input$beta, input$eta, input$eta, 1-input$beta, input$eta, 
                        1-input$beta, input$eta, 1-input$beta,
                        input$eta, 1-input$beta, input$eta, 1-input$beta, input$eta, 
                        1-input$beta, 1-input$beta, input$eta,
                        1-input$beta, 1-input$beta, 1-input$beta, input$eta, 1-input$beta, 
                        1-input$beta, 1-input$beta, 1-input$beta)
        probdf$val <- 1-probdc$val
        probec$val <- c(input$eta, input$eta, input$eta, input$eta, input$eta, 
                        1-input$beta, input$eta, input$eta,
                        input$eta, 1-input$beta, input$eta, input$eta, 1-input$beta, 
                        input$eta, 1-input$beta, 1-input$beta,
                        input$eta, input$eta, 1-input$beta, input$eta, 1-input$beta, 
                        1-input$beta, input$eta, 1-input$beta,
                        1-input$beta, 1-input$beta, input$eta, 1-input$beta, 
                        1-input$beta, 1-input$beta, 1-input$beta, 1-input$beta)
        probef$val <- 1-probec$val
      })
      
      probK <- reactiveValues(val = prob.model)
      probMaxK <- reactiveValues(val = max(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)
        probMaxK$val <- max(probK$val)
        statelist <- which(probK$val == probMaxK$val)
        statelisttext <- sets2[statelist]
        output$assessment <- renderText(paste(
          "Most likely knowledge states (probability ",
          sprintf("%5.3f", probMaxK$val),
          "):"
        ))
        output$assessmentlist <- renderText(statelisttext)
      })
      output$maxProbK <- renderText(sprintf("%f", probMaxK$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 / sum(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$val
            } else {
              tempu <- probK$val * probaf$val
            }
            probK$val <- tempu / sum(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$val
            } else {
              tempu <- probK$val * probbf$val
            }
            probK$val <- tempu / sum(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$val
            } else {
              tempu <- probK$val * probcf$val
            }
            probK$val <- tempu / sum(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$val
            } else {
              tempu <- probK$val * probdf$val
            }
            probK$val <- tempu / sum(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$val
            } else {
              tempu <- probK$val * probef$val
            }
            probK$val <- tempu / sum(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, "maxProbK", suspendWhenHidden = FALSE)  
      
    }
    
    
    shinyApp(ui = ui, server = server)
    <br>&nbsp;<br>
    In the "quiz" tab, you can experience an adaptive assessment of your knowledge in out small probability domain.
    <p />
    We start with an equal probability distribution over the knowledge structure you have developed. After each of
    your answers, the probabilities are update according to the Bayesian Updating formula.
    <p />
    On the left side, you see the question and answer possibilities, on the right side a Hasse diagram of your
    knowledge structure indicating the current probability distribution.