4 | using namespace Rcpp;
5 | using namespace arma;
6 |
7 | // [[Rcpp::depends(RcppArmadillo)]]
8 | // [[Rcpp::plugins(openmp)]]
9 |
10 | // [[Rcpp::export]]
11 | arma::mat GetLinearKernel(arma::mat X){
12 | double p = X.n_rows;
13 | return X.t()*X/p;
14 | }
15 |
16 | // [[Rcpp::export]]
17 | arma::mat ComputePCs(arma::mat X,int top = 10){
18 | mat U;
19 | vec s;
20 | mat V;
21 | svd(U,s,V,X);
22 |
23 | mat PCs = U*diagmat(s);
24 | return PCs.cols(0,top-1);
25 | }
26 |
27 | ////////////////////////////////////////////////////////////////////////////
28 |
29 | //Below are functions for MAPIT using two hypothesis testing strategies:
30 | //(1) MAPIT using the Normal or Z-Test
31 | //(2) MAPIT using the Davies Method
32 |
33 | //Considered are the following submodels:
34 | //(1) Standard Model ---> y = m+g+e
35 | //(2) Standard + Covariate Model ---> y = Wa+m+g+e
36 | //(3) Standard + Common Environment Model ---> y = m+g+c+e
37 | //(4) Standard + Covariate + Common Environment Model ---> y = Wa+m+g+c+e
38 |
39 | //NOTE: delta = {delta(0),delta(1),delta(2)} = {sigma^2,omega^2,tau^2} for models (1) and (2)
40 | //NOTE: delta = {delta(0),delta(1),delta(2),delta(3)} = {sigma^2,omega^2,nu^2,tau^2} for models (3) and (4)
41 |
42 | ////////////////////////////////////////////////////////////////////////////
43 |
44 | // Model 1: Standard Model ---> y = m+g+e
45 |
46 | // [[Rcpp::export]]
47 | List MAPIT1_Normal(mat X,vec y){
48 | int i;
49 | const int n = X.n_cols;
50 | const int p = X.n_rows;
51 |
52 | //Set up the vectors to save the outputs
53 | NumericVector sigma_est(p);
54 | NumericVector sigma_se(p);
55 | NumericVector pve(p);
56 |
57 | //Pre-compute the Linear GSM
58 | mat GSM = GetLinearKernel(X);
59 |
60 | for(i=0; i(n); b.col(1) = trans(X.row(i));
71 | mat btb_inv = inv(b.t()*b);
72 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
73 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
74 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
75 |
76 | //Compute the quantities q and S
77 | vec q = zeros(3); //Create k-vector q to save
78 | mat S = zeros(3,3); //Create kxk-matrix S to save
79 |
80 | q(0) = as_scalar(yc.t()*Gc*yc);
81 | q(1) = as_scalar(yc.t()*Kc*yc);
82 | q(2) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
83 |
84 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
85 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
86 | S(0,2) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
87 | S(1,0) = S(0,1);
88 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
89 | S(1,2) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
90 | S(2,0) = S(0,2);
91 | S(2,1) = S(1,2);
92 | S(2,2) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
93 |
94 | //Compute sigma(0) and sigma(1)
95 | mat Sinv = inv(S);
96 | vec delta = Sinv*q;
97 |
98 | //Compute var(sigma(0))
99 | double V_sigma = as_scalar(2*yc.t()*trans(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*(delta(0)*Gc+delta(1)*Kc+delta(2)*(eye(n,n)-(b*btb_inv)*b.t()))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*yc);
100 |
101 | //Save point estimates and SE of the epistasis component
102 | sigma_est(i) = delta(0);
103 | sigma_se(i) = sqrt(V_sigma);
104 |
105 | //Compute the PVE
106 | pve(i) = delta(0)/accu(delta);
107 | }
108 |
109 | //Compute the p-values for each estimate
110 | NumericVector sigma_pval = 2*Rcpp::pnorm(abs(sigma_est/sigma_se),0.0,1.0,0,0); //H0: sigma = 0 vs. H1: sigma != 0
111 |
112 | //Return a list of the arguments
113 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("SE") = sigma_se,Rcpp::Named("pvalues") = sigma_pval,Rcpp::Named("PVE") = pve);
114 | }
115 |
116 | ////////////////////////////////////////////////////////////////////////////
117 |
118 | // Model 2: Standard + Covariate Model ---> y = Wa+m+g+e
119 |
120 | // [[Rcpp::export]]
121 | List MAPIT2_Normal(mat X,vec y,mat Z){
122 | int i;
123 | const int n = X.n_cols;
124 | const int p = X.n_rows;
125 | const int q = Z.n_rows;
126 |
127 | //Set up the vectors to save the outputs
128 | NumericVector sigma_est(p);
129 | NumericVector sigma_se(p);
130 | NumericVector pve(p);
131 |
132 | //Pre-compute the Linear GSM
133 | mat GSM = GetLinearKernel(X);
134 |
135 | for(i=0; i(n); b.cols(1,q) = Z.t(); b.col(q+1) = trans(X.row(i));
146 | mat btb_inv = inv(b.t()*b);
147 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
148 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
149 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
150 |
151 | //Compute the quantities q and S
152 | vec q = zeros(3); //Create k-vector q to save
153 | mat S = zeros(3,3); //Create kxk-matrix S to save
154 |
155 | q(0) = as_scalar(yc.t()*Gc*yc);
156 | q(1) = as_scalar(yc.t()*Kc*yc);
157 | q(2) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
158 |
159 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
160 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
161 | S(0,2) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
162 | S(1,0) = S(0,1);
163 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
164 | S(1,2) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
165 | S(2,0) = S(0,2);
166 | S(2,1) = S(1,2);
167 | S(2,2) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
168 |
169 | //Compute delta and Sinv
170 | mat Sinv = inv(S);
171 | vec delta = Sinv*q;
172 |
173 | //Compute var(delta(0))
174 | double V_sigma = as_scalar(2*yc.t()*trans(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*(delta(0)*Gc+delta(1)*Kc+delta(2)*(eye(n,n)-(b*btb_inv)*b.t()))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*yc);
175 |
176 | //Save point estimates and SE of the epistasis component
177 | sigma_est(i) = delta(0);
178 | sigma_se(i) = sqrt(V_sigma);
179 |
180 | //Compute the PVE
181 | pve(i) = delta(0)/accu(delta);
182 | }
183 |
184 | //Compute the p-values for each estimate
185 | NumericVector sigma_pval = 2*Rcpp::pnorm(abs(sigma_est/sigma_se),0.0,1.0,0,0); //H0: sigma = 0 vs. H1: sigma != 0
186 |
187 | //Return a list of the arguments
188 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("SE") = sigma_se,Rcpp::Named("pvalues") = sigma_pval,Rcpp::Named("PVE") = pve);
189 | }
190 |
191 | ////////////////////////////////////////////////////////////////////////////
192 |
193 | // Model 3: Standard + Common Environment Model ---> y = m+g+c+e
194 |
195 | // [[Rcpp::export]]
196 | List MAPIT3_Normal(mat X,vec y,mat C){
197 | int i;
198 | const int n = X.n_cols;
199 | const int p = X.n_rows;
200 |
201 | //Set up the vectors to save the outputs
202 | NumericVector sigma_est(p);
203 | NumericVector sigma_se(p);
204 | NumericVector pve(p);
205 |
206 | //Pre-compute the Linear GSM
207 | mat GSM = GetLinearKernel(X);
208 |
209 | for(i=0; i(n); b.col(1) = trans(X.row(i));
220 | mat btb_inv = inv(b.t()*b);
221 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
222 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
223 | mat Cc = C-b*btb_inv*(b.t()*C)-(C*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(C*b))*btb_inv*b.t();
224 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
225 |
226 | //Compute the quantities q and S
227 | vec q = zeros(4); //Create k-vector q to save
228 | mat S = zeros(4,4); //Create kxk-matrix S to save
229 |
230 | q(0) = as_scalar(yc.t()*Gc*yc);
231 | q(1) = as_scalar(yc.t()*Kc*yc);
232 | q(2) = as_scalar(yc.t()*Cc*yc);
233 | q(3) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
234 |
235 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
236 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
237 | S(0,2) = as_scalar(accu(Gc.t()%Cc));
238 | S(0,3) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
239 |
240 | S(1,0) = S(0,1);
241 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
242 | S(1,2) = as_scalar(accu(Kc.t()%Cc));
243 | S(1,3) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
244 |
245 | S(2,0) = S(0,2);
246 | S(2,1) = S(1,2);
247 | S(2,2) = as_scalar(accu(Cc.t()%Cc));
248 | S(2,3) = as_scalar(accu(Cc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
249 |
250 | S(3,0) = S(0,3);
251 | S(3,1) = S(1,3);
252 | S(3,2) = S(2,3);
253 | S(3,3) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
254 |
255 | //Compute delta and Sinv
256 | mat Sinv = inv(S);
257 | vec delta = Sinv*q;
258 |
259 | //Compute var(delta(0))
260 | double V_sigma = as_scalar(2*yc.t()*trans(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*(delta(0)*Gc+delta(1)*Kc+delta(2)*Cc+delta(3)*(eye(n,n)-(b*btb_inv)*b.t()))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*yc);
261 |
262 | //Save point estimates and SE of the epistasis component
263 | sigma_est(i) = delta(0);
264 | sigma_se(i) = sqrt(V_sigma);
265 |
266 | //Compute the PVE
267 | pve(i) = delta(0)/accu(delta);
268 | }
269 |
270 | //Compute the p-values for each estimate
271 | NumericVector sigma_pval = 2*Rcpp::pnorm(abs(sigma_est/sigma_se),0.0,1.0,0,0); //H0: sigma = 0 vs. H1: sigma != 0
272 |
273 | //Return a list of the arguments
274 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("SE") = sigma_se,Rcpp::Named("pvalues") = sigma_pval,Rcpp::Named("PVE") = pve);
275 | }
276 |
277 | ////////////////////////////////////////////////////////////////////////////
278 |
279 | // Model 4: Standard + Covariate + Common Environment Model ---> y = Wa+m+g+c+e
280 |
281 | // [[Rcpp::export]]
282 | List MAPIT4_Normal(mat X,vec y,mat Z,mat C){
283 | int i;
284 | const int n = X.n_cols;
285 | const int p = X.n_rows;
286 | const int q = Z.n_rows;
287 |
288 | //Set up the vectors to save the outputs
289 | NumericVector sigma_est(p);
290 | NumericVector sigma_se(p);
291 | NumericVector pve(p);
292 |
293 | //Pre-compute the Linear GSM
294 | mat GSM = GetLinearKernel(X);
295 |
296 | for(i=0; i(n); b.cols(1,q) = Z.t(); b.col(q+1) = trans(X.row(i));
307 | mat btb_inv = inv(b.t()*b);
308 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
309 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
310 | mat Cc = C-b*btb_inv*(b.t()*C)-(C*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(C*b))*btb_inv*b.t();
311 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
312 |
313 | //Compute the quantities q and S
314 | vec q = zeros(4); //Create k-vector q to save
315 | mat S = zeros(4,4); //Create kxk-matrix S to save
316 |
317 | q(0) = as_scalar(yc.t()*Gc*yc);
318 | q(1) = as_scalar(yc.t()*Kc*yc);
319 | q(2) = as_scalar(yc.t()*Cc*yc);
320 | q(3) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
321 |
322 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
323 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
324 | S(0,2) = as_scalar(accu(Gc.t()%Cc));
325 | S(0,3) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
326 |
327 | S(1,0) = S(0,1);
328 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
329 | S(1,2) = as_scalar(accu(Kc.t()%Cc));
330 | S(1,3) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
331 |
332 | S(2,0) = S(0,2);
333 | S(2,1) = S(1,2);
334 | S(2,2) = as_scalar(accu(Cc.t()%Cc));
335 | S(2,3) = as_scalar(accu(Cc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
336 |
337 | S(3,0) = S(0,3);
338 | S(3,1) = S(1,3);
339 | S(3,2) = S(2,3);
340 | S(3,3) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
341 |
342 | //Compute delta and Sinv
343 | mat Sinv = inv(S);
344 | vec delta = Sinv*q;
345 |
346 | //Compute var(delta(0))
347 | double V_sigma = as_scalar(2*yc.t()*trans(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*(delta(0)*Gc+delta(1)*Kc+delta(2)*Cc+delta(3)*(eye(n,n)-(b*btb_inv)*b.t()))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*yc);
348 |
349 | //Save point estimates and SE of the epistasis component
350 | sigma_est(i) = delta(0);
351 | sigma_se(i) = sqrt(V_sigma);
352 |
353 | //Compute the PVE
354 | pve(i) = delta(0)/accu(delta);
355 | }
356 |
357 | //Compute the p-values for each estimate
358 | NumericVector sigma_pval = 2*Rcpp::pnorm(abs(sigma_est/sigma_se),0.0,1.0,0,0); //H0: sigma = 0 vs. H1: sigma != 0
359 |
360 | //Return a list of the arguments
361 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("SE") = sigma_se,Rcpp::Named("pvalues") = sigma_pval,Rcpp::Named("PVE") = pve);
362 | }
363 |
364 | ////////////////////////////////////////////////////////////////////////////
365 | ////////////////////////////////////////////////////////////////////////////
366 | ////////////////////////////////////////////////////////////////////////////
367 | ////////////////////////////////////////////////////////////////////////////
368 |
369 | //Here is MAPIT using the Davies Method for hypothesis testing
370 |
371 | ////////////////////////////////////////////////////////////////////////////
372 | ////////////////////////////////////////////////////////////////////////////
373 | ////////////////////////////////////////////////////////////////////////////
374 | ////////////////////////////////////////////////////////////////////////////
375 |
376 | // Model 1: Standard Model ---> y = m+g+e
377 |
378 | // [[Rcpp::export]]
379 | List MAPIT1_Davies(mat X,vec y,const vec ind){
380 | int i;
381 | const int n = X.n_cols;
382 | const int p = X.n_rows;
383 |
384 | //Set up the vectors to save the outputs
385 | NumericVector sigma_est(p);
386 | NumericVector pve(p);
387 | mat Lambda(n,p);
388 |
389 | //Pre-compute the Linear GSM
390 | mat GSM = GetLinearKernel(X);
391 |
392 | for(i=0; i(n); b.col(1) = trans(X.row(i));
405 | mat btb_inv = inv(b.t()*b);
406 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
407 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t(); //Scale Kn = MKnM^t
408 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
409 |
410 | //Compute the quantities q and S
411 | vec q = zeros(3); //Create k-vector q to save
412 | mat S = zeros(3,3); //Create kxk-matrix S to save
413 |
414 | q(0) = as_scalar(yc.t()*Gc*yc);
415 | q(1) = as_scalar(yc.t()*Kc*yc);
416 | q(2) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
417 |
418 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
419 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
420 | S(0,2) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
421 |
422 | S(1,0) = S(0,1);
423 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
424 | S(1,2) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
425 |
426 | S(2,0) = S(0,2);
427 | S(2,1) = S(1,2);
428 | S(2,2) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
429 |
430 | //Compute delta and Sinv
431 | mat Sinv = inv(S);
432 | vec delta = Sinv*q;
433 |
434 | //Record omega^2, nu^2, and tau^2 under the null hypothesis
435 | vec q_sub = zeros(2);
436 | mat S_sub = zeros(2,2);
437 |
438 | q_sub(0)=q(1);
439 | q_sub(1)=q(2);
440 |
441 | S_sub(0,0)=S(1,1);
442 | S_sub(0,1)=S(1,2);
443 |
444 | S_sub(1,0)=S(2,1);
445 | S_sub(1,1)=S(2,2);
446 |
447 | //Save point estimates and SE of the epistasis component
448 | sigma_est(i) = delta(0);
449 |
450 | //Compute P and P^{1/2} matrix
451 | vec delta_null = inv(S_sub)*q_sub;
452 |
453 | vec eigval;
454 | mat eigvec;
455 |
456 | eig_sym(eigval,eigvec,delta_null(0)*Kc+delta_null(1)*(eye(n,n)-(b*btb_inv)*b.t()));
457 |
458 | //Find the eigenvalues of the projection matrix
459 | vec evals;
460 |
461 | eig_sym(evals, (eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0))))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*(eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0)))));
462 | Lambda.col(i) = evals;
463 |
464 | //Compute the PVE
465 | pve(i) = delta(0)/accu(delta);
466 | }
467 | }
468 |
469 | //Return a list of the arguments
470 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("Eigenvalues") = Lambda,Rcpp::Named("PVE") = pve);
471 | }
472 |
473 | ////////////////////////////////////////////////////////////////////////////
474 |
475 | // Model 2: Standard + Covariate Model ---> y = Wa+m+g+e
476 |
477 | // [[Rcpp::export]]
478 | List MAPIT2_Davies(mat X,vec y,mat Z,const vec ind){
479 | int i;
480 | const int n = X.n_cols;
481 | const int p = X.n_rows;
482 | const int q = Z.n_rows;
483 |
484 | //Set up the vectors to save the outputs
485 | NumericVector sigma_est(p);
486 | NumericVector pve(p);
487 | mat Lambda(n,p);
488 |
489 | //Pre-compute the Linear GSM
490 | mat GSM = GetLinearKernel(X);
491 |
492 | for(i=0; i(n); b.cols(1,q) = Z.t(); b.col(q+1) = trans(X.row(i));
505 | mat btb_inv = inv(b.t()*b);
506 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
507 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t(); //Scale Kn = MKnM^t
508 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
509 |
510 | //Compute the quantities q and S
511 | vec q = zeros(3); //Create k-vector q to save
512 | mat S = zeros(3,3); //Create kxk-matrix S to save
513 |
514 | q(0) = as_scalar(yc.t()*Gc*yc);
515 | q(1) = as_scalar(yc.t()*Kc*yc);
516 | q(2) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
517 |
518 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
519 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
520 | S(0,2) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
521 |
522 | S(1,0) = S(0,1);
523 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
524 | S(1,2) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
525 |
526 | S(2,0) = S(0,2);
527 | S(2,1) = S(1,2);
528 | S(2,2) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
529 |
530 | //Compute delta and Sinv
531 | mat Sinv = inv(S);
532 | vec delta = Sinv*q;
533 |
534 | //Record omega^2, nu^2, and tau^2 under the null hypothesis
535 | vec q_sub = zeros(2);
536 | mat S_sub = zeros(2,2);
537 |
538 | q_sub(0)=q(1);
539 | q_sub(1)=q(2);
540 |
541 | S_sub(0,0)=S(1,1);
542 | S_sub(0,1)=S(1,2);
543 |
544 | S_sub(1,0)=S(2,1);
545 | S_sub(1,1)=S(2,2);
546 |
547 | //Save point estimates and SE of the epistasis component
548 | sigma_est(i) = delta(0);
549 |
550 | //Compute P and P^{1/2} matrix
551 | vec delta_null = inv(S_sub)*q_sub;
552 |
553 | vec eigval;
554 | mat eigvec;
555 |
556 | eig_sym(eigval,eigvec,delta_null(0)*Kc+delta_null(1)*(eye(n,n)-(b*btb_inv)*b.t()));
557 |
558 | //Find the eigenvalues of the projection matrix
559 | vec evals;
560 |
561 | eig_sym(evals, (eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0))))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*(eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0)))));
562 | Lambda.col(i) = evals;
563 |
564 | //Compute the PVE
565 | pve(i) = delta(0)/accu(delta);
566 | }
567 | }
568 |
569 | //Return a list of the arguments
570 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("Eigenvalues") = Lambda,Rcpp::Named("PVE") = pve);
571 | }
572 |
573 | ////////////////////////////////////////////////////////////////////////////
574 |
575 | // Model 3: Standard + Common Environment Model ---> y = m+g+c+e
576 |
577 | // [[Rcpp::export]]
578 | List MAPIT3_Davies(mat X,vec y,mat C,const vec ind){
579 | int i;
580 | const int n = X.n_cols;
581 | const int p = X.n_rows;
582 |
583 | //Set up the vectors to save the outputs
584 | NumericVector sigma_est(p);
585 | NumericVector pve(p);
586 | mat Lambda(n,p);
587 |
588 | //Pre-compute the Linear GSM
589 | mat GSM = GetLinearKernel(X);
590 |
591 | for(i=0; i(n); b.col(1) = trans(X.row(i));
604 | mat btb_inv = inv(b.t()*b);
605 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
606 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
607 | mat Cc = C-b*btb_inv*(b.t()*C)-(C*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(C*b))*btb_inv*b.t();
608 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
609 |
610 | //Compute the quantities q and S
611 | vec q = zeros(4); //Create k-vector q to save
612 | mat S = zeros(4,4); //Create kxk-matrix S to save
613 |
614 | q(0) = as_scalar(yc.t()*Gc*yc);
615 | q(1) = as_scalar(yc.t()*Kc*yc);
616 | q(2) = as_scalar(yc.t()*Cc*yc);
617 | q(3) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
618 |
619 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
620 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
621 | S(0,2) = as_scalar(accu(Gc.t()%Cc));
622 | S(0,3) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
623 |
624 | S(1,0) = S(0,1);
625 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
626 | S(1,2) = as_scalar(accu(Kc.t()%Cc));
627 | S(1,3) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
628 |
629 | S(2,0) = S(0,2);
630 | S(2,1) = S(1,2);
631 | S(2,2) = as_scalar(accu(Cc.t()%Cc));
632 | S(2,3) = as_scalar(accu(Cc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
633 |
634 | S(3,0) = S(0,3);
635 | S(3,1) = S(1,3);
636 | S(3,2) = S(2,3);
637 | S(3,3) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
638 |
639 | //Compute delta and Sinv
640 | mat Sinv = inv(S);
641 | vec delta = Sinv*q;
642 |
643 | //Record omega^2, nu^2, and tau^2 under the null hypothesis
644 | vec q_sub = zeros(3);
645 | mat S_sub = zeros(3,3);
646 |
647 | q_sub(0)=q(1);
648 | q_sub(1)=q(2);
649 | q_sub(2)=q(3);
650 |
651 | S_sub(0,0)=S(1,1);
652 | S_sub(0,1)=S(1,2);
653 | S_sub(0,2)=S(1,3);
654 |
655 | S_sub(1,0)=S(2,1);
656 | S_sub(1,1)=S(2,2);
657 | S_sub(1,2)=S(2,3);
658 |
659 | S_sub(2,0)=S(3,1);
660 | S_sub(2,1)=S(3,2);
661 | S_sub(2,2)=S(3,3);
662 |
663 | //Save point estimates and SE of the epistasis component
664 | sigma_est(i) = delta(0);
665 |
666 | //Compute P and P^{1/2} matrix
667 | vec delta_null = inv(S_sub)*q_sub;
668 |
669 | vec eigval;
670 | mat eigvec;
671 |
672 | eig_sym(eigval,eigvec,delta_null(0)*Kc+delta_null(1)*Cc+delta_null(2)*(eye(n,n)-(b*btb_inv)*b.t()));
673 |
674 | //Find the eigenvalues of the projection matrix
675 | vec evals;
676 |
677 | eig_sym(evals, (eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0))))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*(eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0)))));
678 | Lambda.col(i) = evals;
679 |
680 | //Compute the PVE
681 | pve(i) = delta(0)/accu(delta);
682 | }
683 | }
684 |
685 | //Return a list of the arguments
686 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("Eigenvalues") = Lambda,Rcpp::Named("PVE") = pve);
687 | }
688 |
689 | ////////////////////////////////////////////////////////////////////////////
690 |
691 | // Model 4: Standard + Common Environment Model ---> y = Wa+m+g+c+e
692 |
693 | // [[Rcpp::export]]
694 | List MAPIT4_Davies(mat X,vec y,mat Z,mat C,const vec ind){
695 | int i;
696 | const int n = X.n_cols;
697 | const int p = X.n_rows;
698 | const int q = Z.n_rows;
699 |
700 | //Set up the vectors to save the outputs
701 | NumericVector sigma_est(p);
702 | NumericVector pve(p);
703 | mat Lambda(n,p);
704 |
705 | //Pre-compute the Linear GSM
706 | mat GSM = GetLinearKernel(X);
707 |
708 | for(i=0; i(n); b.cols(1,q) = Z.t(); b.col(q+1) = trans(X.row(i));
721 | mat btb_inv = inv(b.t()*b);
722 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
723 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
724 | mat Cc = C-b*btb_inv*(b.t()*C)-(C*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(C*b))*btb_inv*b.t();
725 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
726 |
727 | //Compute the quantities q and S
728 | vec q = zeros(4); //Create k-vector q to save
729 | mat S = zeros(4,4); //Create kxk-matrix S to save
730 |
731 | q(0) = as_scalar(yc.t()*Gc*yc);
732 | q(1) = as_scalar(yc.t()*Kc*yc);
733 | q(2) = as_scalar(yc.t()*Cc*yc);
734 | q(3) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
735 |
736 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
737 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
738 | S(0,2) = as_scalar(accu(Gc.t()%Cc));
739 | S(0,3) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
740 |
741 | S(1,0) = S(0,1);
742 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
743 | S(1,2) = as_scalar(accu(Kc.t()%Cc));
744 | S(1,3) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
745 |
746 | S(2,0) = S(0,2);
747 | S(2,1) = S(1,2);
748 | S(2,2) = as_scalar(accu(Cc.t()%Cc));
749 | S(2,3) = as_scalar(accu(Cc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
750 |
751 | S(3,0) = S(0,3);
752 | S(3,1) = S(1,3);
753 | S(3,2) = S(2,3);
754 | S(3,3) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
755 |
756 | //Compute delta and Sinv
757 | mat Sinv = inv(S);
758 | vec delta = Sinv*q;
759 |
760 | //Record omega^2, nu^2, and tau^2 under the null hypothesis
761 | vec q_sub = zeros(3);
762 | mat S_sub = zeros(3,3);
763 |
764 | q_sub(0)=q(1);
765 | q_sub(1)=q(2);
766 | q_sub(2)=q(3);
767 |
768 | S_sub(0,0)=S(1,1);
769 | S_sub(0,1)=S(1,2);
770 | S_sub(0,2)=S(1,3);
771 |
772 | S_sub(1,0)=S(2,1);
773 | S_sub(1,1)=S(2,2);
774 | S_sub(1,2)=S(2,3);
775 |
776 | S_sub(2,0)=S(3,1);
777 | S_sub(2,1)=S(3,2);
778 | S_sub(2,2)=S(3,3);
779 |
780 | //Save point estimates and SE of the epistasis component
781 | sigma_est(i) = delta(0);
782 |
783 | //Compute P and P^{1/2} matrix
784 | vec delta_null = inv(S_sub)*q_sub;
785 |
786 | vec eigval;
787 | mat eigvec;
788 |
789 | eig_sym(eigval,eigvec,delta_null(0)*Kc+delta_null(1)*Cc+delta_null(2)*(eye(n,n)-(b*btb_inv)*b.t()));
790 |
791 | //Find the eigenvalues of the projection matrix
792 | vec evals;
793 |
794 | eig_sym(evals, (eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0))))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*(eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0)))));
795 | Lambda.col(i) = evals;
796 |
797 | //Compute the PVE
798 | pve(i) = delta(0)/accu(delta);
799 | }
800 | }
801 |
802 | //Return a list of the arguments
803 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("Eigenvalues") = Lambda,Rcpp::Named("PVE") = pve);
804 | }
805 |
806 | ////////////////////////////////////////////////////////////////////////////////
807 | ////////////////////////////////////////////////////////////////////////////////
808 | ////////////////////////////////////////////////////////////////////////////////
809 | ////////////////////////////////////////////////////////////////////////////////
810 |
811 | //Here is MAPIT using the Davies Method for the hypothesis testing of every SNP
812 |
813 | ////////////////////////////////////////////////////////////////////////////////
814 | ///////////////////////////////////////////////////////////////////////////////
815 | //////////////////////////////////////////////////////////////////////////////
816 | /////////////////////////////////////////////////////////////////////////////
817 |
818 | // [[Rcpp::export]]
819 | List MAPIT_Davies_Approx(mat X,vec y){
820 | int i;
821 | const int n = X.n_cols;
822 | const int p = X.n_rows;
823 |
824 | //Set up the vectors to save the outputs
825 | NumericVector sigma_est(p);
826 | NumericVector pve(p);
827 | mat Lambda(n,p);
828 |
829 | //Pre-compute the Linear GSM
830 | mat GSM = GetLinearKernel(X);
831 |
832 | for(i=0; i(n); b.col(1) = trans(X.row(i));
842 | mat btb_inv = inv(b.t()*b);
843 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t(); //Scale Kn = MKnM^t
844 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
845 |
846 | //Compute the quantities q and S
847 | vec q = zeros(2); //Create k-vector q to save
848 | mat S = zeros(2,2); //Create kxk-matrix S to save
849 |
850 | q(0) = as_scalar(yc.t()*Gc*yc);
851 | q(1) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
852 |
853 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
854 | S(0,1) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
855 | S(1,0) = S(0,1);
856 | S(1,1) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
857 |
858 | //Compute delta and Sinv
859 | mat Sinv = inv(S);
860 | vec delta = Sinv*q;
861 |
862 | //Save point estimates and SE of the epistasis component
863 | sigma_est(i) = delta(0);
864 |
865 | //Find the eigenvalues of the projection matrix
866 | vec evals;
867 | eig_sym(evals,(Sinv(0,0)*Gc+Sinv(0,1)*(eye(n,n)-(b*btb_inv)*b.t()))*q(1)/S(1,1));
868 | Lambda.col(i) = evals;
869 |
870 | //Compute the PVE
871 | pve(i) = delta(0)/accu(delta);
872 | }
873 |
874 | //Return a list of the arguments
875 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("Eigenvalues") = Lambda,Rcpp::Named("PVE") = pve);
876 | }
877 |
--------------------------------------------------------------------------------
/OpenMP Version/MAPIT_OpenMP.cpp:
--------------------------------------------------------------------------------
1 | // load Rcpp
2 | #include
3 | #include
4 | using namespace Rcpp;
5 | using namespace arma;
6 |
7 | // [[Rcpp::depends(RcppArmadillo)]]
8 | // [[Rcpp::plugins(openmp)]]
9 |
10 | // [[Rcpp::export]]
11 | arma::mat GetLinearKernel(arma::mat X){
12 | double p = X.n_rows;
13 | return X.t()*X/p;
14 | }
15 |
16 | // [[Rcpp::export]]
17 | arma::mat ComputePCs(arma::mat X,int top = 10){
18 | mat U;
19 | vec s;
20 | mat V;
21 | svd(U,s,V,X);
22 |
23 | mat PCs = U*diagmat(s);
24 | return PCs.cols(0,top-1);
25 | }
26 |
27 | ////////////////////////////////////////////////////////////////////////////
28 |
29 | //Below are functions for MAPIT using two hypothesis testing strategies:
30 | //(1) MAPIT using the Normal or Z-Test
31 | //(2) MAPIT using the Davies Method
32 |
33 | //Considered are the following submodels:
34 | //(1) Standard Model ---> y = m+g+e
35 | //(2) Standard + Covariate Model ---> y = Wa+m+g+e
36 | //(3) Standard + Common Environment Model ---> y = m+g+c+e
37 | //(4) Standard + Covariate + Common Environment Model ---> y = Wa+m+g+c+e
38 |
39 | //NOTE: delta = {delta(0),delta(1),delta(2)} = {sigma^2,omega^2,tau^2} for models (1) and (2)
40 | //NOTE: delta = {delta(0),delta(1),delta(2),delta(3)} = {sigma^2,omega^2,nu^2,tau^2} for models (3) and (4)
41 |
42 | ////////////////////////////////////////////////////////////////////////////
43 |
44 | // Model 1: Standard Model ---> y = m+g+e
45 |
46 | // [[Rcpp::export]]
47 | List MAPIT1_Normal(mat X,vec y,int cores = 1){
48 | int i;
49 | const int n = X.n_cols;
50 | const int p = X.n_rows;
51 |
52 | //Set up the vectors to save the outputs
53 | NumericVector sigma_est(p);
54 | NumericVector sigma_se(p);
55 | NumericVector pve(p);
56 |
57 | //Pre-compute the Linear GSM
58 | mat GSM = GetLinearKernel(X);
59 |
60 | omp_set_num_threads(cores);
61 | #pragma omp parallel for schedule(dynamic)
62 | for(i=0; i(n); b.col(1) = trans(X.row(i));
73 | mat btb_inv = inv(b.t()*b);
74 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
75 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
76 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
77 |
78 | //Compute the quantities q and S
79 | vec q = zeros(3); //Create k-vector q to save
80 | mat S = zeros(3,3); //Create kxk-matrix S to save
81 |
82 | q(0) = as_scalar(yc.t()*Gc*yc);
83 | q(1) = as_scalar(yc.t()*Kc*yc);
84 | q(2) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
85 |
86 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
87 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
88 | S(0,2) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
89 | S(1,0) = S(0,1);
90 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
91 | S(1,2) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
92 | S(2,0) = S(0,2);
93 | S(2,1) = S(1,2);
94 | S(2,2) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
95 |
96 | //Compute sigma(0) and sigma(1)
97 | mat Sinv = inv(S);
98 | vec delta = Sinv*q;
99 |
100 | //Compute var(sigma(0))
101 | double V_sigma = as_scalar(2*yc.t()*trans(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*(delta(0)*Gc+delta(1)*Kc+delta(2)*(eye(n,n)-(b*btb_inv)*b.t()))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*yc);
102 |
103 | //Save point estimates and SE of the epistasis component
104 | sigma_est(i) = delta(0);
105 | sigma_se(i) = sqrt(V_sigma);
106 |
107 | //Compute the PVE
108 | pve(i) = delta(0)/accu(delta);
109 | }
110 |
111 | //Compute the p-values for each estimate
112 | NumericVector sigma_pval = 2*Rcpp::pnorm(abs(sigma_est/sigma_se),0.0,1.0,0,0); //H0: sigma = 0 vs. H1: sigma != 0
113 |
114 | //Return a list of the arguments
115 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("SE") = sigma_se,Rcpp::Named("pvalues") = sigma_pval,Rcpp::Named("PVE") = pve);
116 | }
117 |
118 | ////////////////////////////////////////////////////////////////////////////
119 |
120 | // Model 2: Standard + Covariate Model ---> y = Wa+m+g+e
121 |
122 | // [[Rcpp::export]]
123 | List MAPIT2_Normal(mat X,vec y,mat Z,int cores = 1){
124 | int i;
125 | const int n = X.n_cols;
126 | const int p = X.n_rows;
127 | const int q = Z.n_rows;
128 |
129 | //Set up the vectors to save the outputs
130 | NumericVector sigma_est(p);
131 | NumericVector sigma_se(p);
132 | NumericVector pve(p);
133 |
134 | //Pre-compute the Linear GSM
135 | mat GSM = GetLinearKernel(X);
136 |
137 | omp_set_num_threads(cores);
138 | #pragma omp parallel for schedule(dynamic)
139 | for(i=0; i(n); b.cols(1,q) = Z.t(); b.col(q+1) = trans(X.row(i));
150 | mat btb_inv = inv(b.t()*b);
151 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
152 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
153 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
154 |
155 | //Compute the quantities q and S
156 | vec q = zeros(3); //Create k-vector q to save
157 | mat S = zeros(3,3); //Create kxk-matrix S to save
158 |
159 | q(0) = as_scalar(yc.t()*Gc*yc);
160 | q(1) = as_scalar(yc.t()*Kc*yc);
161 | q(2) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
162 |
163 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
164 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
165 | S(0,2) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
166 | S(1,0) = S(0,1);
167 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
168 | S(1,2) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
169 | S(2,0) = S(0,2);
170 | S(2,1) = S(1,2);
171 | S(2,2) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
172 |
173 | //Compute delta and Sinv
174 | mat Sinv = inv(S);
175 | vec delta = Sinv*q;
176 |
177 | //Compute var(delta(0))
178 | double V_sigma = as_scalar(2*yc.t()*trans(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*(delta(0)*Gc+delta(1)*Kc+delta(2)*(eye(n,n)-(b*btb_inv)*b.t()))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*yc);
179 |
180 | //Save point estimates and SE of the epistasis component
181 | sigma_est(i) = delta(0);
182 | sigma_se(i) = sqrt(V_sigma);
183 |
184 | //Compute the PVE
185 | pve(i) = delta(0)/accu(delta);
186 | }
187 |
188 | //Compute the p-values for each estimate
189 | NumericVector sigma_pval = 2*Rcpp::pnorm(abs(sigma_est/sigma_se),0.0,1.0,0,0); //H0: sigma = 0 vs. H1: sigma != 0
190 |
191 | //Return a list of the arguments
192 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("SE") = sigma_se,Rcpp::Named("pvalues") = sigma_pval,Rcpp::Named("PVE") = pve);
193 | }
194 |
195 | ////////////////////////////////////////////////////////////////////////////
196 |
197 | // Model 3: Standard + Common Environment Model ---> y = m+g+c+e
198 |
199 | // [[Rcpp::export]]
200 | List MAPIT3_Normal(mat X,vec y,mat C,int cores = 1){
201 | int i;
202 | const int n = X.n_cols;
203 | const int p = X.n_rows;
204 |
205 | //Set up the vectors to save the outputs
206 | NumericVector sigma_est(p);
207 | NumericVector sigma_se(p);
208 | NumericVector pve(p);
209 |
210 | //Pre-compute the Linear GSM
211 | mat GSM = GetLinearKernel(X);
212 |
213 | omp_set_num_threads(cores);
214 | #pragma omp parallel for schedule(dynamic)
215 | for(i=0; i(n); b.col(1) = trans(X.row(i));
226 | mat btb_inv = inv(b.t()*b);
227 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
228 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
229 | mat Cc = C-b*btb_inv*(b.t()*C)-(C*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(C*b))*btb_inv*b.t();
230 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
231 |
232 | //Compute the quantities q and S
233 | vec q = zeros(4); //Create k-vector q to save
234 | mat S = zeros(4,4); //Create kxk-matrix S to save
235 |
236 | q(0) = as_scalar(yc.t()*Gc*yc);
237 | q(1) = as_scalar(yc.t()*Kc*yc);
238 | q(2) = as_scalar(yc.t()*Cc*yc);
239 | q(3) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
240 |
241 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
242 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
243 | S(0,2) = as_scalar(accu(Gc.t()%Cc));
244 | S(0,3) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
245 |
246 | S(1,0) = S(0,1);
247 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
248 | S(1,2) = as_scalar(accu(Kc.t()%Cc));
249 | S(1,3) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
250 |
251 | S(2,0) = S(0,2);
252 | S(2,1) = S(1,2);
253 | S(2,2) = as_scalar(accu(Cc.t()%Cc));
254 | S(2,3) = as_scalar(accu(Cc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
255 |
256 | S(3,0) = S(0,3);
257 | S(3,1) = S(1,3);
258 | S(3,2) = S(2,3);
259 | S(3,3) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
260 |
261 | //Compute delta and Sinv
262 | mat Sinv = inv(S);
263 | vec delta = Sinv*q;
264 |
265 | //Compute var(delta(0))
266 | double V_sigma = as_scalar(2*yc.t()*trans(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*(delta(0)*Gc+delta(1)*Kc+delta(2)*Cc+delta(3)*(eye(n,n)-(b*btb_inv)*b.t()))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*yc);
267 |
268 | //Save point estimates and SE of the epistasis component
269 | sigma_est(i) = delta(0);
270 | sigma_se(i) = sqrt(V_sigma);
271 |
272 | //Compute the PVE
273 | pve(i) = delta(0)/accu(delta);
274 | }
275 |
276 | //Compute the p-values for each estimate
277 | NumericVector sigma_pval = 2*Rcpp::pnorm(abs(sigma_est/sigma_se),0.0,1.0,0,0); //H0: sigma = 0 vs. H1: sigma != 0
278 |
279 | //Return a list of the arguments
280 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("SE") = sigma_se,Rcpp::Named("pvalues") = sigma_pval,Rcpp::Named("PVE") = pve);
281 | }
282 |
283 | ////////////////////////////////////////////////////////////////////////////
284 |
285 | // Model 4: Standard + Covariate + Common Environment Model ---> y = Wa+m+g+c+e
286 |
287 | // [[Rcpp::export]]
288 | List MAPIT4_Normal(mat X,vec y,mat Z,mat C,int cores = 1){
289 | int i;
290 | const int n = X.n_cols;
291 | const int p = X.n_rows;
292 | const int q = Z.n_rows;
293 |
294 | //Set up the vectors to save the outputs
295 | NumericVector sigma_est(p);
296 | NumericVector sigma_se(p);
297 | NumericVector pve(p);
298 |
299 | //Pre-compute the Linear GSM
300 | mat GSM = GetLinearKernel(X);
301 |
302 | omp_set_num_threads(cores);
303 | #pragma omp parallel for schedule(dynamic)
304 | for(i=0; i(n); b.cols(1,q) = Z.t(); b.col(q+1) = trans(X.row(i));
315 | mat btb_inv = inv(b.t()*b);
316 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
317 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
318 | mat Cc = C-b*btb_inv*(b.t()*C)-(C*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(C*b))*btb_inv*b.t();
319 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
320 |
321 | //Compute the quantities q and S
322 | vec q = zeros(4); //Create k-vector q to save
323 | mat S = zeros(4,4); //Create kxk-matrix S to save
324 |
325 | q(0) = as_scalar(yc.t()*Gc*yc);
326 | q(1) = as_scalar(yc.t()*Kc*yc);
327 | q(2) = as_scalar(yc.t()*Cc*yc);
328 | q(3) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
329 |
330 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
331 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
332 | S(0,2) = as_scalar(accu(Gc.t()%Cc));
333 | S(0,3) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
334 |
335 | S(1,0) = S(0,1);
336 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
337 | S(1,2) = as_scalar(accu(Kc.t()%Cc));
338 | S(1,3) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
339 |
340 | S(2,0) = S(0,2);
341 | S(2,1) = S(1,2);
342 | S(2,2) = as_scalar(accu(Cc.t()%Cc));
343 | S(2,3) = as_scalar(accu(Cc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
344 |
345 | S(3,0) = S(0,3);
346 | S(3,1) = S(1,3);
347 | S(3,2) = S(2,3);
348 | S(3,3) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
349 |
350 | //Compute delta and Sinv
351 | mat Sinv = inv(S);
352 | vec delta = Sinv*q;
353 |
354 | //Compute var(delta(0))
355 | double V_sigma = as_scalar(2*yc.t()*trans(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*(delta(0)*Gc+delta(1)*Kc+delta(2)*Cc+delta(3)*(eye(n,n)-(b*btb_inv)*b.t()))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*yc);
356 |
357 | //Save point estimates and SE of the epistasis component
358 | sigma_est(i) = delta(0);
359 | sigma_se(i) = sqrt(V_sigma);
360 |
361 | //Compute the PVE
362 | pve(i) = delta(0)/accu(delta);
363 | }
364 |
365 | //Compute the p-values for each estimate
366 | NumericVector sigma_pval = 2*Rcpp::pnorm(abs(sigma_est/sigma_se),0.0,1.0,0,0); //H0: sigma = 0 vs. H1: sigma != 0
367 |
368 | //Return a list of the arguments
369 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("SE") = sigma_se,Rcpp::Named("pvalues") = sigma_pval,Rcpp::Named("PVE") = pve);
370 | }
371 |
372 | ////////////////////////////////////////////////////////////////////////////
373 | ////////////////////////////////////////////////////////////////////////////
374 | ////////////////////////////////////////////////////////////////////////////
375 | ////////////////////////////////////////////////////////////////////////////
376 |
377 | //Here is MAPIT using the Davies Method for hypothesis testing
378 |
379 | ////////////////////////////////////////////////////////////////////////////
380 | ////////////////////////////////////////////////////////////////////////////
381 | ////////////////////////////////////////////////////////////////////////////
382 | ////////////////////////////////////////////////////////////////////////////
383 |
384 | // Model 1: Standard Model ---> y = m+g+e
385 |
386 | // [[Rcpp::export]]
387 | List MAPIT1_Davies(mat X,vec y,const vec ind,int cores = 1){
388 | int i;
389 | const int n = X.n_cols;
390 | const int p = X.n_rows;
391 |
392 | //Set up the vectors to save the outputs
393 | NumericVector sigma_est(p);
394 | NumericVector pve(p);
395 | mat Lambda(n,p);
396 |
397 | //Pre-compute the Linear GSM
398 | mat GSM = GetLinearKernel(X);
399 |
400 | omp_set_num_threads(cores);
401 | #pragma omp parallel for schedule(dynamic)
402 | for(i=0; i(n); b.col(1) = trans(X.row(i));
415 | mat btb_inv = inv(b.t()*b);
416 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
417 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t(); //Scale Kn = MKnM^t
418 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
419 |
420 | //Compute the quantities q and S
421 | vec q = zeros(3); //Create k-vector q to save
422 | mat S = zeros(3,3); //Create kxk-matrix S to save
423 |
424 | q(0) = as_scalar(yc.t()*Gc*yc);
425 | q(1) = as_scalar(yc.t()*Kc*yc);
426 | q(2) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
427 |
428 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
429 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
430 | S(0,2) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
431 |
432 | S(1,0) = S(0,1);
433 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
434 | S(1,2) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
435 |
436 | S(2,0) = S(0,2);
437 | S(2,1) = S(1,2);
438 | S(2,2) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
439 |
440 | //Compute delta and Sinv
441 | mat Sinv = inv(S);
442 | vec delta = Sinv*q;
443 |
444 | //Record omega^2, nu^2, and tau^2 under the null hypothesis
445 | vec q_sub = zeros(2);
446 | mat S_sub = zeros(2,2);
447 |
448 | q_sub(0)=q(1);
449 | q_sub(1)=q(2);
450 |
451 | S_sub(0,0)=S(1,1);
452 | S_sub(0,1)=S(1,2);
453 |
454 | S_sub(1,0)=S(2,1);
455 | S_sub(1,1)=S(2,2);
456 |
457 | //Save point estimates and SE of the epistasis component
458 | sigma_est(i) = delta(0);
459 |
460 | //Compute P and P^{1/2} matrix
461 | vec delta_null = inv(S_sub)*q_sub;
462 |
463 | vec eigval;
464 | mat eigvec;
465 |
466 | eig_sym(eigval,eigvec,delta_null(0)*Kc+delta_null(1)*(eye(n,n)-(b*btb_inv)*b.t()));
467 |
468 | //Find the eigenvalues of the projection matrix
469 | vec evals;
470 |
471 | eig_sym(evals, (eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0))))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*(eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0)))));
472 | Lambda.col(i) = evals;
473 |
474 | //Compute the PVE
475 | pve(i) = delta(0)/accu(delta);
476 | }
477 | }
478 |
479 | //Return a list of the arguments
480 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("Eigenvalues") = Lambda,Rcpp::Named("PVE") = pve);
481 | }
482 |
483 | ////////////////////////////////////////////////////////////////////////////
484 |
485 | // Model 2: Standard + Covariate Model ---> y = Wa+m+g+e
486 |
487 | // [[Rcpp::export]]
488 | List MAPIT2_Davies(mat X,vec y,mat Z,const vec ind,int cores = 1){
489 | int i;
490 | const int n = X.n_cols;
491 | const int p = X.n_rows;
492 | const int q = Z.n_rows;
493 |
494 | //Set up the vectors to save the outputs
495 | NumericVector sigma_est(p);
496 | NumericVector pve(p);
497 | mat Lambda(n,p);
498 |
499 | //Pre-compute the Linear GSM
500 | mat GSM = GetLinearKernel(X);
501 |
502 | omp_set_num_threads(cores);
503 | #pragma omp parallel for schedule(dynamic)
504 | for(i=0; i(n); b.cols(1,q) = Z.t(); b.col(q+1) = trans(X.row(i));
517 | mat btb_inv = inv(b.t()*b);
518 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
519 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t(); //Scale Kn = MKnM^t
520 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
521 |
522 | //Compute the quantities q and S
523 | vec q = zeros(3); //Create k-vector q to save
524 | mat S = zeros(3,3); //Create kxk-matrix S to save
525 |
526 | q(0) = as_scalar(yc.t()*Gc*yc);
527 | q(1) = as_scalar(yc.t()*Kc*yc);
528 | q(2) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
529 |
530 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
531 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
532 | S(0,2) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
533 |
534 | S(1,0) = S(0,1);
535 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
536 | S(1,2) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
537 |
538 | S(2,0) = S(0,2);
539 | S(2,1) = S(1,2);
540 | S(2,2) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
541 |
542 | //Compute delta and Sinv
543 | mat Sinv = inv(S);
544 | vec delta = Sinv*q;
545 |
546 | //Record omega^2, nu^2, and tau^2 under the null hypothesis
547 | vec q_sub = zeros(2);
548 | mat S_sub = zeros(2,2);
549 |
550 | q_sub(0)=q(1);
551 | q_sub(1)=q(2);
552 |
553 | S_sub(0,0)=S(1,1);
554 | S_sub(0,1)=S(1,2);
555 |
556 | S_sub(1,0)=S(2,1);
557 | S_sub(1,1)=S(2,2);
558 |
559 | //Save point estimates and SE of the epistasis component
560 | sigma_est(i) = delta(0);
561 |
562 | //Compute P and P^{1/2} matrix
563 | vec delta_null = inv(S_sub)*q_sub;
564 |
565 | vec eigval;
566 | mat eigvec;
567 |
568 | eig_sym(eigval,eigvec,delta_null(0)*Kc+delta_null(1)*(eye(n,n)-(b*btb_inv)*b.t()));
569 |
570 | //Find the eigenvalues of the projection matrix
571 | vec evals;
572 |
573 | eig_sym(evals, (eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0))))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*(eye(n,n)-(b*btb_inv)*b.t()))*(eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0)))));
574 | Lambda.col(i) = evals;
575 |
576 | //Compute the PVE
577 | pve(i) = delta(0)/accu(delta);
578 | }
579 | }
580 |
581 | //Return a list of the arguments
582 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("Eigenvalues") = Lambda,Rcpp::Named("PVE") = pve);
583 | }
584 |
585 | ////////////////////////////////////////////////////////////////////////////
586 |
587 | // Model 3: Standard + Common Environment Model ---> y = m+g+c+e
588 |
589 | // [[Rcpp::export]]
590 | List MAPIT3_Davies(mat X,vec y,mat C,const vec ind,int cores = 1){
591 | int i;
592 | const int n = X.n_cols;
593 | const int p = X.n_rows;
594 |
595 | //Set up the vectors to save the outputs
596 | NumericVector sigma_est(p);
597 | NumericVector pve(p);
598 | mat Lambda(n,p);
599 |
600 | //Pre-compute the Linear GSM
601 | mat GSM = GetLinearKernel(X);
602 |
603 | omp_set_num_threads(cores);
604 | #pragma omp parallel for schedule(dynamic)
605 | for(i=0; i(n); b.col(1) = trans(X.row(i));
618 | mat btb_inv = inv(b.t()*b);
619 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
620 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
621 | mat Cc = C-b*btb_inv*(b.t()*C)-(C*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(C*b))*btb_inv*b.t();
622 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
623 |
624 | //Compute the quantities q and S
625 | vec q = zeros(4); //Create k-vector q to save
626 | mat S = zeros(4,4); //Create kxk-matrix S to save
627 |
628 | q(0) = as_scalar(yc.t()*Gc*yc);
629 | q(1) = as_scalar(yc.t()*Kc*yc);
630 | q(2) = as_scalar(yc.t()*Cc*yc);
631 | q(3) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
632 |
633 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
634 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
635 | S(0,2) = as_scalar(accu(Gc.t()%Cc));
636 | S(0,3) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
637 |
638 | S(1,0) = S(0,1);
639 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
640 | S(1,2) = as_scalar(accu(Kc.t()%Cc));
641 | S(1,3) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
642 |
643 | S(2,0) = S(0,2);
644 | S(2,1) = S(1,2);
645 | S(2,2) = as_scalar(accu(Cc.t()%Cc));
646 | S(2,3) = as_scalar(accu(Cc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
647 |
648 | S(3,0) = S(0,3);
649 | S(3,1) = S(1,3);
650 | S(3,2) = S(2,3);
651 | S(3,3) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
652 |
653 | //Compute delta and Sinv
654 | mat Sinv = inv(S);
655 | vec delta = Sinv*q;
656 |
657 | //Record omega^2, nu^2, and tau^2 under the null hypothesis
658 | vec q_sub = zeros(3);
659 | mat S_sub = zeros(3,3);
660 |
661 | q_sub(0)=q(1);
662 | q_sub(1)=q(2);
663 | q_sub(2)=q(3);
664 |
665 | S_sub(0,0)=S(1,1);
666 | S_sub(0,1)=S(1,2);
667 | S_sub(0,2)=S(1,3);
668 |
669 | S_sub(1,0)=S(2,1);
670 | S_sub(1,1)=S(2,2);
671 | S_sub(1,2)=S(2,3);
672 |
673 | S_sub(2,0)=S(3,1);
674 | S_sub(2,1)=S(3,2);
675 | S_sub(2,2)=S(3,3);
676 |
677 | //Save point estimates and SE of the epistasis component
678 | sigma_est(i) = delta(0);
679 |
680 | //Compute P and P^{1/2} matrix
681 | vec delta_null = inv(S_sub)*q_sub;
682 |
683 | vec eigval;
684 | mat eigvec;
685 |
686 | eig_sym(eigval,eigvec,delta_null(0)*Kc+delta_null(1)*Cc+delta_null(2)*(eye(n,n)-(b*btb_inv)*b.t()));
687 |
688 | //Find the eigenvalues of the projection matrix
689 | vec evals;
690 |
691 | eig_sym(evals, (eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0))))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*(eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0)))));
692 | Lambda.col(i) = evals;
693 |
694 | //Compute the PVE
695 | pve(i) = delta(0)/accu(delta);
696 | }
697 | }
698 |
699 | //Return a list of the arguments
700 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("Eigenvalues") = Lambda,Rcpp::Named("PVE") = pve);
701 | }
702 |
703 | ////////////////////////////////////////////////////////////////////////////
704 |
705 | // Model 4: Standard + Common Environment Model ---> y = Wa+m+g+c+e
706 |
707 | // [[Rcpp::export]]
708 | List MAPIT4_Davies(mat X,vec y,mat Z,mat C,const vec ind,int cores = 1){
709 | int i;
710 | const int n = X.n_cols;
711 | const int p = X.n_rows;
712 | const int q = Z.n_rows;
713 |
714 | //Set up the vectors to save the outputs
715 | NumericVector sigma_est(p);
716 | NumericVector pve(p);
717 | mat Lambda(n,p);
718 |
719 | //Pre-compute the Linear GSM
720 | mat GSM = GetLinearKernel(X);
721 |
722 | omp_set_num_threads(cores);
723 | #pragma omp parallel for schedule(dynamic)
724 | for(i=0; i(n); b.cols(1,q) = Z.t(); b.col(q+1) = trans(X.row(i));
737 | mat btb_inv = inv(b.t()*b);
738 | mat Kc = K-b*btb_inv*(b.t()*K)-(K*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(K*b))*btb_inv*b.t();
739 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t();
740 | mat Cc = C-b*btb_inv*(b.t()*C)-(C*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(C*b))*btb_inv*b.t();
741 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
742 |
743 | //Compute the quantities q and S
744 | vec q = zeros(4); //Create k-vector q to save
745 | mat S = zeros(4,4); //Create kxk-matrix S to save
746 |
747 | q(0) = as_scalar(yc.t()*Gc*yc);
748 | q(1) = as_scalar(yc.t()*Kc*yc);
749 | q(2) = as_scalar(yc.t()*Cc*yc);
750 | q(3) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
751 |
752 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
753 | S(0,1) = as_scalar(accu(Gc.t()%Kc));
754 | S(0,2) = as_scalar(accu(Gc.t()%Cc));
755 | S(0,3) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
756 |
757 | S(1,0) = S(0,1);
758 | S(1,1) = as_scalar(accu(Kc.t()%Kc));
759 | S(1,2) = as_scalar(accu(Kc.t()%Cc));
760 | S(1,3) = as_scalar(accu(Kc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
761 |
762 | S(2,0) = S(0,2);
763 | S(2,1) = S(1,2);
764 | S(2,2) = as_scalar(accu(Cc.t()%Cc));
765 | S(2,3) = as_scalar(accu(Cc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
766 |
767 | S(3,0) = S(0,3);
768 | S(3,1) = S(1,3);
769 | S(3,2) = S(2,3);
770 | S(3,3) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
771 |
772 | //Compute delta and Sinv
773 | mat Sinv = inv(S);
774 | vec delta = Sinv*q;
775 |
776 | //Record omega^2, nu^2, and tau^2 under the null hypothesis
777 | vec q_sub = zeros(3);
778 | mat S_sub = zeros(3,3);
779 |
780 | q_sub(0)=q(1);
781 | q_sub(1)=q(2);
782 | q_sub(2)=q(3);
783 |
784 | S_sub(0,0)=S(1,1);
785 | S_sub(0,1)=S(1,2);
786 | S_sub(0,2)=S(1,3);
787 |
788 | S_sub(1,0)=S(2,1);
789 | S_sub(1,1)=S(2,2);
790 | S_sub(1,2)=S(2,3);
791 |
792 | S_sub(2,0)=S(3,1);
793 | S_sub(2,1)=S(3,2);
794 | S_sub(2,2)=S(3,3);
795 |
796 | //Save point estimates and SE of the epistasis component
797 | sigma_est(i) = delta(0);
798 |
799 | //Compute P and P^{1/2} matrix
800 | vec delta_null = inv(S_sub)*q_sub;
801 |
802 | vec eigval;
803 | mat eigvec;
804 |
805 | eig_sym(eigval,eigvec,delta_null(0)*Kc+delta_null(1)*Cc+delta_null(2)*(eye(n,n)-(b*btb_inv)*b.t()));
806 |
807 | //Find the eigenvalues of the projection matrix
808 | vec evals;
809 |
810 | eig_sym(evals, (eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0))))*(Sinv(0,0)*Gc+Sinv(0,1)*Kc+Sinv(0,2)*Cc+Sinv(0,3)*(eye(n,n)-(b*btb_inv)*b.t()))*(eigvec.cols(find(eigval>0))*diagmat(sqrt(eigval(find(eigval>0))))*trans(eigvec.cols(find(eigval>0)))));
811 | Lambda.col(i) = evals;
812 |
813 | //Compute the PVE
814 | pve(i) = delta(0)/accu(delta);
815 | }
816 | }
817 |
818 | //Return a list of the arguments
819 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("Eigenvalues") = Lambda,Rcpp::Named("PVE") = pve);
820 | }
821 |
822 | ////////////////////////////////////////////////////////////////////////////////
823 | ////////////////////////////////////////////////////////////////////////////////
824 | ////////////////////////////////////////////////////////////////////////////////
825 | ////////////////////////////////////////////////////////////////////////////////
826 |
827 | //Here is MAPIT using the Davies Method for the hypothesis testing of every SNP
828 |
829 | ////////////////////////////////////////////////////////////////////////////////
830 | ///////////////////////////////////////////////////////////////////////////////
831 | //////////////////////////////////////////////////////////////////////////////
832 | /////////////////////////////////////////////////////////////////////////////
833 |
834 | // [[Rcpp::export]]
835 | List MAPIT_Davies_Approx(mat X,vec y,int cores = 1){
836 | int i;
837 | const int n = X.n_cols;
838 | const int p = X.n_rows;
839 |
840 | //Set up the vectors to save the outputs
841 | NumericVector sigma_est(p);
842 | NumericVector pve(p);
843 | mat Lambda(n,p);
844 |
845 | //Pre-compute the Linear GSM
846 | mat GSM = GetLinearKernel(X);
847 |
848 | omp_set_num_threads(cores);
849 | #pragma omp parallel for schedule(dynamic)
850 | for(i=0; i(n); b.col(1) = trans(X.row(i));
860 | mat btb_inv = inv(b.t()*b);
861 | mat Gc = G-b*btb_inv*(b.t()*G)-(G*b)*btb_inv*b.t()+b*btb_inv*(b.t()*(G*b))*btb_inv*b.t(); //Scale Kn = MKnM^t
862 | vec yc = (eye(n,n)-(b*btb_inv)*b.t())*y;
863 |
864 | //Compute the quantities q and S
865 | vec q = zeros(2); //Create k-vector q to save
866 | mat S = zeros(2,2); //Create kxk-matrix S to save
867 |
868 | q(0) = as_scalar(yc.t()*Gc*yc);
869 | q(1) = as_scalar(yc.t()*(eye(n,n)-(b*btb_inv)*b.t())*yc);
870 |
871 | S(0,0) = as_scalar(accu(Gc.t()%Gc));
872 | S(0,1) = as_scalar(accu(Gc.t()%(eye(n,n)-(b*btb_inv)*b.t())));
873 | S(1,0) = S(0,1);
874 | S(1,1) = as_scalar(accu(trans(eye(n,n)-(b*btb_inv)*b.t())%(eye(n,n)-(b*btb_inv)*b.t())));
875 |
876 | //Compute delta and Sinv
877 | mat Sinv = inv(S);
878 | vec delta = Sinv*q;
879 |
880 | //Save point estimates and SE of the epistasis component
881 | sigma_est(i) = delta(0);
882 |
883 | //Find the eigenvalues of the projection matrix
884 | vec evals;
885 | eig_sym(evals,(Sinv(0,0)*Gc+Sinv(0,1)*(eye(n,n)-(b*btb_inv)*b.t()))*q(1)/S(1,1));
886 | Lambda.col(i) = evals;
887 |
888 | //Compute the PVE
889 | pve(i) = delta(0)/accu(delta);
890 | }
891 |
892 | //Return a list of the arguments
893 | return Rcpp::List::create(Rcpp::Named("Est") = sigma_est, Rcpp::Named("Eigenvalues") = Lambda,Rcpp::Named("PVE") = pve);
894 | }
895 |
--------------------------------------------------------------------------------