En esta página están accesibles las simulaciones de migración, mutación, selección y deriva que sirven para ilustrar los aspectos teóricos de la asignatura Biología Evolutiva. Las simulaciones pueden ejecutarse de dos maneras: desde un servidor externo (en cuyo caso es sólo entrar en el enlace proporcionado) o correrlo en local (para lo que deberás instalar R y el paquete shiny).

1 Enlaces a servidores con las simulaciones

Como son servidores externos a la UGR puede que se caigan en algún momento. En ese caso prueba el método 2

1.5 Mutación, migración, selección y deriva simultáneas

Enlace al simulador de Mutación, migración, selección y deriva simultáneas

2 Instrucciones para ejecutar las simulaciones en tu ordenador

2.1 Instalar R

En primer lugar debes instalar R, eligiendo el sistema operativo en el siguiente enlace:

https://cran.r-project.org/bin/

2.2 Instalar RStudio (Opcional)

Una vez instalado, puedes ejecutar R y verás que es una consola donde debes escribir el código que deseas correr. Hay personas que pueden encontrar este interfaz muy complicado y prefieran un entorno con botones y menús en el que se sientan más seguros. RStudio tiene esta función, permitiendo que la interacción entre R y el usuario ocurra a través de una interfaz de menús y botones. Puedes instalar RStudio en el siguiente enlace:

https://rstudio.com/products/rstudio/download/

2.3 Instalar el paquete shiny

Tanto si estás usando R directamente como si lo haces a través de RStudio, encontrarás una ventana que tiene el símbolo ">". Esa es la terminal y en ella debes escribir lo siguiente:

install.packages("shiny",dependences=T)
install.packages("shinyjs",dependences=T)

Sólo es necesario que instales el paquete una vez en tu ordenador. Las siguientes veces que quieras usar el simulador puedes comenzar a partir de aqui. Elige la simulación que quieres ejecutar, copia todo el texto de esa sección y pégalo en tu consola de R. En ese momento se abrirá un navegador (si no aparece pulsa el botón Enter de tu ordenador) en el que podrás simular cada escenario de manera idéntica a como lo harías a través del servidor. Lo único que debes tener en cuenta es que, cuando acabes, debes pinchar en el terminal y pulsar las teclas ctrl o control y c a la vez.

2.4 Ejecutar las simulaciones

2.4.1 Mutación

library(shiny)
server <- function(input, output) {

mutacion.reversible<-function(p,m1,m2,n,grafica="ambas"){
P<-p
for (i in 2:(100*n+1))
P<-c(P,P[i-1]-P[i-1]*m1+(1-P[i-1])*m2)
names(P)<-paste("Generacion",0:n)
    layout(matrix(1:2,ncol=1))
    par(mar=c(3,4.1,4.1,2.1))
    plot(P[1:n],type="n",pch=16,col="black",ylim=c(0,1),xlab="Generaciones",main=ifelse(m1!=0 & m2!=0, "Mutación recurrente reversible",ifelse(length(which(c(m1,m2)==0))==1,"Mutación recurrente irreversible","Sin mutación (EHW)")))
    if(grafica=="al"|grafica=="ambas")
        {
        points(P[1:n],type="o",pch=16,col="black")
        points(1-P[1:n],type="o",pch=16,col="gray")
        }
    if(grafica=="gntp"|grafica=="ambas")
        {
        points(P[1:n]^2,type="o",pch=16,col="red")
        points(2*P[1:n]*(1-P[1:n]),type="o",pch=16,col="orange")
        points((1-P[1:n])^2,type="o",pch=16,col="blue")
        }
    par(mar=c(5.1,4.1,2.1,2.1))
    plot(P,type="n",pch=16,col="red",ylim=c(0,1),xlab="Generaciones (x100)",ylab="Frecuencia")

        if(grafica=="al"|grafica=="ambas")
        {
        points(P,type="o",pch=16,col="black")
        points(1-P,type="o",pch=16,col="gray")
        }
    if(grafica=="gntp"|grafica=="ambas")
        {
        points(P^2,type="o",pch=16,col="red")
        points(2*P*(1-P),type="o",pch=16,col="orange")
        points((1-P)^2,type="o",pch=16,col="blue")
        }
return(P)
}


## Leyenda
leyenda<-function(grafica="ambas"){
leye<-COL<-c()
if(grafica=="gntp"|grafica=="ambas")
    {
    leye<-c("A1A1","A1A2","A2A2")
    COL<-c("blue","orange","red")
    }
if(grafica=="al"|grafica=="ambas")
    {
    leye<-c(leye,"p","q")
    COL<-c(COL,"black","gray")
    }
plot(1:5,type="n",xaxt="n",yaxt="n",bty="n",xlab="",ylab="")
legend("center",legend=leye,col=COL,pch=16,cex=1.5)
}

###
  output$plot2 <- renderPlot(mutacion.reversible(p=input$p,m1=input$m1,m2=input$m2,n=input$Ngen,grafica=input$quePlot))
  output$leyenda <- renderPlot(leyenda(grafica=input$quePlot))

}

