version 0.76

cran · Jun 21, 2011 · 7eda055 · 7eda055
1 parent a585660
commit 7eda055
Show file tree

Hide file tree

Showing 6 changed files with 35 additions and 30 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,13 +1,13 @@
 Package: SKAT
 Type: Package
 Title: SNP-set (Sequence) Kernel Association Test
-Version: 0.75
-Date: 2011-05-11
+Version: 0.76
+Date: 2011-06-21
 Author: Seunggeun Lee, Larisa Miropolsky and Micheal Wu
 Maintainer: Seunggeun (Shawn) Lee <phila78@gmail.com>
 Description: Kernel based SNP set test
 License: GPL (>= 2)
 Depends: R (>= 2.13.0)
-Packaged: 2012-05-11 15:13:23 UTC; seunggeun
+Packaged: 2012-06-26 18:44:15 UTC; seunggeun
 Repository: CRAN
-Date/Publication: 2012-05-11 17:45:50
+Date/Publication: 2012-06-27 05:41:02
diff --git a/MD5 b/MD5
@@ -1,4 +1,4 @@
-eae8b2eba785ee6a4494dc0d57b00136 *DESCRIPTION
+d4fe116718a9dfafd72644e5bde22884 *DESCRIPTION
 91200fad1a7abf0bd2a6288f33694ee3 *NAMESPACE
 1d71c5f98b8afed87f2c55f4f1e62190 *R/Function.R
 1dfb97d6d0ed6d4e023825ed0b22627a *R/Function_Power_Resampling.R
@@ -7,12 +7,12 @@ aeb01912fa7696ed7dae5b8012f1249a *R/KMTest_Logistic.R
 33f8c08f2ccd000b7cd2e89e6e7312da *R/KMTest_Logistic_VarMatching.R
 92b59aadbbac15eed256268a8fc72803 *R/KMTest_Optimal.R
 853c16efc7c8e7230286a5b79d2c92be *R/KMTest_Optimal_VarMatching.R
-69e58ee1e1abd3b6a1011f561d105927 *R/Kernel.R
+a270d1f8802d88edb99d9e9ed343d164 *R/Kernel.R
 22bdf30d46adf06b4a9b695037501297 *R/Main.R
 dedd98339da2922e136233176d41fdfa *R/Main_SSD.R
 66ce4e65dc9e3840c24b919a3c6d2b5e *R/Null_Model.R
-d19eb43269d41058ac658f4772ec5d1b *R/Power.R
-3ee5aca07101be9b950d6fd8bf463047 *R/Power_Corr.R
+5704ca2797f81bf19b6e6ed7dfd96e6e *R/Power.R
+42a6078313aaa5c3ee2826f7cbe907a9 *R/Power_Corr.R
 192e270bf689a25409a2b16e5aaaab5e *R/SKAT_CompQuadForm.R
 7e3fb60e086155509a9f6915f75c506a *R/SSD.R
 00d8424ccbb4423afa3fed1a15bc05e7 *data/SKAT.example.rda
@@ -23,7 +23,7 @@ ba60f2917612cca53407a1933d988f39 *inst/doc/Example1.SetID
 e3b99ed0a36686c879c840e293e7687d *inst/doc/Example1.bim
 9a8d91e7b3c8d88b3d465b2c5ee5e614 *inst/doc/Example1.fam
 40344d9daf587ad38eda15074535dbc5 *inst/doc/SKAT.Rnw
-fefcf0e8a61bb0c9c58d45141a584a5b *inst/doc/SKAT.pdf
+611f2ff6bf64f04eed181c2bea4185d8 *inst/doc/SKAT.pdf
 c15e095daf297308d467f36902f60e62 *man/Close_SSD.rd
 d49220922e600dfd17ba774ebcab9aae *man/Generate_SSD_SetID.rd
 f9800e7e2bc262cf021d87dd53df0876 *man/Get_Genotypes_SSD.rd

