diff --git a/R/Zalpha_BetaCDF.R b/R/Zalpha_BetaCDF.R index 640b13abf5a00c338b99eeeba786834cfdf886d0..2368cef953fd6e29fb6b7a076399cf289638efaf 100644 --- a/R/Zalpha_BetaCDF.R +++ b/R/Zalpha_BetaCDF.R @@ -161,11 +161,13 @@ Zalpha_BetaCDF<-function(pos, ws, x, dist, LDprofile_bins, LDprofile_Beta_a, LDp ##Left # Find distances between each SNP in L and round to bin size bins<-sapply(lower_triangle(outer(dist[pos>=currentPos-ws/2 & pos < currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) Lrsq<- lower_triangle(cor(t(x[pos>=currentPos-ws/2 & pos < currentPos,]),use="pairwise.complete.obs")^2) LrsqExp<-merge(data.frame(bins=as.character(bins),Lrsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_Beta_a,LDprofile_Beta_b),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) LrsqSum<-sum(pbeta(LrsqExp$Lrsq,LrsqExp$LDprofile_Beta_a,LrsqExp$LDprofile_Beta_b)) ##Right bins<-sapply(lower_triangle(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos<=currentPos+ws/2 & pos > currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) Rrsq<-lower_triangle(cor(t(x[pos<=currentPos+ws/2 & pos > currentPos,]),use="pairwise.complete.obs")^2) RrsqExp<-merge(data.frame(bins=as.character(bins),Rrsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_Beta_a,LDprofile_Beta_b),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) RrsqSum<-sum(pbeta(RrsqExp$Rrsq,RrsqExp$LDprofile_Beta_a,RrsqExp$LDprofile_Beta_b)) diff --git a/R/Zalpha_Zscore.R b/R/Zalpha_Zscore.R index d7f25e9eedf1548cb71f6d91d34b7199fbb5f919..4cc3183d0c5df43a6468e79d1165cf41ed5bd752 100644 --- a/R/Zalpha_Zscore.R +++ b/R/Zalpha_Zscore.R @@ -164,11 +164,13 @@ Zalpha_Zscore<-function(pos, ws, x, dist, LDprofile_bins, LDprofile_rsq, LDprofi ##Left # Find distances between each SNP in L and round to bin size bins<-sapply(lower_triangle(outer(dist[pos>=currentPos-ws/2 & pos < currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) Lrsq<- lower_triangle(cor(t(x[pos>=currentPos-ws/2 & pos < currentPos,]),use="pairwise.complete.obs")^2) LrsqExp<-merge(data.frame(bins=as.character(bins),Lrsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq,LDprofile_sd),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) LrsqSum<-sum((LrsqExp$Lrsq-LrsqExp$LDprofile_rsq)/LrsqExp$LDprofile_sd) ##Right bins<-sapply(lower_triangle(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos<=currentPos+ws/2 & pos > currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) Rrsq<-lower_triangle(cor(t(x[pos<=currentPos+ws/2 & pos > currentPos,]),use="pairwise.complete.obs")^2) RrsqExp<-merge(data.frame(bins=as.character(bins),Rrsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq,LDprofile_sd),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) RrsqSum<-sum((RrsqExp$Rrsq-RrsqExp$LDprofile_rsq)/RrsqExp$LDprofile_sd) diff --git a/R/Zalpha_all.R b/R/Zalpha_all.R index 35e99918a929496750cfd5fcbb93fec4ef07efb2..38f9a860a22af9311f32080067928161d7d83f7a 100644 --- a/R/Zalpha_all.R +++ b/R/Zalpha_all.R @@ -235,12 +235,15 @@ Zalpha_all <- function(pos, ws, x=NULL, dist=NULL, LDprofile_bins=NULL, LDprofil if (is.null(dist)==FALSE & is.null(LDprofile_bins)==FALSE & is.null(LDprofile_rsq)==FALSE){ #Left bins<-sapply(lower_triangle(outer(dist[pos>=currentPos-ws/2 & pos < currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) LrsqExp<-merge(data.frame(bins=as.character(bins),Lrsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) #Right bins<-sapply(lower_triangle(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos<=currentPos+ws/2 & pos > currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) RrsqExp<-merge(data.frame(bins=as.character(bins),Rrsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) #Over bins<-sapply(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-"),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) rsqExp<-merge(data.frame(bins=as.character(bins),rsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) outputList$Zalpha_expected[i]<-(sum(LrsqExp$LDprofile_rsq)/choose(noL,2)+sum(RrsqExp$LDprofile_rsq)/choose(noR,2))/2 diff --git a/R/Zalpha_expected.R b/R/Zalpha_expected.R index e86336679ab280d40d4fe56e4efe53fe22e900f5..ae5ce5b48411ada7d11425d837da4a61641acb5e 100644 --- a/R/Zalpha_expected.R +++ b/R/Zalpha_expected.R @@ -132,9 +132,11 @@ Zalpha_expected<-function(pos, ws, dist, LDprofile_bins, LDprofile_rsq, minRandL ##Left # Find distances between each SNP in L and round to bin size bins<-sapply(lower_triangle(outer(dist[pos>=currentPos-ws/2 & pos < currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) LrsqSum<-sum(merge(data.frame(bins=as.character(bins)),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE)[,2]) ##Right bins<-sapply(lower_triangle(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos<=currentPos+ws/2 & pos > currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) RrsqSum<-sum(merge(data.frame(bins=as.character(bins)),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE)[,2]) outputList$Zalpha_expected[i]<-(LrsqSum/choose(noL,2)+RrsqSum/choose(noR,2))/2 diff --git a/R/Zalpha_log_rsq_over_expected.R b/R/Zalpha_log_rsq_over_expected.R index bde2f5cb817cce5111fadb34c47410a7b80d11ba..bbff0271da574aaae7c174d7300a123967aac186 100644 --- a/R/Zalpha_log_rsq_over_expected.R +++ b/R/Zalpha_log_rsq_over_expected.R @@ -155,12 +155,14 @@ Zalpha_log_rsq_over_expected<-function(pos, ws, x, dist, LDprofile_bins, LDprofi ##Left # Find distances between each SNP in L and round to bin size bins<-sapply(lower_triangle(outer(dist[pos>=currentPos-ws/2 & pos < currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) Lrsq<- lower_triangle(cor(t(x[pos>=currentPos-ws/2 & pos < currentPos,]),use="pairwise.complete.obs")^2) Lrsq[Lrsq==0]<-min(Lrsq[Lrsq>0]) #removes zeros by replacing with lowest correlation greater than zero LrsqExp<-merge(data.frame(bins=as.character(bins),Lrsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) LrsqSum<-sum(log10(LrsqExp$Lrsq/LrsqExp$LDprofile_rsq)) ##Right bins<-sapply(lower_triangle(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos<=currentPos+ws/2 & pos > currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) Rrsq<-lower_triangle(cor(t(x[pos<=currentPos+ws/2 & pos > currentPos,]),use="pairwise.complete.obs")^2) Rrsq[Rrsq==0]<-min(Rrsq[Rrsq>0]) #removes zeros by replacing with lowest correlation greater than zero RrsqExp<-merge(data.frame(bins=as.character(bins),Rrsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) diff --git a/R/Zalpha_rsq_over_expected.R b/R/Zalpha_rsq_over_expected.R index 56672a3953facc926d06eee33a64b12d3dd62269..3eb9c54c11d142cd1c3d37967de258a769a8a3c8 100644 --- a/R/Zalpha_rsq_over_expected.R +++ b/R/Zalpha_rsq_over_expected.R @@ -155,11 +155,13 @@ Zalpha_rsq_over_expected<-function(pos, ws, x, dist, LDprofile_bins, LDprofile_r ##Left # Find distances between each SNP in L and round to bin size bins<-sapply(lower_triangle(outer(dist[pos>=currentPos-ws/2 & pos < currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) Lrsq<- lower_triangle(cor(t(x[pos>=currentPos-ws/2 & pos < currentPos,]),use="pairwise.complete.obs")^2) LrsqExp<-merge(data.frame(bins=as.character(bins),Lrsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) LrsqSum<-sum(LrsqExp$Lrsq/LrsqExp$LDprofile_rsq) ##Right bins<-sapply(lower_triangle(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos<=currentPos+ws/2 & pos > currentPos],"-")),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) Rrsq<-lower_triangle(cor(t(x[pos<=currentPos+ws/2 & pos > currentPos,]),use="pairwise.complete.obs")^2) RrsqExp<-merge(data.frame(bins=as.character(bins),Rrsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) RrsqSum<-sum(RrsqExp$Rrsq/RrsqExp$LDprofile_rsq) diff --git a/R/Zbeta_BetaCDF.R b/R/Zbeta_BetaCDF.R index c378482b67c5f8b3dd7e8f64ebe15c92c015fe12..7f58f07dbe8deb16c352272b617f0271e76b2ccf 100644 --- a/R/Zbeta_BetaCDF.R +++ b/R/Zbeta_BetaCDF.R @@ -161,6 +161,7 @@ Zbeta_BetaCDF<-function(pos, ws, x, dist, LDprofile_bins, LDprofile_Beta_a, LDpr # Find distances between each SNP in L and round to bin size bins<-sapply(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-"),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) rsq<-as.vector(t((cor(t(x[pos>=currentPos-ws/2 & pos<=currentPos+ws/2,]),use="pairwise.complete.obs")^2)[1:noL,(noL+2):(noL+noR+1)])) rsqExp<-merge(data.frame(bins=as.character(bins),rsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_Beta_a,LDprofile_Beta_b),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) rsqSum<-sum(pbeta(rsqExp$rsq,rsqExp$LDprofile_Beta_a,rsqExp$LDprofile_Beta_b)) diff --git a/R/Zbeta_Zscore.R b/R/Zbeta_Zscore.R index e2795ddf28cd9156638be62695cc6a0ecce689b1..41338cffafcbb694e96f33391c74de3822b38924 100644 --- a/R/Zbeta_Zscore.R +++ b/R/Zbeta_Zscore.R @@ -163,6 +163,7 @@ Zbeta_Zscore<-function(pos, ws, x, dist, LDprofile_bins, LDprofile_rsq, LDprofil } else { # Find distances between each SNP in L and round to bin size bins<-sapply(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-"),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) rsq<-as.vector(t((cor(t(x[pos>=currentPos-ws/2 & pos<=currentPos+ws/2,]),use="pairwise.complete.obs")^2)[1:noL,(noL+2):(noL+noR+1)])) rsqExp<-merge(data.frame(bins=as.character(bins),rsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq,LDprofile_sd),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) rsqSum<-sum((rsqExp$rsq-rsqExp$LDprofile_rsq)/rsqExp$LDprofile_sd) diff --git a/R/Zbeta_expected.R b/R/Zbeta_expected.R index 76776da51b627a83c619b406ca9b007eb5579733..064b16775de39a48b70e5f351aeb60f5a3cfbb4f 100644 --- a/R/Zbeta_expected.R +++ b/R/Zbeta_expected.R @@ -132,6 +132,7 @@ Zbeta_expected<-function(pos, ws, dist, LDprofile_bins, LDprofile_rsq, minRandL # Find the distances between each SNP in the over region and round to bin size bins<-sapply(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-"),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) rsqSum<-sum(merge(data.frame(bins=as.character(bins)),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE)[,2]) outputList$Zbeta_expected[i]<-rsqSum/(noL*noR) diff --git a/R/Zbeta_log_rsq_over_expected.R b/R/Zbeta_log_rsq_over_expected.R index d5640bbf6cfcd9fe7d5a761fb1a4573b31dcabde..928e9d29de8094be1f0d930702e2e5ca0f956979 100644 --- a/R/Zbeta_log_rsq_over_expected.R +++ b/R/Zbeta_log_rsq_over_expected.R @@ -155,6 +155,7 @@ Zbeta_log_rsq_over_expected<-function(pos, ws, x, dist, LDprofile_bins, LDprofil # Find distances between each SNP in L and round to bin size bins<-sapply(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-"),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) rsq<-as.vector(t((cor(t(x[pos>=currentPos-ws/2 & pos<=currentPos+ws/2,]),use="pairwise.complete.obs")^2)[1:noL,(noL+2):(noL+noR+1)])) rsq[rsq==0]<-min(rsq[rsq>0]) #removes zeros by replacing with lowest correlation greater than zero rsqExp<-merge(data.frame(bins=as.character(bins),rsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) diff --git a/R/Zbeta_rsq_over_expected.R b/R/Zbeta_rsq_over_expected.R index e0cc7fe392808f172928b0a58eb2341c478e5598..0c01611be0f66b2810cec07c3d2233d36fdd65f7 100644 --- a/R/Zbeta_rsq_over_expected.R +++ b/R/Zbeta_rsq_over_expected.R @@ -155,6 +155,7 @@ Zbeta_rsq_over_expected<-function(pos, ws, x, dist, LDprofile_bins, LDprofile_rs # Find distances between each SNP in L and round to bin size bins<-sapply(outer(dist[pos<=currentPos+ws/2 & pos > currentPos],dist[pos>=currentPos-ws/2 & pos < currentPos],"-"),assign_bins,bin_size=bin_size) + bins[bins>max(LDprofile_bins)]<-max(LDprofile_bins) rsq<-as.vector(t((cor(t(x[pos>=currentPos-ws/2 & pos<=currentPos+ws/2,]),use="pairwise.complete.obs")^2)[1:noL,(noL+2):(noL+noR+1)])) rsqExp<-merge(data.frame(bins=as.character(bins),rsq),data.frame(LDprofile_bins=as.character(LDprofile_bins),LDprofile_rsq),by.x="bins",by.y="LDprofile_bins",all.x=TRUE,sort=FALSE) rsqSum<-sum(rsqExp$rsq/rsqExp$LDprofile_rsq)