Antes de começar a responder as perguntas, vamos carregar os pacotes necessários para a análise de dados:
library(tidyverse)
library(readxl)
O primeiro exemplo de associação entre um lócus marcador e um caractere quantitativo foi o reportado por Karl Sax em 1923. Tratava-se da relação entre o genótipo num lócus que controlava a pigmentação do olho (cor de uma área do grão) e o peso da semente, no feijão Phaseolus vulgaris. Uma das linhagens parentais (Improved Yellow Eye 1317) era homozigota para um gene dominante de pigmentação (P) e tinha sementes com peso médio de 48 centigramas (cg). A outra linhagem parental (White 1228) era homozigota para um alelo recessivo de pigmentação (p) e tinha sementes de peso médio igual a 21 (cg). Cruzando estas parentais para produzir uma F1 e depois cruzando plantas desta F1 entre si para produzir uma F2 , os seguintes genótipos no lócus de pigmentação (marcador***) e o peso médio das sementes foram observados:
# Questão 1
## Criando o dataset a ser utilizado (é a tabela disponibilizada)
q1 <- tibble(gen = c("PP", "Pp", "pp"),
peso = c(30.7, 28.3, 26.4))
q1
## # A tibble: 3 × 2
## gen peso
## <chr> <dbl>
## 1 PP 30.7
## 2 Pp 28.3
## 3 pp 26.4
## Calculando o valor intermediário entre os homozigotos
q1_valor_interm <- (q1[q1$gen == "PP", ][["peso"]] + q1[q1$gen == "pp", ][["peso"]]) / 2
q1_valor_interm
## [1] 28.55
# Valor de Aditividade (homozigotos menos o valor intermediário)
q1[q1$gen == "PP", ][["peso"]] - q1_valor_interm
## [1] 2.15
q1[q1$gen == "pp", ][["peso"]] - q1_valor_interm
## [1] -2.15
# Valor de Dominância (o quanto o heterozigoto desvia do valor intermediário)
q1[q1$gen == "Pp", ][["peso"]] - q1_valor_interm
## [1] -0.25
# Diferença entre os dois homozigotos F2
q1[q1$gen == "PP", ][["peso"]] - q1[q1$gen == "pp", ][["peso"]]
## [1] 4.3
# Diferença original P
48 - 21
## [1] 27
# 27 - 100%
# 4.3 - X
(4.3 * 100)/27
## [1] 15.92593
## X = 15.92593
Algum QTLs está afetando o peso da semente nesta população? Há QTLs afetando o peso da semente. Vemos que o locus associado à pigmentação está tendo algum tipo de efeito sobre o tamanho da semente. Existe a chance de não ser especificamente esse locus que esteja afetando o tamanho da semente, mas sim outro locus (ou loci) em desequilíbrio com esse primeiro.
Onde está localizado este QTL (pense no marcador). O QTL está localizado na região que compreende o locus da questão, que se refere a pigmentação da semente.
Há outro gene afetando o peso da semente ou neste caso pode ser o próprio marcador? Outros genes em desequilíbrio de ligação podem estar afetando o peso da semente, e não necessariamente o marcador em si.
Se o efeito sobre o tamanho vier de um gene ligado ao marcador, então o efeito estimado em % só vale se não tiver recombinação entre o marcador e o gene em questão, certo? No caso desse estudo, sim, uma vez que foi utilizado linhagens diferentes para a pigmentação da semente, e, portanto, é dessa forma que vemos diferença de tamanho entre as populações. Caso houver recombinação entre o marcador e o gene em questão, o efeito ainda existirá, mas precisaríamos procurar por outros marcadores para entender como diferenciar os grupos.
O efeito sobre os fenótipos poderia ser de um gene com efeito muito forte sobre fenótipo peso, mas fracamente ligado ao marcador? Não pode ter recombinação entre o marcador e os loci afetando o fenótipo sob estudo
Finalmente, o QTL identificado poderia não ser explicado não à ligação a um gene, mas sim a dois ou mais genes ligados ao marcador? Sim, uma vez que QTL é uma região genômica que pode potencialmente englobar diversos genes.
No esquema abaixo está representado um cromossomo do par 9 da espécie de roedor Dentus dentussus com algumas posições demarcadas. Para cada posição, temos o valor fenotípico médio do carácter tamanho do crânio de cada um dos genótipos. Responda.
Onde está localizado o QTL de maior efeito?
Qual é o padrão de herança envolvido (aditividade ou dominância)?
Faça um gráfico que represente a variação dos valores de efeito aditivo ao longo do cromossomo. Faça o mesmo para representar a variação dos valores de efeito de dominância.
library(tidyverse)
q2 <- tibble(pos = c(0, 10, 20, 30, 40),
AA = c(15.2, 16.3, 17.3, 15.8, 16),
AB = c(15.2, 16.6, 19.4, 16.4, 16.2),
BB = c(15.2, 16.9, 21.3, 16.8, 16.4))
q2 |>
mutate(ponto_interm = (AA + BB)/2,
a1 = BB - ponto_interm,
d = AB - ponto_interm) |>
pivot_longer(c(a1, d), names_to = "type", values_to = "values") |>
ggplot(aes(pos, values, color = type)) +
geom_point(size = 3) +
geom_line() +
scale_color_discrete(name = "Tipo do Efeito") +
labs(x = "Posição",
y = "Valor dos Efeitos") +
theme_bw()
Vamos usar a base de dados com as medidas de vocês para esta última parte da aula. A planilha “Filial e Parental bio 208 2022 - com genotipos dois cromossomos (final)”, disponivel na aula 10, organiza os dados de vocês e da geração parental para altura, peso e tamanho do pé de forma que todos os dados estejam na mesma coluna (altura para ambas as gerações, peso para ambas as gerações assim como o tamanho do pé). Além disso já são apresentados como desvios às médias de cada grupo (valor para cada meninas - média das meninas; valor para cada menino - média dos meninos, valor para cada mãe-média das mães, e assim sucessivamente).
R: Nesses dados, estamos lidando com dois loci: um no cromossomo 17 e outro no cromossomo 3. Para cada caráter morfológico, apresento a relação entre os valores genotípicos e fenotípicos através de um gráfico de dispersão e pelo modelo linear. É legal lembrar que, através do modelo de regressão dos fenótipos observados pelos genótipos, podemos ver o efeito médio de substituição de um alelo. Basicamente, se pegarmos um alelo e trocarmos pelo outro, o efeito na média da população é igual a um valor que corresponde à inclinação da reta de regressão. Além do modelo linear, apresento também os valores aditivos e de dominância para cada loci
q4 <- readxl::read_xls("./aula_qtl/Filial e Parental bio 208 2022 - com genotipos dois cromossomos (final) aula 11.xls")
# Cromossomo 17 Alelos e Genótipos
homoAA <- q4[q4$Gen1_cromo17 == "AA", ]
homoaa <- q4[q4$Gen1_cromo17 == "aa", ]
heteAa <- q4[q4$Gen1_cromo17 == "Aa", ]
freq_chr17 <- q4 |>
select(Gen1_cromo17) |>
group_by(Gen1_cromo17) |>
summarise(n = n()) |>
mutate(freq = n / sum(n))
freq_A <- freq_chr17[freq_chr17$Gen1_cromo17 == "AA", ][["freq"]] + ((freq_chr17[freq_chr17$Gen1_cromo17 == "Aa", ][["freq"]]) / 2)
freq_a <- freq_chr17[freq_chr17$Gen1_cromo17 == "aa", ][["freq"]] + ((freq_chr17[freq_chr17$Gen1_cromo17 == "Aa", ][["freq"]]) / 2)
# Cromossomo 3 Alelos e Genótipos
homoBB <- q4[q4$Gen2_cromo3 == "BB", ]
homobb <- q4[q4$Gen2_cromo3 == "bb", ]
heteBb <- q4[q4$Gen2_cromo3 == "Bb", ]
freq_chr3 <- q4 |>
select(Gen2_cromo3) |>
group_by(Gen2_cromo3) |>
summarise(n = n()) |>
mutate(freq = n / sum(n))
freq_B <- freq_chr3[freq_chr3$Gen2_cromo3 == "BB", ][["freq"]] + ((freq_chr3[freq_chr3$Gen2_cromo3 == "Bb", ][["freq"]])/2)
freq_b <- freq_chr3[freq_chr3$Gen2_cromo3 == "bb", ][["freq"]] + ((freq_chr3[freq_chr3$Gen2_cromo3 == "Bb", ][["freq"]])/2)
# Chr 17
## Altura
lm_chr17_alt <- lm(Des_Altura ~ Ge1_N_cromo17, data = q4)
summary(lm_chr17_alt)
##
## Call:
## lm(formula = Des_Altura ~ Ge1_N_cromo17, data = q4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -12.5981 -2.9194 -0.3391 2.9093 12.0448
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7.5448 0.6841 -11.03 <2e-16 ***
## Ge1_N_cromo17 7.1219 0.5277 13.50 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.766 on 142 degrees of freedom
## Multiple R-squared: 0.5619, Adjusted R-squared: 0.5588
## F-statistic: 182.1 on 1 and 142 DF, p-value: < 2.2e-16
q4 |>
ggplot(aes(Ge1_N_cromo17, Des_Altura)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(y = "Desvio Altura", x = "Genótipo Cromossomo 17") +
theme_bw()
## `geom_smooth()` using formula 'y ~ x'
ponto_interm <- (mean(homoAA$Des_Altura) + mean(homoaa$Des_Altura)) / 2
### a
mean(homoAA$Des_Altura) - ponto_interm
## [1] 7.077288
### d
mean(heteAa$Des_Altura) - ponto_interm
## [1] -1.057131
### Alfa = (a + d) * q + (a - d) * p = a + (q - p) * d
(mean(homoAA$Des_Altura) - ponto_interm) + (freq_a - freq_A) * mean(heteAa$Des_Altura) - ponto_interm
## [1] 7.099287
## Peso 1
lm_chr17_peso1 <- lm(Des_Peso_1 ~ Ge1_N_cromo17, data = q4)
summary(lm_chr17_peso1)
##
## Call:
## lm(formula = Des_Peso_1 ~ Ge1_N_cromo17, data = q4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -21.440 -8.024 -2.266 6.689 66.976
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -7.891 1.710 -4.615 8.69e-06 ***
## Ge1_N_cromo17 7.307 1.319 5.541 1.42e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 11.91 on 142 degrees of freedom
## Multiple R-squared: 0.1778, Adjusted R-squared: 0.172
## F-statistic: 30.7 on 1 and 142 DF, p-value: 1.419e-07
q4 |>
ggplot(aes(Ge1_N_cromo17, Des_Peso_1)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(y = "Desvio Peso 1", x = "Genótipo Cromossomo 17") +
theme_bw()
## `geom_smooth()` using formula 'y ~ x'
ponto_interm <- (mean(homoAA$Des_Peso_1) + mean(homoaa$Des_Peso_1))/2
### a
mean(homoAA$Des_Peso_1) - ponto_interm
## [1] 7.291621
### d
mean(heteAa$Des_Peso_1) - ponto_interm
## [1] -0.3734204
### Alfa = (a + d) * q + (a - d) * p = a + (q - p) * d
(mean(homoAA$Des_Peso_1) - ponto_interm) + (freq_a - freq_A) * (mean(heteAa$Des_Peso_1) - ponto_interm)
## [1] 7.312366
## Peso 2
lm_chr17_peso2 <- lm(Desvio_peso_2 ~ Ge1_N_cromo17, data = q4)
summary(lm_chr17_peso2)
##
## Call:
## lm(formula = Desvio_peso_2 ~ Ge1_N_cromo17, data = q4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -21.5625 -7.1907 -0.2678 5.4341 30.3347
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5.564 1.326 -4.195 4.78e-05 ***
## Ge1_N_cromo17 5.103 1.023 4.988 1.76e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.239 on 142 degrees of freedom
## Multiple R-squared: 0.1491, Adjusted R-squared: 0.1431
## F-statistic: 24.88 on 1 and 142 DF, p-value: 1.756e-06
q4 |>
ggplot(aes(Ge1_N_cromo17, Desvio_peso_2)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(y = "Desvio Peso 2", x = "Genótipo Cromossomo 17") +
theme_bw()
## `geom_smooth()` using formula 'y ~ x'
ponto_interm <- (mean(homoAA$Desvio_peso_2) + mean(homoaa$Desvio_peso_2))/2
### a
mean(homoAA$Desvio_peso_2) - ponto_interm
## [1] 5.069335
### d
mean(heteAa$Desvio_peso_2) - ponto_interm
## [1] -0.7926284
### Alfa = (a + d) * q + (a - d) * p = a + (q - p) * d
(mean(homoAA$Desvio_peso_2) - ponto_interm) + (freq_a - freq_A) * (mean(heteAa$Desvio_peso_2) - ponto_interm)
## [1] 5.11337
## Comprimento do Pé
lm_chr17_pe <- lm(Desvio_Pé ~ Ge1_N_cromo17, data = q4)
summary(lm_chr17_pe)
##
## Call:
## lm(formula = Desvio_Pé ~ Ge1_N_cromo17, data = q4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.3635 -0.9262 -0.0093 0.9907 5.2194
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.3032 0.1969 -6.620 6.85e-10 ***
## Ge1_N_cromo17 1.2086 0.1519 7.959 5.02e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.371 on 142 degrees of freedom
## Multiple R-squared: 0.3085, Adjusted R-squared: 0.3036
## F-statistic: 63.34 on 1 and 142 DF, p-value: 5.018e-13
q4 |>
ggplot(aes(Ge1_N_cromo17, Desvio_Pé)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(y = "Desvio Pé", x = "Genótipo Cromossomo 17") +
theme_bw()
## `geom_smooth()` using formula 'y ~ x'
ponto_interm <- (mean(homoAA$Desvio_Pé) + mean(homoaa$Desvio_Pé))/2
### a
mean(homoAA$Desvio_Pé) - ponto_interm
## [1] 1.198407
### d
mean(heteAa$Desvio_Pé) - ponto_interm
## [1] -0.2406422
### Alfa = (a + d) * q + (a - d) * p = a + (q - p) * d
(mean(homoAA$Desvio_Pé) - ponto_interm) + (freq_a - freq_A) * (mean(heteAa$Desvio_Pé) - ponto_interm)
## [1] 1.211776
#########
# Chr 3
## Altura
lm_chr3_alt <- lm(Des_Altura ~ Gen2_N_cromo3, data = q4)
summary(lm_chr3_alt)
##
## Call:
## lm(formula = Des_Altura ~ Gen2_N_cromo3, data = q4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -20.9803 -5.0799 -0.4911 4.9542 17.9924
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.8375 0.9150 0.915 0.362
## Gen2_N_cromo3 -0.9727 0.7803 -1.247 0.215
##
## Residual standard error: 7.161 on 142 degrees of freedom
## Multiple R-squared: 0.01083, Adjusted R-squared: 0.003859
## F-statistic: 1.554 on 1 and 142 DF, p-value: 0.2146
q4 |>
ggplot(aes(Gen2_N_cromo3, Des_Altura)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Genótipo Cromossomo 3", y = "Desvio Altura") +
theme_bw()
## `geom_smooth()` using formula 'y ~ x'
ponto_interm <- (mean(homoBB$Des_Altura) + mean(homobb$Des_Altura))/2
### a
mean(homoBB$Des_Altura) - ponto_interm
## [1] -0.9868357
### d
mean(heteBb$Des_Altura) - ponto_interm
## [1] 0.1841003
### Alfa = (a + d) * q + (a - d) * p = a + (q - p) * d
(mean(homoBB$Des_Altura) - ponto_interm) + (freq_b - freq_B) * (mean(heteBb$Des_Altura) - ponto_interm)
## [1] -0.9663801
## Peso 1
lm_chr3_peso1 <- lm(Des_Peso_1 ~ Gen2_N_cromo3, data = q4)
summary(lm_chr3_peso1)
##
## Call:
## lm(formula = Des_Peso_1 ~ Gen2_N_cromo3, data = q4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -26.082 -8.093 -0.999 6.918 73.909
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.07423 1.67806 0.044 0.965
## Gen2_N_cromo3 -0.28358 1.43105 -0.198 0.843
##
## Residual standard error: 13.13 on 142 degrees of freedom
## Multiple R-squared: 0.0002765, Adjusted R-squared: -0.006764
## F-statistic: 0.03927 on 1 and 142 DF, p-value: 0.8432
q4 |>
ggplot(aes(Gen2_N_cromo3, Des_Peso_1)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Genótipo Cromossomo 3", y = "Desvio Peso 1") +
theme_bw()
## `geom_smooth()` using formula 'y ~ x'
ponto_interm <- (mean(homoBB$Des_Peso_1) + mean(homobb$Des_Peso_1))/2
### a
mean(homoBB$Des_Peso_1) - ponto_interm
## [1] -0.4911525
### d
mean(heteBb$Des_Peso_1) - ponto_interm
## [1] 2.71273
### Alfa = (a + d) * q + (a - d) * p = a + (q - p) * d
(mean(homoBB$Des_Peso_1) - ponto_interm) + (freq_b - freq_B) * (mean(heteBb$Des_Peso_1) - ponto_interm)
## [1] -0.1897381
## Peso 2
lm_chr3_peso2 <- lm(Desvio_peso_2 ~ Gen2_N_cromo3, data = q4)
summary(lm_chr3_peso2)
##
## Call:
## lm(formula = Desvio_peso_2 ~ Gen2_N_cromo3, data = q4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -22.565 -6.543 -0.565 6.549 35.140
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.2874 1.2797 -0.225 0.823
## Gen2_N_cromo3 0.1232 1.0913 0.113 0.910
##
## Residual standard error: 10.02 on 142 degrees of freedom
## Multiple R-squared: 8.978e-05, Adjusted R-squared: -0.006952
## F-statistic: 0.01275 on 1 and 142 DF, p-value: 0.9103
q4 |>
ggplot(aes(Gen2_N_cromo3, Desvio_peso_2)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Genótipo Cromossomo 3", y = "Desvio Peso 2") +
theme_bw()
## `geom_smooth()` using formula 'y ~ x'
ponto_interm <- (mean(homoBB$Desvio_peso_2) + mean(homobb$Desvio_peso_2))/2
### a
mean(homoBB$Desvio_peso_2) - ponto_interm
## [1] 0.07537993
### d
mean(heteBb$Desvio_peso_2) - ponto_interm
## [1] 0.6253316
### Alfa = (a + d) * q + (a - d) * p = a + (q - p) * d
(mean(homoBB$Desvio_peso_2) - ponto_interm) + (freq_b - freq_B) * (mean(heteBb$Desvio_peso_2) - ponto_interm)
## [1] 0.1448612
## Comprimento do Pé
lm_chr3_pe <- lm(Desvio_Pé ~ Gen2_N_cromo3, data = q4)
summary(lm_chr3_pe)
##
## Call:
## lm(formula = Desvio_Pé ~ Gen2_N_cromo3, data = q4)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.4468 -1.0927 -0.0174 0.9826 6.3368
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.2198 0.2096 -1.049 0.296
## Gen2_N_cromo3 0.2164 0.1788 1.210 0.228
##
## Residual standard error: 1.641 on 142 degrees of freedom
## Multiple R-squared: 0.01021, Adjusted R-squared: 0.003243
## F-statistic: 1.465 on 1 and 142 DF, p-value: 0.2281
q4 |>
ggplot(aes(Gen2_N_cromo3, Desvio_Pé)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Genótipo Cromossomo 3", y = "Desvio Pé") +
theme_bw()
## `geom_smooth()` using formula 'y ~ x'
ponto_interm <- (mean(homoBB$Desvio_Pé) + mean(homobb$Desvio_Pé))/2
### a
mean(homoBB$Desvio_Pé) - ponto_interm
## [1] 0.2169472
### d
mean(heteBb$Desvio_Pé) - ponto_interm
## [1] -0.007080661
### Alfa = (a + d) * q + (a - d) * p = a + (q - p) * d
(mean(homoBB$Desvio_Pé) - ponto_interm) + (freq_b - freq_B) * (mean(heteBb$Desvio_Pé) - ponto_interm)
## [1] 0.2161605
### QTL
q4 |>
select(Des_Altura, Des_Peso_1, Desvio_peso_2, Desvio_Pé, Gen1_cromo17) |>
group_by(Gen1_cromo17) |>
summarise(mean_alt = round(mean(Des_Altura), 2),
mean_p1 = round(mean(Des_Peso_1), 2),
mean_p2 = round(mean(Desvio_peso_2), 2),
mean_pe = round(mean(Desvio_Pé), 2))
## # A tibble: 3 × 5
## Gen1_cromo17 mean_alt mean_p1 mean_p2 mean_pe
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 aa -7.04 -7.71 -5.19 -1.19
## 2 Aa -1.02 -0.8 -0.91 -0.23
## 3 AA 7.11 6.87 4.95 1.21
q4 |>
select(Des_Altura, Des_Peso_1, Desvio_peso_2, Desvio_Pé, Gen2_cromo3) |>
group_by(Gen2_cromo3) |>
summarise(mean_alt = round(mean(Des_Altura), 2),
mean_p1 = round(mean(Des_Peso_1), 2),
mean_p2 = round(mean(Desvio_peso_2), 2),
mean_pe = round(mean(Desvio_Pé), 2))
## # A tibble: 3 × 5
## Gen2_cromo3 mean_alt mean_p1 mean_p2 mean_pe
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 bb 0.78 -0.83 -0.5 -0.22
## 2 Bb -0.03 1.39 0.2 -0.01
## 3 BB -1.2 -1.82 -0.35 0.22
De acordo com essas tabelas, eu diria que há QTLs no cromossomo 17 afetando os caracteres altura, Peso 1, Peso 2 e Pé. Não há QTLs no cromossomo 3.