# Visualizing selection's effect on a population with a fitness landscape in R

I'm trying to write a script to demonstrate the effect of selection in a population. The problem that I have is that it is not realistic in the sense that not only the mean would change for directional selection, but the Skewness of the distribution would change as well. How would that be possible to code that and show the movement of the population going toward the maximum fitness peak?

# Define the normal distribution
slect <- function(x,mu,sigma,constant) {
temp = exp(constant*((x-mu)/sigma)^2)
return(temp)
}

# Multiply 2 functions
Multiply=function(a,b){
force(a)
force(b)
function(x){a(x)*b(x)}
}
# Set some parameters
ylim = c(0,2)
# X limits
from = -4
to = 7
# Sequence of X
x = seq(from,to,length.out=100)
# Means
muinit = 1
mu1=muinit
mu2=3
# Number of generations
n.gen = 10
# Variance
sigma.0 = 1.1
sigma = sigma.0

# Initialize population
init0 = function(x)slect(x,mu = muinit,sigma = sigma.0,constant = -.5)
# How the population will move because of selection
popmov = function(x)slect(x,mu = mu1,sigma = sigma,constant = -.5)
# Final fitness function
finl = function(x)slect(x,mu = mu2,sigma = sigma,constant = -.5)

# Empty data
data.all = NULL
gen = 1
for(gen in 1:n.gen){
# system("sleep .2")
# png(paste0("Desktop/fittest/test",gen,".png"))
int1 = curve(expr = init0,from = from, to = to, col = "red",
ylab = "Fitness", xlab = "Phenotype", ylim = ylim, main = paste("Fitness result gen:",gen))

if (gen ==1) {
# Result of the first generation
h0 = Multiply(init0,finl)
h1 = curve(expr = h0,from = from, to = to, col = "black", lty = 3, add = TRUE)
finl1 = curve(expr = finl,from = from, to = to, col = "black", lty = 2,lwd = 2, add = TRUE)
mu1=mean(c(mu1,mu2))
popmov1 = curve(expr = popmov,from = from, to = to, col = "red",lwd = 2,add = TRUE)
h = h0
}
if (gen>1) {
mu1 = mean(c(mu1,mu2))
popmov1 = curve(expr = popmov,from = from, to = to, col = "red",lwd = 2,add = TRUE)
h = Multiply(h,finl)
h1 = curve(expr = h,from = from, to = to, col = "black", lty = 3, add = TRUE)
finl1 = curve(expr = finl,from = from, to = to, col = "black", lty = 2,lwd = 2, add = TRUE)
}

popmov1$$type = "popmovement" finl1$$type = "final"
h1$$type = "movement" int1$$type = "initial"
popmov1$$it = gen int1$$it = gen
finl1$$it = gen h1$$it = gen
df1 = as.data.frame.list(int1)
df1.1 = as.data.frame.list(popmov1)
df2 = as.data.frame.list(finl1)
df3 = as.data.frame.list(h1)
df4 = rbind(df1,df1.1,df2,df3)
data.all =c(data.all,list(df4))
# dev.off()
} • Someone here may be able to answer your question, but if not I would try SE Bioinformatics, which might have been a better bet in the first place. – David May 20 at 16:31
• Modeling for a single genotype parameter or a single phenotype parameter is (IMHO) very unrealistic. I know that doesn't address your question, but it may be relevant to your goal. – S. McGrew May 20 at 21:11
• @S.McGrew You are right! But my goal here is to have a "simple" case to be visualized (adding traits would start making the thing in 3d and further make it even harder to visualize). But as a first approximation, I wonder how to "show" the effect of a fitness landscape on the population. Therefore, I'm pretty sure that not only the mean is changing, but also the skew of the distribution. This is the core of my question. – M. Beausoleil May 20 at 23:41
• If your selective "force" works equally on all parts of the population, you will keep the shape of the original distribution. In real life, though, the "leading edge" of the population will procreate faster than the "trailing edge". Account for that and I'm pretty sure you will get the skew you're looking for. – S. McGrew May 21 at 1:44
• @S.McGrew, This is it, but how to 'account for that' is my question! I don't know how to simulate this part. Now I'm only modifying the mean of the distribution (the  mu1=mean(c(mu1,mu2)) in the script). But there should be something modifying the shape and skew of the distribution (and Kurtosis if the actual density of the population changes) as well. – M. Beausoleil May 21 at 12:24