abline(a = 0, b = -0.7)
x = mvrnorm(n = n , mu = c(0,0), Sigma = matrix(c(1,0,0,1), ncol = 2) )
plot(x[,1], x[,2], ylab  ="y", xlab = "x", main = "Correlation 0")
x = 1:100
y = x^2
cor(x,y)
plot(x,y)
y = x^3
plot(x,y)
cor(x,y)
y = x^2
y = x^2 + nrorm(n = 100,sd = 0.1)
plot(x,y)
y = x^2 + rnorm(n = 100,sd = 0.1)
plot(x,y)
cor(x,y)
y = x^(0.5) + rnorm(n = 100,sd = 0.1)
plot(x,y)
cor(x,y)
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(xyy2)
cor(xy,y2)
cor(x ,y2)
which.max(y2)
which.max(y)
which.max(y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
x = 1:100
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(x ,y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
x = 1:100
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(x ,y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
x = 1:100
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(x ,y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
x = 1:100
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(x ,y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
x = 1:100
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(x ,y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
x = 1:100
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(x ,y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
x = 1:100
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(x ,y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
x = 1:100
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(x ,y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
x = 1:100
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(x ,y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
x = 1:100
y = x^(0.5) + rnorm(n = 100,sd = 1)
plot(x,y)
cor(x,y)
y2 = x + rnorm(n = 100,sd = 5)
points(x,y2,col = 3)
cor(x ,y2)
cor(x,y)
which.max(y)
cor(x,y2)
which.max(y2)
0.12+0.19+0.46+0.49+0.26+0.21+0.12+0.49
0.29+0.5+0.48+0.14+1.3+1+2+2.4
1.4+0.14+1.5
2.34+0.29+0.5+0.48
2.34+8.11+3.04+3.61
rm(list = ls())
load("/Users/marialse/Box Sync/RoslinProjects/HerdDataProject/PresentResultsSimulationStudy/MainStudy/Res/AverageCorrelationAndCrps_Rep1-60FromAugSimulationStudyCattle00035.RData")
mergeByRows = function(x,y){
finalM = matrix(0, ncol = ncol(x), nrow = 2*nrow(x))
teller = 1
for(i in seq(1, 2*nrow(x)-1, length.out = nrow(x) )){
finalM[i,] = x[teller, ]
finalM[i+1,] = y[teller, ]
teller = teller +1
}
return(finalM)
}
mergeByCols = function(x,y){
finalM = matrix(0, ncol = 2*ncol(x), nrow = nrow(x))
teller = 1
for(i in seq(1, 2*ncol(x)-1, length.out = ncol(x) )){
finalM[,i] = x[,teller ]
finalM[,i+1] = y[,teller ]
teller = teller +1
}
return(finalM)
}
modelsChosen = c(1:4,6)
avCor = avCor[modelsChosen,]
avCorG = avCorG[modelsChosen,]
load("/Users/marialse/Box Sync/RoslinProjects/HerdDataProject/PresentResultsSimulationStudy/MainStudy/Res/AverageCorrelationAndCrps_Rep1-60FromMaySimulationStudyCattle00035")
load("/Users/marialse/Box Sync/RoslinProjects/HerdDataProject/PresentResultsSimulationStudy/MainStudy/Res/AverageCorrelationAndCrps_Rep1-60FromMaySimulationStudyCattle00035.RData")
mergeByRows = function(x,y){
finalM = matrix(0, ncol = ncol(x), nrow = 2*nrow(x))
teller = 1
for(i in seq(1, 2*nrow(x)-1, length.out = nrow(x) )){
finalM[i,] = x[teller, ]
finalM[i+1,] = y[teller, ]
teller = teller +1
}
return(finalM)
}
mergeByCols = function(x,y){
finalM = matrix(0, ncol = 2*ncol(x), nrow = nrow(x))
teller = 1
for(i in seq(1, 2*ncol(x)-1, length.out = ncol(x) )){
finalM[,i] = x[,teller ]
finalM[,i+1] = y[,teller ]
teller = teller +1
}
return(finalM)
}
modelsChosen = c(1:4,6)
avCor = avCor[modelsChosen,]
avCorG = avCorG[modelsChosen,]
avCor12 = avCor12[modelsChosen,]
avCorG12 = avCorG12[modelsChosen,]
avCorSd = avCorSd[modelsChosen,]
avCorSdG = avCorSdG[modelsChosen,]
avCorSd12 = avCorSd12[modelsChosen,]
avCorSdG12 = avCorSdG12[modelsChosen,]
Gen11 = t(mergeByCols(avCorG,avCor ) )
Gen12 = t(mergeByCols(avCorG12,avCor12 ) )
Gen11sd = t(mergeByCols(avCorSdG,avCorSd ) )
Gen12sd = t(mergeByCols(avCorSdG12,avCorSd12 ) )
CorrelationMatrix = round( mergeByCols(  cbind(Gen11, Gen12) , cbind(Gen11sd, Gen12sd)    ) , 4)
CorrelationMatrixLite = round(  cbind(Gen11, Gen12) , 2)
avCrps = avCrps[modelsChosen,]
avCrpsG = avCrpsG[modelsChosen,]
avCrps12 = avCrps12[modelsChosen,]
avCrpsG12 = avCrpsG12[modelsChosen,]
avCrpsSd = avCrpsSd[modelsChosen,]
avCrpsSdG = avCrpsSdG[modelsChosen,]
avCrpsSd12 = avCrpsSd12[modelsChosen,]
avCrpsSdG12 = avCrpsSdG12[modelsChosen,]
Gen11Crps = t(mergeByCols(avCrpsG,avCrps ) )
Gen12Crps = t(mergeByCols(avCrpsG12,avCrps12 ) )
Gen11sdCrps = t(mergeByCols(avCrpsSdG,avCrpsSd ) )
Gen12sdCrps = t(mergeByCols(avCrpsSdG12,avCrpsSd12 ) )
library(knitr)
library(kableExtra)
CorrelationMatrix2Lite = round(mergeByCols (rbind(avCor, avCorG) ,rbind(avCor12, avCorG12) ) ,2 )
colnames(CorrelationMatrix2Lite) = c("EBV","PBV","EBV","PBV","EBV","PBV")
rownames(CorrelationMatrix2Lite) =  c("G","H", "S","HS", "HSC","G","H", "S","HS", "HSC")
kable(CorrelationMatrix2Lite, "latex",  booktabs = T, caption ="Average correlation with $delta = 1$ for the different breeding scenarios, using genomic markers or pedigree, and for EBV and PBV. The standard error for some values had order of magnitude $10^{-2}$, and most had $10^{-3}$.") %>%
add_header_above(c(" ", "Strategy A" = 2, "Strategy B" = 2, "Strategy C" = 2)) %>%
kable_styling(latex_options = c("repeat_header")) %>%
pack_rows("Pedigree", 1,5) %>%
pack_rows("Genomic markers", 6,10)
CrpsMatrix2Lite = round(mergeByCols (rbind(avCrps, avCrpsG) ,rbind(avCrps12, avCrpsG12) ) ,3)
colnames(CrpsMatrix2Lite) = c("EBV","PBV","EBV","PBV","EBV","PBV")
rownames(CrpsMatrix2Lite) =  c("G","H", "S","HS", "HSC","G","H", "S","HS", "HSC")
kable(CrpsMatrix2Lite, "latex",  booktabs = T, caption ="Average CRPS with $delta = 1$ for the different breeding scenarios, using genomic markers or pedigree, and for EBV and PBV. The standard error for all values had order of magnitude $10^{-3}$.") %>%
add_header_above(c(" ", "Strategy A" = 2, "Strategy B" = 2, "Strategy C" = 2)) %>%
kable_styling(latex_options = c("repeat_header")) %>%
pack_rows("Pedigree", 1,5) %>%
pack_rows("Genomic markers", 6,10)
library(INLA)
inla.doc("prec")
inla.doc("iid")
? rloggamma
library(INLA)
? inla.mesh.projector
? inla.mesh.project
plDom = cbind(c(0, 1, 1, 1, 0), c(0, 0, 1, 1, 1))
mesh = inla.mesh.2d(loc.domain = plDom, max.e = c(0.092, 0.2))
xLoc = runif(nVillages ,min = 0.05, max =0.95)
nVillages = 100
nHerdsPerVill = 20
plDom = cbind(c(0, 1, 1, 1, 0), c(0, 0, 1, 1, 1))
mesh = inla.mesh.2d(loc.domain = plDom, max.e = c(0.092, 0.2))
xLoc = runif(nVillages ,min = 0.05, max =0.95)
yLoc = runif(nVillages ,min = 0.05, max =0.95)
villageLoc = cbind(xLoc, yLoc)
herdLocTemp =  apply(villageLoc, 1, function(x) SimulateFarmLocation(x, nHerds = nHerdsPerVill, sigmaHerds = sigmaHerds )   )
source('~/Box Sync/Abel/SimulationStudyCattle/Script/Functions.R')
herdLocTemp =  apply(villageLoc, 1, function(x) SimulateFarmLocation(x, nHerds = nHerdsPerVill, sigmaHerds = sigmaHerds )   )
xHerd =as.vector(herdLocTemp[ 1:nHerdsPerVill  ,] )
sigmaHerds = 0.00035
herdLocTemp =  apply(villageLoc, 1, function(x) SimulateFarmLocation(x, nHerds = nHerdsPerVill, sigmaHerds = sigmaHerds )   )
xHerd =as.vector(herdLocTemp[ 1:nHerdsPerVill  ,] )
yHerd =as.vector(herdLocTemp[(nHerdsPerVill +1): (2*nHerdsPerVill ) ,] )
herdLoc = cbind(xHerd,yHerd)
nIndepFields = 10
sampleRanges = runif(n = nIndepFields, min = 0.1, max = 0.9)
sampleSd = sqrt(sample(x = c(0.2, 0.3 ), size = nIndepFields, replace = T))
sampleFields = cbind(sapply(1:10, function(x) SimulateSpdeField(mesh, n.fields = 1, range0 = sampleRanges[x],sigma0 = sampleSd[x]) ) )
B1= diag(c(1,1,1))
B2= diag(c(1,1,1))
B3= diag(c(1,1))
B1[lower.tri(B1)] = runif(3, min = -0.5, max = 0.5)
B2[lower.tri(B2)] = runif(3, min = -0.5, max = 0.5)
B3[lower.tri(B3)] = runif(1, min = -0.5, max = 0.5)
B = bdiag(B1,B2,B3)
dependentFields = B %*% t(sampleFields[,1:8])
trueField =colSums(dependentFields )
library(fields)
library(ggplot2)
library(viridisLite)
PlotSpdeField = function(mesh,sample.field1,zlim =NULL, myTitle=NULL){
proj <- inla.mesh.projector(mesh,dims=c(300, 300))
field.proj1 <- inla.mesh.project(proj, sample.field1)
image.plot(list(x = proj$x, y=proj$y, z = (field.proj1)),zlim=zlim, col = viridis(25),ylim = c(0,1), xlim = c(0,1),ylab = "Northing", xlab = "Easting", cex.lab = 0.8, cex.axis = 0.8, axis.args = list(cex.axis = 0.8))
title(main = list(myTitle, cex = 0.8),  adj =0)
}
PlotSpdeField = function(mesh,sample.field1,zlim =NULL, myTitle=NULL){
proj <- inla.mesh.projector(mesh,dims=c(300, 300))
field.proj1 <- inla.mesh.project(proj, sample.field1)
image.plot(list(x = proj$x, y=proj$y, z = (field.proj1)),zlim=zlim, col = viridis(25) )
}
load("/Users/marialse/Box Sync/Abel/SimulationStudyCattle/ResultsMai2019-sigmaherds=00035/Rep31_BreedingScenarioA_MarkersF/Results.RData")
PlotSpdeField(mesh, trueField)
PlotSpdeField = function(mesh,sample.field,zlim =NULL, myTitle=NULL){
proj <- inla.mesh.projector(mesh,dims=c(300, 300))
field.proj <- inla.mesh.project(proj, sample.field)
image.plot(list(x = proj$x, y=proj$y, z = (field.proj)),zlim=zlim, col = viridis(25) )
}
PlotSpdeField(mesh, trueField)
library(INLA)
? image.plot
? inla.hyperpar.sample
?inla.posterior.sample
inla.doc("ar1")
n = 100
rho = 0.8
prec = 10
marg.prec = prec * (1-rho^2)
E=sample(c(5,4,10,12),size=n,replace=T)
eta = as.vector(arima.sim(list(order = c(1,0,0), ar = rho), n = n,sd=sqrt(1/prec)))
y=rpois(n,E*exp(eta))
data = list(y=y, z=1:n, E=E)
head(data)
plot(data$"Dyestuff")
plot(data$y)
plot(data$y/data$E)
formula = y~f(z,model="ar1")
result = inla(formula,family="poisson", data = data, E=E)
summary(result)
result = inla(formula,family="poisson", data = data, E=E, control.compute=list(config=TRUE))
postHyper = inla.hyperpar.sample(result = result, n = 10)
head(postHyper)
? inla.hyperpar.sample
postHyper = inla.hyperpar.sample(result = result, n = 2000)
head(postHyper)
hist(postHyper[,1])
summary(result)
hist(postHyper[,2])
postField = inla.posterior.sample(result=result, n = 10)
postField
postField = inla.posterior.sample(result=result, n = 1)
postField
load("/Users/marialse/Box Sync/RoslinProjects/HerdDataProject/RealHerdData/FitModels/Results3800Factor/ResultsRandomSamePriorAsSimFactor.RData")
rm(list = ls())
load("/Users/marialse/Box Sync/RoslinProjects/HerdDataProject/RealHerdData/FitModels/Results3800Factor/ResultsRandomSamePriorAsSimFactor.RData")
library(INLA)
library(fields)
PlotSpdeField = function(mesh,sample.field,zlim =NULL, myTitle=NULL){
proj <- inla.mesh.projector(mesh,dims=c(300, 300))
field.proj <- inla.mesh.project(proj, sample.field)
image.plot(list(x = proj$x, y=proj$y, z = (field.proj)),zlim=zlim, col = viridis(25) )
}
PlotSpdeField(mesh, fitS$)
PlotSpdeField(mesh, fitS$summary.random$fieldID$mean)
PlotSpdeField(mesh, fitS$summary.random$fieldID$sd)
PlotSpdeField(mesh, fitS$summary.random$fieldID$mode)
PlotSpdeField(mesh, fitS$summary.random$fieldID$mean)
fitS$summary.random$fieldID$mean %*% A
dim(A)
length(fitS$summary.random$fieldID$mean)
A %*% fitS$summary.random$fieldID$mean
inla.posterior.sample(fitS, n = 2)
spatialAllAnim = A %*% fitS$summary.random$fieldID$mean # Spatial effect of each animal
spatialAllHerd = unique(spatialAllAnim) # Spatial effect of each herd
spatialAllAnim = A %*% fitS$summary.random$fieldID$mean # Spatial effect of each animal
spatialAllHerd = unique(spatialAllAnim) # Spatial effect of each herd
spatialAllAnim
spatialAllAnim = as.vector(A %*% fitS$summary.random$fieldID$mean) # Spatial effect of each animal
spatialAllHerd = unique(spatialAllAnim) # Spatial effect of each herd
var(spatialAllHerd)
library(INLA)
? inla.pc.prec
? inla.pc.rprec
inla.doc("pc.prec")
? inla.control.fixed
0.001
1/0.001
library(INLA)
inla.doc("pc.prec")
inla.doc(pc.cor1)
inla.doc("pc.cor1")
a = c(1,2,3,1,2,3,5,34,,2,1,2,2,3,3)
a = c(1,2,3,1,2,3,5,34,0,2,1,2,2,3,3)
var(a)
b = c(a, numeric(10))
var(b)
b = c(a, numeric(10), a/2)
var(b)
b = c(a, numeric(10), a)
var(b)
getwd()
setwd("~/Box Sync/RoslinProjects/HerdDataProject/CodeForPaper/Part1_GeneticSimulation/")
#Script Name: RunSim.R
#Author: Owen Powell
#Description: Script to run breeding simulation part 1
# Cleanup
rm(list = ls())
start_time = Sys.time()
cat("Handling the arguments...\n")
# args = commandArgs(trailingOnly = TRUE)
# Rep = as.integer(args[1])
Rep = 1 # Replicate number
setwd("~/Box Sync/RoslinProjects/HerdDataProject/CodeForPaper/Part1_GeneticSimulation/")
rep =1
dir.create(paste0("./ResultsPart1/Rep",rep), recursive = T)
setwd(paste0("./ResultsPart1/Rep",rep))
print(getwd())
cat("Sourcing global parameters...\n")
source("../../Scripts/GlobalParameters.R")
cat("Creating parents...\n")
source("../../Scripts/CreateParents.R")
save.image(file='Founders.RData')
cat("Assigning animals...\n")
source("../../Scripts/AnimalAssignment.R")
Generation <- vector(length = nYrs+1, mode = "list")
Generation[[1]] <- Villages
cat("Storing founders...\n")
save.image(file='Founders.RData')
scenario = "scenarioA"
if (scenario == "scenarioA"){
allBulls = c()
source("../../Scripts/BullAssignmentA.R")
cat("Breeding Scenario A...\n")
for (yr in 2:(nYrs+1)){
cat(paste0("Year ",yr," running..."))
source("../../Scripts/ScenarioAMating.R")
cat("Mating Completed...")
source("../../Scripts/ScenarioASelection.R")
cat("Animals Selected...")
Generation[[yr]] = Villages
cat(paste0("Year ",yr," Complete...\n"))
}
}
source("../../Scripts/DataExtraction.R")
cat("Loading old founders...\n")
load("Founders.RData")
scenario = "scenarioB"
if (scenario == "scenarioB"){
allBulls = c()
source("../../Scripts/BullAssignmentB.R")
cat("Breeding Scenario B...\n")
for (yr in 2:(nYrs+1)){
cat(paste0("Year ",yr," running..."))
source("../../Scripts/ScenarioBMating.R")
cat("Mating Completed...")
source("../../Scripts/ScenarioBSelection.R")
cat("Animals Selected...")
Generation[[yr]] = Villages
cat(paste0("Year ",yr," Complete...\n"))
}
}
source("../../Scripts/DataExtraction.R")
cat("Loading old founders...\n")
load("Founders.RData")
scenario = "scenarioC"
if (scenario == "scenarioC"){
allBulls = c()
source("../../Scripts/BullAssignmentC.R")
cat("Breeding Scenario C...\n")
for (yr in 2:(nYrs+1)){
cat(paste0("Year ",yr," running..."))
source("../../Scripts/ScenarioCMating.R")
cat("Mating Completed...")
source("../../Scripts/ScenarioCSelection.R")
cat("Animals Selected...")
Generation[[yr]] = Villages
cat(paste0("Year ",yr," Complete...\n"))
}
}
source("../../Scripts/DataExtraction.R")
)
rm(list = ls())
getwd()
setwd("../../../Part2_DataSimulationAndFitModels/")
rep = 1 # Replicate number
useMarkers = F # Use pedigree (F) or markers (T)
breedingScenario = "A" # Controls the genetic connectedness, Scenario A corresponds to weak genetic connectedness, scenario B to intermediate genetic connectedness, and scenario C to strong genetic connectedness.
sigmaHerds = 0.0035 # Controls the spread of herds
part1Results = "../../../Part1_GeneticSimulation/ResultsPart1" # The directory of results from part 1
cat("Loading the required packages and functions ...\n")
source("Script/Functions.R")
# cat("Handling the arguments...\n")
# args = commandArgs(trailingOnly = TRUE)
# #          markers
# # args = c(T)
# if (length(args) < 2) {
#   stop("Must provide arguments!")
# }
# rep = as.numeric(args[1])
# useMarkers = args[2]
# breedingScenario = args[3]
# sigmaHerds = as.numeric(args[4])
scenarioName = paste("Results/", "Rep", rep,"_BreedingScenario", breedingScenario, "_Markers", useMarkers,  sep = "")
createAndSetScenarioFolder(x = scenarioName)
source("../../Script/GlobalParameters.R")
# Simulate genetic part
source("../../Script/SimulateGeneticEffect.R")
# Simulate spatial part
source("../../Script/SimulateSpatialEffects.R")
# Simulate phenotype
cat("Simulating phenotype...\n")
source("../../Script/SimulatePhenotype.R")
# Prepare for fitting pedigree and genomic relationship matrix
cat("Prepare pedigree or marker data...\n")
source("../../Script/PreparePedigreeAndSnp.R")
# Make formulas
source("../../Script/MakeFormulas.R")
# Make covariates
source("../../Script/MakeObservedCovariates.R")
# Fit model
cat("Fitting models...\n")
source("../../Script/RunInla.R")
source("../../Script/ComputeCorrelations.R")
# Save information from the fit objects and the data
cat("Saving results...\n")
save(CorEbv11,CorEbv12, estBreedingValue11, sdEstBreedingValue11,
TrueBreedingValue12, estBreedingValue12 , sdEstBreedingValue12 ,phenoData, dicFit, logScore, modeStatus,ResVarMean, ResVar0.025Median0.975, IndVarMean, IndVar0.025Median0.975,HerdVarMean,HerdVar0.025Median0.975, SpatialVarMean, SpatialVar0.025Median0.975, SpatialRangeMean, SpatialRange0.025Median0.975, estIntercept, estCov5, estCov6, VarWbeta, meanGeneticEffect11, sigmaHerds,file  = "Results.RData")
setwd("..")
cat("Done. \n")
