library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Very simple Random-walk model"),
helpText("as described in chapter 2 in Farrell and Lewandowsky (2018);
authors' code downloaded from https://tinyurl.com/yz4us3ts and slightly
modified"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("drift",
"Drift rate",
min = 0,
max = .05,
value = 0),
sliderInput("sp",
"Starting point",
min = -2,
max = 2,
value = 0,
step=.1),
sliderInput("sd_drift",
"SD of drift rate (0 means fixed at drift rate)",
min = 0,
max = .05,
value = 0),
sliderInput("sd_sp",
"SD of starting point (0 means fixed at starting point)",
min = 0,
max = 1,
value = 0),
sliderInput("criterion",
"Criterion",
min = 1,
max = 4,
value = 3)
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel("Distribution of response time", plotOutput("distPlot")),
tabPanel("5 random walks", plotOutput("distPlot2")),
tabPanel("100 random walks", plotOutput("distPlot3"))
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
thedata = reactive({
#random walk model with unequal latencies between responses classes
nreps <- 1000*5
nsamples <- 2000
drift <- input$drift # 0 = noninformative stimulus; >0 = informative
sd_drift <- input$sd_drift
sd_sp <- input$sd_sp
sdrw <- .3
criterion <- unlist(input$criterion)
latencies <- rep(0,nreps)
responses <- rep(0,nreps)
evidence <- matrix(0, nreps, nsamples+1)
for (i in c(1:nreps)) {
if(sd_sp > 0){
sp <- rnorm(1,input$sp,sd_sp)
} else {
sp <- input$sp
}
if(sd_drift > 0){
dr <- rnorm(1,drift,sd_drift)
}else{
dr <- drift
}
evidence[i,] <- cumsum(c(sp,rnorm(nsamples,dr,sdrw)))
p <- which(abs(evidence[i,])>criterion)[1]
responses[i] <- sign(evidence[i,p])
latencies[i] <- p
}
res = cbind(latencies,responses,evidence)
})
####
output$distPlot2 <- renderPlot({
res_act = thedata()
latencies = unlist(res_act[,1])
responses = unlist(res_act[,2])
nreps = length(latencies)
evidence = (res_act[1:5,3:ncol(res_act)])
criterion = unlist(input$criterion)
#plot up to 100 random walk paths
tbpn <- min(nreps,5)
plot(1:max(latencies[1:tbpn])+10,type="n",las=1,
ylim=c(-criterion-.5,criterion+.5),
ylab="Evidence",xlab="Decision time")
for (i in c(1:tbpn)) {
lines(evidence[i,1:(latencies[i])],col="grey",lwd=2)
}
for (i in c(1:tbpn)) {
lines(evidence[i,1:(latencies[i]-1)],col=rainbow(5)[i],lwd=2)
}
abline(h=c(criterion,-criterion),lty="dashed")
})
###
####
output$distPlot3 <- renderPlot({
res_act = thedata()
latencies = unlist(res_act[,1])
responses = unlist(res_act[,2])
nreps = length(latencies)
evidence = (res_act[1:100,3:ncol(res_act)])
criterion = unlist(input$criterion)
#plot up to 100 random walk paths
tbpn <- min(nreps,nrow(evidence))
plot(1:max(latencies[1:tbpn])+10,type="n",las=1,
ylim=c(-criterion-.5,criterion+.5),
ylab="Evidence",xlab="Decision time")
for (i in c(1:tbpn)) {
col_cond = ifelse(evidence[i,latencies[i]]>0,"#20EB54","#EB2020")
lines(evidence[i,1:(latencies[i])],col=
adjustcolor(col_cond, alpha.f = 0.2),lwd=2)
}
abline(h=c(criterion,-criterion),lty="dashed")
})
###
output$distPlot <- renderPlot({
res_act = thedata()
latencies = unlist(res_act[,1])
responses = unlist(res_act[,2])
nreps = length(latencies)
#plot histograms of latencies
par(mfrow=c(2,1))
toprt <- latencies[responses>0]
topprop <- length(toprt)/nreps
hist(toprt,col="gray",
xlab="Decision time", xlim=c(0,max(latencies)),
main=paste("Top responses (",as.numeric(topprop),
") m=",as.character(signif(mean(toprt),4)),
sep=""),las=1)
botrt <- latencies[responses<0]
botprop <- length(botrt)/nreps
hist(botrt,col="gray",
xlab="Decision time",xlim=c(0,max(latencies)),
main=paste("Bottom responses (",as.numeric(botprop),
") m=",as.character(signif(mean(botrt),4)),
sep=""),las=1)
})
}
# Run the application
shinyApp(ui = ui, server = server, options = list( display.mode = "showcase"))