[Genabel-commits] r1992 - in pkg/MultiABEL: R src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 3 23:46:27 CEST 2015
Author: shenxia
Date: 2015-06-03 23:46:27 +0200 (Wed, 03 Jun 2015)
New Revision: 1992
Added:
pkg/MultiABEL/src/MultiSummaryLoopInbred.f90
pkg/MultiABEL/src/MultiSummaryLoopPrecise.f90
Modified:
pkg/MultiABEL/R/MultiSummary.R
pkg/MultiABEL/src/symbols.rds
Log:
Options for analyzing inbred populations included for MultiSummary() procedure.
Modified: pkg/MultiABEL/R/MultiSummary.R
===================================================================
--- pkg/MultiABEL/R/MultiSummary.R 2015-06-03 21:27:00 UTC (rev 1991)
+++ pkg/MultiABEL/R/MultiSummary.R 2015-06-03 21:46:27 UTC (rev 1992)
@@ -79,7 +79,7 @@
pil = numeric(k), fstat = numeric(k), PACKAGE = "MultiABEL")
} else if (type == 'precise' & !is.null(vars)) {
scan <- .Fortran('MultiSummaryLoopPrecise', k = as.integer(k), m = as.integer(m), nn = n,
- f = f, betamat = betamat, R = x$cor.pheno, invR = solve(x$cor.pheno),
+ betamat = betamat, R = x$cor.pheno, invR = solve(x$cor.pheno),
E0 = diag(m), H = diag(m), coef = betamat,
pil = numeric(k), fstat = numeric(k), vg = vars, PACKAGE = "MultiABEL")
} else {
Added: pkg/MultiABEL/src/MultiSummaryLoopInbred.f90
===================================================================
--- pkg/MultiABEL/src/MultiSummaryLoopInbred.f90 (rev 0)
+++ pkg/MultiABEL/src/MultiSummaryLoopInbred.f90 2015-06-03 21:46:27 UTC (rev 1992)
@@ -0,0 +1,38 @@
+!
+! MultiSummaryLoop.f90
+!
+! Created by Xia Shen on 5/29/15.
+!
+
+subroutine MultiSummaryLoopInbred(k, m, nn, f, betamat, R, invR, E0, H, coef, pil, fstat)
+
+ implicit none
+ integer :: i, j, k, m
+ double precision, dimension(m, m) :: R, invR, E0, H, HinvE0
+ double precision, dimension(1, m) :: beta
+ double precision, dimension(m, 1) :: tmp
+ double precision, dimension(k) :: nn, f, pil, fstat
+ double precision, dimension(k, m) :: betamat, coef
+ double precision, dimension(m) :: lambda
+ double precision :: vg
+ do j = 1, k
+ vg = f(j)*(1 - f(j))
+ E0 = nn(j)*R
+ do i = 1, m
+ beta(1,i) = betamat(j,i)
+ end do
+ tmp = matmul(invR, transpose(beta))*vg
+ do i = 1, m
+ coef(j,i) = tmp(i,1)
+ end do
+ H = matmul(transpose(beta), beta)*nn(j)*vg
+ HinvE0 = matmul(H, invR)/nn(j)
+ do i = 1, m
+ lambda(i) = HinvE0(i,i)
+ end do
+ pil(j) = sum(lambda)
+ fstat(j) = pil(j)/m/(1 - pil(j))*(nn(j) - m - 1)
+ end do
+
+end subroutine MultiSummaryLoopInbred
+
Property changes on: pkg/MultiABEL/src/MultiSummaryLoopInbred.f90
___________________________________________________________________
Added: svn:executable
+ *
Added: pkg/MultiABEL/src/MultiSummaryLoopPrecise.f90
===================================================================
--- pkg/MultiABEL/src/MultiSummaryLoopPrecise.f90 (rev 0)
+++ pkg/MultiABEL/src/MultiSummaryLoopPrecise.f90 2015-06-03 21:46:27 UTC (rev 1992)
@@ -0,0 +1,37 @@
+!
+! MultiSummaryLoop.f90
+!
+! Created by Xia Shen on 5/29/15.
+!
+
+subroutine MultiSummaryLoopPrecise(k, m, nn, betamat, R, invR, E0, H, coef, pil, fstat, vg)
+
+ implicit none
+ integer :: i, j, k, m
+ double precision, dimension(m, m) :: R, invR, E0, H, HinvE0
+ double precision, dimension(1, m) :: beta
+ double precision, dimension(m, 1) :: tmp
+ double precision, dimension(k) :: nn, pil, fstat
+ double precision, dimension(k, m) :: betamat, coef
+ double precision, dimension(m) :: lambda
+ double precision :: vg
+ do j = 1, k
+ E0 = nn(j)*R
+ do i = 1, m
+ beta(1,i) = betamat(j,i)
+ end do
+ tmp = matmul(invR, transpose(beta))*vg
+ do i = 1, m
+ coef(j,i) = tmp(i,1)
+ end do
+ H = matmul(transpose(beta), beta)*nn(j)*vg
+ HinvE0 = matmul(H, invR)/nn(j)
+ do i = 1, m
+ lambda(i) = HinvE0(i,i)
+ end do
+ pil(j) = sum(lambda)
+ fstat(j) = pil(j)/m/(1 - pil(j))*(nn(j) - m - 1)
+ end do
+
+end subroutine MultiSummaryLoopPrecise
+
Property changes on: pkg/MultiABEL/src/MultiSummaryLoopPrecise.f90
___________________________________________________________________
Added: svn:executable
+ *
Modified: pkg/MultiABEL/src/symbols.rds
===================================================================
(Binary files differ)
More information about the Genabel-commits
mailing list