## Haplotype counts
AB <- 40
Ab <- 10
aB <- 20
ab <- 30
# Total sample size
n <- AB + Ab + aB + ab
n
## [1] 100
# Allele frequencies
pA <- pAB + pAb
pa <- paB + pab
pB <- pAB + paB
pb <- pAb + pab
c(pA = pA, pa = pa, pB = pB, pb = pb)
##  pA  pa  pB  pb 
## 0.5 0.5 0.6 0.4
# LD coefficient D
D <- pAB - pA * pB
D
## [1] 0.1
# Maximum possible D for positive D
Dmax <- min(pA * pb, pa * pB)
# Standardized D and r-squared
Dprime <- D / Dmax
r2 <- D^2 / (pA * pa * pB * pb)
round(c(D = D, Dprime = Dprime, r2 = r2), 4)
##      D Dprime     r2 
## 0.1000 0.5000 0.1667
## A reusable function

ld_measures <- function(AB, Ab, aB, ab) { 
  n <- AB + Ab + aB + ab
pAB <- AB/n
pAb <- Ab/n
paB <- aB/n
pab <- ab/n
pA <- pAB + pAb
pa <- paB + pab
pB <- pAB + paB
pb <- pAb + pab 
D <- pAB - pA * pB
if(
D >= 0) {
Dmax <- min(pA* pb, pa* pB)
} else{
Dmax <- min(pA* pB, pa* pb)
}
Dprime <-D/ Dmax
r2 <-D^2/ (pA* pa* pB*pb)

return(c(D=D, Dprime = Dprime, r2 = r2))
}
### ASSIGNMENT
##TASK 1
##Haplotype counts
AB <- 25
Ab <- 15
aB <- 35
ab <- 25
#TOTAL
n <- AB + Ab + aB + ab
n
## [1] 100
##
ld_measures <- function(AB, Ab, aB, ab) {
  N <- AB + Ab + aB + ab
  
  pA <- (AB + Ab) / N
  pa <- (aB + ab) / N
  pB <- (AB + aB) / N
  pb <- (Ab + ab) / N
  
  P_AB <- AB / N
  D <- P_AB - (pA * pB)
  
  return(list(
    pA = pA,
    pa = pa,
    pB = pB,
    pb = pb,
    D = D
  ))
}

ld_measures(AB = 25, Ab = 15, aB = 35, ab = 25)
## $pA
## [1] 0.4
## 
## $pa
## [1] 0.6
## 
## $pB
## [1] 0.6
## 
## $pb
## [1] 0.4
## 
## $D
## [1] 0.01
##TASK 2
#Haplotype frequencies
pAB<- 0.30
pAb<- 0.20
paB<- 0.10
pab<- 0.40

#Allele frequencies
pA <- pAB + pAb
pa <- paB + pab
pB <- pAB + paB
pb <- pAb + pab
c(pA = pA, pa = pa, pB = pB, pb = pb)
##  pA  pa  pB  pb 
## 0.5 0.5 0.4 0.6
#Expected pAB under independence
pAB_exp <- pA * pB
pAB_exp
## [1] 0.2
#D
D <- pAB - pAB_exp
D
## [1] 0.1
#Interpretation
if (D > 0) {
  "LD is positive"
} else if (D < 0) {
  "LD is negative"
} else {
  "LD is zero"
}
## [1] "LD is positive"
##TASK 3
#Values
pA <- 0.7
pa <- 0.3
pB <- 0.6
pb <- 0.4
pAB <- 0.50

# Expected frequency
pAB_exp <- pA * pB
pAB_exp
## [1] 0.42
# D
D <- pAB - pAB_exp
D
## [1] 0.08
#D'
Dmax <- min(pA * pb, pa * pB)
Dprime <- D / Dmax
Dprime
## [1] 0.4444444
# r^2
r2 <- D^2 / (pA * pa * pB * pb)
r2 
## [1] 0.1269841