# Supplementary code for: 
# Smaldino PE, Aplin LM, Farine DR (2018) Sigmoidal Acquisition Curves Probably Indicate Conformity. Scientific Reports.  

# Replication of the model of van Leeuwen et al. (2016), with time windowing analysis. 
# Code written by Damien Farine. 

N <- 100
max_T <- 10000
repetitions <- 1000

out_frequency_behaviour = matrix(0,nrow=max_T*repetitions,ncol=2)
out_frequency_individual = matrix(0,nrow=max_T*repetitions,ncol=2)
count <- 1
#act.frequency.window <- matrix(NA,nrow=max_T*repetitions,ncol=2)
#windows <- c(10,seq(100,9950,50))
windows <- c(10,20,30,40,50,70,90,110,130,150,180,210,240,270,300,350,400,450,500,580,660,740,820,900,1000,1100,1200,1350,1500,1850,2100,2500,3000,3500,4000,5000,6000,7000,8000,9000,9999)
windows.data <- list()
total.windows.empty <- list()

for (w in 1:length(windows)) {
	windows.data[[w]] <- matrix(NA,nrow=max_T*repetitions,ncol=2)
	total.windows.empty[[w]] <- rep(NA,windows[w])
}

for (i in 1:repetitions) {
	print(i)
	freq_behav <- 0
	pop <- sample(c(0,1),N,replace=TRUE)
	total.windows <- total.windows.empty

	for (t in 1:max_T) {

		freq_ind <- sum(pop)/N

		behaviour <- sample(pop,1)

		freq_behav <- freq_behav + behaviour

		# update the windowing and windowed frequency
		for (w in 1:length(windows)) {

			total.windows[[w]][1:(windows[w]-1)] <- total.windows[[w]][2:windows[w]]
			total.windows[[w]][windows[w]] <- behaviour
			windows.data[[w]][count,] <- c(behaviour,sum(total.windows[[w]],na.rm=T)/sum(!is.na(total.windows[[w]])))

		}

		pop[sample(1:N,1)] <- behaviour

		out_frequency_individual[count,] <- c(behaviour, freq_ind)
		out_frequency_behaviour[count,] <- c(behaviour, freq_behav/t)

		count <- count + 1

	}

}


## PLOT BASIC

quartz(width=12,height=4)
par(mfrow=c(1,3), mar=c(4.5,4.5,3,1), mgp=c(3,0.5,0), cex.lab=1.4, cex.axis=1.3, las=1)

# Plot 1

x1 <- round(seq(0,1,0.01),2)
y1 <- rep(NA,length(x1))
out_frequency_individual[,2] <- round(out_frequency_individual[,2],2)

for (i in 1:length(x1)) {
	y1[i] <- mean(out_frequency_individual[out_frequency_individual[,2]==x1[i],1])
}
plot(NULL,xlab=expression("Frequency"[A]),ylab=expression("Probability"["A"]), tck = 0.02, xlim=c(0,1), ylim=c(0,1))
lines(x1,predict(lm(y1~x1),type="response"),col="red",lty=2)
lines(x1,predict(glm(y1~x1,family="binomial"),type="response"),col="blue",lty=2)
for (i in seq(0,1,0.2)) {
	abline(v=i, col="lightgrey", lwd=0.4)
	abline(h=i, col="lightgrey", lwd=0.4)
}
points(x1,y1,cex=1.3)
legend("bottomright",pch=c(21,NA,NA),lty=c(NA,2,2),col=c("black","red","blue"),legend=c("Original data","Linear fit","Sigmoid fit"),bty="n")
mtext("A", side=3, outer=TRUE, line=-2.5, adj=0.005, cex=2.2)

# Plot 2

x2 <- round(seq(0,1,0.01),2)
y2 <- rep(NA,length(x2))
out_frequency_behaviour[,2] <- round(out_frequency_behaviour[,2],2)

