# 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)
Jessica Loke
Martin Losert
David de Segovia
Wai Wong
Chris Yndgaard
Cord Hockemeyer
