examen

Índice

1 Instrucciones

  • Hay que justificar todas las respuestas.
  • Crea en tu carpeta personal de carleos2.epv.uniovi.es un directorio llamado A.DD.2-examen2020enero y pon dentro todos los documentos que consideres necesarios para responder a los enunciados de abajo. No modifiques los contenidos de esa carpeta tras acabar el examen.

2 Enunciados

  1. (2 puntos) Considera los datos carleos2.epv.uniovi.es:/home/manadine/dat/jacatón

    Considera los ficheros MetadatosHackathon.csv (con PGRASADC) y pedigriHackathon.txt (vaca, padre, madre; 0 desconocido).

    Entrégame un fichero .rda que contenga un dataframe tal que

    • cada fila corresponde a un padre; el identificador del padre debe ser el correspondiente rowname
    • tenga una única columna que, en cada fila, contenga la PGRASADC media de las vacas hijas del padre correspondiente a esa fila
    • esté ordenado por valor de la variable: deben aparecer primero los mayores valores de PGRASADC media
  2. (1 punto) Explica qué diferencias hay entre parallel::mclapply y parallel::mcparallel

    ¿Qué ventajas e inconvenientes tiene cada uno?

    Pon un ejemplo que demuestre la diferencia entre ambos (verbigracia, puedes usar Sys.sleep, system.time…).

  3. (2 puntos) Sea la muestra:
    x <- c(1.02, 0.87, 0.89, 0.56, 0.39, 1.05, 0.66, 0.64, 0.61, 0.78, 0.50,
           0.58, 0.80, 1.45, 1.05, 0.60, 0.54, 0.25, 0.72, 1.23, 0.35, 0.53,
           0.61, 0.78, 1.04, 1.23, 0.47, 0.51, 1.45, 1.05, 0.66, 0.85, 0.86,
           0.41, 1.38, 0.50, 0.17, 0.97, 0.81, 1.12, 1.27, 1.23, 0.78, 0.64,
           0.71, 0.47, 0.77, 0.90, 1.21, 0.40, 0.86, 0.82, 0.67, 0.55, 1.04,
           0.98, 0.57, 0.84, 1.09, 0.81, 1.20, 1.72, 0.53, 0.54, 1.18, 0.69,
           1.79, 1.09, 0.38, 0.50, 1.06, 1.35, 0.69, 0.76, 1.46)
    

    Supongamos que proviene de una población con distribución gama. Estima sus dos parámetros mediante máxima verosimilitud, sabiendo que

    • la densidad de una gama en R se consigue con la función dgamma
    • la verosimilitud de una muestra es el producto de las densidades de cada observación
    • la logverosimilitud de una muestra es la suma de los logaritmos de las densidades de cada observación
    • dgamma tiene una opción llamada log
    • los parámetros que maximizan la verosimilitud maximizan también la logverosimilitud
  4. (2 puntos) En R, considera el problema del viajante aplicado a los datos eurodist

    Implementa un algoritmo genético para resolver tal problema. Puedes inspirarte mirando ?optim

3 Soluciones

3.1 PGRASADC media de las vacas hijas

karleoj@bellman:~  $ ssh karleoj@carleos2.epv.uniovi.es
karleoj@carleos2:~ $ R
meta <- read.csv("/home/manadine/dat/jacatón/MetadatosHackathon.csv")
pedi <- read.table("/home/manadine/dat/jacatón/pedigriHackathon.txt", na.string="0")
names(pedi) <- c("vaca","padre","madre")
dato <- merge(meta, pedi, by.x="x", by.y="vaca")
medias <- aggregate(dato$PGRASADC, list(dato$padre), mean, na.rm=TRUE)
rownames(medias) <- medias$Group.1
medias$Group.1 <- NULL
medias <- medias[order(medias,decreasing=TRUE),,drop=FALSE]
system("mkdir ~/A.DD.2-examen2020enero")
save(medias,file="~/A.DD.2-examen2020enero/ejercicio1.rda")

3.2 mclapply y mcparallel

  • definiciones
    mcparallel
    función que lanza un programa de R para que se ejecute en paralelo; se ejecuta varias veces para que varios programas se ejecuten en paralelo en varios hilos; devuelve un objeto que puede ser usado luego por mccollect; los programas lanzados son expresiones (no usan parámetros);
    mclapply
    función que lanza varios programas en R en paralelo (en varios hilos) y devuelve una lista con sus resultados; los programas lanzados son funciones, cada una depende de un parámetro (obtenido del primer argumento de mclapply);
  • ventajas
    mclapply
    más cómoda de usar porque se ocupa de devolver los resultados;
    mcparallel
    más eficiente porque no hace falta que terminen todos los hilos; en cualquier momento se pueden obtener mediante mccollect los resultados de los hilos que sí han terminado;
  • inconvenientes
    mclapply
    hay que esperar a que acaben todos los hilos para chequear los resultados;
    mcparallel
    más difícil de usar porque hay que recurrir a mccollect para recoger los resultados;
  • recomendaciones de uso
    mclapply
    úsese cuando se necesitan los resultados de todos los hilos;
    mcparallel
    úsese cuando basta con que un hilo termine y el tiempo de ejecución importa;
  • ejemplo
    trabajo <- function (n) {Sys.sleep (n); cat ("acabé en", n, "s\n")} # espera "n" segundos  
    library (parallel)
    
    • mclapply
      system.time (resultados <- mclapply (c(10,30), trabajo)) # tarda aproximadamente 30 segundos
      resultados                                               # devuelve una lista de tamaño 2
      
    • mcparallel
      inicio <- proc.time()
      trabajos <- lapply (c(10,30), function (n) mcparallel (trabajo (n)))
      while (length (resultados <- mccollect (trabajos, wait=FALSE)) == 0) 
          Sys.sleep (1)    # espera 1 segundo para volver a chequear
      proc.time() - inicio # aprox. 10 segundos; no espera a que termine el trabajo de 30 segundos
      resultados           # lista de tamaño 1
      

