pfx <- file.path(system.file("extdata", package="plinkFile"), "m20")
gmx <- readBED(pfx) # read genotype matrix from PLINK BED.
gmx <- scale(gmx) # standardize
tmp <- tempdir() # for example outputs
dir.create(tmp, FALSE)
# kinship matrix as Gaussian kernel, built from the first 10 variants
gmx.gau <- gmx[, +(1:10)] # the first 10 variants
not.na.gau <- tcrossprod(!is.na(gmx.gau)) # variant count matrix
kin.gau <- exp(as.matrix(-dist(gmx.gau, "euc")) / not.na.gau)
print(kin.gau) # the Gaussian kernel
out.gau <- file.path(tmp, "m20.gau")
saveGRM(out.gau, kin.gau, not.na.gau) # gau.grm.* should appear
# kinship matrix as Laplacian kernel, built without the first 10 variants
gmx.lap <- gmx[, -(1:10)] # drop the first 10 variants
not.na.lap <- tcrossprod(!is.na(gmx.lap)) # variant count matrix
kin.lap <- exp(as.matrix(-dist(gmx.lap, "man")) / not.na.lap)
out.lap <- file.path(tmp, "m20.lap")
print(kin.lap) # the Laplacian kernel
saveGRM(out.lap, kin.lap, not.na.lap) # lap.grm.* should appear
# merge kinship in R language for a radius based function kernel matrix
not.na.rbf <- not.na.gau + not.na.lap
kin.rbf <- (kin.gau * not.na.gau + kin.lap * not.na.lap) / not.na.rbf
print(kin.rbf)
out.rbf <- file.path(tmp, "m20.rbf")
saveGRM(out.rbf, kin.rbf, not.na.rbf) # rbf.grm.* should appear
# show saved matrices, then clean up
dir(tmp, "(gau|lap|rbf)")
unlink(tmp, recursive=TRUE)
Run the code above in your browser using DataLab