Los datos adjuntos (abajo) son estimaciones de la resistencia de distintas líneas parentales de camote (Ipomoea batatas) a distintas especies de herbívoro. Primero, hay un Complejo de especies denominado wireworm-Diabrotica-Systema (WDS) y hay cuatro estimadores. Del escarabajo del camote (Chaetocnema confinis, hay dos estimadores; y finalmente hay un estimado global de resistencia para todos los herbívoros (última columna).
Las evaluaciones consisten en a. % de raíces dañadas, b. hoyos por raíz, c. índice de severidad, y d. score de daño por WDS, y e. % de raíces dañadas y f. túneles por raíz por Chaetocnema. Finalmente, se obtuvo g. el daño por todos los insectos como el % de raíces dañadas. (También les proporciono el archivo Excel)

En la Parte 1 de la tarea, calcular la heredabilidad (h2) de cada carácter de resistencia medido. P = parental y O offspring (hijos).

Datos

# Importar los datos desde el archivo CSV
getwd()

## [1] "C:/Users/mrube/Documents/Maestría/Segundo semestre/Genetica Cuantitativa"

datos <- read.csv("Ipomea.csv", sep = ",", header = TRUE)
datos_clean <- (datos[1:22,])

# Mostrar las primeras filas de los datos
head(datos_clean) %>% kable()

Parental.line	Roots.injured.P	Roots.injured.O	Holes.per.root.P	Holes.per.root.O	Severity.index.P	Severity.index.O	Damage.score.P	Damage.score.O	X..roots..Inj.SPBeetle.P	X..roots..Inj.SPBeetle.O	Tunnels.root.SPB.P	Tunnels.root.SPB.O	X..roots.inj.insects.P	X..roots.inj.insects.O
w-178	64.0	37.8	2.50	0.87	0.81	0.43	1.59	1.34	63.3	18.4	1.52	0.26	70.3	47.6
w-2	68.0	38.7	1.97	1.12	0.79	0.45	1.41	1.48	25.0	19.9	0.31	0.40	72.7	47.6
w-3	63.3	31.2	2.03	0.94	0.73	0.38	1.59	1.29	2.0	10.9	0.02	0.09	63.3	38.1
w-4	41.3	33.0	1.22	1.06	0.49	0.40	1.59	1.40	20.0	11.5	0.28	0.13	63.0	39.0
w-8	14.0	23.2	0.19	0.45	0.14	0.24	1.05	1.19	2.3	6.9	0.02	0.10	20.3	27.3
w-9	16.0	30.3	0.25	0.60	0.17	0.31	1.03	1.40	0.0	9.0	0.00	0.16	16.0	39.0

Limpieza y preparación de datos

# Comprobar si hay valores faltantes
sum(is.na(datos))

## [1] 13678

Cálculo de heredabilidad (h²)

La heredabilidad en sentido estricto (h²) se puede calcular mediante regresión progenitor-descendencia.

Porcentaje de raíces dañadas
Hoyos por raíz
Índice de severidad
Score de daño por WDS
Porcentaje de raíces dañadas por Chaetocnema (SPBeetle)
Túneles por raíz por Chaetocnema (SPB)
Porcentaje de raíces dañadas por todos los insectos

calcular_heredabilidad <- function(datos, var_parental, var_offspring, nombre_var) {
  
  df_analisis <- data.frame(
    parental = datos[[var_parental]],
    offspring = datos[[var_offspring]]
  )
  
  
  # Calcular la regresión lineal
  modelo <- lm(offspring ~ parental, data = df_analisis)
  
  resumen <- summary(modelo)
  
  heredabilidad <- coef(modelo)[2]
  r2 <- resumen$r.squared
  error_estandar <- sqrt(vcov(modelo)[2,2])
  
  # Gráfico 
  p <- ggplot(df_analisis, aes(x = parental, y = offspring)) +
    geom_point(size = 3, alpha = 0.7) +
    geom_smooth(method = "lm", se = TRUE, color = "blue") +
    labs(
      title = paste("Heredabilidad de", nombre_var),
      subtitle = paste("h2 =", round(heredabilidad, 3), "± SE =", round(error_estandar, 3), "| R2 =", round(r2, 3)),
      x = "Padres (P)",
      y = "Hijos (O)"
    ) +
    theme_bw() +
    theme(
      plot.title = element_text(hjust = 0.5, face = "bold"),
      plot.subtitle = element_text(hjust = 0.5)
    )
  
  return(list(
    heredabilidad = heredabilidad,
    r2 = r2,
    error_estandar = error_estandar,
    grafico = p,
    modelo = modelo
  ))
}

Análisis de heredabilidad para cada carácter

1. Porcentaje de raíces dañadas

h2_raices_dañadas <- calcular_heredabilidad(
  datos_clean, 
  "Roots.injured.P", 
  "Roots.injured.O", 
  "Porcentaje de raíces dañadas"
)

# Mostrar el gráfico
h2_raices_dañadas$grafico

# Resumen del modelo
tidy(h2_raices_dañadas$modelo) %>% kable(digits = 3)

term	estimate	std.error	statistic	p.value
(Intercept)	18.879	3.275	5.765	0.000
parental	0.225	0.060	3.770	0.001

2. Hoyos por raíz

h2_hoyos <- calcular_heredabilidad(
  datos_clean, 
  "Holes.per.root.P", 
  "Holes.per.root.O", 
  "Hoyos por raíz"
)

# Mostrar el gráfico
h2_hoyos$grafico

# Resumen del modelo
tidy(h2_hoyos$modelo) %>% kable(digits = 3)

term	estimate	std.error	statistic	p.value
(Intercept)	0.543	0.088	6.146	0.000
parental	0.159	0.043	3.697	0.001

3. Índice de severidad

h2_severidad <- calcular_heredabilidad(
  datos_clean, 
  "Severity.index.P", 
  "Severity.index.O", 
  "Índice de severidad"
)

# Mostrar el gráfico
h2_severidad$grafico

# Resumen del modelo
tidy(h2_severidad$modelo) %>% kable(digits = 3)

term	estimate	std.error	statistic	p.value
(Intercept)	0.229	0.040	5.722	0.000
parental	0.186	0.057	3.251	0.004

4. Score de daño

h2_score <- calcular_heredabilidad(
  datos_clean, 
  "Damage.score.P", 
  "Damage.score.O", 
  "Score de daño"
)

# Mostrar el gráfico
h2_score$grafico

# Resumen del modelo
tidy(h2_score$modelo) %>% kable(digits = 3)

term	estimate	std.error	statistic	p.value
(Intercept)	1.032	0.132	7.812	0.000
parental	0.193	0.088	2.203	0.039

5. Porcentaje de raíces dañadas por Chaetocnema (SPBeetle)

h2_raices_spb <- calcular_heredabilidad(
  datos_clean, 
  "X..roots..Inj.SPBeetle.P", 
  "X..roots..Inj.SPBeetle.O", 
  "Porcentaje de raíces dañadas por Chaetocnema"
)

# Mostrar el gráfico
h2_raices_spb$grafico

# Resumen del modelo
tidy(h2_raices_spb$modelo) %>% kable(digits = 3)

term	estimate	std.error	statistic	p.value
(Intercept)	7.818	1.073	7.286	0
parental	0.202	0.037	5.417	0

6. Túneles por raíz por Chaetocnema (SPB)

h2_tuneles <- calcular_heredabilidad(
  datos_clean, 
  "Tunnels.root.SPB.P", 
  "Tunnels.root.SPB.O", 
  "Túneles por raíz por Chaetocnema"
)

# Mostrar el gráfico
h2_tuneles$grafico

# Resumen del modelo
tidy(h2_tuneles$modelo) %>% kable(digits = 3)

term	estimate	std.error	statistic	p.value
(Intercept)	0.140	0.024	5.858	0.000
parental	0.125	0.039	3.160	0.005

7. Porcentaje de raíces dañadas por todos los insectos

h2_todos_insectos <- calcular_heredabilidad(
  datos_clean, 
  "X..roots.inj.insects.P", 
  "X..roots.inj.insects.O", 
  "Porcentaje de raíces dañadas por todos los insectos"
)

# Mostrar el gráfico
h2_todos_insectos$grafico

# Resumen del modelo
tidy(h2_todos_insectos$modelo) %>% kable(digits = 3)

term	estimate	std.error	statistic	p.value
(Intercept)	22.577	3.893	5.800	0
parental	0.267	0.062	4.313	0

Resumen de heredabilidades

Resumen de heredabilidades (h²) para los caracteres de resistencia
Carácter	Heredabilidad_h2	Error_Estándar	R_cuadrado
Porcentaje de raíces dañadas	0.225	0.060	0.415
Hoyos por raíz	0.159	0.043	0.406
Índice de severidad	0.186	0.057	0.346
Score de daño	0.193	0.088	0.195
Porcentaje de raíces dañadas por Chaetocnema	0.202	0.037	0.595
Túneles por raíz por Chaetocnema	0.125	0.039	0.333
Porcentaje de raíces dañadas por todos los insectos	0.267	0.062	0.482

PARTE 2

h2_valores <- list(
  "Roots.injured.P" = h2_raices_dañadas$heredabilidad,
  "Holes.per.root.P" = h2_hoyos$heredabilidad,
  "Severity.index.P" = h2_severidad$heredabilidad,
  "Damage.score.P" = h2_score$heredabilidad,
  "X..roots..Inj.SPBeetle.P" = h2_raices_spb$heredabilidad,
  "Tunnels.root.SPB.P" = h2_tuneles$heredabilidad,
  "X..roots.inj.insects.P" = h2_todos_insectos$heredabilidad
)

Función

# Definir los pares de caracteres para calcular correlaciones genéticas
pares_caracteres <- list(
  list(
    nombre1 = "Porcentaje de raíces dañadas",
    nombre2 = "Hoyos por raíz",
    var1_p = "Roots.injured.P",
    var1_o = "Roots.injured.O",
    var2_p = "Holes.per.root.P",
    var2_o = "Holes.per.root.O"
  ),
  list(
    nombre1 = "Porcentaje de raíces dañadas",
    nombre2 = "Índice de severidad",
    var1_p = "Roots.injured.P",
    var1_o = "Roots.injured.O",
    var2_p = "Severity.index.P",
    var2_o = "Severity.index.O"
  ),
  list(
    nombre1 = "Hoyos por raíz",
    nombre2 = "Índice de severidad",
    var1_p = "Holes.per.root.P",
    var1_o = "Holes.per.root.O",
    var2_p = "Severity.index.P",
    var2_o = "Severity.index.O"
  ),
  list(
    nombre1 = "Porcentaje de raíces dañadas por Chaetocnema",
    nombre2 = "Túneles por raíz por Chaetocnema",
    var1_p = "X..roots..Inj.SPBeetle.P",
    var1_o = "X..roots..Inj.SPBeetle.O",
    var2_p = "Tunnels.root.SPB.P",
    var2_o = "Tunnels.root.SPB.O"
  ),
  list(
    nombre1 = "Porcentaje de raíces dañadas",
    nombre2 = "Porcentaje de raíces dañadas por todos los insectos",
    var1_p = "Roots.injured.P",
    var1_o = "Roots.injured.O",
    var2_p = "X..roots.inj.insects.P",
    var2_o = "X..roots.inj.insects.O"
  )
)

# Calcular las correlaciones genéticas para todos los pares definidos
resultados_correlaciones <- lapply(pares_caracteres, function(par) {
  resultado <- calcular_correlacion_genetica(
    datos_clean,
    par$var1_p,
    par$var1_o,
    par$var2_p,
    par$var2_o
  )
  
  return(data.frame(
    Caracter1 = par$nombre1,
    Caracter2 = par$nombre2,
    Correlacion_Genetica = resultado$correlacion_genetica_m2,
    Correlacion_Fenotipica = resultado$correlacion_fenotipica,
    h2_Caracter1 = resultado$h2_var1,
    h2_Caracter2 = resultado$h2_var2,
    Error_Estandar = resultado$error_estandar,
    N = resultado$n_observaciones
  ))
})

# Combinar todos los resultados en un único dataframe
tabla_correlaciones <- do.call(rbind, resultados_correlaciones)

# Mostrar la tabla de correlaciones genéticas
tabla_correlaciones %>%
  kable(digits = 3,
        caption = "Correlaciones genéticas (rG) entre caracteres de resistencia")

Correlaciones genéticas (rG) entre caracteres de resistencia
	Caracter1	Caracter2	Correlacion_Genetica	Correlacion_Fenotipica	h2_Caracter1	h2_Caracter2	Error_Estandar	N
parental	Porcentaje de raíces dañadas	Hoyos por raíz	1.022	0.912	0.225	0.159	0.010	22
parental1	Porcentaje de raíces dañadas	Índice de severidad	1.018	0.957	0.225	0.186	0.008	22
parental2	Hoyos por raíz	Índice de severidad	1.004	0.986	0.159	0.186	0.002	22
parental3	Porcentaje de raíces dañadas por Chaetocnema	Túneles por raíz por Chaetocnema	1.041	0.981	0.202	0.125	0.019	22
parental4	Porcentaje de raíces dañadas	Porcentaje de raíces dañadas por todos los insectos	1.006	0.942	0.225	0.267	0.003	22

PARTE 3

# porcentaje de raíces dañadas
caracter_seleccion <- "Roots.injured.P"
caracter_respuesta <- "Roots.injured.O"
nombre_caracter <- "Porcentaje de raíces dañadas"

#  (z-scores)
datos_seleccion <- datos_clean %>%
  mutate(
    valor_original = .data[[caracter_seleccion]],
    media_poblacion = mean(valor_original, na.rm = TRUE),
    desviacion_std = sd(valor_original, na.rm = TRUE),
    z_score = (valor_original - media_poblacion) / desviacion_std
  )


proporcion_seleccion <- 0.3
punto_truncamiento <- quantile(datos_seleccion$valor_original, proporcion_seleccion, na.rm = TRUE)

#  individuos seleccionados
datos_seleccion <- datos_seleccion %>%
  mutate(seleccionado = valor_original <= punto_truncamiento)

# diferencial de selección 
media_seleccionados <- mean(datos_seleccion$valor_original[datos_seleccion$seleccionado], na.rm = TRUE)
S <- media_seleccionados - datos_seleccion$media_poblacion[1]

# observadO en la descendencia
media_descendencia_total <- mean(datos_clean[[caracter_respuesta]], na.rm = TRUE)

media_descendencia_seleccionados <- mean(
  datos_clean[[caracter_respuesta]][datos_seleccion$seleccionado], 
  na.rm = TRUE
)

# Respuesta observada 
R_observada <- media_descendencia_seleccionados - datos_seleccion$media_poblacion[1]

h2 <- h2_raices_dañadas$heredabilidad
R_esperada <- S * h2

#  resultados
resultados_seleccion <- data.frame(
  Medida = c("Media población inicial", 
             "Media individuos seleccionados", 
             "Media descendencia total",
             "Media descendencia de seleccionados",
             "Diferencial de selección",
             "h2",
             "Respuesta observada (R)",
             "Respuesta esperada"),
  Valor = c(datos_seleccion$media_poblacion[1],
            media_seleccionados,
            media_descendencia_total,
            media_descendencia_seleccionados,
            S,
            h2,
            R_observada,
            R_esperada)
)

kable(resultados_seleccion, 
      digits = 3,
      caption = paste("Resultados de selección ", nombre_caracter))

Resultados de selección Porcentaje de raíces dañadas
Medida	Valor
Media población inicial	50.205
Media individuos seleccionados	26.271
Media descendencia total	30.177
Media descendencia de seleccionados	24.529
Diferencial de selección	-23.933
h2	0.225
Respuesta observada (R)	-25.676
Respuesta esperada	-5.386

Cálculo de heredabilidad en caracteres de resistencia de Ipomoea batatas

Rubén Muñoz

16 de mayo de 2025