3.3 máxima verosimilitud

x <- c(1.02, 0.87, 0.89, 0.56, 0.39, 1.05, 0.66, 0.64, 0.61, 0.78, 0.50,
       0.58, 0.80, 1.45, 1.05, 0.60, 0.54, 0.25, 0.72, 1.23, 0.35, 0.53,
       0.61, 0.78, 1.04, 1.23, 0.47, 0.51, 1.45, 1.05, 0.66, 0.85, 0.86,
       0.41, 1.38, 0.50, 0.17, 0.97, 0.81, 1.12, 1.27, 1.23, 0.78, 0.64,
       0.71, 0.47, 0.77, 0.90, 1.21, 0.40, 0.86, 0.82, 0.67, 0.55, 1.04,
       0.98, 0.57, 0.84, 1.09, 0.81, 1.20, 1.72, 0.53, 0.54, 1.18, 0.69,
       1.79, 1.09, 0.38, 0.50, 1.06, 1.35, 0.69, 0.76, 1.46)
logverosimilitud <- function (p.a) sum (dgamma (x, p.a[1], p.a[2], log=TRUE))
optim (c(1,1), logverosimilitud, control=list(fnscale=-1)) $ par # estimaciones de los parámetros "p" y "a"

3.4 viajante genético

### definiciones inspiradas en «?optim»
eurodistmat <- as.matrix(eurodist)
distance <- function(sq) {  # Target function
    sq  <- c (sq, 1)        # añadimos vuelta al origen
    sq2 <- embed(sq, 2)
    sum(eurodistmat[cbind(sq2[,2], sq2[,1])])
}
aptitud <- function (secuencia) - distance (secuencia) # cambio de signo

### implementación completa: basada en la de nReinas
nRei    <- nrow(eurodistmat) # cálculo del tamaño de las permutaciones
nPob    <- 100
tasaCan <- 0.05
nIte    <- 1000              # debería ser mayor para acercarse al óptimo
tasaMut <- 1
## inicializacio'n
pob <- lapply (1:nPob, function (i) sample (nRei))
aptitudes.medias <- c()
aptitudes.mejores <- c()
## evolucio'n
for (i in 1:nIte) {
    iCandidatos  <- sample (nPob, round(tasaCan*nPob))
    aptitudesCan <- sapply (iCandidatos, function (i) aptitud (pob [[i]]))
    iPadres      <- order (aptitudesCan, decreasing = TRUE) [1:2]
    padres       <- pob [iCandidatos] [iPadres]
    pos          <- sample (nRei, 1)
    hijo1        <- c (padres[[1]][1:pos],
                       setdiff (padres[[2]], padres[[1]][1:pos])) 
    hijo2        <- c (padres[[2]][1:pos],
                       setdiff (padres[[1]], padres[[2]][1:pos]))
    if (rbinom (1, 1, tasaMut))
        {
            ij <- sample (nRei, 2)
            hijo1[ij] <- hijo1[rev(ij)]
        }
    if (rbinom (1, 1, tasaMut))
        {
            ij <- sample (nRei, 2)
            hijo2[ij] <- hijo2[rev(ij)]
        }
    pob       <- c (pob, list (hijo1, hijo2))
    aptitudes <- sapply (pob, aptitud)
    iMejores  <- order (aptitudes, decreasing=TRUE) [1:nPob]
    pob       <- pob[iMejores]
    aptitud.mejor     <- aptitud (pob[[1]])
    aptitudes.mejores <- c (aptitudes.mejores, aptitud.mejor)
    aptitud.media     <- mean (aptitudes)
    aptitudes.medias  <- c (aptitudes.medias, aptitud.media)
    plot (1:i, aptitudes.mejores)
    lines (1:i, aptitudes.medias)
    ## if (aptitud.mejor == 1) break # inútil en este problema
}
cat ("La mejor solucion es", pob[[1]], "cuya aptitud es", aptitud.mejor, ".\n")

### implementación usando biblioteca
install.packages ("GA")
library ("GA")
a <- ga("permutation", aptitud, lower=1, upper=nrow(eurodistmat),
        maxiter=10000)   # debería ser mayor
a@solution               # mejor ruta
-a@fitnessValue          # mejor distancia = -aptitud(a@solution)

Autor: Carlos Enrique Carleos Artime

Created: 2020-01-18 sáb 09:31

Emacs 25.2.2 (Org mode 8.2.10)

Validate