library(shiny)
ui <- splitLayout(
#cellWidths = c("60%","10%" ,"30%"),
fluidPage(
  titlePanel("Parámetros de la simulación"),
  sidebarLayout(
    sidebarPanel(
    radioButtons(inputId = "quePlot",
                  label = "Representar:",
                 choices= c("Frecuencias alélicas"="al","Frecuencias genotípicas"="gntp","Ambas"="ambas")
                 ),
      numericInput(inputId = "p",
                  label = "Frecuencia del alelo A1:",
                  min = 0,
                  max = 1,
                  value = 0.4,
                  step=0.01),
     numericInput(inputId = "Ngen",
                  label = "Número de generaciones:",
                  min = 1,
                  max = 1000,
                  value = 30,
                  step=5),
       numericInput(inputId = "m1",
                label="Tasa de mutacion 1 (µ)",
                 min = 0,
                  max = 1,
                  value = 0.00005,
                  step=0.01),
       numericInput(inputId="m2",
            label="Tasa de mutacion 2 (ν)",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
     ),
    mainPanel(
      column(width=3,
      plotOutput("leyenda")),
    column(width=9,
      plotOutput("plot2"))
    )
  )
),

)

shinyApp(ui, server)

2.4.2 Migración

library(shiny)
server <- function(input, output) {

migracion.continente.isla<-function(p.isla,p.continente,m,n,grafica="ambas"){
P<-c(p.isla,p.continente+(p.isla-p.continente)*(1-m)^(1:n))
names(P)<-paste("Generacion",0:(n))

plot(P,type="n",pch=16,col="red",ylim=c(0,1),main="Migración modelo continente isla",xlab="Generaciones",ylab="Frecuencias")
    
if(grafica=="al"|grafica=="ambas")
        {
        points(P,type="o",pch=16,col="black")
        points(1-P,type="o",pch=16,col="gray")
        }
if(grafica=="gntp"|grafica=="ambas")
        {
        points(P^2,type="o",pch=16,col="blue")
        points(2*P*(1-P),type="o",pch=16,col="orange")
        points((1-P)^2,type="o",pch=16,col="red")
        }

return(P)
}


## Leyenda
leyenda<-function(grafica="ambas"){
leye<-COL<-c()
if(grafica=="gntp"|grafica=="ambas")
    {
    leye<-c("A1A1","A1A2","A2A2")
    COL<-c("blue","orange","red")
    }
if(grafica=="al"|grafica=="ambas")
    {
    leye<-c(leye,"p","q")
    COL<-c(COL,"black","gray")
    }
plot(1:5,type="n",xaxt="n",yaxt="n",bty="n",xlab="",ylab="")
legend("center",legend=leye,col=COL,pch=16,cex=1.5)
}

###
  output$plot3 <- renderPlot(migracion.continente.isla(p.isla=input$p,p.continente=input$p.cont,m=input$mig,n=input$Ngen,grafica=input$quePlot))
  output$leyenda <- renderPlot(leyenda(grafica=input$quePlot))

}

library(shiny)
ui <- splitLayout(
#cellWidths = c("60%","40%"),
fluidPage(
  titlePanel("Parámetros de la simulación"),
  sidebarLayout(
    sidebarPanel(
    radioButtons(inputId = "quePlot",
                  label = "Representar:",
                 choices= c("Frecuencias alélicas"="al","Frecuencias genotípicas"="gntp","Ambas"="ambas")
                 ),
      numericInput(inputId = "p",
                  label = "Frecuencia de alelos A1:",
                  min = 0,
                  max = 1,
                  value = 0.4,
                  step=0.01),
     numericInput(inputId = "Ngen",
                  label = "Número de generaciones:",
                  min = 1,
                  max = 1000,
                  value = 30,
                  step=5),
    numericInput(inputId = "mig",
        label="Tasa de migracion",
                 min = 0,
                  max = 1,
                  value = 0.05,
                  step=0.01),

      numericInput(inputId="p.cont",
            label="Frecuencia de A1 en el continente",
            value= 0.1,
            min = 0,
            max = 1,
            step = 0.01),
     ),
    mainPanel(
     column(width=3,
      plotOutput("leyenda")),
    column(width=9,
      plotOutput("plot3")),
    )
  )
),
)

shinyApp(ui, server)

2.4.3 Selección

library(shiny)
library(shinyjs)
ui <- splitLayout(
fluidPage(
# cellWidths = c("50%","80%"),
  titlePanel("Parámetros de la simulación"),
  sidebarLayout(
    sidebarPanel(
    radioButtons(inputId = "quePlot",
                  label = "Representar:",
                 choices= c("Frecuencias alélicas"="al","Frecuencias genotípicas"="gntp","Ambas"="ambas")
                  )
                 ,
      numericInput(inputId = "p",
                  label = "Frecuencia del alelo A1:",
                  min = 0,
                  max = 1,
                  value = 0.4,
                  step=0.01),
      numericInput(inputId = "Ngen",
                  label = "Número de generaciones:",
                  min = 1,
                  max = 1000,
                  value = 30,
                  step=5),

    numericInput(inputId="sA1A1",
            label="Coeficiente selección A1A1",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
            
      numericInput(inputId="sA1A2",
            label="Coeficiente selección A1A2",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
            
      numericInput(inputId="sA2A2",
            label="Coeficiente selección A2A2",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
 
            
     ),             #side bar panels
    mainPanel(
      column(width=3,
      plotOutput("leyenda")),
    column(width=9,
      plotOutput("plot2"))
    )
  )                 #sidebarLayout
),                  #fluidPage
)                   #splitLayout


library(shiny)
server <- function(input, output) {

mutYmig<-function(p.inicial,n,sA1A1,sA1A2,sA2A2,grafica="ambas"){
P<-p.inicial
P2<-Q2<-PQ2<-c()
for (i in 2:(n+1))
    {
    newP<-P[i-1]
    # seleccion
    s<-c(sA1A1,sA1A2,sA2A2)
    w<-1-s
    freqEsp<-c(newP^2,2*newP*(1-newP),(1-newP)^2)
    freqEspxw<-freqEsp*w
    newPsel<-freqEspxw/sum(freqEspxw)
    p2<-newPsel[1]
    q2<-newPsel[3]
    pq2<-newPsel[2]
    
    P<-c(P,p2+pq2*0.5)
    P2 <- c(P2,p2)
    PQ2 <- c(PQ2,pq2)
    Q2 <- c(Q2,q2)
    }
names(P)<-paste("Generacion",0:n)

plot(y=P,x=0:n,type="n",pch=16,col="red",ylim=c(0,1),main="Selección",xlab="Generaciones",ylab="Frecuencia")
    
if(grafica=="al"|grafica=="ambas")
        {
        points(y=P,x=0:n,type="o",pch=16,col="black")
        points(y=1-P,x=0:n,type="o",pch=16,col="gray")
        }
if(grafica=="gntp"|grafica=="ambas")
        {
        points(y=P2,x=1:n,type="o",pch=16,col="blue")
        points(y=PQ2,x=1:n,type="o",pch=16,col="orange")
        points(y=Q2,x=1:n,type="o",pch=16,col="red")
        }

return(P)

}

## Leyenda
leyenda<-function(grafica="ambas"){
leye<-COL<-c()
if(grafica=="gntp"|grafica=="ambas")
    {
    leye<-c("A1A1","A1A2","A2A2")
    COL<-c("blue","orange","red")
    }
if(grafica=="al"|grafica=="ambas")
    {
    leye<-c(leye,"p","q")
    COL<-c(COL,"black","gray")
    }
plot(1:5,type="n",xaxt="n",yaxt="n",bty="n",xlab="",ylab="")
legend("center",legend=leye,col=COL,pch=16,cex=1.5)
}

###
  output$plot2 <- renderPlot(mutYmig(p.inicial=input$p,n=input$Ngen,sA1A1=input$sA1A1, sA1A2=input$sA1A2, sA2A2=input$sA2A2,grafica=input$quePlot))
  output$leyenda <- renderPlot(leyenda(grafica=input$quePlot))

}



shinyApp(ui, server)

2.4.4 Deriva

library(shiny)
library(shinyjs)
ui <- splitLayout(
fluidPage(
# cellWidths = c("50%","80%"),
  titlePanel("Parámetros de la simulación"),
  sidebarLayout(
    sidebarPanel(
    fluidRow(
    column(width=6,
    radioButtons(inputId = "quePlot",
                  label = "Representar:",
                 choices= c("Frecuencias alélicas"="al","Frecuencias genotípicas"="gntp","Ambas"="ambas")
                 )),
    column(width=6,
    useShinyjs(),                           ##--- esto es para el boton
    actionButton("refresh", "Repetir simulación")  ##--- esto es para el boton
                 )           
                 )
                 ,
      numericInput(inputId = "p",
                  label = "Frecuencia del alelo A1:",
                  min = 0,
                  max = 1,
                  value = 0.4,
                  step=0.01),
     numericInput(inputId = "Nids",
                  label = "Tamaño poblacional:",
                  min = 2,
                  max = 10000,
                  value = 100,
                  step=10),
     numericInput(inputId = "Ngen",
                  label = "Número de generaciones:",
                  min = 1,
                  max = 1000,
                  value = 30,
                  step=5),
            
     ),             #side bar panels
    mainPanel(
      column(width=3,
      plotOutput("leyenda")),
    column(width=9,
      plotOutput("plot2"))
    )
  )                 #sidebarLayout
),                  #fluidPage
)                   #splitLayout


library(shiny)
server <- function(input, output) {

mutYmig<-function(p,n,Nid,grafica="ambas"){
P<-p
P2<-Q2<-PQ2<-c()
for (i in 2:(n+1))
    {
    newP<-P[i-1]
    p2<-newP^2
    q2<-(1-newP)^2
    pq2<-2*newP*(1-newP)
    
    # Deriva
    randomVALS<-runif(n=Nid, min = 0, max = 1)
    # Los valores iguales o menores a p2 serán A1Â1
    idsA1A1<-length(which(randomVALS<=p2))
    # Los valores mayores que p2 e iguales o menores que p2+2pq serán A1A2
    idsA1A2<-length(which(randomVALS>p2 & randomVALS<=(p2+pq2)))
    # Los valores mayores a p2+2pq serán A1Â1
    idsA2A2<-length(which(randomVALS>(p2+pq2)))
    # Frecuencias:
    p2<-idsA1A1/Nid
    q2<-idsA2A2/Nid
    pq2<-idsA1A2/Nid

    P<-c(P,p2+pq2*0.5)
    P2 <- c(P2,p2)
    PQ2 <- c(PQ2,pq2)
    Q2 <- c(Q2,q2)
    }
names(P)<-paste("Generacion",0:n)

plot(y=P,x=0:n,type="n",pch=16,col="red",ylim=c(0,1),main="Deriva",xlab="Generaciones",ylab="Frecuencia")
    
if(grafica=="al"|grafica=="ambas")
        {
        points(y=P,x=0:n,type="o",pch=16,col="black")
        points(y=1-P,x=0:n,type="o",pch=16,col="gray")
        }
if(grafica=="gntp"|grafica=="ambas")
        {
        points(y=P2,x=1:n,type="o",pch=16,col="blue")
        points(y=PQ2,x=1:n,type="o",pch=16,col="orange")
        points(y=Q2,x=1:n,type="o",pch=16,col="red")
        }

return(P)

}

## Leyenda
leyenda<-function(grafica="ambas"){
leye<-COL<-c()
if(grafica=="gntp"|grafica=="ambas")
    {
    leye<-c("A1A1","A1A2","A2A2")
    COL<-c("blue","orange","red")
    }
if(grafica=="al"|grafica=="ambas")
    {
    leye<-c(leye,"p","q")
    COL<-c(COL,"black","gray")
    }
plot(1:5,type="n",xaxt="n",yaxt="n",bty="n",xlab="",ylab="")
legend("center",legend=leye,col=COL,pch=16,cex=1.5)
}

###
observeEvent(input$refresh, {
      refresh()
    })
  output$plot2 <- renderPlot(mutYmig(p=input$p,n=input$Ngen, Nid=input$Nids, grafica=input$quePlot))
  output$leyenda <- renderPlot(leyenda(grafica=input$quePlot))

}

shinyApp(ui, server)

2.4.5 Mutación y migración simultáneas

library(shiny)
server <- function(input, output) {

mutYmig<-function(p.isla,p.continente,m,n,m1,m2,grafica="ambas"){
P<-p.isla
P2<-Q2<-PQ2<-c()
for (i in 2:(n+1))
    {
    newPmut.isla<-P[i-1]-P[i-1]*m1+(1-P[i-1])*m2
    newPmutMIG<-p.continente+(newPmut.isla-p.continente)*(1-m)
    p2<-newPmutMIG^2
    q2<-(1-newPmutMIG)^2
    pq2<-2*newPmutMIG*(1-newPmutMIG)

    P<-c(P,p2+pq2*0.5)
    P2 <- c(P2,p2)
    PQ2 <- c(PQ2,pq2)
    Q2 <- c(Q2,q2)
    }
names(P)<-paste("Generacion",0:n)

plot(y=P,x=0:n,type="n",pch=16,col="red",ylim=c(0,1),main="Mutación + Migración (modelo continente isla)",xlab="Generaciones",ylab="Frecuencia")
    
if(grafica=="al"|grafica=="ambas")
        {
        points(y=P,x=0:n,type="o",pch=16,col="black")
        points(y=1-P,x=0:n,type="o",pch=16,col="gray")
        }
if(grafica=="gntp"|grafica=="ambas")
        {
        points(y=P2,x=1:n,type="o",pch=16,col="blue")
        points(y=PQ2,x=1:n,type="o",pch=16,col="orange")
        points(y=Q2,x=1:n,type="o",pch=16,col="red")
        }

return(P)

}

## Leyenda
leyenda<-function(grafica="ambas"){
leye<-COL<-c()
if(grafica=="gntp"|grafica=="ambas")
    {
    leye<-c("A1A1","A1A2","A2A2")
    COL<-c("blue","orange","red")
    }
if(grafica=="al"|grafica=="ambas")
    {
    leye<-c(leye,"p","q")
    COL<-c(COL,"black","gray")
    }
plot(1:5,type="n",xaxt="n",yaxt="n",bty="n",xlab="",ylab="")
legend("center",legend=leye,col=COL,pch=16,cex=1.5)
}

###

  output$plot2 <- renderPlot(mutYmig(p.isla=input$p,p.continente=input$p.cont,m=input$mig,m1=input$m1,m2=input$m2,n=input$Ngen, grafica=input$quePlot))
  output$leyenda <- renderPlot(leyenda(grafica=input$quePlot))

}


library(shiny)
ui <- splitLayout(
fluidPage(
# cellWidths = c("50%","80%"),
  titlePanel("Parámetros de la simulación"),
  sidebarLayout(
    sidebarPanel(
    radioButtons(inputId = "quePlot",
                  label = "Representar:",
                 choices= c("Frecuencias alélicas"="al","Frecuencias genotípicas"="gntp","Ambas"="ambas")
                 )
                 ,
      numericInput(inputId = "p",
                  label = "Frecuencia del alelo A1:",
                  min = 0,
                  max = 1,
                  value = 0.4,
                  step=0.01),
     numericInput(inputId = "Ngen",
                  label = "Número de generaciones:",
                  min = 1,
                  max = 1000,
                  value = 30,
                  step=5),
       numericInput(inputId = "m1",
                label="Tasa de mutacion 1 (µ)",
                 min = 0,
                  max = 1,
                  value = 0.00005,
                  step=0.01),
       numericInput(inputId="m2",
            label="Tasa de mutacion 2 (ν)",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
        numericInput(inputId = "mig",
                label="Tasa de migración",
                 min = 0,
                  max = 1,
                  value = 0.05,
                  step=0.01),

      numericInput(inputId="p.cont",
            label="Frecuencia de A1 en el continente",
            value= 0.1,
            min = 0,
            max = 1,
            step = 0.01),
            
     ),             #side bar panels
    mainPanel(
      column(width=3,
      plotOutput("leyenda")),
    column(width=9,
      plotOutput("plot2"))
)
)                 #sidebarLayout
),                  #fluidPage
)                   #splitLayout


shinyApp(ui, server)

2.4.6 Mutación, migración y selección simultáneas

library(shiny)
library(shinyjs)
ui <- splitLayout(
fluidPage(
# cellWidths = c("50%","80%"),
  titlePanel("Parámetros de la simulación"),
  sidebarLayout(
    sidebarPanel(
    radioButtons(inputId = "quePlot",
                  label = "Representar:",
                 choices= c("Frecuencias alélicas"="al","Frecuencias genotípicas"="gntp","Ambas"="ambas")
                  )
                 ,
      numericInput(inputId = "p",
                  label = "Frecuencia del alelo A1:",
                  min = 0,
                  max = 1,
                  value = 0.4,
                  step=0.01),
      numericInput(inputId = "Ngen",
                  label = "Número de generaciones:",
                  min = 1,
                  max = 1000,
                  value = 30,
                  step=5),
       numericInput(inputId = "m1",
                label="Tasa de mutacion 1 (µ)",
                 min = 0,
                  max = 1,
                  value = 0.00005,
                  step=0.01),
       numericInput(inputId="m2",
            label="Tasa de mutacion 2 (ν)",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
        numericInput(inputId = "mig",
                label="Tasa de migración",
                 min = 0,
                  max = 1,
                  value = 0.05,
                  step=0.01),

      numericInput(inputId="p.cont",
            label="Frecuencia de A1 en el continente",
            value= 0.1,
            min = 0,
            max = 1,
            step = 0.01),
            
      numericInput(inputId="sA1A1",
            label="Coeficiente selección A1A1",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
            
      numericInput(inputId="sA1A2",
            label="Coeficiente selección A1A2",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
            
      numericInput(inputId="sA2A2",
            label="Coeficiente selección A2A2",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
 
            
     ),             #side bar panels
    mainPanel(
      column(width=3,
      plotOutput("leyenda")),
    column(width=9,
      plotOutput("plot2"))
    )
  )                 #sidebarLayout
),                  #fluidPage
)                   #splitLayout


library(shiny)
server <- function(input, output) {

mutYmig<-function(p.isla,p.continente,m,n,m1,m2,sA1A1,sA1A2,sA2A2,Nid,grafica="ambas"){
P<-p.isla
P2<-Q2<-PQ2<-c()
for (i in 2:(n+1))
    {
    newPmut.isla<-P[i-1]-P[i-1]*m1+(1-P[i-1])*m2
    newPmutMIG<-p.continente+(newPmut.isla-p.continente)*(1-m)
    p2<-newPmutMIG^2
    q2<-(1-newPmutMIG)^2
    pq2<-2*newPmutMIG*(1-newPmutMIG)
    # seleccion
    s<-c(sA1A1,sA1A2,sA2A2)
    w<-1-s
    freqEsp<-c(newPmutMIG^2,2*newPmutMIG*(1-newPmutMIG),(1-newPmutMIG)^2)
    freqEspxw<-freqEsp*w
    newPmutMIGsel<-freqEspxw/sum(freqEspxw)
    p2<-newPmutMIGsel[1]
    q2<-newPmutMIGsel[3]
    pq2<-newPmutMIGsel[2]
    
        P<-c(P,p2+pq2*0.5)
    P2 <- c(P2,p2)
    PQ2 <- c(PQ2,pq2)
    Q2 <- c(Q2,q2)
    }
names(P)<-paste("Generacion",0:n)

plot(y=P,x=0:n,type="n",pch=16,col="red",ylim=c(0,1),main="Mutación + Migración (modelo continente isla) + Selección",xlab="Generaciones",ylab="Frecuencia")
    
if(grafica=="al"|grafica=="ambas")
        {
        points(y=P,x=0:n,type="o",pch=16,col="black")
        points(y=1-P,x=0:n,type="o",pch=16,col="gray")
        }
if(grafica=="gntp"|grafica=="ambas")
        {
        points(y=P2,x=1:n,type="o",pch=16,col="blue")
        points(y=PQ2,x=1:n,type="o",pch=16,col="orange")
        points(y=Q2,x=1:n,type="o",pch=16,col="red")
        }

return(P)

}

## Leyenda
leyenda<-function(grafica="ambas"){
leye<-COL<-c()
if(grafica=="gntp"|grafica=="ambas")
    {
    leye<-c("A1A1","A1A2","A2A2")
    COL<-c("blue","orange","red")
    }
if(grafica=="al"|grafica=="ambas")
    {
    leye<-c(leye,"p","q")
    COL<-c(COL,"black","gray")
    }
plot(1:5,type="n",xaxt="n",yaxt="n",bty="n",xlab="",ylab="")
legend("center",legend=leye,col=COL,pch=16,cex=1.5)
}

###
  output$plot2 <- renderPlot(mutYmig(p.isla=input$p,p.continente=input$p.cont,m=input$mig,m1=input$m1,m2=input$m2,n=input$Ngen,sA1A1=input$sA1A1, sA1A2=input$sA1A2, sA2A2=input$sA2A2,grafica=input$quePlot))
  output$leyenda <- renderPlot(leyenda(grafica=input$quePlot))

}



shinyApp(ui, server)

2.4.7 Mutación, migración, selección y deriva simultáneas

library(shiny)
library(shinyjs)
ui <- splitLayout(
fluidPage(
# cellWidths = c("50%","80%"),
  titlePanel("Parámetros de la simulación"),
  sidebarLayout(
    sidebarPanel(
    fluidRow(
    column(width=6,
    radioButtons(inputId = "quePlot",
                  label = "Representar:",
                 choices= c("Frecuencias alélicas"="al","Frecuencias genotípicas"="gntp","Ambas"="ambas")
                 )),
    column(width=6,
    useShinyjs(),                           ##--- esto es para el boton
    actionButton("refresh", "Repetir simulación")  ##--- esto es para el boton
                 )           
                 )
                 ,
      numericInput(inputId = "p",
                  label = "Frecuencia del alelo A1:",
                  min = 0,
                  max = 1,
                  value = 0.4,
                  step=0.01),
     numericInput(inputId = "Nids",
                  label = "Tamaño poblacional:",
                  min = 2,
                  max = 10000,
                  value = 100,
                  step=10),
     numericInput(inputId = "Ngen",
                  label = "Número de generaciones:",
                  min = 1,
                  max = 1000,
                  value = 30,
                  step=5),
       numericInput(inputId = "m1",
                label="Tasa de mutacion 1 (µ)",
                 min = 0,
                  max = 1,
                  value = 0.00005,
                  step=0.01),
       numericInput(inputId="m2",
            label="Tasa de mutacion 2 (ν)",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
        numericInput(inputId = "mig",
                label="Tasa de migración",
                 min = 0,
                  max = 1,
                  value = 0.05,
                  step=0.01),

      numericInput(inputId="p.cont",
            label="Frecuencia de A1 en el continente",
            value= 0.1,
            min = 0,
            max = 1,
            step = 0.01),
            
      numericInput(inputId="sA1A1",
            label="Coeficiente selección A1A1",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
            
      numericInput(inputId="sA1A2",
            label="Coeficiente selección A1A2",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
            
      numericInput(inputId="sA2A2",
            label="Coeficiente selección A2A2",
            value= 0,
            min = 0,
            max = 1,
            step = 0.01),
 
            
     ),             #side bar panels
    mainPanel(
      column(width=3,
      plotOutput("leyenda")),
    column(width=9,
      plotOutput("plot2"))
    )
  )                 #sidebarLayout
),                  #fluidPage
)                   #splitLayout


library(shiny)
server <- function(input, output) {

mutYmig<-function(p.isla,p.continente,m,n,m1,m2,sA1A1,sA1A2,sA2A2,Nid,grafica="ambas"){
P<-p.isla
P2<-Q2<-PQ2<-c()
for (i in 2:(n+1))
    {
    newPmut.isla<-P[i-1]-P[i-1]*m1+(1-P[i-1])*m2
    newPmutMIG<-p.continente+(newPmut.isla-p.continente)*(1-m)
    p2<-newPmutMIG^2
    q2<-(1-newPmutMIG)^2
    pq2<-2*newPmutMIG*(1-newPmutMIG)
    # seleccion
    s<-c(sA1A1,sA1A2,sA2A2)
    w<-1-s
    freqEsp<-c(newPmutMIG^2,2*newPmutMIG*(1-newPmutMIG),(1-newPmutMIG)^2)
    freqEspxw<-freqEsp*w
    newPmutMIGsel<-freqEspxw/sum(freqEspxw)
    p2<-newPmutMIGsel[1]
    q2<-newPmutMIGsel[3]
    pq2<-newPmutMIGsel[2]
    
    # Deriva
    randomVALS<-runif(n=Nid, min = 0, max = 1)
    # Los valores iguales o menores a p2 serán A1Â1
    idsA1A1<-length(which(randomVALS<=p2))
    # Los valores mayores que p2 e iguales o menores que p2+2pq serán A1A2
    idsA1A2<-length(which(randomVALS>p2 & randomVALS<=(p2+pq2)))
    # Los valores mayores a p2+2pq serán A1Â1
    idsA2A2<-length(which(randomVALS>(p2+pq2)))
    # Frecuencias:
    p2<-idsA1A1/Nid
    q2<-idsA2A2/Nid
    pq2<-idsA1A2/Nid

    P<-c(P,p2+pq2*0.5)
    P2 <- c(P2,p2)
    PQ2 <- c(PQ2,pq2)
    Q2 <- c(Q2,q2)
    }
names(P)<-paste("Generacion",0:n)

plot(y=P,x=0:n,type="n",pch=16,col="red",ylim=c(0,1),main="Mutación + Migración (modelo continente isla) + Selección + Deriva",xlab="Generaciones",ylab="Frecuencia")
    
if(grafica=="al"|grafica=="ambas")
        {
        points(y=P,x=0:n,type="o",pch=16,col="black")
        points(y=1-P,x=0:n,type="o",pch=16,col="gray")
        }
if(grafica=="gntp"|grafica=="ambas")
        {
        points(y=P2,x=1:n,type="o",pch=16,col="blue")
        points(y=PQ2,x=1:n,type="o",pch=16,col="orange")
        points(y=Q2,x=1:n,type="o",pch=16,col="red")
        }

return(P)

}

## Leyenda
leyenda<-function(grafica="ambas"){
leye<-COL<-c()
if(grafica=="gntp"|grafica=="ambas")
    {
    leye<-c("A1A1","A1A2","A2A2")
    COL<-c("blue","orange","red")
    }
if(grafica=="al"|grafica=="ambas")
    {
    leye<-c(leye,"p","q")
    COL<-c(COL,"black","gray")
    }
plot(1:5,type="n",xaxt="n",yaxt="n",bty="n",xlab="",ylab="")
legend("center",legend=leye,col=COL,pch=16,cex=1.5)
}

###
observeEvent(input$refresh, {
      refresh()
    })
  output$plot2 <- renderPlot(mutYmig(p.isla=input$p,p.continente=input$p.cont,m=input$mig,m1=input$m1,m2=input$m2,n=input$Ngen,sA1A1=input$sA1A1, sA1A2=input$sA1A2, sA2A2=input$sA2A2, Nid=input$Nids, grafica=input$quePlot))
  output$leyenda <- renderPlot(leyenda(grafica=input$quePlot))

}


shinyApp(ui, server)

3 Simulación del experimento de Buri

Para reproducir el experimento en tu ordenador, sólo necesitas copiar y pegar lo siguiente en la consola de R:

## Definiciones de funciones
        deriva<-function(NA1,NA2,Npop,verbose=T){
        alelost0<-c(rep("A1",NA1),rep("A2",NA2))
        FreqAl<-table(alelost0)/sum(table(alelost0))

        FreqGntHWE<-c(FreqAl[1]^2,2*FreqAl[1]*FreqAl[2],FreqAl[2]^2)
        names(FreqGntHWE) <- c("A1A1","A1A2","A2A2")

        IDS<-sapply(round((1:Npop)/2),function(x) paste(sort(sample(alelost0,2,replace=TRUE)),collapse=""))

        NS<-table(IDS)

        FG<-table(IDS)/sum(table(IDS))

        if(verbose)
            {
            cat("\n######\nFrecuencias esperadas en el Equilibrio Hardy-Weinberg:\n")
            print(round(FreqGntHWE,2))
            cat(paste("\nFrecuencias observadas en una población de tamaño ",Npop,":\n"))
            print(round(FG,2))
            cat("######\n")
            }else
            {
            OUT<-list(FreqGntHWE)
            OUT[[2]]<-FG
            return(OUT)
            }
        }
    
    
    deriva.tiempo<-function(NA1,NA2,Npop,Ngeneraciones,plot=TRUE){
OUT<-c()
    primero<-c((NA1/(NA1+NA2))^2,2*(NA1/(NA1+NA2))*(NA2/(NA1+NA2)),(NA2/(NA1+NA2))^2)
for (i in 1:Ngeneraciones)
    {
    out<-deriva(NA1=NA1,NA2=NA2,Npop=Npop,verbose=FALSE)[[2]]
    if(length(out)!=3)
        {
        out2<-rep(0,3)
        names(out2)<-c("A1A1","A1A2","A2A2")
        out2[na.exclude(match(names(out),names(out2)))]<-out
        out<-out2
        }
    OUT<-rbind(OUT,out)
    NA1<-100*(out[1]+out[2]/2)
    NA2<-100*(out[3]+out[2]/2)
    }

OUT<-rbind(primero,OUT)
plot(x=c(0:Ngeneraciones),y=OUT[,1],col="blue",pch=16,type="o",ylim=c(0,1),xlim=c(-0.055*Ngeneraciones,Ngeneraciones),xlab="Generaciones",ylab="Frecuencia")
points(x=c(0:Ngeneraciones),y=OUT[,2],col="orange",pch=16,type="o")
points(x=c(0:Ngeneraciones),y=OUT[,3],col="red",pch=16,type="o")
abline(v=0)
legend("topleft",legend=c(names(out),"p","q"),col=c("blue","orange","red","black","gray"),pch=16)

points(x=c(0:Ngeneraciones),y=apply(OUT,1,function(x) x[1]+0.5*x[2]),lty="dotted",col="black",type="l",cex=1.5)
points(x=c(0:Ngeneraciones),y=apply(OUT,1,function(x) x[3]+0.5*x[2]),lty="dotted",col="darkgray",type="l",cex=1.5)

row.names(OUT)<-paste("Generacion",0:Ngeneraciones,sep="_")
OUT
}

## Experimento:
Q<-c()
for (i in 1:107)
    {
    poblacion1 <- deriva.tiempo(NA1=50,NA2=50,Npop=16,Ngeneraciones=19,plot=F)
    Q<-rbind(Q,apply(poblacion1,1,function(x) x[2]/2+x[3]))
    }
dimnames(Q)<-list(paste("Poblacion",1:nrow(Q),sep=""),paste("Generacion",1:ncol(Q)))

## Gráficas:
hist(rep(0.5,nrow(Q)/3),breaks=c(0.45,0.55), col="red",xlim=c(0,1),ylim=c(0,100),main=paste("Generacion",0),n=10,xlab="q en cada población",ylab="Frecuencia")
    Sys.sleep(0.5)
for(i in 2:ncol(Q))
    {
    hist(Q[,i],col="red",xlim=c(0,1),ylim=c(0,100),main=paste("Generacion",(i-1)),n=10,xlab="q en cada población",ylab="Frecuencia")
    Sys.sleep(0.5)
    }