Wright-Fisher Simulation of Genetic Drift using R - r

Question

I'm trying to run a simulation of the wright-fisher model of genetic drift in R.
# Wright-Fisher simulation
# n = number of individuals
# f = number of focal alleles at base population
n=10
f=1
pop = as.matrix( c( rep(0,n-f), rep(1,f) ) )
pop = as.matrix( sample(pop, n, replace=T) )
This works, effectively this is one replicate, and each time I run the final line of script is a new generation. What I would like to do, but can't, is have a loop which automatically loops it for X generations and repeat for Y number of replicates.
It should store the results for each generation in a dataframe and then allow me to plot them in a graph which looks something like this (where f/n is allele frequency, each replicate is represented by one line, and the number of generations determines the length of the X axis)...

Answer 1

Here is a function I wrote a few years ago. You can set the pop size, generations to simulate for, and replicates.
Since you haven't shown any code of your own, I'll leave it up to you to figure out how to store output. At any rate, this should get you going:
Drift_graph = function(t,R){
N<-250
p<-0.5
freq<-as.numeric();
for( i in 1:t ){
A1=rbinom(1,2*N,p)
p=A1/(N*2);
freq[length(freq)+1]<-p;
}
plot(freq,type="l",ylim=c(0,1),col=3,xlab="t",ylab=expression(p(A[1])))
for(u in 1:R){
freq1<-as.numeric();
p<-0.5
for( j in 1:t ){
A1=rbinom(1,2*N,p)
p=A1/(N*2);
freq1[length(freq1)+1]<-p;
}
random<-sample(1:1000,1,replace=F)
randomcolor<-colors()[random]
lines(freq1,type="l",col=(randomcolor))
}
}
Drift_graph(2000,50)

Answer 2

# Pop = Replicate populations
# Gen = Generations
# NM = Male population size
# NF = Female population size
# P = Frequency of focal allele
GenDriftSim = function(Pop = Pop, Gen = Gen, NM, NF, P, graph = "y", histo = "y"){
P = (2*(NM+NF))*P
NE = round((4*NM*NF)/(NM+NF),0)
SR = round(NM/NF,2)
Na = NM+NF
if(graph=="y"){
plot(c(0,0),type = "n", main = bquote('N'[M]~'/ N'[F]~'='~.(SR)*', N'[A]~'='~.(Na)*', N'[E]~'='~.(NE)), cex.main = 1,
xlim = c(1,Gen), ylim=c(0,1), xlab = "Generations", ylab = "Fequency of focal allele")
}else{}
for (i in 1:Pop){
N = NM+NF
startA = as.vector(c(rep(1, times = P),rep(0, times = (2*N)-P)))
Population = matrix(c(
c(sample(startA, size = 2*N, replace = FALSE)),
c(rep("M", times = NM), rep("F", times = NF))),
ncol = 3)
SimResults[(Gen*i)+1-Gen, 3] <<- sum(as.numeric(Population[,1:2]))/(N*2)
for(j in 1:(Gen-1)){
Population = matrix(c(
c(sample(sample(Population[(1:NM),1:2], replace = TRUE),N, replace = TRUE)),
c(sample(sample(Population[(1+NM):N,1:2], replace = TRUE),N, replace = TRUE)),
c(rep("M", times = NM), rep("F", times = NF))), ncol = 3)
SimResults[(Gen*i)+1+j-Gen, 3] <<- sum(as.numeric(Population[,1:2]))/(N*2)
}
s = (i*Gen)-Gen+1; e = i*Gen
r = as.vector(SimResults[s:e, 3])
if(graph=="y"){
points(r~c(1:Gen), type = "l")
}else{}
}
if(histo == "y"){SimResults[,1] = rep(1:Pop, each = Gen)
SimResults[,2] = rep(1:Gen, times = Pop)
hist(SimResults[,3][SimResults[,2]==Gen], breaks = 100, cex.lab = 0.7, cex.axis = 0.7, xlim = c(0,1), cex.main = 1, main = bquote('N'[M]~'/ N'[F]~'='~.(SR)*', N'[A]~'='~.(Na)*', N'[E]~'='~.(NE)), xlab = paste0("Frequency of focal allele after ",Gen," Generations"))
}else{}
}
Pop = 10
Gen = 25
P = 0.5
SimResults = matrix(data = NA, ncol = 3, nrow = Gen*Pop)
GenDriftSim(Pop = Pop, Gen = Gen, NM = 100, NF = 900, P = P, graph = "y", histo = "n")
GenDriftSim(Pop = Pop, Gen = Gen, NM = 180, NF = 180, P = P, graph = "y", histo = "n")
dev.off()