for (i in 1:length(x2)) {
	y2[i] <- mean(out_frequency_behaviour[out_frequency_behaviour[,2]==x2[i],1])
}
plot(NULL,xlab=expression("Frequency"[A]),ylab=expression("Probability"["A"]), tck = 0.02, xlim=c(0,1), ylim=c(0,1))
for (i in seq(0,1,0.2)) {
	abline(v=i, col="lightgrey", lwd=0.4)
	abline(h=i, col="lightgrey", lwd=0.4)
}
lines(x2,predict(lm(y2~x2),type="response"),col="red",lty=2)
lines(x2,predict(glm(y2~x2,family="binomial"),type="response"),col="blue",lty=2)
points(x2,y2,cex=1.2)
legend("bottomright",pch=c(21,NA,NA),lty=c(NA,2,2),col=c("black","red","blue"),legend=c("Original data","Linear fit","Sigmoid fit"),bty="n")
mtext("B", side=3, outer=TRUE, line=-2.5, adj=0.345, cex=2.2)

# Plot 3

x3 <- c(0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0)
y3 <- rep(NA,length(x3))
act.frequency.window <- round(windows.data[[1]],2)
#act.frequency.window <- act.frequency.window[which(act.frequency.window[,2] %in% seq(0,1,0.1)),]
#act.frequency.window[,2] <- round(act.frequency.window[,2],1)
for (i in 1:length(x3)) {
	y3[i] <- mean(act.frequency.window[act.frequency.window[,2] == x3[i],1])
}
plot(NULL,xlab=expression("Frequency"[A]),ylab=expression("Probability"["A"]), tck = 0.02, xlim=c(0,1), ylim=c(0,1))
for (i in seq(0,1,0.2)) {
	abline(v=i, col="lightgrey", lwd=0.4)
	abline(h=i, col="lightgrey", lwd=0.4)
}
lines(x3,predict(lm(y3~x3),type="response"),col="red",lty=2)
lines(x3,predict(glm(y3~x3,family="binomial"),type="response"),col="blue",lty=2)
points(x3,y3,cex=1.2)
legend("bottomright",pch=c(21,NA,NA),lty=c(NA,2,2),col=c("black","red","blue"),legend=c("Original data","Linear fit","Sigmoid fit"),bty="n")
mtext("C", side=3, outer=TRUE, line=-2.5, adj=0.685, cex=2.2)




## Windowing

b <- rep(NA,length(windows))
l <- rep(NA,length(windows))
windows.data.tmp <- windows.data
tolerance = .Machine$double.eps^0.5

for (i in 1:length(windows)) {
	x <- seq(0,1,0.1)
	windows.data.tmp[[i]] <- windows.data.tmp[[i]]
	windows.data.tmp[[i]][,2] <- round(windows.data.tmp[[i]][,2],1)
	y <- rep(NA,length(x))
	for (j in 1:length(x)) {
		y[j] <- mean(windows.data.tmp[[i]][which(abs(windows.data.tmp[[i]][,2] - x[j]) < tolerance),1])
	}
	x <- x[is.finite(y)]
	y <- y[is.finite(y)]

	model.binom <- glm(y~x, family="binomial")
	y2 <- predict(model.binom,type="response")
	b[i] <- sum((y2-y)^2)*11/length(x)
	model.gaus <- glm(y~x, family="gaussian")
	y2 <- predict(model.gaus,type="response")
	l[i] <- sum((y2-y)^2)*11/length(x)
}

quartz(width=5,height=5)
par(mar=c(4.5,4.5,1,1), cex.lab=1.4, cex.axis=1.1, las=1, mgp=c(3,0.5,0))
plot(windows,b,ylim=c(0,max(c(b,l))),lty=2,type='l',lwd=2, xlab="Window size (# previous observations)", ylab="Sum of squares (error)", col="blue", tck=0.02)
lines(windows,l,lwd=2, col="red")
offset <- -100
segments(windows[which.min(abs(b - l))[1]]+offset,b[which.min(abs(b - l))[1]],windows[which.min(abs(b - l))[1]]+offset,0)
legend("topleft",lty=c(2,2),col=c("red","blue"),legend=c("Linear fit","Sigmoid fit"),bty="n", lwd=c(2,2))