diff --git a/R/Kernel.R b/R/Kernel.R
@@ -22,6 +22,9 @@ call_Kernel_IBS_Weight<-function(Z,n,p,weights){
 	if( is.null(weights)){
 		weights = rep(0,p);
 		given_weight = 0;
+	} else {
+		# change!!
+		weights<-weights^2;
 	}
 	K<- matrix(rep(0,n*n),nrow = n, ncol = n)	
 	temp<-.C("Kernel_IBS_Weight",as.integer(as.vector(t(Z))),as.integer(n), as.integer(p),as.integer(given_weight),
@@ -39,18 +42,6 @@ call_Kernel_2wayIX<-function(Z,n,p){
 
 lskmTest.GetKernel = function(Z, kernel, weights,n,m){
 
-	if (kernel == "linear") {
-      		K = Z%*%t(Z)/m
-    	}
-    	if (kernel == "linear.weighted") {
-     		#K = matrix(nrow = n, ncol = n)
-      		if (is.null(weights)) {
-        		qs = apply(Z, 2, mean)/(2)
-        		weights = 1/sqrt(qs)
-      		}
-      		Z1 = t(t(Z)*(weights))
-      		K = Z1%*%t(Z1)/m
-    	} 
     	if (kernel == "quadratic") {
       		K = (Z%*%t(Z)+1)**2
     	}
@@ -60,6 +51,7 @@ lskmTest.GetKernel = function(Z, kernel, weights,n,m){
       		K = call_Kernel_IBS(Z,n,m)
     	}
     	if (kernel == "IBS.weighted") {
+
       		K = call_Kernel_IBS_Weight(Z,n,m,weights)
     	}
   	if (kernel == "2wayIX") {
@@ -70,7 +62,9 @@ lskmTest.GetKernel = function(Z, kernel, weights,n,m){
       		if (is.null(weights)) {
         		qs = apply(Z, 2, mean)/(2)
         		weights = 1/sqrt(qs)
-      		}
+      		} else {
+			weights<-weights^2
+		}
       		K1 = matrix(nrow =n, ncol = n)
       		for (i in 1:n) {
         		K1[i,] = apply(abs(t(Z)-Z[i,])*weights,2, sum)

diff --git a/R/Power.R b/R/Power.R
@@ -30,13 +30,13 @@ Get_Beta<-function(Type, MAF, MaxValue,Sign=0){
 		re[IDX]<-MaxValue
 	}	
 
-    	if(Sign > 0){
+    	if(Sign > 0){
       		#temp.n<-round(n * Sign)
 		temp.n<-floor(n * Sign)
-		if(temp.n > 0){
-      			temp.idx<-sample(1:n, temp.n)
+		if(temp.n > 0){
+      			temp.idx<-sample(1:n, temp.n)
       			re[temp.idx]<--re[temp.idx]
-		}
+		}
     	} 
 	return(re)
 
@@ -77,7 +77,16 @@ Get_RequiredSampleSize_OLD<-function(Power.Est, Power=0.8){
 Get_CausalSNPs<-function(MAF, Causal.Ratio, Causal.MAF.Cutoff){
 
 	IDX<-which(MAF < Causal.MAF.Cutoff)
+	if(length(IDX) == 0){
+		msg<-sprintf("No SNPs with MAF < %f",Causal.MAF.Cutoff)
+		stop(msg)
+	}
+
+
 	N.causal<-round(Causal.Ratio * length(IDX))
+	if(N.causal < 1){
+		N.causal = 1
+	}
 	#print(N.causal)
 	#print(Causal.Ratio)
 	#print(length(IDX))
@@ -423,7 +432,7 @@ Power_Logistic<-function(Haplotypes=NULL, SNP.Location=NULL, SubRegion.Length=-1
 		Beta = Get_Beta(OR.Type, Marker.Causal.MAF, log(MaxOR),Negative.Percent/100)
 
 		Causal.Idx1<-IDX.Marker[Causal.Idx]
-		eta<-(Haplotypes[,Causal.Idx1] %*% Beta)[,1] - (t(Marker.Causal.MAF *2)  %*% Beta)[1,1]
+		eta<-(as.matrix(Haplotypes[,Causal.Idx1]) %*% Beta)[,1] - (t(Marker.Causal.MAF *2)  %*% Beta)[1,1]
 		eta1<-eta[H1] + eta[H2]
 
 		#print(Beta)
@@ -498,8 +507,10 @@ Power_Continuous<-function(Haplotypes=NULL, SNP.Location=NULL, SubRegion.Length=
 		Beta = Get_Beta(BetaType, Marker.Causal.MAF, MaxBeta,Negative.Percent/100)
 
 		Causal.Idx1<-IDX.Marker[Causal.Idx]
-		eta<-(Haplotypes[,Causal.Idx1] %*% Beta)[,1] - (t(Marker.Causal.MAF *2)  %*% Beta)[1,1]
+		eta<-(as.matrix(Haplotypes[,Causal.Idx1]) %*% Beta)[,1] - (t(Marker.Causal.MAF *2)  %*% Beta)[1,1]
 		eta1<-eta[H1] + eta[H2]
+
+
 		out.r_2[i]<-sum(Beta^2*2*Marker.Causal.MAF*(1-Marker.Causal.MAF))
 
 

diff --git a/R/Power_Corr.R b/R/Power_Corr.R
@@ -180,7 +180,7 @@ Power_Logistic_R<-function(Haplotypes=NULL, SNP.Location=NULL, SubRegion.Length=
 		# Seunggeun Change
 		#eta<-(Haplotypes[,Causal.Idx1] %*% Beta)[,1] - (t(Marker.Causal.MAF *2)  %*% Beta)[1,1]
 		#eta1<-eta[H1] + eta[H2]
-		eta1<-(X1[,Causal.Idx] %*% Beta)[,1] - (t(Marker.Causal.MAF *2)  %*% Beta)[1,1]
+		eta1<-(as.matrix(X1[,Causal.Idx]) %*% Beta)[,1] - (t(Marker.Causal.MAF *2)  %*% Beta)[1,1]
 
 		#print(Beta)
 		#####################################
@@ -259,7 +259,7 @@ Power_Continuous_R<-function(Haplotypes=NULL, SNP.Location=NULL, SubRegion.Lengt
 		# Seunggeun Change
 		#eta<-(Haplotypes[,Causal.Idx1] %*% Beta)[,1] - (t(Marker.Causal.MAF *2)  %*% Beta)[1,1]
 		#eta1<-eta[H1] + eta[H2]
-		eta1<-(X1[,Causal.Idx] %*% Beta)[,1] - (t(Marker.Causal.MAF *2)  %*% Beta)[1,1]
+		eta1<-(as.matrix(X1[,Causal.Idx]) %*% Beta)[,1] - (t(Marker.Causal.MAF *2)  %*% Beta)[1,1]
 
 		#print(Causal.Idx)
 		#print(Beta)

diff --git a/inst/doc/SKAT.pdf b/inst/doc/SKAT.pdf